' Shows how to shell to another program, and wait until it finishes
' before continuing.
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 OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Sub Command1_Click()
Dim iTask As Long, ret As Long, pHandle As Long
iTask = Shell("notepad.exe", vbNormalFocus)
pHandle = OpenProcess(SYNCHRONIZE, False, iTask)
ret = WaitForSingleObject(pHandle, INFINITE)
ret = CloseHandle(pHandle)
MsgBox "程序运行完成!"
End Sub
Dim tProcInfo As PROCESS_INFORMATION, lRetVal As Long, lSuccess As Long
Dim tStartupInf As STARTUPINFO
Dim tSecurAttrib As SECURITY_ATTRIBUTES
Dim hSnapShot As Long, uProcess As PROCESSENTRY32
Const SW_HIDE = 0, SW_NORMAL = 1
Const NORMAL_PRIORITY_CLASS = &H20&
Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
'---------------------------------------------------------------------------
Private Declare Function CreateProcessA Lib "kernel32" _
(ByVal lpApplicationName As Long, ByVal lpCommandLine As _
String, lpProcessAttributes As Any, lpThreadAttributes As _
Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As _
Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As _
Long, lpStartupInfo As Any, lpProcessInformation As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" _
(ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" _
(ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" _
(ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
'--------------------------------------------------------------------------------------------
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As Long
lpDesktop As Long
lpTitle As Long
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
tSecurAttrib.nLength = Len(tSecurAttrib)
tSecurAttrib.bInheritHandle = 1&
tSecurAttrib.lpSecurityDescriptor = 0&
CreatePipe(lhwndReadPipe, lhwndWritePipe, tSecurAttrib, 0)
tStartupInf.cb = Len(tStartupInf)
tStartupInf.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
tStartupInf.hStdOutput = lhwndWritePipe
tStartupInf.wShowWindow = SW_HIDE
CreateProcessA(0&, sCommandLine, tSecurAttrib, tSecurAttrib, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, tStartupInf, tProcInfo)
Dim r, n, i
'============================================================================================================
hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
uProcess.dwSize = Len(uProcess)
r = Process32First(hSnapShot, uProcess)
Do While r
n = LCase(Left$(uProcess.szExeFile, IIf(InStr(1, uProcess.szExeFile, Chr$(0)) > 0, InStr(1, uProcess.szExeFile, Chr$(0)) - 1, 0)))
For i = Len(n) To 1 Step -1
If Mid$(n, i, 1) = "\" Then n = Mid$(n, i + 1, Len(n) - i)
Next i
If n = "uharc.exe" Then
CloseHandle hSnapShot
Exit Function
End If
'Retrieve information about the next process recorded in our system snapshot
r = Process32Next(hSnapShot, uProcess)
Loop
'close our snapshot handle
CloseHandle hSnapShot
GoTo Err:
'============================================================================================================
Exit Function
Err:
'Close handles
Call CloseHandle(tProcInfo.hProcess)
Call CloseHandle(tProcInfo.hThread)