資訊好好玩

0愛的鼓勵 0訂閱站台

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+SYNCHRONIZE, 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+SYNCHRONIZE, 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 SYNCHRONIZE = &H100000
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+SYNCHRONIZE, 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+SYNCHRONIZE, 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