VB and VBA Users Source Code: Shell and wait for a process to finish
[
Home
|
Contents
|
Search
|
Reply
| Previous |
Next
]
VB/VBA Source Code
Shell and wait for a process to finish
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Saturday, October 28, 2000
Hits:
2842
Category:
Windows API
Article:
One of the limitation of using the Shell function is that it is asynchronous. Below are a couple of different methods of shelling processes and waiting until they are finished (or initialised): Option Explicit '--------------Shell API and Constants---------- Private Const WAIT_FAILED = -1& Private Const WAIT_OBJECT_0 = 0 Private Const WAIT_ABANDONED = &H80& Private Const WAIT_ABANDONED_0 = &H80& Private Const WAIT_TIMEOUT = &H102& Private Const INFINITE = &HFFFFFFFF ' Infinite timeout Private Const NORMAL_PRIORITY_CLASS = &H20 Private Const SYNCHRONIZE = &H100000 Private Const STARTF_USESHOWWINDOW = &H1 Private Const SW_HIDE As Long = 0 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 Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Private Declare Function WaitForInputIdle Lib "user32" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds 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 GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode 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 'Purpose : Shells a process synchronised i.e. Holds execution until application has closed. 'Inputs : sFilePath The path to the application or process to startup e.g. "C:\Winnt\Notepad.exe" ' [sCommandLine] Any command lines parameters to pass to the application or process. ' [lState] The Window State to run of the process. ' [lProcessFailedCode] The code to return if the call to create process fails. 'Outputs : Returns the process exit code, or lProcessFailedCode on error. 'Author : Andrew Baker 'Date : 30/05/2000 22:04 'Notes : Have noticed side effects. Other applications like Internet Explorer seem to be effected by this. Function ShellAndHold(sFilePath As String, Optional sCommandLine As String = vbNullString, Optional lState As VbAppWinStyle = vbNormalFocus, Optional lProcessFailedCode As Long = -1) As Long Dim lRetVal As Long, FileToOpen As String Dim lPID As Long, lExitCode As Long Dim tStartUp As STARTUPINFO Dim tProcInfo As PROCESS_INFORMATION 'Initialize the STARTUPINFO structure tStartUp.cb = Len(tStartUp) If lState = vbHide Then 'Hide the window tStartUp.wShowWindow = SW_HIDE tStartUp.dwFlags = STARTF_USESHOWWINDOW End If If Len(sCommandLine) > 0 Then 'Add leading space to command line sCommandLine = " " & sCommandLine End If 'Create the process lRetVal = CreateProcessA(sFilePath, sCommandLine, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, vbNullString, tStartUp, tProcInfo) 'Check if the process was created successfully If tProcInfo.hProcess = 0 Then 'Failed to start process return failed code ShellAndHold = lProcessFailedCode Else 'Wait for the application to finish lRetVal = WaitForSingleObject(tProcInfo.hProcess, INFINITE) Call GetExitCodeProcess(tProcInfo.hProcess, lExitCode) Call CloseHandle(tProcInfo.hThread) Call CloseHandle(tProcInfo.hProcess) ShellAndHold = lExitCode End If End Function 'Purpose : Holds execution until application has closed. 'Inputs : sFilePath = The path to the application to run e.g. "Notepad.exe" ' [sCommandLine] = Any command line arguments ' [lState] = The Window State to run of the shelled program (A Long) ' [lMaxTimeOut] = The maximum amount of time to wait for the process to finish (in secs). ' -1 = infinate ' [lProcessFailedCode] The code to return if the call to create process fails. 'Outputs : Returns the process exit code, or lProcessFailedCode on error. 'Author : Andrew Baker 'Date : 30/05/2000 22:04 'Notes : Similiar to ShellAndHold, but will not get any 'spiking' effects using this method. Function ShellAndWait(sFilePath As String, Optional sCommandLine, Optional lState As VbAppWinStyle = vbNormalFocus, Optional lMaxTimeOut As Long = -1, Optional lProcessFailedCode As Long = -1) As Long Dim lRetVal As Long, siStartTime As Single Dim lExitCode As Long Dim tStartUp As STARTUPINFO Dim tProcInfo As PROCESS_INFORMATION 'Initialize the STARTUPINFO structure tStartUp.cb = Len(tStartUp) If lState = vbHide Then 'Hide the window tStartUp.wShowWindow = SW_HIDE tStartUp.dwFlags = STARTF_USESHOWWINDOW End If If Len(sCommandLine) > 0 Then 'Add leading space to command line sCommandLine = " " & sCommandLine End If 'Create the process lRetVal = CreateProcessA(sFilePath, sCommandLine, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, vbNullString, tStartUp, tProcInfo) 'Check if the process was created successfully If tProcInfo.hProcess = 0 Then 'Failed to start process return failed code ShellAndHold = lProcessFailedCode Exit Function End If siStartTime = Timer Do 'Wait for the application to finish lRetVal = WaitForSingleObject(tProcInfo.hProcess, 0) If lRetVal = WAIT_OBJECT_0 Then 'Finished process 'Get exit process code Call GetExitCodeProcess(tProcInfo.hProcess, lExitCode) 'Return exit code ShellAndWait = lExitCode 'Clean up lRetVal = CloseHandle(tProcInfo.hProcess) Exit Do ElseIf lRetVal = WAIT_FAILED Then 'Failed to open process ShellAndWait = lProcessFailedCode Exit Do End If 'Send thread to sleep Sleep 200 DoEvents If lMaxTimeOut > 0 Then 'Check timeout has not been exceeded If siStartTime + lMaxTimeOut < Timer Then 'Failed, timeout exceeded ShellAndWait = lProcessFailedCode End If End If Loop Call CloseHandle(tProcInfo.hThread) Call CloseHandle(tProcInfo.hProcess) End Function 'Purpose : Holds execution until application has finished opening 'Inputs : sCommandLine = The Command line to run the application e.g. "Notepad.exe" ' lState = The Window State to run of the shelled program (A Long) 'Outputs : Returns the Process Handle 'Author : Andrew Baker 'Date : 30/05/2000 22:04 'Notes : Use this when you want to wait for an application to finishing opening before proceeding ' The side effects mentioned in ShellAndHold will be negligible since the most applications ' load in under 5 seconds. Function ShellAndWaitReady(sCommandLine As String, Optional lState As VbAppWinStyle = vbNormalFocus) As Long Dim lhProc As Long lhProc = Shell(sCommandLine, lState) 'Wait for the process to initialize Call WaitForInputIdle(lhProc, INFINITE) 'Return the handle ShellAndWaitReady = lhProc End Function
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
