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

I have a small VB6 app in which I use the Shell command 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.

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?

The secret sauce needed to do this is the WaitForSingleObject function, 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.

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 only when 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:

One possibility (and the way I'd do it) is by using the ShellExecuteEx function, also from the Windows API, as a drop-in replacement for the Shell function 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 WaitForSingleObject function as the hHandle parameter, and you're in business. Execution of your application will be blocked (suspended) until the process that you've called terminates.
Another possibility is to use the CreateProcess function (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.
Finally, perhaps the simplest approach yet is to take advantage of the fact that the built-in Shell function'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 OpenProcess function to obtain a process handle that can be passed to the WaitForSingleObject function.

However, the simplicity of this approach does come 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 VBnet have 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.}

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.

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.

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

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

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

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

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

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

Dim ret as Long

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

Kind regards

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.

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

来源：https://stackoverflow.com/questions/5685972/how-to-wait-for-a-shell-process-to-finish-before-executing-further-code-in-vb6

标签

windows

winapi

vb6

process

waitforsingleobject