使Shell指令具Wait功能

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()的等待。若要它无限的等下去，就设定为INFINITE。

pid = Shell("C:/tools/spe3/pe2.exe", vbNormalFocus)

hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid)

ExitEvent = WaitForSingleObject(hProcess, INFINITE)

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，以这个例子来看，如果程式正处於以下的LOOPDo

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 INFINITE = &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/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

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, INFINITE)

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