如何在VB6中执行进一步的代码之前等待shell进程完成

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

这是我的代码现在看起来像:

 sCommand = "\evaluate.exe<test.txt " Shell ("cmd.exe /c" & App.Path & sCommand) MsgBox Text2String(App.Path & "\experiments\" & genname & "\freq") 

问题是VB程序使用msgbox打印的输出是文件的旧状态。 是否有一些方法来执行VB代码,直到我的shell命令程序完成,以便我得到输出文件的正确状态,而不是以前的状态?

需要这样做的秘诀就是WaitForSingleObject函数 ,该函数阻止应用程序进程的执行,直到指定的进程完成(或超时)为止。 它是Windows API的一部分,在向你的代码添加适当的声明之后,很容易从VB 6应用程序调用。

该声明看起来像这样:

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

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

有了这些知识,唯一的任务就是搞清楚如何处理你开始的过程。 事实证明,这很简单,可以通过许多不同的方式来完成:

  1. 一种可能性(以及我这样做的方式)是通过使用ShellExecuteEx函数 (也是来自Windows API)作为嵌入到VB 6中的Shell函数的嵌入式替换。此版本功能更强大且功能更强大,但同样很容易使用适当的声明来调用。

    它返回它创建的进程的句柄。 你所要做的就是把这个句柄作为hHandle参数传递给WaitForSingleObject函数,并且你正在运行。 您的应用程序的执行将被阻止(暂停),直到您调用的进程终止。

  2. 另一种可能是使用CreateProcess函数 (再次从Windows API)。 这个函数在调用进程(即VB 6应用程序)的同一个安全上下文中创建一个新的进程和主线程。

    微软发表了一篇详细介绍这种方法的知识库文章,甚至提供了一个完整的示例实现。 您可以在这里找到这篇文章: 如何使用32位应用程序来确定外壳进程何时结束 。

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

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

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

没有必要求助于调用CreateProcess()等额外的努力,这或多或少重复旧的兰迪桦树代码,虽然它不是基于他的例子。 只有这么多的方法来剥皮猫。

这里我们有一个便于使用的预包装函数,它也返回退出代码。 将其放置到一个静态(.BAS)模块中,或者将它包含在Form或Class中。

 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 

我知道这是一个古老的线程,但…

如何使用Windows脚本宿主的运行方法? 它有一个bWaitOnReturn参数。

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

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

intWindowStyle = 0,所以cmd将被隐藏

这样做:

  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 

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

伟大的代码。 只是一个小问题:你必须在ExecCmd中声明(在Dim start STARTUPINFO之后):

Dim ret as Long

如果您不想在VB6中编译,您将会遇到错误。 但它工作的很好:)

亲切的问候

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

设置intWindowStyle = 3并手动关闭窗口将控制权交还给后者