windows 如何在 VB6 中执行更多代码之前等待 shell 进程完成

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/5685972/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-09 08:17:41  来源:igfitidea点击:

How to wait for a shell process to finish before executing further code in VB6

windowswinapivb6processwaitforsingleobject

提问by anubhav

I have a small VB6 app in which I use the Shellcommand to execute a program. I am storing the output of the program in a file. I am then reading this file and putting the output on the screen using a msgbox in VB6.

我有一个小的 VB6 应用程序,我在其中使用Shell命令来执行程序。我将程序的输出存储在一个文件中。然后我正在读取这个文件并使用 VB6 中的 msgbox 将输出放在屏幕上。

This is what my code looks like now:

这就是我的代码现在的样子:

sCommand = "\evaluate.exe<test.txt "
Shell ("cmd.exe /c" & App.Path & sCommand)

MsgBox Text2String(App.Path & "\experiments\" & genname & "\freq")

The problem is that the output which the VB program is printing using the msgbox is the old state of the file. Is there some way to hold the execution of the VB code until my shell command program finishes so that I get the correct state of the output file and not a previous state?

问题是 VB 程序使用 msgbox 打印的输出是文件的旧状态。是否有某种方法可以在我的 shell 命令程序完成之前保持 VB 代码的执行,以便我获得输出文件的正确状态而不是以前的状态?

回答by Cody Gray

The secret sauce needed to do this is the WaitForSingleObjectfunction, which blocks execution of your application's process until the specified process completes (or times out). It's part of the Windows API, easily called from a VB 6 application after adding the appropriate declaration to your code.

执行此操作所需的秘诀是WaitForSingleObject函数,它会阻止应用程序进程的执行,直到指定的进程完成(或超时)。它是 Windows API 的一部分,在向代码中添加适当的声明后,可以轻松地从 VB 6 应用程序调用。

That declaration would look something like this:

该声明将如下所示:

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle _
                            As Long, ByVal dwMilliseconds As Long) As Long

It takes two parameters: a handle to the process that you want to wait on, and the time-out interval (in milliseconds) that indicates the maximum amount of time that you want to wait. If you do not specify a time-out interval (a value of zero), the function does not wait and returns immediately. If you specify an infinite time-out interval, the function returns onlywhen the process signals that it has completed.

它需要两个参数:要等待的进程的句柄,以及指示要等待的最长时间的超时间隔(以毫秒为单位)。如果未指定超时间隔(值为零),则该函数不会等待并立即返回。如果您指定无限超时间隔,则该函数在进程发出已完成信号时返回。

Armed with that knowledge, the only task that remains is figuring out how to get a handle to the process that you started. That turns out to be pretty simple, and can be accomplished a number of different ways:

有了这些知识,剩下的唯一任务就是弄清楚如何处理您开始的流程。事实证明这非常简单,并且可以通过多种不同的方式完成:

  1. One possibility (and the way I'd do it) is by using the ShellExecuteExfunction, also from the Windows API, as a drop-in replacement for the Shellfunction that is built into VB 6. This version is far more versatile and powerful, yet just as easily called using the appropriate declaration.

    It returns a handle to the process that it creates. All you have to do is pass that handle to the WaitForSingleObjectfunction as the hHandleparameter, and you're in business. Execution of your application will be blocked (suspended) until the process that you've called terminates.

  2. Another possibility is to use the CreateProcessfunction(once again, from the Windows API). This function creates a new process and its primary thread in the same security context as the calling process (i.e., your VB 6 application).

    Microsoft has published a knowledge base article detailing this approach that even provides a complete sample implementation. You can find that article here: How To Use a 32-Bit Application to Determine When a Shelled Process Ends.

  3. Finally, perhaps the simplest approach yet is to take advantage of the fact that the built-in Shellfunction's return value is an application task ID. This is a unique number that identifies the program you started, and it can be passed to the OpenProcessfunctionto obtain a process handle that can be passed to the WaitForSingleObjectfunction.

    However, the simplicity of this approach doescome at a cost. A very significant disadvantage is that it will cause your VB 6 application to become completely unresponsive. Because it will not be processing Windows messages, it will not respond to user interaction or even redraw the screen.

    The good folks over at VBnethave made complete sample code available in the following article: WaitForSingleObject: Determine when a Shelled App has Ended.
    I'd love to be able to reproduce the code here to help stave off link rot (VB 6 is getting up there in years now; there's no guarantee that these resources will be around forever), but the distribution license in the code itself appears to explicitly forbid that.

  1. 一种可能性(和我做的方式)是使用ShellExecuteEx功能,还从Windows API,作为一个下拉更换为Shell内置于VB 6,该版本功能更加灵活和强大,但就像使用适当的声明一样容易调用。

    它返回一个它创建的进程的句柄。您所要做的就是将该句柄WaitForSingleObject作为hHandle参数传递给函数,然后您就可以开展业务了。您的应用程序的执行将被阻止(暂停),直到您调用的进程终止。

  2. 另一种可能性是使用该CreateProcess函数(再次来自 Windows API)。此函数在与调用进程(即您的 VB 6 应用程序)相同的安全上下文中创建一个新进程及其主线程。

    Microsoft 发布了一篇详细介绍这种方法的知识库文章,其中甚至提供了完整的示例实现。您可以在此处找到该文章:如何使用 32 位应用程序确定脱壳进程何时结束

  3. 最后,也许最简单的方法是利用内置Shell函数的返回值是应用程序任务 ID这一事实。这是一个唯一的编号,用于标识您启动的程序,它可以传递给OpenProcess函数以获得可以传递给函数的进程句柄WaitForSingleObject

    但是,这种方法的简单性确实是有代价的。一个非常显着的缺点是它会导致您的 VB 6 应用程序完全没有响应。因为它不会处理 Windows 消息,所以它不会响应用户交互,甚至不会重绘屏幕。

    好乡亲在VBnet作出了下面的文章中提供完整的示例代码:WaitForSingleObject的:确定何时带壳应用程序已经结束
    我希望能够在此处重现代码以帮助避免链接腐烂(VB 6 已经在几年内出现了;不能保证这些资源将永远存在),但是代码本身中的分发许可证出现了明确禁止。

回答by Bob77

There is no need to resort to the extra effort of calling CreateProcess(), etc. This more or less duplicates the old Randy Birch code though it wasn't based on his example. There are only so many ways to skin a cat.

没有必要求助于调用 CreateProcess() 等的额外努力。这或多或少重复了旧的 Randy Birch 代码,尽管它不是基于他的示例。给猫剥皮的方法只有这么多。

Here we have a prepackaged Function for handy use, which also returns the exit code. Drop it into a static (.BAS) module or include it inline in a Form or Class.

这里我们有一个方便使用的预先打包的函数,它也返回退出代码。将其放入静态 (.BAS) 模块或将其内联包含在表单或类中。

Option Explicit

Private Const INFINITE = &HFFFFFFFF&
Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_QUERY_INFORMATION = &H400&

Private Declare Function CloseHandle Lib "kernel32" ( _
    ByVal hObject As Long) As Long

Private Declare Function GetExitCodeProcess Lib "kernel32" ( _
    ByVal hProcess As Long, _
    lpExitCode As Long) As Long

Private Declare Function OpenProcess Lib "kernel32" ( _
    ByVal dwDesiredAccess As Long, _
    ByVal bInheritHandle As Long, _
    ByVal dwProcessId As Long) As Long

Private Declare Function WaitForSingleObject Lib "kernel32" ( _
    ByVal hHandle As Long, _
    ByVal dwMilliseconds As Long) As Long

Public Function ShellSync( _
    ByVal PathName As String, _
    ByVal WindowStyle As VbAppWinStyle) As Long
    'Shell and wait.  Return exit code result, raise an
    'exception on any error.
    Dim lngPid As Long
    Dim lngHandle As Long
    Dim lngExitCode As Long

    lngPid = Shell(PathName, WindowStyle)
    If lngPid <> 0 Then
        lngHandle = OpenProcess(SYNCHRONIZE _
                             Or PROCESS_QUERY_INFORMATION, 0, lngPid)
        If lngHandle <> 0 Then
            WaitForSingleObject lngHandle, INFINITE
            If GetExitCodeProcess(lngHandle, lngExitCode) <> 0 Then
                ShellSync = lngExitCode
                CloseHandle lngHandle
            Else
                CloseHandle lngHandle
                Err.Raise &H8004AA00, "ShellSync", _
                          "Failed to retrieve exit code, error " _
                        & CStr(Err.LastDllError)
            End If
        Else
            Err.Raise &H8004AA01, "ShellSync", _
                      "Failed to open child process"
        End If
    Else
        Err.Raise &H8004AA02, "ShellSync", _
                  "Failed to Shell child process"
    End If
End Function

回答by csaba

I know it's an old thread, but...

我知道这是一个旧线程,但是...

How about using the Windows Script Host's Run method? It has a bWaitOnReturn parameter.

如何使用 Windows Script Host 的 Run 方法?它有一个 bWaitOnReturn 参数。

object.Run (strCommand, [intWindowStyle], [bWaitOnReturn])

object.Run (strCommand, [intWindowStyle], [bWaitOnReturn])

Set oShell = CreateObject("WSCript.shell")
oShell.run "cmd /C " & App.Path & sCommand, 0, True

intWindowStyle = 0, so cmd will be hidden

intWindowStyle = 0,所以 cmd 将被隐藏

回答by Rui Fernandes

Great code. Just one tiny little problem: you must declare in the ExecCmd (after Dim start As STARTUPINFO):

很棒的代码。只是一个小问题:您必须在 ExecCmd 中声明(在 Dim start As STARTUPINFO 之后):

Dim ret as Long

Dim ret as Long

You will get an error when trying to compile in VB6 if you don't. But it works great :)

如果不这样做,尝试在 VB6 中编译时会出现错误。但效果很好:)

Kind regards

亲切的问候

回答by Farzin Zaker

Do like this :

这样做:

    Private Type STARTUPINFO
      cb As Long
      lpReserved As String
      lpDesktop As String
      lpTitle As String
      dwX As Long
      dwY As Long
      dwXSize As Long
      dwYSize As Long
      dwXCountChars As Long
      dwYCountChars As Long
      dwFillAttribute As Long
      dwFlags As Long
      wShowWindow As Integer
      cbReserved2 As Integer
      lpReserved2 As Long
      hStdInput As Long
      hStdOutput As Long
      hStdError As Long
   End Type

   Private Type PROCESS_INFORMATION
      hProcess As Long
      hThread As Long
      dwProcessID As Long
      dwThreadID As Long
   End Type

   Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
      hHandle As Long, ByVal dwMilliseconds As Long) As Long

   Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
      lpApplicationName As String, ByVal lpCommandLine As String, ByVal _
      lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
      ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
      ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, _
      lpStartupInfo As STARTUPINFO, lpProcessInformation As _
      PROCESS_INFORMATION) As Long

   Private Declare Function CloseHandle Lib "kernel32" _
      (ByVal hObject As Long) As Long

   Private Declare Function GetExitCodeProcess Lib "kernel32" _
      (ByVal hProcess As Long, lpExitCode As Long) As Long

   Private Const NORMAL_PRIORITY_CLASS = &H20&
   Private Const INFINITE = -1&

   Public Function ExecCmd(cmdline$)
      Dim proc As PROCESS_INFORMATION
      Dim start As STARTUPINFO

      ' Initialize the STARTUPINFO structure:
      start.cb = Len(start)

      ' Start the shelled application:
      ret& = CreateProcessA(vbNullString, cmdline$, 0&, 0&, 1&, _
         NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)

      ' Wait for the shelled application to finish:
         ret& = WaitForSingleObject(proc.hProcess, INFINITE)
         Call GetExitCodeProcess(proc.hProcess, ret&)
         Call CloseHandle(proc.hThread)
         Call CloseHandle(proc.hProcess)
         ExecCmd = ret&
   End Function

   Sub Form_Click()
      Dim retval As Long
      retval = ExecCmd("notepad.exe")
      MsgBox "Process Finished, Exit Code " & retval
   End Sub

Reference : http://support.microsoft.com/kb/129796

参考:http: //support.microsoft.com/kb/129796

回答by Shyaku

In my hands, the csaba solution hangs with intWindowStyle = 0, and never passes control back to VB. The only way out is to end process in taskmanager.

在我手中,csaba 解决方案以 intWindowStyle = 0 挂起,并且永远不会将控制权交还给 VB。唯一的出路是在任务管理器中结束进程。

Setting intWindowStyle = 3 and closing the window manually passes control back

设置 intWindowStyle = 3 并手动关闭窗口将控制权传回

回答by Biel Gonzalez Pibernat

I've found a better & simpler solution:

我找到了一个更好更简单的解决方案:

Dim processID = Shell("C:/path/to/process.exe " + args
Dim p As Process = Process.GetProcessById(processID)
p.WaitForExit()

and then you just continue with your code. Hope it helps ;-)

然后你就继续你的代码。希望能帮助到你 ;-)