三九宝宝网宝宝百科宝宝知识

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

12月02日 编辑 39baobao.com

[如何在excle2007中设置监视窗口]2选择功能区的公式选项3在公式选项卡里我们选择监视窗口4点击之后会出来监视窗口对话框,我们选择添加监5选择添加监视会它会出现添加监视点对话框,这时我们在工作表中拖动...+阅读

一、前言

有些对外营业的公司在大厅中都有一个触摸屏,以供客户查询公司的信息,可是通常查询程序都很大,而且很复杂,这样在连续长时间使用后难免会出现错误以致程序中途退出,这时就要工作人员来重新启动那个程序,而且有时候很忙不一定能有专人守在这个地方。其实可以用一个程序来专门处理这种情况的。我们局电信营业前台的多媒体查询系统也常常会出现这样的问题,下面是本人开发出来的监控程序处理思路。

二、实现思路及关键技术

要防止程序中途退出,就需要另外的一个程序专门对要监控的进程进行时刻不停的监控,检测到被监控的进程退出了就重新启动它。但是有时候可能是操作系统出了问题,不能简单地重复启动要监控的进程,在重启了一定的次数后被监控进程仍然退出,那就需要重新启动操作系统了,以便使操作系统中的环境参数等重新初始化,然后再运行监控进程并启动被监控的进程。

监控进程的存在不能影响被监控的进程,监控进程启动的时候要进行判断,看当前状况下被监控的进程有没有起来,如果起来了就获取其进程句柄并进行监控,如果没有起来则使之起来并监控。这里判断一个被监控的进程有没有起来不能简单地通过查找窗口标题来实现,因为窗口标题在程序内部可能是根据运行的时刻和条件动态地改变的,而且别的进程也可以和可能去改变被监控进程的窗口标题。

程序中使用了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 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 "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 lpmandLine 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’如果重启次数超过设置的次数就重新启动系统

SeSetting 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 = "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:teleinfoti.exe"’如果读取不到或系统不存在相应的文件,则取一个默认值。

或者给一个提示:

'sFileName = InputBox("找不到程序,请输入包含全路径的程序名:", "输入", "C:teleinfoti.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

SeSetting 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))

SeSetting AppName, Section, sKeyNum, Trim(NumT)’保存有效设置

Label4 = NumTerminate

End Sub

该程序在VB5.0、Windows98下运行通过。

注意,该程序不要进行调试,因为VB本身是单线程的,不支持多线程的调试,只能编译好后运行,或者一个一个分开调试,再合到一起。

四、结束语

随着科技的发展,办公自动化的流行,很多公司摆脱了老的办公机制,都使用了计算机来流水型自动执行很多以前需要人去手工执行的工作,但是这些程序因为处理的东西比较多,代码比较复杂,常常程序中会有一些小小的Bug,这些Bug有时会导致在自动化过程中程序被意外地关闭,致使流水线的中断,上面的这个程序可以帮助解决这个问题。

该程序在无人职守但又需要维持一个进程时刻执行的地方都适用。

以下为关联文档:

浅析监视和测量装置的控制摘要:公司的监视和测量装置主要适用于公司的房屋销售面积测量、工程施工建设,并对施工和监理单位使用的监视和测量装置进行监督检查。工程部负责监视和测量装置的归口管理工作...

编写安全的SQLServer扩展存储过程SQL Server 的扩展存储过程,其实就是一个普通的 Windows DLL,只不过按照某种规则实现了某些函数而已。近日在写一个扩展存储过程时,发现再写这类动态库时,还是有一些需要特别...

如何编写英文简历An effective resume is the foundation of every successful job campaign. Most students write their first resume when they are seeking internships or summer emplo...

刑诉—取保候审和监视居住刑事诉讼中的取保候审是公安机关、人民检察院和人民法院等专门机关对未被逮捕的犯罪嫌疑人、被告人,为防止其逃避侦查、起诉和审判,责令其提出保证人或者交纳保证金,并出具保证...

C++系统相关:InternetExplorer文件下载监视你是否想过类似下面的一些问题: 如何过滤IE中的flash 如何过滤在网页中嵌入email的病毒 如何实现像ants、flashget那样的下载监视 看到上面问题,你会很快认为这很简单: “对IE...

工程项目监理规划的编写的基本要求(1)监理规划的基本内容应当力求统一 监理规划是指导监理组织全面开展监理工作的指导性文件,它在总体内容组成上要求基本统一。监理规划的基本内容构成,应考虑以下因素:符合工程建...

JavaFX在一分钟内编写一个视频播放器首先在beans下新建一个JaFX空项目。然后从左边拖一个stage进来 Stage是一个jaFX的基础,一个Stage下包含一个sence,就是我们放可视的组件的地方。 改一下大小,取个名字如下: 1 St...

编写一段题为“谈论考试”的对话1.Kate觉得英语、数学题目不容易,但愿能通过考试。 2.Dick认为英语、数学考得还可以,但担心物理,因为一部分题目太难。 3.Kate安慰Dick说:“坐在我旁边的一位同学说,他花了两个小时,...

用汇编编写DOS下的内存驻留程序绪言 0.1 内存驻留与中断 内存驻留程序英文叫Terminate and Stay Resident Program,缩写为TSR.这些程序加载进内存,执行完后,就驻留在内存里,当满足条件时,调到前台来执行。...

推荐阅读
图文推荐