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
取得 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
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
Do Call GetExitCodeProcess(hProcess, ExitCode) Debug.Print ExitCode DoEvents Loop While ExitCode = STILL_ALIVE Debug.print ExitCode
然而,这个方式在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
===================================================================================
在使用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
=============================================================================
=============================================================================
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
=============================================
shell命令一观:
shell "cmd /c dir",1'/c表示执行完即关闭窗口
shell "cmd /k dir",1'/k表示执行完停留
shell "cmd /c dir && pause",1'多条语句可用&&连接
关于cmd的具体用法可以在命令提示符下敲入cmd/?看看太多了,只列举一些典型的:
CMD [/A | /U] [/Q] [/D] [/E:ON | /E:OFF] [/F:ON | /F:OFF] [/V:ON | /V:OFF] [[/S] [/C | /K] string]
/C 执行字符串指定的命令然后终断
/K 执行字符串指定的命令但保留
/S 在 /C 或 /K 后修改字符串处理(见下)
/Q 关闭回应
/D 从注册表中停用执行 AutoRun 命令(见下)
/A 使向内部管道或文件命令的输出成为 ANSI
/U 使向内部管道或文件命令的输出成为 Unicode
/T:fg 设置前景/背景颜色(详细信息,请见 COLOR /?)
/E:ON 启用命令扩展(见下)
/E:OFF 停用命令扩展(见下)
/F:ON 启用文件和目录名称完成字符 (见下)
/F:OFF 停用文件和目录名称完成字符(见下)
/V:ON 将 ! 作为定界符启动延缓环境变量扩展。
如: /V:ON 会允许 !var! 在执行时允许 !var! 扩展变量 var。var 语法在输入时扩展变量,这与在一个 FOR 循环内不同。
/V:OFF 停用延缓的环境扩展。