程序死机后重启

[「已注销」]

我要实现程序死机后重启的功能，请问怎么判断程序的运行状态，是正常还是已经死机了。

[cbm6666]

自己都死了还能再怎样? 当然是由另个程序来监控了.

用CPU使用率也不准,如果你这个程序的CPU耗用率有明显差距的话用这个最准,差距不大甚至没差则无法用CPU来判断.

另种方法是你可以用个随时在浮动变化的文字或数字当Flag(旗标),例如 Me.Caption的内容,或 Text1.text 等, 正常情况是会变化的,简单点在Timer事件中Text1.text=time$或Me.caption=Time$只要检查这个没变化就知道是死机啦.

[舉杯邀明月]

5/6楼说的可行吗？

我非常怀疑……

我觉得4楼的方法比较可靠。

[「已注销」]

怀疑中，vb支持不支持多线程还存疑。至少vb的多线程不稳定吧。

[cbm6666]

'**************************** 被监视的代码
'添加 Text1 Timer1

Private Sub Form_Load()
Me.Caption = "死机测试"
Timer1.Interval = 500
End Sub

Private Sub Timer1_Timer()
Text1.Text = Time$
End Sub


'****************************监视的代码
'添加 Timer1

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const WM_GETTEXT = &HD
Const WM_GETTEXTLENGTH = &HE
Dim Phwnd&, ChildHwnd&, Tmpstr$, Textlen&, Errcount%, OldStr$
Private Sub Form_Load()
Timer1.Interval = 100
End Sub

Private Sub Timer1_Timer()
Phwnd = FindWindow(vbNullString, "死机测试")
If Phwnd <> 0 Then
ChildHwnd = FindWindowEx(Phwnd, 0, "ThunderTextBox", vbNullString)
If ChildHwnd > 0 Then
If GetText(ChildHwnd) <> OldStr Then
Errcount = Errcount + 1
If Errcount > 100 Then MsgBox "死机了"
OldStr = GetText(ChildHwnd)
End If
Else
OldStr = "未运行"
End If
Else
OldStr = "未运行"
End If
Me.Caption = OldStr
End Sub

Function GetText(Thwnd As Long) As String
Textlen = SendMessage(Thwnd, WM_GETTEXTLENGTH, 0, 0)
If Textlen = 0 Then GetText = "": Exit Function
Textlen = Textlen + 1
Tmpstr = Space(Textlen)
Textlen = SendMessage(Thwnd, WM_GETTEXT, Textlen, ByVal Tmpstr)
GetText = Left(Tmpstr, Textlen)
End Function

[「已注销」]

请教一下 这样可以么

Private Sub Command1_Click()

'被监控程序标题
Dim MoniterPrgTitle As String
MoniterPrgTitle = "die"


Dim lngResult As Long
Dim lngReturnValue As Long

'被监控程序句柄
Dim windowshwnd As Long
windowshwnd = FindWindow(vbNullString, MoniterPrgTitle)

'modlngWndIE为要接收消息的一个窗口的句柄
lngReturnValue = SendMessageTimeout(windowshwnd, WM_NULL, 0&, 0&, SMTO_ABORTIFHUNG And SMTO_BLOCK, 1000, lngResult)

If lngReturnValue Then
MsgBox "程序运行正常"
Else
MsgBox "程序失去响应"

'关闭程序
SendMessage windowshwnd, wm_close, 0, 0
'重新启动
'App.EXEName 为工程名 注意工程名与生成的exe名称相同
'Shell (IIf(Right(App.Path, 1) <> "\", App.Path & "\", App.Path) & App.EXEName & ".exe")
Shell (IIf(Right(App.Path, 1) <> "\", App.Path & "\", App.Path) & "die.exe")

End If

End Sub

[「已注销」]

楼上有人说用标题，想了一下没用
Private Sub Command1_Click()

Open "pic/date.txt" For Output As #1
Print #1, "a"
Close #1

End Sub

简单的创建一个文件，但是pic文件夹不存在，这样会报错。但是标题不发生变化，这个程序就不能用那些方法监控。

[Mars.CN]

2F的搞复杂了
winsock用到的东西太多了
直接API就可以监控
或者用哪个DDE（好像是这个，就是公用一块存储区域的东西）
再不行弄个文件，最简单的
Winsock确实不是好的解决方案

[cbm6666]

10F 代码难道不行吗 ?

If Errcount > 100 Then MsgBox "死机了"

改为

If Errcount > 100 Then
'关闭程序
'重新启动
'结束进程
'看你要做其它什么啦....
End If

12F

Open "pic/date.txt" For Output As #1
这行是啥 ? 文件名你要写全路径啊,还有路径中是 \ 不是 /

[msn2005]

看来动真格的了

[「已注销」]

我知道那个文件的错误啊，我就是让它错，然后程序就提示错误，弹出一个消息框。但是程序不退出。这时就需要监控程序把这个报错的程序杀死，再重新开启。
谢谢10楼的建议。我再试试。

[嗷嗷叫的老马]

[Quote=引用 9 楼 ncu571633 的回复:]
怀疑中，vb支持不支持多线程还存疑。至少vb的多线程不稳定吧。
[/Quote]

//

看看这个稳定不:

http://www.m5home.com/blog/article.asp?id=54

这是用这方法写的一个下载程序:

http://www.m5home.com/blog/article.asp?id=65

如果用另一单元线程来写只狗,估计会方便很多.

不过那样的话,你主功能如何重新启动,这又是另一个问题了.

[嗷嗷叫的老马]

而且我认为,除非你的那个主功能写得有问题,不然怎么会有这种需求?

你的主功能的错误,无法从流程上解决吗?非得用这些非常手段?

我觉得应该不会是绝对的吧.

[嗷嗷叫的老马]

[Quote=引用 16 楼 ncu571633 的回复:]
我知道那个文件的错误啊，我就是让它错，然后程序就提示错误，弹出一个消息框。但是程序不退出。这时就需要监控程序把这个报错的程序杀死，再重新开启。
谢谢10楼的建议。我再试试。
[/Quote]

//

为什么不把这个错误捕捉了,再处理?而非要抛出错误后再由强行的手段去重启?

[cbm6666]

10F的是顺着思路写的没测试,呵呵...是有些错误.

以下代码已经过测试, 思路是这样的代码1(被监控的c:\die.exe), 这个代码上面有个按钮让它计时或不计时.
代码2是 监控的程序, 如果代码1的计时停止一段时间,则认为代码1已死机, 自动把它关掉,3秒后让它再启动运行.

请点击代码1的按钮让计时器跑或停止.

'**************** 代码 1 被监控的代码, 请编译后放在 c:\die.exe
'添加 Timer1 Command1 Text1

Private Sub Form_Load()
Me.Caption = "死机测试"
Timer1.Interval = 500
Timer1.Enabled = True
Command1.Caption = "停 止"
End Sub

Private Sub Timer1_Timer()
Text1.Text = Time$
End Sub

Private Sub Command1_Click()
Timer1.Enabled = Not Timer1.Enabled
Command1.Caption = IIf(Command1.Caption = "计 时", "停 止", "计 时")
End Sub



'*************************** 代码 2 监控的代码
'添加 Timer1

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const WM_CLOSE = &H10
Const WM_GETTEXT = &HD
Const WM_GETTEXTLENGTH = &HE
Dim Phwnd&, ChildHwnd&, Tmpstr$, Textlen&, Errcount%, OldStr$, ExePath$, Starttm&, aa$
Private Sub Form_Load()
Timer1.Interval = 100
ExePath = "c:\die.exe"
End Sub

Private Sub Timer1_Timer()
Phwnd = FindWindow(vbNullString, "死机测试")
If Phwnd <> 0 Then
ChildHwnd = FindWindowEx(Phwnd, 0, "ThunderRT6TextBox", vbNullString)
If ChildHwnd > 0 Then
aa = GetText(ChildHwnd)
If OldStr = aa Then
Errcount = Errcount + 1
If Errcount > 100 Then
Timer1.Enabled = False
'******************* 关掉它并停止计时器的监控
Call SendMessage(Phwnd, WM_CLOSE, 0, ByVal 0&)
Me.Caption = "死机了, 已被我关掉啦"
Starttm = Timer
Do
DoEvents
Loop Until Timer - Starttm >= 3
'******************* 暂停3秒后,再度开启c:\die.exe并重新启动计时器监控
Call Shell(ExePath, vbNormalFocus)
Timer1.Enabled = True
End If
Else
OldStr = aa: Errcount = 0
End If
Else
OldStr = "找不到检测窗口"
End If
Else
OldStr = "程序未运行"
End If
Me.Caption = OldStr
End Sub

Function GetText(Thwnd As Long) As String
Textlen = SendMessage(Thwnd, WM_GETTEXTLENGTH, 0, 0)
If Textlen = 0 Then GetText = "": Exit Function
Textlen = Textlen + 1
Tmpstr = Space(Textlen)
Textlen = SendMessage(Thwnd, WM_GETTEXT, Textlen, ByVal Tmpstr)
GetText = Left(Tmpstr, Textlen)
End Function

[shakoe]

楼上几位说的都有道理。

但是我考虑不用开另外的进程也能实现这样的功能。（毕竟多出来的进程也需要管理）

思路如下：


程序开始就建立一个独立的类似”看门狗“功能的线程。

然后在主线程里面在合适的位置“喂狗”。当然觉得麻烦也可以在主线程开一个定时器“喂狗”。

[shakoe]

“看门狗”功能简单介绍：
“看门狗”线程定期的轮询某一个标志位（VB里面可以是一个全局变量)，如果不是“正常状态”就认为程序进入异常状态。

那么就重启程序或者关闭程序。

如果是“正常状态”那么把标志位设置成“非正常状态”，为下次轮询做准备。

“喂狗”
在你的主程序里面，定时或者定量（走过一定的逻辑）把标志位设置成“正常状态”。


举例：
比如你做的逻辑你认为每次大概10分钟左右一个循环，超过20分钟就可以认为是当机了。

那么你把“看门狗”线程的轮询周期设置为20分钟，然后在每次的逻辑最后“喂狗”

这样如果超过20分钟还没有“喂狗”，“看门狗”线程就认为你的主线程当了，就可以关闭本进程了。



当然，VB是事件驱动的，不一定存在一个循环的主逻辑。可以在主线程“主窗体”里面设置一个定时器来喂狗，要是这个定时器当了可以认为主线程也当了。

[cbm6666]

每个程序一运行就会有句柄, 另个监控程序随时检查这个句柄里面指定的任何一个子句柄(例如标题或TextBox), 看看内容有没有变化不就知道了,也不过就短短几行代码罢了, 为什么还要搞得那么复杂呢??

[嗷嗷叫的老马]

做另一个程序的话,比较简单的方法是交换消息....

思路:

目标程序定期使用BroadcastSystemMessage广播一条自定义消息.比如一秒一次,语法:

BroadcastSystemMessage BSF_IGNORECURRENTTASK Or BSF_POSTMESSAGE, BSM_APPLICATIONS, MyMsg, 0, 0

其中MyMsg为自定义消息,最好使用RegisterWindowMessage得到;

检测程序的主窗口里做个子类化,拦截此自定义消息,一旦发现高于某时间(例如五秒)未收到这个自定义消息,那就可以判断为目标程序挂了~~~~

如果你的目标程序可以由检测程序启动,那就更方便,SHELL后返回的是PID,一旦判断为目标程序挂了,直接TerminateProcess后再次SHELL,嘿嘿.

代码很简单的,没几句,自己写吧.....

说句题外话:

为什么不把目标程序挂起的原因找到呢?这样未免太不健壮了~~

PS:

以上思路的前提是,"目标程序"也是由你写的!

不然就得想其它办法了!

[josephSC]

同意8楼的看法

[「已注销」]

多谢各位大虾给的提示和答案，这个问题我想已经差不多了，特别是cbm666和myjian两位。谢谢了，分数
等我做完再给吧，虽然才20分比较少。但是我还是想表示谢意。