前兩天看了Delphi版面精華區(qū)中的“進(jìn)程死亡的自動復(fù)活“一文，覺得作者的思路很不錯，利用api來監(jiān)視進(jìn)程的活動，當(dāng)被銷毀時就自動再創(chuàng)建進(jìn)程。仔細(xì)推敲之后，發(fā)覺其實(shí)用vb也是可以做到的。于是花了半天的時間寫了以下的程序，實(shí)現(xiàn)了使用WaitForSingleObject  API來監(jiān)視被創(chuàng)建的進(jìn)程的活動，一旦返回除time out 之外的消息就自動創(chuàng)建新的進(jìn)程。以下為其實(shí)現(xiàn)代碼。在win2000 server + vb 6.0下通過。
Option Explicit

Private RunFile$

Private Const NORMAL_PRIORITY_CLASS = &H20    '如果進(jìn)程位于前臺，則基本值是9；如果在后臺，則優(yōu)先值為7
Private Const INFINITE = &HFFFFFFFF
Private Const WAIT_TIMEOUT = &H102&           '對象保持未發(fā)出信號的狀態(tài)，但等待超時時間已經(jīng)超過
Private Flag As Boolean ‘進(jìn)程活動監(jiān)視標(biāo)志


'說明∶PROCESS_INFORMATION結(jié)構(gòu)由CreateProcess函數(shù)將關(guān)于新建立的進(jìn)程和
'主要線索的信息寫入其中成員變量
Private Type PROCESS_INFORMATION    '
        hProcess As Long
        hThread As Long
        dwProcessId As Long
        dwThreadId As Long
End Type

'說明∶STARTUPINFO結(jié)構(gòu)用在CreateProcess函數(shù)中指定為新進(jìn)程建立的新窗口的主要屬性。這一
'一信息影響由CreateWindows函數(shù)建立的第一個窗口
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函數(shù)，用于創(chuàng)建一個新的進(jìn)程
    res = CreateProcess(DemoFile, vbNullString, 0, 0, True, _
                       NORMAL_PRIORITY_CLASS, ByVal 0&, vbNullString, sinfo, pinfo)
    If res Then
        Label1.Caption = "程序正在運(yùn)行中"
        WaitForTerm pinfo
        Label1.Caption = "程序已經(jīng)結(jié)束"
    Else
        Label1.Caption = "啟動程序時出錯，可能未正確輸入" & Chr(13) & "程序名或程序所在路徑。"
    End If
End Sub

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

Private Sub Command3_Click()
Flag = True
End Sub

Private Sub Form_Load()
    RunFile = InputBox$("請輸入需要運(yùn)行的程序名與路經(jīng)")
    Flag = False
    
End Sub