Question

我有一个小的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命令程序完成，以便我得到输出文件的正确状态而不是以前的状态？

Answer 1

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

该声明看起来像这样：

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

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

有了这些知识，剩下的唯一任务就是弄清楚如何处理你开始的过程。事实证明这很简单，可以通过多种方式实现：

一种可能性（以及我的方式）是使用ShellExecuteEx function（也来自Windows API）作为Shell函数的替代品。内置于VB 6.这个版本功能更强大，功能更强大，但使用适当的声明也很容易调用。

它返回它创建的进程的句柄。您所要做的就是将该句柄作为WaitForSingleObject参数传递给hHandle函数，然后您就可以了。您的应用程序的执行将被阻止（暂停），直到您调用的进程终止。
另一种可能性是使用CreateProcess function（再次来自Windows API）。此函数在与调用进程（即您的VB 6应用程序）相同的安全上下文中创建新进程及其主线程。

Microsoft已发布了一篇详细介绍此方法的知识库文章，该文章甚至提供了完整的示例实现。您可以在此处找到该文章：How To Use a 32-Bit Application to Determine When a Shelled Process Ends。
最后，也许最简单的方法是利用内置Shell函数的返回值是应用程序任务ID这一事实。这是标识您启动的程序的唯一编号，可以传递给OpenProcess function以获取可以传递给WaitForSingleObject函数的进程句柄。

然而，这种方法的简单性需要付出代价。一个非常明显的缺点是它会导致你的VB 6应用程序完全没有响应。因为它不会处理Windows消息，所以它不会响应用户交互甚至重绘屏幕。

VBnet的优秀人员在以下文章中提供了完整的示例代码：WaitForSingleObject: Determine when a Shelled App has Ended。
_{我希望能够在这里重现代码以帮助避免链接腐烂（VB 6现在已经存在多年了;不能保证这些资源将永远存在），但是分发许可证在代码本身似乎明确禁止。}

Answer 2

没有必要求助于调用CreateProcess（）等额外的努力。这或多或少重复了旧的Randy Birch代码，尽管它不是基于他的例子。皮猫只有很多种方法。

这里我们有一个预先打包的功能，方便使用，它还返回退出代码。将其放入静态（.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

Answer 3

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

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

object.Run（strCommand，[intWindowStyle]，[bWaitOnReturn]）

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

intWindowStyle = 0，因此cmd将被隐藏

Answer 4

这样做：

    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

Answer 5

很棒的代码。只是一个小问题：你必须在ExecCmd中声明（在Dim start as STARTUPINFO之后）：

Dim ret为Long

如果你没有尝试在VB6中编译，你会收到错误。但它很有效：）

亲切的问候

Answer 6

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

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

Answer 7

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

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

，然后继续执行代码。希望对您有所帮助；-）

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

7 个答案: