明輝手游網(wǎng)中心:是一個(gè)免費(fèi)提供流行視頻軟件教程、在線學(xué)習(xí)分享的學(xué)習(xí)平臺(tái)!

用VB編寫監(jiān)視指定進(jìn)程的程序

[摘要]作者: 徐原 一、前言 有些對(duì)外營業(yè)的公司在大廳中都有一個(gè)觸摸屏,以供客戶查詢公司的信息,可是通常查詢程序都很大,而且很復(fù)雜,這樣在連續(xù)長時(shí)間使用后難免會(huì)出現(xiàn)錯(cuò)誤以致程序中途退出,這時(shí)就要工作人...
作者: 徐原

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

Public Type STARTUPINFO’記錄進(jìn)程啟動(dòng)信息的結(jié)構(gòu)
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’ 記錄進(jìn)程啟動(dòng)后相關(guān)信息的結(jié)構(gòu)
hProcess As Long’進(jìn)程句柄
hThread As Long’線程句柄
dwProcessId As Long’進(jìn)程ID
dwThreadId As Long’線程ID
End Type
Public Declare Function GetCurrentProcess Lib "kernel32" () As Long’獲取當(dāng)前進(jìn)程句柄
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long;獲取當(dāng)前進(jìn)程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’線程函數(shù)
WaitForTheProcess GetProcessHandle(sFileName), sFileName’開始監(jiān)控
StartMonitor = 1
End Function

Public Function SendEnter As Long()’搜尋系統(tǒng)登陸對(duì)話框,找到就發(fā)送回車鍵
Dim Currwnd As Long, Length As Long, ListItem As String
Currwnd = GetWindow(Form1.hwnd, GW_HWNDFIRST)’這里用窗口標(biāo)題查找的原因是系統(tǒng)重啟時(shí)基本上不會(huì)加載多少進(jìn)程,這樣窗口的標(biāo)題通常是不會(huì)被改變的。
While Currwnd <> 0
Length = GetWindowTextLength(Currwnd)’獲取窗口標(biāo)題字符串的長度。
If Length <> 0 Then
ListItem As String = Space As String(Length)
Length = GetWindowText(Currwnd, ListItem As String, Length + 2)’獲取窗口標(biāo)題
If InStr(ListItem, "輸入網(wǎng)絡(luò)密碼") <> 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)’開始監(jiān)控進(jìn)程
Dim Pro_Info As PROCESS_INFORMATION, StartInfo As STARTUPINFO
StartInfo.cb = Len(StartInfo)
If hProcess > 0 Then’如果已經(jīng)運(yùn)行了被監(jiān)控進(jìn)程則開始監(jiān)控
Dim WaitResult As Long
WaitResult = WaitForSingleObject(hProcess, (-1))
CloseHandle hProcess
If StartNum >= NumTerminate Then’如果重啟次數(shù)超過設(shè)置的次數(shù)就重新啟動(dòng)系統(tǒng)
SaveSetting AppName, Section, sKey, "1"
ExitWindowsEx EWX_REBOOT Or EWX_FORCE, 0’強(qiáng)制退出,這樣可以順利退出
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’ 否則用被監(jiān)控進(jìn)程的全路徑文件名來創(chuàng)建被監(jiān)控進(jìn)程
WaitForTheProcess Pro_Info.hProcess, sPath
End Sub

Public Function GetProcessHandle As Long(ByVal sPath As String)’獲取被監(jiān)控進(jìn)程的進(jìn)程句柄
sPath = LCase(sPath)
hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)’創(chuàng)建一個(gè)snapshot對(duì)象
pe.dwSize = Len(pe)
bValue = Process32First(hSnapshot, pe)’開始遍歷系統(tǒng)進(jìn)程池
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’獲取“輸入網(wǎng)絡(luò)密碼框”窗口中“確定”按鈕的句柄
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’發(fā)送Click消息
GetOkButton = 0’退出EnumChildWindows()函數(shù)的枚舉循環(huán)
Exit Function
End If
End If
GetOkButton = 1’繼續(xù)EnumChildWindows()函數(shù)的枚舉循環(huán)
End Function
窗口中有幾個(gè)Label控件:
Label2用來提示當(dāng)前被監(jiān)控的進(jìn)程的,Label4和Label6用來記錄次數(shù)的。窗口中還有一個(gè)菜單,用來向用戶提供設(shè)置方法的。因?yàn)樵试S操作人員設(shè)置,不能隱藏窗口,所以這里隱藏了菜單,在窗口上用鼠標(biāo)點(diǎn)右鍵才能看見,而觸摸屏上顧客是無法點(diǎn)右鍵的,這樣設(shè)置就安全了,具體的菜單項(xiàng)見下面程序:

作者:安徽省滁州市電信局小型機(jī)房 徐原
來自:計(jì)算機(jī)世界網(wǎng)

Private Sub Form_Load()
RegisterServiceProcess GetCurrentProcessId, RSP_SIMPLE_SERVICE’注冊(cè)進(jìn)程為系統(tǒng)服務(wù)進(jìn)程,這樣進(jìn)程只在系統(tǒng)關(guān)機(jī)的最后一刻才從系統(tǒng)中卸掉。
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’獲取當(dāng)前進(jìn)程的全路徑文件名
FN = Trim(FN)
lpSubKey = "Sysexplor"
tSubKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\RunServices"
RegOpenKey HKEY_LOCAL_MACHINE, tSubKey, phkResult’打開注冊(cè)表項(xiàng)
RegSetValueEx phkResult, lpSubKey, 0, REG_SZ, FN, Len(FN)’寫當(dāng)前進(jìn)程的全路徑到上面所說的注冊(cè)表項(xiàng)中,以便下次系統(tǒng)重啟說能和系統(tǒng)登陸對(duì)話框一同運(yùn)行
RegCloseKey phkResult’關(guān)閉注冊(cè)表項(xiàng)

AppName = "TiMonitor"
Section = "Reboot"

sKeyFile = "FileName"
sFileName = GetSetting(AppName, Section, sKeyFile, "")’讀取注冊(cè)表中記錄的被監(jiān)控進(jìn)程的全路徑名
aa:If Len(Dir(sFileName, vbDirectory)) < 4 Then
sFileName = "c:\teleinfo\ti.exe"’如果讀取不到或系統(tǒng)不存在相應(yīng)的文件,則取一個(gè)默認(rèn)值;蛘呓o一個(gè)提示:
'sFileName = InputBox("找不到程序,請(qǐng)輸入包含全路徑的程序名:", "輸入", "C:\teleinfo\ti.exe")
'Goto aa
End If
Label2 = sFileName

sKey = "Once"
appValue = GetSetting(AppName, Section, sKey, "0")’判斷該進(jìn)程起的時(shí)候是系統(tǒng)重新啟動(dòng)時(shí)還是在運(yùn)行過程中啟動(dòng)
If appValue = "1" Then
DeleteSetting AppName, Section, sKey’如果是,刪除系統(tǒng)重啟標(biāo)志
TimePassed1 = GetTickCount
Do
DoEvents
EnterResult = SendEnter()
TimePassed2 = GetTickCount
If TimePassed2 - TimePassed1 > 60000 Then Exit Do’超時(shí)1分鐘就退出該循環(huán)
Loop Until EnterResult <> 0
End If

sKeyNum = "TerminateNumbers"
appValue = GetSetting(AppName, Section, sKeyNum, "4")’讀取注冊(cè)表中被監(jiān)控進(jìn)程重啟次數(shù)的設(shè)置信息
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)’為了不能讓顧客關(guān)閉監(jiān)控進(jìn)程,這里屏蔽了相關(guān)的系統(tǒng)菜單
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)’創(chuàng)建一個(gè)監(jiān)控線程
End Sub

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

Private Sub munClose_Click()
TerminateProcess GetCurrentProcess, 1’關(guān)閉自己,因?yàn)橄到y(tǒng)菜單的關(guān)閉被屏蔽了,只能在程序中自己提供方法來關(guān)閉,又因?yàn)槭嵌嗑程的,不能僅僅用Unload Me 來關(guān)閉,那只是關(guān)閉了一個(gè)線程,而監(jiān)控線程沒有被關(guān)閉,這里直接把當(dāng)前進(jìn)程給關(guān)閉了,這樣可同時(shí)關(guān)閉進(jìn)程中所有運(yùn)行的線程。
End Sub

Private Sub munPause_Click()’這是一個(gè)有Check標(biāo)記的菜單,用來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()’設(shè)置要監(jiān)控進(jìn)程的全路徑名
Dim rFileName As String
rFileName = InputBox("請(qǐng)輸入要監(jiān)控進(jìn)程的全路徑名:", "輸入", sFileName)
If Len(Trim(rFileName)) < 4 Then Exit Sub’ 輸入明顯不對(duì),就不作任何保存直接退出該過程

If Len(Dir(rFileName, vbArchive)) > 4 Then
sFileName = rFileName
SaveSetting AppName, Section, sKeyFile, sFileName’保存正確設(shè)置
Label2 = sFileName
Dim bPaused As Long
If MsgBox("重新開始監(jiān)控進(jìn)程嗎?", vbYesNo) = vbYes Then’詢問是否立刻轉(zhuǎn)到監(jiān)控新的進(jìn)程
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)’如果窗口菜單上這時(shí)設(shè)置了Pause,則這時(shí)也創(chuàng)建一個(gè)Suspend線程,以便和菜單保持一致。
End If
End If
End Sub

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

結(jié)束語:
隨著科技的發(fā)展,辦公自動(dòng)化的流行,很多公司擺脫了老的辦公機(jī)制,都使用了計(jì)算機(jī)來流水型自動(dòng)執(zhí)行很多以前需要人去手工執(zhí)行的工作,但是這些程序因?yàn)樘幚淼臇|西比較多,代碼比較復(fù)雜,常常程序中會(huì)有一些小小的Bug,這些Bug有時(shí)會(huì)導(dǎo)致在自動(dòng)化過程中程序被意外地關(guān)閉,致使流水線的中斷,上面的這個(gè)程序可以幫助解決這個(gè)問題。
該程序在無人職守但又需要維持一個(gè)進(jìn)程時(shí)刻執(zhí)行的地方都適用。