用VB编写监视指定进程的程序

langke.org

一、前言
有些对外营业的公司在大厅中都有一个触摸屏，以供客户查询公司的信息，可是通常查询程序都
很大，而且很复杂，这样在连续长时间使用后难免会出现错误以致程序中途退出，这时就要工作
人员来重新启动那个程序，而且有时候很忙不一定能有专人守在这个地方。其实可以用一个程序
来专门处理这种情况的。我们局电信营业前台的多媒体查询系统也常常会出现这样的问题，下面
是本人开发出来的监控程序处理思路。
二、实现思路及关键技术
要防止程序中途退出，就需要另外的一个程序专门对要监控的进程进行时刻不停的监控，检测到
被监控的进程退出了就重新启动它。但是有时候可能是操作系统出了问题，不能简单地重复启动
要监控的进程，在重启了一定的次数后被监控进程仍然退出，那就需要重新启动操作系统了，以
便使操作系统中的环境参数等重新初始化，然后再运行监控进程并启动被监控的进程。
监控进程的存在最好不能影响被监控的进程，监控进程启动的时候要进行判断，看当前状况下被
监控的进程有没有起来，如果起来了就获取其进程句柄并进行监控，如果没有起来则使之起来并监控。这里判断一个被监控的
进程有没有起来不能简单地通过查找窗口标题来实现，因为窗口标题在程序内部可能是根据运行的时刻和条
件动态地改变的，而且别的进程也可以和可能去改变被监控进程的窗口标题。程序中使用了
CreateToolhelp32SnapShot（）这个API函数遍历系统进程池里的所有进程全路径等信息来查找
的，一个进程运行起来之后，它的路径是不可能被改变的，无论它自己还是别的进程。
为了实现程序的高效率，这里监控进程不是用Timer控件轮寻来检测，而是用API函数
WaitForSingleObject ()，同时传入等待时间为无限长（-1），但是这里有个问题，就是程序在
等待的同时被冻结，这样用户在这个时候就无法对该监控程序进行设置操作了，为了避免这种情
况，这里使用了多线程技术，在VB中使用多线程一直是不安全的，在线程代码中必须不能出任何
错误。要使监控进程能自动启动操作系统，必须要在
系统启动的登陆对话框出现的时候该进程也能运行起来，这可以通过把该进程放入注册表项
HKEY_LOCAL_MACHINESoftWareMicrosoftWindowsCurrentVersionRunSevices里来实现。在
进程运行起来之后就需要检测登陆对话框
，如果找到就发送回车（这里没设登陆密码，如果有密码，可以修改程序中发送的按键来实现登
陆）。但是这里也有可能是登陆的时候系统设置的不是“网络用户”方式或有用户在屏幕上按了
“确定”对话框，程序不能这这里一直等待一个不可能的事件，所以要在这个地方加以判断，如果等了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 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’获取
“输入胶带机http://www.kaina.cn网络密码框”窗口中“确定”按钮的句柄
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 = "Sy易做图plor"
tSubKey = "SOFTWAREMicrosoftWindowsCurrentVersionRunServices"
RegOpenKey HKEY_LOCAL_MACHINE, tSubKey, phkResult’打开注册表项
RegSetValueEx phkResult, lpSubKey, 0, REG_SZ, FN, Len(FN)’写当前进程的全路径到上面
所说的注册表项中，以便下次系

补充：软件开发 , Vb ,