判斷一個被Shell的程序進程是否結束

    新建一個項目，添加命令按鈕和標簽各一個，加上以下代碼，然后運行....
Option Explicit
' Copyright ? 1997 by Desaware Inc. All Rights Reserved
Dim DemoFile$
Private Const NORMAL_PRIORITY_CLASS = &H20 '如果進程位于前臺，則基本值是9；如果在后臺，則優先值為7
Private Const INFINITE = &HFFFFFFFF
Private Const WAIT_TIMEOUT = &H102& '對象保持未發出信號的狀態，但等待超時時間已經超過

'說明∶PROCESS_INFORMATION結構由CreateProcess函數將關于新建立的進程和
'主要線索的信息寫入其中成員變量
Private Type PROCESS_INFORMATION '
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type

'說明∶STARTUPINFO結構用在CreateProcess函數中指定為新進程建立的新窗口的主要屬性。這一
'一信息影響由CreateWindows函數建立的第一個窗口
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
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 Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDirectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function WaitForInputIdle Lib "user32" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long


Private Sub command1_Click()
Dim res&
Dim sinfo As STARTUPINFO
Dim pinfo As PROCESS_INFORMATION
sinfo.cb = Len(sinfo)
sinfo.lpReserved = vbNullString
sinfo.lpDesktop = vbNullString
sinfo.lpTitle = vbNullString
sinfo.dwFlags = 0

Label1.Caption = "正在啟動程序"
Label1.Refresh
' CreateProcess函數，用于創建一個新的進程
res = CreateProcess(DemoFile, vbNullString, 0, 0, True, _
NORMAL_PRIORITY_CLASS, ByVal 0&, vbNullString, sinfo, pinfo)
If res Then
Label1.Caption = "程序正在運行"
WaitForTerm pinfo
End If
Label1.Caption = "程序已經結束"

End Sub

Private Sub WaitForTerm(pinfo As PROCESS_INFORMATION)
Dim res&
' 等待指定的進程進入空閑狀態，,空閑(Idle)指的是進程準備處理
'一條消息、但目前暫時沒有消息需要處理的一種狀態
Call WaitForInputIdle(pinfo.hProcess, INFINITE)
' 關閉指定進程
Call CloseHandle(pinfo.hThread)
Command1.Enabled = False
Label1.Refresh
Do
'等待發出信號
res = WaitForSingleObject(pinfo.hProcess, 0)
If res <> WAIT_TIMEOUT Then '如果對象發出了信號
Exit Do
End If
DoEvents
Loop While True
Command1.Enabled = True
Call CloseHandle(pinfo.hProcess)
End Sub

Private Sub Form_Load()
DemoFile = InputBox$("請輸入需要運行的程序名", , "C:\WINDOWS\notepad.exe")
End Sub

原文轉自：http://www.anti-gravitydesign.com