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

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函数,它阻止应用程序进程的执行,直到指定的进程完成(或超时).它是Windows API的一部分,在向代码添加适当的声明后,可以从VB 6应用程序轻松调用.

该声明看起来像这样:

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

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

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

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:确定Shelled App已结束的时间.
   _{我希望能够在这里重现代码以帮助避免链接腐烂(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将被隐藏