2023年6月23日发(作者：)

⼀、前⾔　　有些对外营业的公司在⼤厅中都有⼀个触摸屏，以供客户查询公司的信息，可是通常查询程序都很⼤，⽽且很复杂，这样在连续长时间使⽤后难免会出现错误以致程序中途退出，这时就要⼯作⼈员来重新启动那个程序，⽽且有时候很忙不⼀定能有专⼈守在这个地⽅。其实可以⽤⼀个程序来专门处理这种情况的。我们局电信营业前台的多媒体查询系统也常常会出现这样的问题，下⾯是本⼈开发出来的监控程序处理思路。　　⼆、实现思路及关键技术　　要防⽌程序中途退出，就需要另外的⼀个程序专门对要监控的进程进⾏时刻不停的监控，检测到被监控的进程退出了就重新启动它。但是有时候可能是操作系统出了问题，不能简单地重复启动要监控的进程，在重启了⼀定的次数后被监控进程仍然退出，那就需要重新启动操作系统了，以便使操作系统中的环境参数等重新初始化，然后再运⾏监控进程并启动被监控的进程。　　监控进程的存在不能影响被监控的进程，监控进程启动的时候要进⾏判断，看当前状况下被监控的进程有没有起来，如果起来了就获取其进程句柄并进⾏监控，如果没有起来则使之起来并监控。这⾥判断⼀个被监控的进程有没有起来不能简单地通过查找窗⼝标题来实现，因为窗⼝标题在程序内部可能是根据运⾏的时刻和条件动态地改变的，⽽且别的进程也可以和可能去改变被监控进程的窗⼝标题。程序中使⽤了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) AsLong’⽤来遍历进程池的函数，这是查找的起始函数　　Public Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) AsLong’遍历进程池的向下递归函数　　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 TypePublic 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 "" Alias "RegSetValueExA" (ByVal hKey As Long, ByVallpValueName 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 "" (ByVal hKey As Long) As Long　　Public Declare Function RegOpenKey Lib "" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKeyAs 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 lpStringAs String, ByVal cch As Long) As Long　　Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) AsLong　　Public Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String,ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByValbInheritHandles 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 wFlagsAs 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) AsLong　　Public Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) AsLong　　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 AsString, 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(, 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　　 = 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　　6 = StartNum　　End If　　CreateProcess vbNullString, sPath, 0, 0, True, 32, ByVal 0 As Long, vbNullString, StartInfo, Pro_Info’ 否则⽤被监控进程的全路径⽂件名来创建被监控进程　　WaitForTheProcess Pro_ss, sPath　　End Sub　　Public Function GetProcessHandle As Long(ByVal sPath As String)’获取被监控进程的进程句柄　　sPath = LCase(sPath)　　hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)’创建⼀个snapshot对象　　 = Len(pe)　　bValue = Process32First(hSnapshot, pe)’开始遍历系统进程池　　While bValue <> 0　　If InStr(LCase(ile), sPath) <> 0 Then’如果找到了，则…　　Dim hProcess As Long　　hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, 32ProcessID)　　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 nce, FN, 255’获取当前进程的全路径⽂件名　　FN = Trim(FN)　　lpSubKey = "Sysexplor"　　tSubKey = "SOFTWAREMicrosoftWindowsCurrentVersionRunServices"　　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:"’如果读取不到或系统不存在相应的⽂件，则取⼀个默认值。或者给⼀个提⽰：　　'sFileName = InputBox("找不到程序，请输⼊包含全路径的程序名：", "输⼊", "C:")　　'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 d Then　　d = True　　ResumeThread hThread　　Else　　d = False　　SuspendThread hThread　　End If　　d = Not d　　End Sub　　Private Sub munResume_Click()　　If d Then　　d = True　　SuspendThread hThread　　Else　　d = False　　ResumeThread hThread　　End If　　d = Not d　　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(d, 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有时会导致在⾃动化过程中程序被意外地关闭，致使流⽔线的中断，上⾯的这个程序可以帮助解决这个问题。　　该程序在⽆⼈职守但⼜需要维持⼀个进程时刻执⾏的地⽅都适⽤。