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

1.简介
有些外企的大堂有触摸屏，供客户查询公司信息。但是查询程序通常非常庞大复杂，连续长时间使用难免出错，程序会中途退出。这个时候工作人员就要重新启动程序，有时候忙的时候可能无法有专门的人在这个地方放哨。其实可以用一个程序来处理这种情况。我们电信业务前台的多媒体查询系统经常出现这种问题。下面是自己开发的监控程序的处理思路。
二。实现思路及关键技术
为了防止程序中途退出，需要另一个程序不断地监控被监控的进程，当检测到被监控的进程退出时，重新启动它。但有时可能是操作系统出了问题，要监控的进程无法重复启动。重启一定次数后，被监控进程仍然存在，需要重启操作系统，重新初始化操作系统中的环境参数，然后运行监控进程，启动被监控进程。
监控进程的存在不能影响被监控的进程。当监控进程启动时，判断被监控的进程当前是否启动。如果它启动了，获取它的进程句柄并监视它；如果没有，就把它弄起来，进行监控。这里判断一个被监控的进程是否启动，不能简单的通过查找窗口标题来实现，因为窗口标题可能会根据运行时间和运行条件在程序中动态变化，其他进程可以也可能改变被监控进程的窗口标题。在程序中，使用API函数CreateToolhelp32SnapShot()遍历系统进程池中所有进程的完整路径来找出。一个进程运行后，无论是自身还是其他进程，其路径都是不可更改的。
为了实现程序的高效率，这里的监控进程不是通过定时器控件来检测的，而是通过API函数WaitForSingleObject()来检测的，进来的等待时间是无限的(-1)。但是这里有一个问题，就是程序在等待的时候被冻结了，以至于用户此时无法设置监控程序。为了避免这种情况，这里使用了多线程技术，VB中使用了多线程。
要使监控进程自动启动操作系统，该进程还必须在系统启动的登录对话框出现时运行。这可以通过将进程放入注册表项HKEY _本地_机器软件控制窗口当前版本运行服务来实现。流程运行后，需要检测登录对话框，如果检测到，发送enter(这里没有登录密码，如果有密码，可以修改程序中发送的按钮实现登录)。但是，也有可能在登录时，系统未设置为“网络用户”模式，或者用户按下了屏幕上的“确定”对话框。程序不可能一直在这里等一个不可能的事件，所以要在这个地方判断。如果等待1分钟后仍未找到登录对话框，程序将继续以下操作。
三。代码示例
模块:
记录进程信息的公共类型进程条目32 '的结构[/Br/]dwsize AS LONG[/Br/]CNT Usage AS LONG[/Br/]th32 processid AS LONG[/Br/]th32 defaultheapid AS LONG[/Br/]th32 moduleid AS LONG[/Br/]CNT trends AS LONG[/Br/]th32 parentprocessid AS LONG[/Br/]pcPriClassBase AS LONG[/Br/]dw flags AS lppe作为进程入口32) as long '用于遍历进程池，这是search
public declare function process 32 next lib " kernel 32 "(byval hsnapshot as long， Pe as process entry32) as long '遍历进程池的向下递归函数
Public Type STARTUPINFO '记录进程启动信息的结构
cbas Long
LP reserved As String
LP desktop As String
dwX As String
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
hStdError As Long
End Type
Type process _ information '进程启动后记录相关信息的结构
hProcess As Long '进程句柄
hThread As Long '线程句柄
dwProcessId As Long '进程ID
DwThreadId As Long '线程ID
end type公共声明函数getcurrentprocesslib " kernel 32 "()As Long '获取当前进程句柄
公共声明函数getcurrentprocesslib 获取当前进程id
Public const th32 cs _ snap process = aslongh 2
公共声明函数waitforsingleobject Lib " kernel 32 "(ByVal h handle As Long，ByVal dw milliseconds As Long)
公共声明函数ExitWindowsEx Lib " user 32 "(ByVal u flags As Long，ByVal dw reserved As Long)
公共声明函数RegisterServiceProcess Lib " kernel 32 "(ByVal dw processid As Long，ByVal dwType As Long ByVal nSize As Long)
Long公共声明函数RegSetValueEx Lib "advapi32.dll "别名" RegSetValueExA "(ByVal hKey As Long、ByVal lpValueName As String、ByVal Reserved As Long、ByVal dwType As Long、ByVal lpData As String、ByVal CB data As Long)Long
公共声明函数RegCloseKey Lib " advapi32 . dll "(ByVal hKey As Long)公共声明函数RegOpenKey Lib " phkResult As Long)Long
公共声明函数GetWindow Lib " user 32 "(ByVal hwnd As Long，ByVal wCmd As Long)Long
公共声明函数GetWindow text Lib " user 32 " Alias " GetWindow texta "(ByVal hwnd As Long，ByVal lpString As String，ByVal CCH As Long)Long
公共声明函数GetWindow textlength Lib " user 32 " Alias " GetWindow textlength a "(ByVal hwnd As Long) ByVal bInheritHandles As Long，ByVal dwCreationFlags As Long，lpEnvironment As Any，ByVal lpcurrent directory As String，lpStartupInfo As STARTUPINFO，lpprocess INFORMATION As PROCESS _ INFORMATION)Long
公共声明函数get system menu Lib“user 32”(ByVal hwnd As Long，ByVal b revert As Long)
公共声明函数remove menu Lib“user 32”(ByVal hMenu As Long，ByVal nPosition As Long， ByVal wFlags一样长)一样长
公共声明函数DrawMenuBar Lib " user 32 "(ByVal hwnd一样长)一样长
公共声明函数GetMenuItemCount Lib " user 32 "(ByVal hMenu一样长)一样长
公共声明函数resume thread Lib " kernel 32 "(ByVal hThread一样长)一样长
公共声明函数suspend thread Lib " kernel 32 "(ByVal hThread一样长)一样长
公共声明函数 lpThreadId As Long)
Public Declare Function termin ate process Lib " kernel 32 "(ByVal hProcess As Long，ByVal uExitCode As Long)
Public Declare Function termin ate thread Lib " kernel 32 "(ByVal hThread As Long， ByVal dwExitCode As Long)
Public Const PROCESS _ termin ate = & 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 _ hwnd first = 0
Public Const GW _ hwnd next = 2
Public Const GW Public Const BM _ CLICK = & HF5
Public PE As process entry 32，hSnapshot As Long
Public start num As Long，AppName As String，Section As String，sKey As String，appValue As String，sKeyFile As String，sKey num As String
Public num terminate As Long，hThread As Long，ThreadID As Long，S filename As String
Public function start monitor(lparam As Long)As Long ' thread function
waitforthep SFileName ' start monitor
start monitor = 1
end function
public function send enter As Long()'搜索系统登录对话框，发送回车键
Dim Currwnd As Long，Length as long，listitem As string
curr wnd = getwindow(form 1 . hwnd，GW _ hwndfirst)'这里用窗口标题搜索的原因是系统重启时基本上不会加载太多进程，所以窗口的标题一般不会改变。
while curr wnd 0
length = getwindowtextlength(curr wnd)'获取窗口标题字符串的长度。
If Length 0 Then
ListItem As String = Space As String(Length)
Length = GetWindowText(curr wnd，ListItem As String，Length+2)'获取窗口标题
If InStr(ListItem，“输入网络密码”)0 Then
enumchildwindows curr wnd，获取ok按钮的地址，0
SendEnter = 1
Exit函数
End If
End If startinfo as startup info
startinfo . CB = len(startinfo)
if hProcess > 0 then '如果被监视的进程已经运行，则开始监视
dim wait result as long
wait result = WaitForSingleObject(hProcess，(-1)]
close handle hProcess
if startnum > = num termin ate then '如果重新启动的次数超过了设定的次数，则重新启动系统
save setting appname，section，skeleton 可以成功退出
exit sub
end if
startnum = startnum+1
form 1 . label 6 = startnum
end if
createprocessvbnullstring，Spath，0，0，true，32，byval0aslong，vbnullstring，startinfo，pro _ info '否则，用被监控进程的完整路径文件名
waitfortheprocesspro _ info . hprocess， sPath
end sub
public function getprocesshandle as long(byval sPath as string)'获取被监视进程的进程句柄
sPath = LCase(sPath)
Hsnapshot = Create toolhelp 32 snapshot(th 32 cs _ snap process，0)'创建快照对象
pe . dwsize = len(Pe)
bvalue = process 32 first(Hsnapshot，Pe)'开始遍历系统进程池
然后…
dim hProcess as long
hProcess = open process(process _ query _ information，0，Pe . th 32 processid)
GetProcessHandle = hProcess
close handle hSnapshot
Exit Function
End If
b value = process 32 next(hSnapshot，Pe)
wend
close handle hSnapshot
GetProcessHandle = 0 '否则 Vallparam as long)'获取“输入网络密码”框窗口中“确定”按钮的句柄
Dim Length & ListItem$
Length = GetWindowTextLength(hwnd)
如果长度为0，则
ListItem $ = Space $(Length)
Length = GetWindowText(hwnd，ListItem $，length+2)
如果instr (listitem，“确定”)为0，则
sendmessagehwnd，BM _ click 0 '发送Click消息
GetOkButton = 0 '退出EnumChildWindows()函数的枚举循环
退出函数
end if
end if
get button = 1 '继续EnumChildWindows()函数的枚举循环
end function
窗口中有几个标签控件:
Label2用于提示当前被监控的进程，Label4和Label6用于记录次数。 窗口中还有一个菜单，用来给用户提供设置方法。因为允许操作员设置，但是窗口不能隐藏，这里菜单是隐藏的，只有在窗口上点击鼠标右键才能看到，而客户在触摸屏上不能点击鼠标右键，所以设置是安全的。具体菜单项见以下程序:
private subform _ load()
RegisterServiceProcess GetCurrentProcess ID，RSP _ simple _ service '将进程注册为系统服务进程，这样进程只有在系统关闭的最后时刻才从系统中卸载。
Dim FN As String，hReg As Long，tRegKey As String，tSubKey As String，phkResult As Long，lpSubKey As String，enter result As Long
Dim time passes 1 As Long，time passes 2 As Long
FN = Space(255)
GetModuleFileName app . hin instance，FN，25 '获取当前进程的完整路径文件名
FN = trim(FN)
LP subkey fn，len (fn)'并将当前进程的完整路径写入上述注册表项，这样下次系统重启时就可以用系统登录对话框
RegCloseKey phkResult '关闭注册表项
appname = " ti monitor "
section = " reboot "/br/]skeyfile = " filename "
S filename = get setting(appname，section，skey file， "")'读取注册表中记录的被监控进程的完整路径名
AA: iflen (dir (s filename，VB目录))< 4 then
s filename = " C:tele infoti . exe " '如果无法读取或给出提示:
'sFileName = InputBox("找不到程序，请输入带有完整路径的程序名:"，" enter "，" C:tele infoti . exe ")
' Goto AA
End “0”)'确定进程是在系统重启时启动还是在运行过程中
如果appvalue =" 1 "则
删除设置appname，section，skey '如果是， 删除系统重新启动标志
time passed 1 = gettickcount
do
do events
enter result = send enter()
time passed 2 = gettickcount
If passed 2-time passed 1 > 60000然后exit do '将在1分钟超时
后退出循环，直到enter result 0
end If
sKeyNum = " termin ate numbers "
appValue = get setting(AppName，AppName " 4)'读取注册表中被监控进程重启次数的设置信息
num terminate = val(app value)
startnum = 0
label 4 = num terminate
label 6 = 0
Dimhmenu as long、lparam as long、menu count as long、I as long
hmenu = get system menu(hwnd，0)'为了不让客户关闭监控进程， 相关系统菜单
menu count = getmenuitemcount(hmenu)
for I = 0 to menu count-1
remove menu count，I，MF _ by position
Next
DrawMenuBar hwnd
hThread = Create thread(0，2000，AddressOf StartMonitor，lParam，0，ThreadID)'创建一个监视线程
end sub
私有子form _ mousedown As single)
如果button = 2那么popup menu munset '弹出设置菜单
end sub
private submunclose _ click()
termin ate process getcurrentprocess，1 '自行关闭，因为关闭系统菜单被阻塞，所以只能在程序中提供自己的方法来关闭，而且因为是多线程的，不能随便用Unload Me关闭。 它只是关闭了一个线程，但没有关闭监控线程。这里直接关闭当前进程，这样进程中所有正在运行的线程都可以同时关闭。
end sub
private sub mun pause _ click()'这是一个标有Check，examing，if mun pause . checked then
munResume . checked = true
resume thread hthread
else
munResume的菜单。checked = False
suspend thread hThread
End If
mun pause。选中=不是munPause。选中
End Sub
Private Sub mun resume _ Click()
If mun resume。检查然后
暂停。checked = True
suspend thread hThread
Else
mun pause。checked = False
resume thread hThread
End If
munResume。选中=非munResume。checked
End Sub
private mun setfile _ click()'设置要监控的进程的完整路径名
dim r filename为string
r filename = inputbox("请输入要监控的进程的完整路径名:"，" input "，S filename)
iflen(trim(r filename))< 4 then exit Sub '如果输入明显错误，则不做任何保存直接退出进程
如果Len(Dir(rFileName， VB archive))> 4然后
s filename = r filename
保存设置appname，section，skey file，s filename '保存正确的设置
label 2 = s filename
dim b如果msgbox ("Start over，vbYesNo) = vbYes，则'询问是否立即转到监视新进程
TerminateThread hThread，1
CloseHandle hThread
StartNum = 0
Checked，CREATE_SUSPENDED，0)
hthread = createthread (0，2000，start monitor的地址，0，b Paused，threadid)'如果此时在窗口菜单上设置了暂停，此时也会创建一个暂停线程，以便与菜单保持一致。
end If
end If
end sub
private sub munsettimes _ click()
dimnumt as string
numt =输入框("请输入重新启动进程的次数:"，" enter "，NumTerminate)'设置被监控进程重新启动的次数
if trim (numt) = " "然后退出sub '如果操作员选择"取消"或输入空，这次修改无效[/br trim (numt)'保存有效设置
label 4 = num terminate
end sub
this
注意，这个程序不要调试，因为VB本身是单线程的，不支持多线程调试。 只能编译运行，或者单独一个一个调试然后组合在一起。
四。结论
随着科学技术的发展和办公自动化的普及，许多公司摆脱了陈旧的办公机制，全部使用计算机自动执行许多过去由人工执行的任务。但是这些程序因为处理的东西多，代码复杂，往往会有一些小bug。这些bug有时会导致程序在自动化过程中意外关闭，导致流水线中断。
本程序适用于无人值班，但需要一直维护流程的地方。