|
Private Declare Function OpenProcess Lib kernel (ByVal dwDesiredAccess As Long ByVal bInheritHandle As Long ByVal dwProcessId As Long) As Long Private Declare Function GetExitCodeProcess Lib kernel (ByVal hProcess As Long lpExitCode As Long) As Long Private Declare Function CloseHandle Lib kernel (ByVal hObject As Long) As Long Const PROCESS_QUERY_INFORMATION = &H Const STILL_ALIVE = &H Private Sub Command_Click() Dim pid As Long pid = Shell(c:\abat vbNormalFocus) hProcess = OpenProcess(PROCESS_QUERY_INFORMATION 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（）的等待若要它无限的等下去就设定为INFINvE pid = Shell(C:\tools\spe\peexe vbNormalFocus) hProcess = OpenProcess(PROCESS_QUERY_INFORMATION pid) ExitEvent = WaitForSingleObject(hProcess INFINvE) Call CloseHandle(hProcess) 上例会无限等待shell指令create之process结束后才再做后面的vb指令有时觉得那会等太久所以有第二个解决方式等process结束时再通知vb 就好即设定一个公用变数（isDone）当它变成True时代表Shell所Create的Process已结束当Process还在执行时GetExitCodeProcess会传&H给其第二个三数直到结束时才传另外的数值如果程式正常结束那Exitcode = 否则就得看它如何结束了或许有人在其他地方看到 loop的地方是Loop while Exitcode ＜＞ 那有一点危险如果以这程子来看您不是用F来离开pe而是用右上方 X 的结束dos window那麽会因为ExitCode的值永远不会是而进入无穷的回圈 Dim pid As Long pid = Shell(C:\tools\spe\peexe vbNormalFocus) hProcess = OpenProcess(PROCESS_QUERY_INFORMATION pid) isDone = False Do Call GetExitCodeProcess(hProcess ExitCode) DebugPrint ExitCode DoEvents Loop While ExitCode = STILL_ALIVE Call CloseHandle(hProcess) isDone = True 另外如果您的shell所Create的程式有视窗且为立刻Focus者可另外用以 下的方式 Dim pid As Long Dim hwnd As Long pid = Shell(c:\tools\spe\peexe vbNormalFocus) hwnd = GetForegroundWindow() isDone = False Do While IsWindow(hwnd) DoEvents Loop isDone = True 而如何强迫shell所Create的process结束呢那便是 Dim aa As Long If hProcess <> Then aa = TerminateProcess(hProcess ) End If hProcess便是先前的例子中所取得的那个Process Handle 所指的是传给GetExitCodeProcess（）中的第二三数这是我们任意给的但最好不要是因为一般是代表正常结束当然这样设也不会有错当然不可设&H以这个例子来看如果程式正处于以下的LOOP Do Call GetExitCodeProcess(hProcess ExitCode) DebugPrint ExitCode DoEvents Loop While ExitCode = STILL_ALIVE Debugprint ExitCode 而执行了 TerminateProcess（hProcess ）那会看到ExitCode = 然而这个方式在win没问题在NT中可能您要在OpenProcess（）的第一个三数要更改成 PROCESS_QUERY_INFORMATION Or PROCESS_TERMINATE 这样才能Work不过良心的建议非到最后关头不要使用TerminateProcess（）因不正常的结束往往许多程式结束前所要做的事都没有做可能造成Resource的浪费甚者下次再执行某些程式时会有问题例如本人常使用MSdos Shell Link 的方式执行一程式透过Com port与大电脑的联结如果Msdos Shell Link 不正常结束下次再想Link时会发现too Many Opens这便是一例 另外有人使用Shell来执行bat档即pid = Shell（c\aabat vbNormalFocus） 可是却遇上aabat结束了但msdos的Window却仍活着那可以用以下的方式来做pid = Shell（c\ /c c\aabat vbNormalFocus） 那是执行而指定执行c\aabat 而且结束时自动Close所有程式如下 Private Declare Function OpenProcess Lib kernel _ (ByVal dwDesiredAccess As Long ByVal bInheritHandle As Long _ ByVal dwProcessId As Long) As Long Private Declare Function WaitForSingleObject Lib kernel _ (ByVal hHandle As Long ByVal dwMilliseconds As Long) As Long Private Declare Function CloseHandle Lib kernel _ (ByVal hObject As Long) As Long Private Declare Function GetExitCodeProcess Lib kernel _ (ByVal hProcess As Long lpExitCode As Long) As Long Private Declare Function TerminateProcess Lib kernel _ (ByVal hProcess As Long ByVal uExitCode As Long) As Long Private Declare Function GetForegroundWindow Lib user () As Long Private Declare Function IsWindow Lib user _ (ByVal hwnd As Long) As Long Const PROCESS_QUERY_INFORMATION = &H Const STILL_ALIVE = &H Const INFINvE = &HFFFF Private ExitCode As Long Private hProcess As Long Private isDone As Long Private Sub Command_Click() Dim pid As Long pid = Shell(C:\tools\spe\peexe vbNormalFocus) hProcess = OpenProcess(PROCESS_QUERY_INFORMATION pid) isDone = False Do Call GetExitCodeProcess(hProcess ExitCode) DebugPrint ExitCode DoEvents Loop While ExitCode = STILL_ALIVE Call CloseHandle(hProcess) isDone = True End Sub Private Sub Command_Click() Dim pid As Long Dim ExitEvent As Long pid = Shell(C:\tools\spe\peexe vbNormalFocus) hProcess = OpenProcess(PROCESS_QUERY_INFORMATION pid) ExitEvent = WaitForSingleObject(hProcess INFINvE) Call CloseHandle(hProcess) End Sub Private Sub Command_Click() Dim aa As Long If hProcess <> Then aa = TerminateProcess(hProcess ) End If End Sub Private Sub Command_Click() Dim pid As Long Dim hwnd As Long pid = Shell(c:\tools\spe\peexe vbNormalFocus) hwnd = GetForegroundWindow() isDone = False Do While IsWindow(hwnd) DoEvents Loop isDone = True End Sub Private Sub Command_Click() Dim pid As Long pid = Shell(c:\windows\command\xcopy c:\aabat a: vbHide) pid = Shell(c:\ /c c:\aabat vbNormalFocus) End Sub 「Modest」 在使用shell后如何等待此程序完成后程序才继续执行我们使用 shell 调用一个外部程序的时候通常 vb（a） 会在调用之后继续下面的语句而不管此 shell 程序执行完成没有有时我们需要在此 shell 执行完成之后才继续又当如何呢？ 请看源程 Public Declare Function OpenProcess Lib kernel Alias OpenProcess (ByVal dwDesiredAccess As Long ByVal bInheritHandle As Long ByVal dwProcessId As Long) As Long Public Declare Function WaitForSingleObject Lib kernel Alias WaitForSingleObject (ByVal hHandle As Long ByVal dwMilliseconds As Long) As Long Public Declare Function CloseHandle Lib kernel Alias CloseHandle (ByVal hObject As Long) As Long Dim lngPId As Long Dim lngPHandle As Long lngPId = Shell(Notepad vbNormalFocus) lngPHandle = OpenProcess(SYNCHRONIZE lngpId) If lngPHandle <> Then Call WaitForSingleObject(lngPHandle INFINITE) 无限等待 直到程式结束 Call CloseHandle(lngPHandle) End If 需要注意的是在 shell 程序未完成前你的程序不能做任何事请小心为之 ?boardid=&ID= 【laviewpbt】: Private Declare Function WaitForSingleObject Lib kernel (ByVal hHandle As Long ByVal dwMilliseconds As Long) As Long Private Declare Function CloseHandle Lib kernel (ByVal hObject As Long) As Long Private Declare Function ShellExecuteEx Lib shelldll 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 sicbSize = Len(si) silpVerb = open silpFile = notepadexe silpParameters = silpDirectory = sinShow = SW_SHOW sifMask = &H SEE_MASK_NOCLOSEPROCESS ShellExecuteEx si If sihProcess <> Then WaitForSingleObject sihProcess &HFFFFFFFF 无限等待 直到程式结束 CloseHandle sihProcess MsgBox 程序运行完毕！ End If End Sub |
