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

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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long



Const PROCESS_QUERY_INFORMATION = &H400

Const STILL_ALIVE = &H103

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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Const PROCESS_QUERY_INFORMATION = &H400
Const STILL_ALIVE = &H103

Private Sub Command1_Click()

Dim pid As Long

pid = Shell("c:\a.bat", vbNormalFocus)

hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid)

Do

Call GetExitCodeProcess(hProcess, ExitCode)

DoEvents

Loop While ExitCode = STILL_ALIVE

Call CloseHandle(hProcess)



MsgBox ("運行結束")

End Sub

Private Sub Command1_Click()
Dim pid As Long
pid = Shell("c:\a.bat", vbNormalFocus)
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid)
Do
Call GetExitCodeProcess(hProcess, ExitCode)
DoEvents
Loop While ExitCode = STILL_ALIVE
Call 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 Long

Private 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

[url]http://blog.csdn.net/szwangdf/archive/2007/01/29/1496640.aspx[/url]

【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 Long
Public Declare Function WaitForSingleObject Lib "kernel32" Alias "WaitForSingleObject" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" Alias "CloseHandle" (ByVal hObject As Long) As Long
Dim lngPId As Long
Dim lngPHandle As Long
lngPId = Shell("Notepad", vbNormalFocus)
lngPHandle = OpenProcess(SYNCHRONIZE, 0, lngpId)
If lngPHandle <> 0 Then
    Call WaitForSingleObject(lngPHandle, INFINITE) ' 無限等待， 直到程式結束
    Call CloseHandle(lngPHandle)
End If
需要注意的是,在 shell 程序未完成前,你的程序不能做任何事,請小心爲之

[url]http://bbs.office-cn.net/dispbbs.asp?boardid=150&ID=7623[/url]

【laviewpbt】:
Private 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 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 Long
End 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 If
End Sub