VB Shell調用後 等待程式運行結束

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As LongPrivate Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As LongPrivate Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongConst PROCESS_QUERY_INFORMATION = &H400Const STILL_ALIVE = &H103

Private Sub Command1_Click()Dim pid As Longpid = Shell("c:/a.bat", vbNormalFocus)hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid)DoCall GetExitCodeProcess(hProcess, ExitCode)DoEventsLoop While ExitCode = STILL_ALIVECall CloseHandle(hProcess)MsgBox ("運行結束")End Sub

摘自原文如下：

-------------------------------------------------------------------------

VB啟動/結束另一程式(Shell 等待程式運行結束) VB 中，常以Shell指令來執行外部程式，然而它在Create該外部process 後，立刻 就會回到vb 的下一行程式，無法做到等待該Process結束時，才執行下一行指令， 或是說，無法得知該Process是否已結束，甚者，該Process執行到一半，又該如何 中止其執行等等，這些都不是Shell指令所能控制的，因此我們需使API的協助來完 成。 第一個問題，如何等待shell所Create的process結束後才往後執行vb的程式。 首先要知道的是，每個Process有唯一的一個ProcessID，這是OS給定的，用來 區別每個 Process，這個Process ID(PID)主要可用來取得該Process相對應的一些 資訊，然而要對該Process的控制，卻大多透過 Process Handle(hProcess)。VB Shell指令的傳回值是PID，而非hProcess，所以我們需透過OpenProcess這個API來 取得 hProcess而OpenProcess()的第一個三數，指的是所取得的hProcess所具有的 能力，像 PROCESS_QUERY_INFORMATION 便是讓GetExitCode()可取得hProcess所指 的process之狀態，而PROCESS_TERMINATE，便是讓TerminateProcess(hProcess..) 的指令能夠生效，也就是說，不同三數設定，使hProcess所具有的許可權、能力有所 不同。取得 hProcess後便可以使用WaitForSingleObject()來等待hProcess狀態的 改變，也就是說，它會等待 hProcess所指的process執行完，這個指令才結束，它 第二個三數所指的是 WaitForSingleObject()所要等待的時間(in milliseconds ) ，如果超過所指的時間，就TimeOut而結束WaitForSingleObject()的等待。若要它 無限的等下去，就設定為INFIN99vE。 pid = Shell("C:/tools/spe3/pe2.exe", vbNormalFocus) hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid) ExitEvent = WaitForSingleObject(hProcess, INFIN99vE) Call CloseHandle(hProcess) 上例會無限等待shell指令create之process結束後，才再做後面的vb指令。有 時覺得那會等太久，所以有第二個解決方式：等process結束時再通知vb 就好，即 ：設定一個公用變數(isDone)，當它變成True時代表Shell所Create的Process已結 束。當Process還在執行時，GetExitCodeProcess會傳&H103給其第二個三數，直到 結束時才傳另外的數值，如果程式正常結束，那Exitcode = 0，否則就得看它如何 結束了。或許有人在其他地方看到 loop的地方是Loop while Exitcode ＜＞ 0，那 有一點危險，如果以這程子來看，您不是用F4來離開pe2而是用右上方 X 的結束 dos window那麽，會因為ExitCode的值永遠不會是0，而進入無窮的迴圈。 Dim pid As Long pid = Shell("C:/tools/spe3/pe2.exe", vbNormalFocus) hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid) isDone = False Do Call GetExitCodeProcess(hProcess, ExitCode) Debug.Print ExitCode DoEvents Loop While ExitCode = STILL_ALIVE Call CloseHandle(hProcess) isDone = True 另外，如果您的shell所Create的程式，有視窗且為立刻Focus者，可另外用以 下的方式Dim pid As Long Dim hwnd5 As Long pid = Shell("c:/tools/spe3/pe2.exe", vbNormalFocus) hwnd5 = GetForegroundWindow() isDone = False Do While IsWindow(hwnd5) DoEvents Loop isDone = True 而如何強迫shell所Create的process結束呢，那便是 Dim aa As Long If hProcess <> 0 Then aa = TerminateProcess(hProcess, 3838) End If hProcess便是先前的例子中所取得的那個Process Handle， 3838所指的是傳給 GetExitCodeProcess()中的第二三數，這是我們任意給的，但最好不要是0，因為 0一般是代表正常結束，當然這樣設也不會有錯。當然不可設&H103，以這個例子來 看，如果程式正處於以下的LOOP Do Call GetExitCodeProcess(hProcess, ExitCode) Debug.Print ExitCode DoEvents Loop While ExitCode = STILL_ALIVE Debug.print ExitCode 而執行了 TerminateProcess(hProcess, 3838)那會看到ExitCode = 3838。然 而，這個方式在win95沒問題，在NT中，可能您要在OpenProcess()的第一個三數要 更改成 PROCESS_QUERY_INFORMATION Or PROCESS_TERMINATE 這樣才能Work。不過 良心的建議，非到最後關頭，不要使用TerminateProcess()，因不正常的結束，往 往許多程式結束前所要做的事都沒有做，可能造成Resource的浪費，甚者，下次再 執行某些程式時會有問題，例如：本人常使用MS-dos Shell Link 的方式執行一程 式，透過Com port與大電腦的連接，如果Ms-dos Shell Link 不正常結束，下次再 想Link時，會發現too Many Opens，這便是一例。 另外，有人使用Shell來執行.bat檔，即： pid = Shell("c:/aa.bat", vbNormalFocus) 可是卻遇上aa.bat結束了，但ms-dos的Window卻仍活著，那可以用以下的方式來做 pid = Shell("c:/command.com /c c:/aa.bat", vbNormalFocus) 那是執行Command.com，而Command.com指定執行c:/aa.bat 而且結束時自動Close 所有程式如下： Private Declare Function OpenProcess Lib "kernel32" _ (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As LongPrivate Declare Function WaitForSingleObject Lib "kernel32" _ (ByVal hHandle As Long, ByVal dwMilliseconds As Long) 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 Declare Function TerminateProcess Lib "kernel32" _ (ByVal hProcess As Long, ByVal uExitCode As Long) As Long Private Declare Function GetForegroundWindow Lib "user32" () As Long Private Declare Function IsWindow Lib "user32" _ (ByVal hwnd As Long) As Long Const PROCESS_QUERY_INFORMATION = &H400 Const STILL_ALIVE = &H103 Const INFIN99vE = &HFFFF Private ExitCode As Long Private hProcess As Long Private isDone As Long Private Sub Command1_Click() Dim pid As Long pid = Shell("C:/tools/spe/pe2.exe", vbNormalFocus) hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid) isDone = False Do Call GetExitCodeProcess(hProcess, ExitCode) Debug.Print ExitCode DoEvents Loop While ExitCode = STILL_ALIVE Call CloseHandle(hProcess) isDone = True End Sub Private Sub Command2_Click() Dim pid As Long Dim ExitEvent As Long pid = Shell("C:/tools/spe3/pe2.exe", vbNormalFocus) hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid) ExitEvent = WaitForSingleObject(hProcess, INFIN99vE) Call CloseHandle(hProcess) End Sub Private Sub Command3_Click() Dim aa As Long If hProcess <> 0 Then aa = TerminateProcess(hProcess, 3838) End If End Sub Private Sub Command4_Click() Dim pid As Long Dim hwnd5 As Long pid = Shell("c:/tools/spe3/pe2.exe", vbNormalFocus) hwnd5 = GetForegroundWindow() isDone = False Do While IsWindow(hwnd5) DoEvents Loop isDone = True End Sub Private Sub Command5_Click() Dim pid As Long 'pid = Shell("c:/windows/command/xcopy c:/aa.bat a:", vbHide) pid = Shell("c:/command.com /c c:/aa.bat", vbNormalFocus) End Sub   http://blog.csdn.net/szwangdf/archive/2007/01/29/1496640.aspx【Modest】:在使用shell後,如何等待此程式完成後,程式才繼續執行.我們使用 shell 調用一個外部程式的時候,通常 vb(a) 會在調用之後繼續下面的語句,而不管此 shell 程式執行完成沒有.有時我們需要在此 shell 執行完成之後才繼續,又當如何呢?請看源程:Public Declare Function OpenProcess Lib "kernel32" Alias "OpenProcess" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As LongPublic Declare Function WaitForSingleObject Lib "kernel32" Alias "WaitForSingleObject" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As LongPublic Declare Function CloseHandle Lib "kernel32" Alias "CloseHandle" (ByVal hObject As Long) As LongDim lngPId As Long Dim lngPHandle As LonglngPId = Shell("Notepad", vbNormalFocus)lngPHandle = OpenProcess(SYNCHRONIZE, 0, lngpId)If lngPHandle <> 0 Then     Call WaitForSingleObject(lngPHandle, INFINITE) ' 無限等待， 直到程式結束    Call CloseHandle(lngPHandle) End If需要注意的是,在 shell 程式未完成前,你的程式不能做任何事,請小心為之http://bbs.office-cn.net/dispbbs.asp?boardid=150&ID=7623【laviewpbt】:Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As LongPrivate Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPrivate Declare Function ShellExecuteEx Lib "shell32.dll" Alias "ShellExecuteExA" (lpInfo As Any) As Long Private Type SHELLEXECUTEINFO       cbSize  As Long       fMask  As Long       hwnd  As Long       lpVerb  As String       lpFile  As String       lpParameters  As String       lpDirectory  As String       nShow  As Long       hInstApp  As Long       '  Optional  members       lpIDList  As Long       lpClass    As String       hkeyClass  As Long       dwHotKey  As Long       hIcon_OR_Monitor  As Long       hProcess  As LongEnd Type  Private Sub Form_Load()    Dim si   As SHELLEXECUTEINFO    si.cbSize = Len(si)    si.lpVerb = "open"    si.lpFile = "notepad.exe"    si.lpParameters = ""    si.lpDirectory = ""    si.nShow = 5            'SW_SHOW    si.fMask = &H40      'SEE_MASK_NOCLOSEPROCESS    ShellExecuteEx si    If si.hProcess <> 0 Then        WaitForSingleObject si.hProcess, &HFFFFFFFF      '  無限等待，  直到程式結束        CloseHandle si.hProcess        MsgBox "程式運行完畢！"    End IfEnd Sub