Detect if program is not responding!

[Jhivago]

I am hosting a little application called "cserver.exe" but sometimes it crashes for no reazon. sometimes it happens at night and it starts to be a problem.

is there any way of detecting if cserver.exe stopped responding? and if so, kill it and re-open it. thanks.

ps. it can be a timer that checks the application status every 3 minutes.

[Nightwalker83]

You might find something useful here.

[Jhivago]

it didn't help since the other guy couldn't't figure it aswell

[Nightwalker83]

How about this?

[Jhivago]

i don't really understand that one. where do i place cserver.exe so it can trace it? close it and re-open it if it's not responding

[Nightwalker83]

I guess it would be something like:

Option Explicit
 
'API Constants
Const SMTO_BLOCK = &H1
Const SMTO_ABORTIFHUNG = &H2
Const WM_NULL = &H0
Const WM_CLOSE = &H10
Const PROCESS_ALL_ACCESS = &H1F0FFF
'API functions
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, _
lpdwProcessId As Long) As Long
 
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
 
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" _
(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As _
Long, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long
 
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, _
ByVal uExitCode As Long) As Long
 
Private modObjIE As Object
Private modlngWndIE As Long
 
Private Sub cmdCheck_Click()
    Dim lngResult As Long
    Dim lngReturnValue As Long
  lngReturnValue = SendMessageTimeout(modlngWndIE, WM_NULL, 0&, 0&, SMTO_ABORTIFHUNG And SMTO_BLOCK, 1000, lngResult)
    If lngReturnValue Then
        MsgBox "Responding"
    Else
        MsgBox "Not Responding","Block tester"
    End If
End Sub
 
Private Sub cmdLaunch_Click()
    Set modObjIE = Nothing
    Set modObjIE = CreateObject("cserver.exe")
     'cserver activities code
      modObjIE.Visible = True
 
    modlngWndIE = modObjIE.hwnd
End Sub
 
Private Sub cmdKill_Click()
    Dim lngProcessID As Long
    Dim lngReturnValue As Long
    Dim lngProcess As Long
    lngReturnValue = GetWindowThreadProcessId(modlngWndIE, lngProcessID)
    lngProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, lngProcessID)
    lngReturnValue = TerminateProcess(lngProcess, 0&)
End Sub

That is after you add a reference to "cserver.exe" in to the project.

[Jhivago]

i can't figure it out from there, sorry for bugging you so much, but here is a change of plan. i just want this:

i have a button and a textbox

if i press the button it will put in the textbox 1 or 0
1 if cserver.exe is running
0 if cserver.exe is not responding

[Nightwalker83]

i have a button and a textbox

if i press the button it will put in the textbox 1 or 0
1 if cserver.exe is running
0 if cserver.exe is not responding

From what I can tell this would still require the code I posted above except instead displaying a message box saying whether or not the program was responding you would display the particular value in a text box.

I have an idea try the code I posted above using the instructions from the page I linked to.

# Start a new Standard EXE project in Visual Basic.
# Form1 is created by default. Place three command buttons on the form and name them cmdCheck, cmdLaunch, and cmdKill. Change their Caption property to Check, Launch, and Kill, respectively.

Add the code I posted above to the form.

All I changed in the code I posted above was:

Set modObjIE = CreateObject("cserver.exe")

from

Set modObjIE = CreateObject("InternetExplorer.Application")

[Jhivago]

i get a syntax error, and this text is red:

lngReturnValue = SendMessageTimeout(modlngWndIE, WM_NULL, 0&,
0&, SMTO_ABORTIFHUNG And SMTO_BLOCK, 1000, lngResult)

the one under Private Sub cmdCheck_Click()

[Nightwalker83]

I formatted the above code so that line of code would be:

lngReturnValue = SendMessageTimeout(modlngWndIE, WM_NULL, 0&, 0&, SMTO_ABORTIFHUNG And SMTO_BLOCK, 1000, lngResult)

[Jhivago]

i get a msgbox that tells me the program is not responding even if working.

[Nightwalker83]

i get a msgbox that tells me the program is not responding even if working.

Did you add a reference to "cserver.exe" in the project?

Edit:

I created this and it seems to work.

Private 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 Long
      hStdInput As Long
      hStdOutput As Long
      hStdError As Long
   End Type
 
   Private Type PROCESS_INFORMATION
      hProcess As Long
      hThread As Long
      dwProcessId As Long
      dwThreadID As Long
   End Type
 
   Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
      hHandle As Long, ByVal dwMilliseconds As Long) As Long
'API Constants
Const SMTO_BLOCK = &H1
Const SMTO_ABORTIFHUNG = &H2
Const WM_NULL = &H0
Const WM_CLOSE = &H10
Const PROCESS_ALL_ACCESS = &H1F0FFF
'API functions
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, _
lpdwProcessId As Long) As Long
 
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
 
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" _
(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As _
Long, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long
 
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, _
ByVal uExitCode As Long) As Long
 
   Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
      lpApplicationName As String, ByVal lpCommandLine As String, ByVal _
      lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
      ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
      ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, _
      lpStartupInfo As STARTUPINFO, lpProcessInformation As _
      PROCESS_INFORMATION) As Long
 
   Private Declare Function CloseHandle Lib "kernel32" _
      (ByVal hObject As Long) As Long
 
   Private Declare Function GetExitCodeProcess Lib "kernel32" _
      (ByVal hProcess As Long, lpExitCode As Long) As Long
 
   Private Const NORMAL_PRIORITY_CLASS = &H20&
   Private Const INFINITE = -1&
      Dim proc As PROCESS_INFORMATION
      Dim start As STARTUPINFO
 
 
   Public Function ExecCmd(cmdline$)
   
      ' Initialize the STARTUPINFO structure:
      start.cb = Len(start)
 
      ' Start the shelled application:
      ret& = CreateProcessA(vbNullString, cmdline$, 0&, 0&, 1&, _
         NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)
 
      ' Wait for the shelled application to finish:
         ret& = WaitForSingleObject(proc.hProcess, INFINITE)
         Call GetExitCodeProcess(proc.hProcess, ret&)
         Call CloseHandle(proc.hThread)
         Call CloseHandle(proc.hProcess)
         ExecCmd = ret&
   End Function
 
   Sub Form_Click()
      Dim retval As Long
        Dim lngResult As Long
    Dim lngReturnValue As Long
    'Replace the path and app.name.type with that of the application you want to use
      retval = ExecCmd("C:\Users\User\Desktop\cserver.exe")
        lngReturnValue = SendMessageTimeout(modlngWndIE, WM_NULL, 0&, 0&, SMTO_ABORTIFHUNG And SMTO_BLOCK, 1000, lngResult)
    DoEvents
    If lngReturnValue Then
        MsgBox ("Responding")
    Else
    'Close the host and the client if the client does not respond
        Call GetExitCodeProcess(proc.hProcess, ret&)
        Call CloseHandle(proc.hThread)
        Call CloseHandle(proc.hProcess)
       Unload Me
    End If
   End Sub

I created the above using a mixture of code from previous code above and the code here.

[Doogle]

Using NightWalker83's code in Post #12 as a basis, here's a (trimmed down) version that will start and then monitor the program every second (you can easily change the Timer interval)

Option Explicit
'
' Assumes a Timer Control is drawn on the Form named Timer1
' On clicking on the Form, this Program will start C:\Project1.Exe 
' and monitor it until it terminates
'
Private 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 Long
      hStdInput As Long
      hStdOutput As Long
      hStdError As Long
End Type

Private Type PROCESS_INFORMATION
      hProcess As Long
      hThread As Long
      dwProcessId As Long
      dwThreadID As Long
End Type

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
      hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
      lpApplicationName As String, ByVal lpCommandLine As String, ByVal _
      lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
      ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
      ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, _
      lpStartupInfo As STARTUPINFO, lpProcessInformation As _
      PROCESS_INFORMATION) As Long

Private Declare Function CloseHandle Lib "kernel32" _
      (ByVal hObject As Long) As Long


Private Const NORMAL_PRIORITY_CLASS = &H20&
Private proc As PROCESS_INFORMATION
Private start As STARTUPINFO


Private Function ExecCmd(cmdline$)
Dim ret As Long
' Initialize the STARTUPINFO structure:
start.cb = Len(start)
' Start the application:
ret = CreateProcessA(vbNullString, cmdline$, 0&, 0&, 1&, _
         NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)
ExecCmd = ret
End Function

Sub Form_Click()
Dim retval As Long
Dim lngResult As Long
Dim lngReturnValue As Long
'Replace the path and name with that of the application you want to use
retval = ExecCmd("C:\Project1.exe")
Timer1.Enabled = True
End Sub

Private Sub Form_Load()
Timer1.Enabled = False
Timer1.Interval = 1000
End Sub

Private Sub Timer1_Timer()
Dim lngResult As Long
Dim lngReturnValue As Long
Dim ret As Long
ret = WaitForSingleObject(proc.hProcess, 500)
If ret = 0 Then
    MsgBox "Not Responding", , "Monitor"
    Call CloseHandle(proc.hThread)
    Call CloseHandle(proc.hProcess)
    Unload Me
End If
End Sub

This is the program to be monitored: (C:\Project1.exe)

Option Explicit

Private Sub Command_Click()
Dim x As Long
Do While True
    x = x + 1
Loop
End Sub

When you click the button in the above it will run for a time and then fail with an Overflow Error. When you acknowledge the error, the monitor will detect the fact and issue a Message.

Mind you, I think it would be better in the long run to determine why cserver.exe fails 'for no reason' - there's always a reason.

[dilettante]

My guess is that the program enters an infinite loop or it deadlocks somewhere, rather than just terminating all the time.

The weird thing they seem to be stabbing around at above only works for an ActiveX EXE that exposes an hWnd property on its default class (if any). That's what IE does for its Application class.

You could simply Shell() the program, grab the PID returned, lookup the process handle from that via an API call. Then open the process to monitor for completion as well as look up the hWnd based on the PID by enumerating all windows. That hWnd could be used to SendMessageTimeout the WM_NULL message.

Without threading you can't do all of this perfectly since the SendMessageTimeout is a long-running sync call the way they're using it, but they might shorten the timeout and check for both things (process terminated and "window ping" working) based on a Timer tick.


Better to just fix the program though.

[Nightwalker83]

When you click the button in the above it will run for a time and then fail with an Overflow Error. When you acknowledge the error, the monitor will detect the fact and issue a Message.

I have tested this with a program I am currently creating although, it restarts the target program regardless of if it were closed correctly or as a result of a crash. Is there a way to detect whether it was a crash that closes the program or the user that closed the program?

[jpbro]

You could do something like this for crash checking:

When the program you are monitoring starts up, set a registry value to 1. E.g. SaveSetting "MyApp", "Startup", "CrashCheck", 1
In the Form_Unload event of the main form, delete that registry value. E.g. DeleteSettings "MyApp", "Startup", "CrashCheck"

In your watchdog program, if the registry value is 1 (GetSetting("MyApp", "Startup", "CrashCheck", 0) and the program being monitored is not running, then you can assume that it crashed. Delete the registry value and restart the program.

[Stupidiot]

U can create a txt file to check this:
Every 3 minutes - Timer-60000*3 - the main program “cserver.exe” will write the current time in a file:

WriteAlive()
Open App.Path & "\Live.txt" For Output As #1
Print #1, Time$
Close #1

Private Sub Load () - main program cserver.exe load 
If App.PrevInstance = True Then
Unload Me
Exit Sub
End If
Shell App.Path & "\Monitor.exe "
End Sub

Private Sub Unload() - main program cserver.exe unload
Open App.Path & "\Log.txt" For Output As #1
Print #1, "User Closed" & Time$
Close #1
KillProcess "Monitor.exe" 'No need to Monitor
End Sub

Every 1 minutes - Timer-60000*1- the Monitor program “Monitor.exe” will check the same file and if necessary, kill & Reopen cserver.exe:

CheckAlive()
Dim TextLine, X
Open App.Path & "\Live.txt" For Input As #1
   Line Input #1, TextLine
Close #1
X = DateDiff("n", TextLine, Time$)
If X > 3 Then
KillProcess "cserver.exe" 'Kill
Open App.Path & "\Log.txt" For Output As #1
Print #1, "Stopped responding, Killed and re-opened" & Time$    
Close #1
Shell App.Path & "\cserver.exe" 'Re-Open
End If

Private Sub Load () - Monitor program Monitor.exe load 
If App.PrevInstance = True Then
Unload Me
Exit Sub
End If
End Sub

Check this:
http://www.vbforums.com/showthread.php?t=651961