原文地址 http://yulv.net/archives/10/
前两天看了Delphi版面精华区中的《进程死亡的自动复活》一文,觉得作者的思路很不错,利用api来监视进程的活动,当被销毁时就自动再创建进程。仔细推敲之后,发觉其实用vb也是可以做到的。于是花了半天的时间写了以下的程序,实现了使用WaitForSingleObject API来监视被创建的进程的活动,一旦返回除 time out 之外的消息就自动创建新的进程。以下为其实现代码。在 win2000 server + vb 6.0下通过。
OptionExplicit
PrivateRunFile$
Private ConstNORMAL_PRIORITY_CLASS =&H20'如果进程位于前台,则基本值是9;如果在后台,则优先值为7 Private ConstINFINITE =&HFFFFFFFF Private ConstWAIT_TIMEOUT =&H102&'对象保持未发出信号的状态,但等待超时时间已经超过 PrivateFlagAs Boolean‘进程活动监视标志
'说明∶PROCESS_INFORMATION结构由CreateProcess函数将关于新建立的进程和 '主要线索的信息写入其中成员变量 PrivateType PROCESS_INFORMATION' hProcessAs Long hThreadAs Long dwProcessIdAs Long dwThreadIdAs Long EndType
'说明∶STARTUPINFO结构用在CreateProcess函数中指定为新进程建立的新窗口的主要属性。这一 '一信息影响由CreateWindows函数建立的第一个窗口 PrivateType STARTUPINFO cbAs Long lpReservedAs String lpDesktopAs String lpTitleAs String dwXAs Long dwYAs Long dwXSizeAs Long dwYSizeAs Long dwXCountCharsAs Long dwYCountCharsAs Long dwFillAttributeAs Long dwFlagsAs Long wShowWindowAs Integer cbReserved2As Integer lpReserved2As Long hStdInputAs Long hStdOutputAs Long hStdErrorAs Long EndType
Private Declare FunctionCloseHandleLib"kernel32"(ByValhObjectAs Long)As Long Private Declare FunctionWaitForSingleObjectLib"kernel32"(ByValhHandleAs Long,ByValdwMillisecondsAs Long)As Long Private Declare FunctionCreateProcessLib"kernel32"Alias"CreateProcessA"(ByVallpApplicationNameAs String,ByVallpCommandLineAs String,ByVallpProcessAttributesAs Long,ByVallpThreadAttributesAs Long,ByValbInheritHandlesAs Long,ByValdwCreationFlagsAs Long,lpEnvironmentAsAny,ByVallpCurrentDirectoryAs String,lpStartupInfoAsSTARTUPINFO,lpProcessInformationAsPROCESS_INFORMATION)As Long Private Declare FunctionWaitForInputIdleLib"user32"(ByValhProcessAs Long,ByValdwMillisecondsAs Long)As Long
Private Subcommand1_Click() Dimres& DimsinfoAsSTARTUPINFO DimpinfoAsPROCESS_INFORMATION sinfo.cb = Len(sinfo) sinfo.lpReserved = vbNullString sinfo.lpDesktop = vbNullString sinfo.lpTitle = vbNullString sinfo.dwFlags =0
Label1.Caption ="正在启动程序" Label1.Refresh ' CreateProcess函数,用于创建一个新的进程 res = CreateProcess(DemoFile,vbNullString,0,True,_ NORMAL_PRIORITY_CLASS,ByVal0&,sinfo,pinfo) IfresThen Label1.Caption ="程序正在运行中" WaitForTerm pinfo Label1.Caption ="程序已经结束" Else Label1.Caption ="启动程序时出错,可能未正确输入"& Chr(13) &"程序名或程序所在路径。" End If End Sub
Private SubWaitForTerm(pinfoAsPROCESS_INFORMATION) Dimres& Dimres1& ' 等待指定的进程进入空闲状态,,空闲(Idle)指的是进程准备处理一条消息、但目前暂时没有消息需要处理的一种状态 CallWaitForInputIdle(pinfo.hProcess,INFINITE) Command1.Enabled =False Command2.Enabled =True Label1.Refresh Do IfFlagThen Exit Do
'等待发出信号 res = WaitForSingleObject(pinfo.hProcess,0) Ifres<> WAIT_TIMEOUTThen'如果对象发出了信号 command1_Click
Exit Do End If DoEvents Debug.Print res
Loop While True Command1.Enabled =True Command2.Enabled =False End Sub
Private SubCommand3_Click() Flag =True End Sub
Private SubForm_Load() RunFile = InputBox$("请输入需要运行的程序名与路经") Flag =FalseEnd Sub (编辑:李大同)
【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容!
|