Shell调用程序后等待该程序结束后继续执行其他操作的多中方法
作者:JiaJia 日期:2008-09-19
- 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
- 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