作者: 徐原

  一、前言
有些對外營業的公司在大廳中都有一個觸摸屏，以供客戶查詢公司的信息，可是通常查詢程序都很大，而且很復雜，這樣在連續長時間使用后難免會出現錯誤以致程序中途退出，這時就要工作人員來重新啟動那個程序，而且有時候很忙不一定能有專人守在這個地方。其實可以用一個程序來專門處理這種情況的。我們局電信營業前臺的多媒體查詢系統也常常會出現這樣的問題，下面是本人開發出來的監控程序處理思路。
二、實現思路及關鍵技術
要防止程序中途退出，就需要另外的一個程序專門對要監控的進程進行時刻不停的監控，檢測到被監控的進程退出了就重新啟動它。但是有時候可能是操作系統出了問題，不能簡單地重復啟動要監控的進程，在重啟了一定的次數后被監控進程仍然退出，那就需要重新啟動操作系統了，以便使操作系統中的環境參數等重新初始化，然后再運行監控進程并啟動被監控的進程。
監控進程的存在最好不能影響被監控的進程，監控進程啟動的時候要進行判斷，看當前狀況下被監控的進程有沒有起來，如果起來了就獲取其進程句柄并進行監控，如果沒有起來則使之起來并監控。這里判斷一個被監控的進程有沒有起來不能簡單地通過查找窗口標題來實現，因為窗口標題在程序內部可能是根據運行的時刻和條件動態地改變的，而且別的進程也可以和可能去改變被監控進程的窗口標題。程序中使用了CreateToolhelp32SnapShot（）這個API函數遍歷系統進程池里的所有進程全路徑等信息來查找的，一個進程運行起來之后，它的路徑是不可能被改變的，無論它自己還是別的進程。
為了實現程序的高效率，這里監控進程不是用Timer控件輪尋來檢測，而是用API函數WaitForSingleObject ()，同時傳入等待時間為無限長（-1），但是這里有個問題，就是程序在等待的同時被凍結，這樣用戶在這個時候就無法對該監控程序進行設置操作了，為了避免這種情況，這里使用了多線程技術，在VB中使用多線程一直是不安全的，在線程代碼中必須不能出任何錯誤。
要使監控進程能自動啟動操作系統，必須要在系統啟動的登陸對話框出現的時候該進程也能運行起來，這可以通過把該進程放入注冊表項HKEY_LOCAL_MACHINE\SoftWare\Microsoft\Windows\CurrentVersion\RunSevices里來實現。在進程運行起來之后就需要檢測登陸對話框，如果找到就發送回車（這里沒設登陸密碼，如果有密碼，可以修改程序中發送的按鍵來實現登陸）。但是這里也有可能是登陸的時候系統設置的不是“網絡用戶”方式或有用戶在屏幕上按了“確定”對話框，程序不能這這里一直等待一個不可能的事件，所以要在這個地方加以判斷，如果等了1分鐘沒有找到登陸對話框，程序就繼續下面的操作。
三、代碼示例
模塊中：
Public Type PROCESSENTRY32’記錄進程信息的結構
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntTreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * 260’這就是包含全路徑的進程文件名
End Type
Public Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long’用來遍歷進程池的函數，這是查找的起始函數
Public Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long’遍歷進程池的向下遞歸函數

Public 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 Byte
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Public Type PROCESS_INFORMATION’ 記錄進程啟動后相關信息的結構
hProcess As Long’進程句柄
hThread As Long’線程句柄
dwProcessId As Long’進程ID
dwThreadId As Long’線程ID
End Type
Public Declare Function GetCurrentProcess Lib "kernel32" () As Long’獲取當前進程句柄
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long;獲取當前進程ID
Public Const TH32CS_SNAPPROCESS = As LongH2

Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Public Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessId As Long, ByVal dwType As Long) As Long
Public Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Public 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 lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Public Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long

Public Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long
Public Declare Function SuspendThread Lib "kernel32" (ByVal hThread As Long) As Long
Public Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long

Public Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Public Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long

Public Const PROCESS_TERMINATE =&H1
Public Const PROCESS_QUERY_INFORMATION =&H400
Public Const EWX_FORCE = 4
Public Const EWX_REBOOT = 2
Public Const GW_CHILD = 5
Public Const GW_HWNDFIRST = 0
Public Const GW_HWNDNEXT = 2
Public Const GW_MAX = 5
Public Const GW_OWNER = 4
Public Const HKEY_LOCAL_MACHINE =&H80000002
Public Const REG_SZ = 1
Public Const RSP_SIMPLE_SERVICE = 1
Public Const RSP_UNREGISTER_SERVICE = 0
Public Const CREATE_SUSPENDED = &H4
Public Const MF_BYPOSITION = &H400
Public Const BM_CLICK = &HF5
Public pe As PROCESSENTRY32, hSnapshot As Long
Public StartNum As Long, AppName As String, Section As String, sKey As String, appValue As String, sKeyFile As String, sKeyNum As String
Public NumTerminate As Long, hThread As Long, ThreadID As Long, sFileName As String

Public Function StartMonitor(lParam As Long) As Long’線程函數
WaitForTheProcess GetProcessHandle(sFileName), sFileName’開始監控
StartMonitor = 1
End Function

Public Function SendEnter As Long()’搜尋系統登陸對話框，找到就發送回車鍵
Dim Currwnd As Long, Length As Long, ListItem As String
Currwnd = GetWindow(Form1.hwnd, GW_HWNDFIRST)’這里用窗口標題查找的原因是系統重啟時基本上不會加載多少進程，這樣窗口的標題通常是不會被改變的。
While Currwnd <> 0
Length = GetWindowTextLength(Currwnd)’獲取窗口標題字符串的長度。
If Length <> 0 Then
ListItem As String = Space As String(Length)
Length = GetWindowText(Currwnd, ListItem As String, Length + 2)’獲取窗口標題
If InStr(ListItem, "輸入網絡密碼") <> 0 Then
EnumChildWindows Currwnd, AddressOf GetOkButton, 0
SendEnter = 1
Exit Function
End If
End If
Currwnd = GetWindow(Currwnd, GW_HWNDNEXT)
Wend
SendEnter = 0
End Function

Public Sub WaitForTheProcess(ByVal hProcess As Long, ByVal sPath As String)’開始監控進程
Dim Pro_Info As PROCESS_INFORMATION, StartInfo As STARTUPINFO
StartInfo.cb = Len(StartInfo)
If hProcess > 0 Then’如果已經運行了被監控進程則開始監控
Dim WaitResult As Long
WaitResult = WaitForSingleObject(hProcess, (-1))
CloseHandle hProcess
If StartNum >= NumTerminate Then’如果重啟次數超過設置的次數就重新啟動系統
SaveSetting AppName, Section, sKey, "1"
ExitWindowsEx EWX_REBOOT Or EWX_FORCE, 0’強制退出，這樣可以順利退出
Exit Sub
End If
StartNum = StartNum + 1
Form1.Label6 = StartNum
End If
CreateProcess vbNullString, sPath, 0, 0, True, 32, ByVal 0 As Long, vbNullString, StartInfo, Pro_Info’ 否則用被監控進程的全路徑文件名來創建被監控進程
WaitForTheProcess Pro_Info.hProcess, sPath
End Sub

Public Function GetProcessHandle As Long(ByVal sPath As String)’獲取被監控進程的進程句柄
sPath = LCase(sPath)
hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)’創建一個snapshot對象
pe.dwSize = Len(pe)
bValue = Process32First(hSnapshot, pe)’開始遍歷系統進程池
While bValue <> 0
If InStr(LCase(pe.szExeFile), sPath) <> 0 Then’如果找到了，則…
Dim hProcess As Long
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pe.th32ProcessID)
GetProcessHandle = hProcess
CloseHandle hSnapshot
Exit Function
End If
bValue = Process32Next(hSnapshot, pe)
Wend
CloseHandle hSnapshot
GetProcessHandle = 0’否則返回0
End Function

Public Function GetOkButton(ByVal hwnd As Long, ByVal lParam As Long) As Long’獲取“輸入網絡密碼框”窗口中“確定”按鈕的句柄
Dim Length&, ListItem$
Length = GetWindowTextLength(hwnd)
If Length <> 0 Then
ListItem$ = Space$(Length)
Length = GetWindowText(hwnd, ListItem$, Length + 2)
If InStr(ListItem, "確定") <> 0 Then
SendMessage hwnd, BM_CLICK, 0, 0’激活窗口
SendMessage hwnd, BM_CLICK, 0, 0’發送Click消息
GetOkButton = 0’退出EnumChildWindows()函數的枚舉循環
Exit Function
End If
End If
GetOkButton = 1’繼續EnumChildWindows()函數的枚舉循環
End Function
窗口中有幾個Label控件：
Label2用來提示當前被監控的進程的，Label4和Label6用來記錄次數的。窗口中還有一個菜單，用來向用戶提供設置方法的。因為允許操作人員設置，不能隱藏窗口，所以這里隱藏了菜單，在窗口上用鼠標點右鍵才能看見，而觸摸屏上顧客是無法點右鍵的，這樣設置就安全了，具體的菜單項見下面程序：

作者：安徽省滁州市電信局小型機房 徐原
來自：計算機世界網

Private Sub Form_Load()
RegisterServiceProcess GetCurrentProcessId, RSP_SIMPLE_SERVICE’注冊進程為系統服務進程，這樣進程只在系統關機的最后一刻才從系統中卸掉。
Dim FN As String, hReg As Long, tRegKey As String, tSubKey As String, phkResult As Long, lpSubKey As String, EnterResult As Long
Dim TimePassed1 As Long, TimePassed2 As Long
FN = Space(255)
GetModuleFileName App.hInstance, FN, 255’獲取當前進程的全路徑文件名
FN = Trim(FN)
lpSubKey = "Sysexplor"
tSubKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\RunServices"
RegOpenKey HKEY_LOCAL_MACHINE, tSubKey, phkResult’打開注冊表項
RegSetValueEx phkResult, lpSubKey, 0, REG_SZ, FN, Len(FN)’寫當前進程的全路徑到上面所說的注冊表項中，以便下次系統重啟說能和系統登陸對話框一同運行
RegCloseKey phkResult’關閉注冊表項

AppName = "TiMonitor"
Section = "Reboot"

sKeyFile = "FileName"
sFileName = GetSetting(AppName, Section, sKeyFile, "")’讀取注冊表中記錄的被監控進程的全路徑名
aa:If Len(Dir(sFileName, vbDirectory)) < 4 Then
sFileName = "c:\teleinfo\ti.exe"’如果讀取不到或系統不存在相應的文件，則取一個默認值。或者給一個提示：
'sFileName = InputBox("找不到程序，請輸入包含全路徑的程序名：", "輸入", "C:\teleinfo\ti.exe")
'Goto aa
End If
Label2 = sFileName

sKey = "Once"
appValue = GetSetting(AppName, Section, sKey, "0")’判斷該進程起的時候是系統重新啟動時還是在運行過程中啟動
If appValue = "1" Then
DeleteSetting AppName, Section, sKey’如果是，刪除系統重啟標志
TimePassed1 = GetTickCount
Do
DoEvents
EnterResult = SendEnter()
TimePassed2 = GetTickCount
If TimePassed2 - TimePassed1 > 60000 Then Exit Do’超時1分鐘就退出該循環
Loop Until EnterResult <> 0
End If

sKeyNum = "TerminateNumbers"
appValue = GetSetting(AppName, Section, sKeyNum, "4")’讀取注冊表中被監控進程重啟次數的設置信息
NumTerminate = Val(appValue)
StartNum = 0
Label4 = NumTerminate
Label6 = 0
Dim hMenu As Long, lParam As Long, MenuCount As Long, i As Long
hMenu = GetSystemMenu(hwnd, 0)’為了不能讓顧客關閉監控進程，這里屏蔽了相關的系統菜單
MenuCount = GetMenuItemCount(hMenu)
For i = 0 To MenuCount - 1
RemoveMenu hMenu, i, MF_BYPOSITION
Next
DrawMenuBar hwnd
hThread = CreateThread(0, 2000, AddressOf StartMonitor, lParam, 0, ThreadID)’創建一個監控線程
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then PopupMenu munSet’彈出設置菜單
End Sub

Private Sub munClose_Click()
TerminateProcess GetCurrentProcess, 1’關閉自己，因為系統菜單的關閉被屏蔽了，只能在程序中自己提供方法來關閉，又因為是多線程的，不能僅僅用Unload Me 來關閉，那只是關閉了一個線程，而監控線程沒有被關閉，這里直接把當前進程給關閉了，這樣可同時關閉進程中所有運行的線程。
End Sub

Private Sub munPause_Click()’這是一個有Check標記的菜單，用來Pause和Resume線程的
If munPause.Checked Then
munResume.Checked = True
ResumeThread hThread
Else
munResume.Checked = False
SuspendThread hThread
End If
munPause.Checked = Not munPause.Checked
End Sub

Private Sub munResume_Click()
If munResume.Checked Then
munPause.Checked = True
SuspendThread hThread
Else
munPause.Checked = False
ResumeThread hThread
End If
munResume.Checked = Not munResume.Checked
End Sub

Private Sub munSetFile_Click()’設置要監控進程的全路徑名
Dim rFileName As String
rFileName = InputBox("請輸入要監控進程的全路徑名：", "輸入", sFileName)
If Len(Trim(rFileName)) < 4 Then Exit Sub’ 輸入明顯不對，就不作任何保存直接退出該過程

If Len(Dir(rFileName, vbArchive)) > 4 Then
sFileName = rFileName
SaveSetting AppName, Section, sKeyFile, sFileName’保存正確設置
Label2 = sFileName
Dim bPaused As Long
If MsgBox("重新開始監控進程嗎？", vbYesNo) = vbYes Then’詢問是否立刻轉到監控新的進程
TerminateThread hThread, 1
CloseHandle hThread
StartNum = 0
Label6 = "0"
bPaused = IIf(munPause.Checked, CREATE_SUSPENDED, 0)
hThread = CreateThread(0, 2000, AddressOf StartMonitor, 0, bPaused, ThreadID)’如果窗口菜單上這時設置了Pause，則這時也創建一個Suspend線程，以便和菜單保持一致。
End If
End If
End Sub

Private Sub munSetTimes_Click()
Dim NumT As String
NumT = InputBox("請輸入要重啟進程的最大次數：", "輸入", NumTerminate)’設置被監控進程重啟的最大次數
If Trim(NumT) = "" Then Exit Sub’如果操作人員選擇“取消”或輸入空格，則本次修改無效
NumTerminate = Val(Trim(NumT))
SaveSetting AppName, Section, sKeyNum, Trim(NumT)’保存有效設置
Label4 = NumTerminate
End Sub
該程序在VB5.0、Windows98下運行通過。
注意，該程序不要進行調試，因為VB本身是單線程的，不支持多線程的調試，只能編譯好后運行，或者一個一個分開調試，再合到一起。

結束語：
隨著科技的發展，辦公自動化的流行，很多公司擺脫了老的辦公機制，都使用了計算機來流水型自動執行很多以前需要人去手工執行的工作，但是這些程序因為處理的東西比較多，代碼比較復雜，常常程序中會有一些小小的Bug，這些Bug有時會導致在自動化過程中程序被意外地關閉，致使流水線的中斷，上面的這個程序可以幫助解決這個問題。
該程序在無人職守但又需要維持一個進程時刻執行的地方都適用。