Detect if Process is 'Not Responding' [Almost RESOLVED]

[LITHIA]

Hey everyone,

I searched for how you would detect whether a certain process is Not Responding or not, but I didnt have any luck - sorry if it has been answered elsewhere though.

What the problem is, I have this application which needs to detect when a certain process is 'Not Responding'.

This process is called "Game.exe" so it needs to be exactly like that.

If it finds that it is 'Not Responding' how would I end it? A simple

SendMessage lWnd, WM_CLOSE, 0&, 0&

should work really, because I can still use the Window name as that doesnt change.

Thanks for any help! This program is really going to help me and my friends when its finished.

P.S. If this will end up being done with a loop, how much resources are we expecting to use up? It doesnt matter much at all, but I am just asking. (If there are problems at the end with lagging "Game.exe" at all, I can try and find a different solution) - thanks again

[LITHIA]

I tested the

SendMessage lWnd, WM_CLOSE, 0&, 0&

against a Not Responding app...

as I thought after posting the main thread, it didnt work.

The app is not responding so it cant respond to the Close request (which is pretty obvious now you think about it)

So ill need another method of ending the process.

Thanks

LITHIA

[TheVader]

Hmm, I came around this code once that enumerated all active processes and could also 'terminate' one; don't know how it worked, but it sounds like it exactly what you're looking for. I found it somewhere on www.vbcode.com; try searching for 'processes' or 'active processes'.

[crptcblade]

Use SendMessageTimeOut.

Option Explicit
 
Private Declare Function SMTO 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 FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
                                                                      ByVal lpWindowName As String) _
                                                                      As Long
 
Private Const SMTO_ABORTIFHUNG = &H2
Private Const SMTO_BLOCK = &H1
Private Const SMTO_NORMAL = &H0
 
Private Const WM_CLOSE = &H10
 
Private Sub Command2_Click()
Dim h As Long
 
    h = FindWindow(vbNullString, "Hung Process")
 
    If SMTO(h, WM_CLOSE, 0&, 0&, SMTO_ABORTIFHUNG, 3000, 0&) = 0& Then
        MsgBox "Process is hung!"
    Else
        MsgBox "Process is not hung!"
    End If
 
End Sub

[LITHIA]

Originally posted by crptcblade
Use SendMessageTimeOut.

thanks very much for the code. It looks great, but what code could I use to Terminate the Process where it says

MsgBox "Process is hung!"

Thats where I will want to add the end process code.

And

MsgBox "Process is not hung!"

Will be just Exit Sub

Dim h As Long
    h = FindWindow(vbNullString, "Hung Process")
    If SMTO(h, WM_CLOSE, 0&, 0&, SMTO_ABORTIFHUNG, 3000, 0&) = 0& Then

I have put this on a 2 second timer. That way it will detect if the process is hung every 2 seconds. Good enough?

Thanks again,

TheVader, thanks for the tip ill try it out and tell you what i get. Cya

(Please can somone still try and help with the end process code though, I may not be able to find it but I should from TheVaders help )

[LITHIA]

Hmm i just realised somthing.

I dont understand what your code is doing.

If SMTO(h, WM_CLOSE, 0&, 0&, SMTO_ABORTIFHUNG, 3000, 0&) = 0& Then

seems to close the window even if its not hung!

(and if it was hung, i dont think it would work because it sends the close request to the program doesnt it?)

Like i said before, it cant accept a close request if its hung. You need windows to end its process.

Thanks for help, can you stop it from closing the window?

Thanks

[lejohn]

By the way, Anybody knows Where I can find API docs ?

Thanks alot.

[LITHIA]

www.allapi.net i believe gives u lots of stuff, and a nice viewer u can download

[TheVader]

I just came across this code, it might be helpful. Didn't test it, but it should terminate a process given its ID.

Private Type LUID
  lowpart As Long
  highpart As Long
End Type
 
Private Type TOKEN_PRIVILEGES
   PrivilegeCount As Long
   LuidUDT As LUID
   Attributes As Long
End Type
 
Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
Const PROCESS_ALL_ACCESS = &H1F0FFF
 
Private Declare Function GetVersion Lib "kernel32" () As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As _
   Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle _
   As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias _
   "LookupPrivilegeValueA" (ByVal lpSystemName As String, _
   ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal _
   TokenHandle As Long, ByVal DisableAllPrivileges As Long, _
   NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, _
   PreviousState As Any, ReturnLength As Any) 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 TerminateProcess Lib "kernel32" (ByVal hProcess As _
   Long, ByVal uExitCode As Long) As Long
 
' Terminate any application and return an exit code to Windows
' This works under NT/2000, even when the calling process
' doesn't have the privilege to terminate the application
' (for example, this may happen when the process was launched
'  by yet another program)
'
' Usage:  Dim pID As Long
'         pID = Shell("Notepad.Exe", vbNormalFocus)
'         '...
'         If KillProcess(pID, 0) Then
'             MsgBox "Notepad was terminated"
'         End If
 
Function KillProcess(ByVal hProcessID As Long, Optional ByVal ExitCode As Long) _
   As Boolean
   Dim hToken As Long
   Dim hProcess As Long
   Dim tp As TOKEN_PRIVILEGES
   
   ' Windows NT/2000 require a special treatment
   ' to ensure that the calling process has the
   ' privileges to shut down the system
   
   ' under NT the high-order bit (that is, the sign bit)
   ' of the value retured by GetVersion is cleared
   If GetVersion() >= 0 Then
       ' open the tokens for the current process
       ' exit if any error
       If OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or _
           TOKEN_QUERY, hToken) = 0 Then
           GoTo CleanUp
       End If
       
       ' retrieves the locally unique identifier (LUID) used
       ' to locally represent the specified privilege name
       ' (first argument = "" means the local system)
       ' Exit if any error
       If LookupPrivilegeValue("", "SeDebugPrivilege", tp.LuidUDT) = 0 Then
           GoTo CleanUp
       End If
   
       ' complete the TOKEN_PRIVILEGES structure with the # of
       ' privileges and the desired attribute
       tp.PrivilegeCount = 1
       tp.Attributes = SE_PRIVILEGE_ENABLED
   
       ' try to acquire debug privilege for this process
       ' exit if error
       If AdjustTokenPrivileges(hToken, False, tp, 0, ByVal 0&, _
           ByVal 0&) = 0 Then
           GoTo CleanUp
       End If
   End If
   
   ' now we can finally open the other process
   ' while having complete access on its attributes
   ' exit if any error
   hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, hProcessID)
   If hProcess Then
       ' call was successful, so we can kill the application
       ' set return value for this function
       KillProcess = (TerminateProcess(hProcess, ExitCode) <> 0)
       ' close the process handle
       CloseHandle hProcess
   End If
   
   If GetVersion() >= 0 Then
       ' under NT restore original privileges
       tp.Attributes = 0
       AdjustTokenPrivileges hToken, False, tp, 0, ByVal 0&, ByVal 0&
       
CleanUp:
       If hToken Then CloseHandle hToken
   End If
End Function

[LITHIA]

thanks for the code Vader,

only prob is i get this error when It trys terminating the process

Run Time Error: '53'

File Not Found

I have made sure that making pID equal the correct process as "Game.exe" as it shows in Task Manager.

Any ideas? Thanks

Btw, i cleaned alot of crap i didnt need. Like that NT/2000 verification rubbish

When I get the error, on Debug it highlights

pID = Shell("Game.exe", vbNormalFocus)

[LITHIA]

*bump*

[TheVader]

I just tried the code myself and it's working fine. The process is terminated (it didn't hang though). I used exactly this code:

Option Explicit
 
Dim pID As Variant
 
Private Type LUID
  lowpart As Long
  highpart As Long
End Type
 
Private Type TOKEN_PRIVILEGES
   PrivilegeCount As Long
   LuidUDT As LUID
   Attributes As Long
End Type
 
Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
Const PROCESS_ALL_ACCESS = &H1F0FFF
 
Private Declare Function GetVersion Lib "kernel32" () As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As _
   Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle _
   As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias _
   "LookupPrivilegeValueA" (ByVal lpSystemName As String, _
   ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal _
   TokenHandle As Long, ByVal DisableAllPrivileges As Long, _
   NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, _
   PreviousState As Any, ReturnLength As Any) 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 TerminateProcess Lib "kernel32" (ByVal hProcess As _
   Long, ByVal uExitCode As Long) As Long
 
' Terminate any application and return an exit code to Windows
' This works under NT/2000, even when the calling process
' doesn't have the privilege to terminate the application
' (for example, this may happen when the process was launched
'  by yet another program)
'
' Usage:  Dim pID As Long
'         pID = Shell("Notepad.Exe", vbNormalFocus)
'         '...
'         If KillProcess(pID, 0) Then
'             MsgBox "Notepad was terminated"
'         End If
 
Function KillProcess(ByVal hProcessID As Long, Optional ByVal ExitCode As Long) _
   As Boolean
   Dim hToken As Long
   Dim hProcess As Long
   Dim tp As TOKEN_PRIVILEGES
   
   ' Windows NT/2000 require a special treatment
   ' to ensure that the calling process has the
   ' privileges to shut down the system
   
   ' under NT the high-order bit (that is, the sign bit)
   ' of the value retured by GetVersion is cleared
   If GetVersion() >= 0 Then
       ' open the tokens for the current process
       ' exit if any error
       If OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or _
           TOKEN_QUERY, hToken) = 0 Then
           GoTo CleanUp
       End If
       
       ' retrieves the locally unique identifier (LUID) used
       ' to locally represent the specified privilege name
       ' (first argument = "" means the local system)
       ' Exit if any error
       If LookupPrivilegeValue("", "SeDebugPrivilege", tp.LuidUDT) = 0 Then
           GoTo CleanUp
       End If
   
       ' complete the TOKEN_PRIVILEGES structure with the # of
       ' privileges and the desired attribute
       tp.PrivilegeCount = 1
       tp.Attributes = SE_PRIVILEGE_ENABLED
   
       ' try to acquire debug privilege for this process
       ' exit if error
       If AdjustTokenPrivileges(hToken, False, tp, 0, ByVal 0&, _
           ByVal 0&) = 0 Then
           GoTo CleanUp
       End If
   End If
   
   ' now we can finally open the other process
   ' while having complete access on its attributes
   ' exit if any error
   hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, hProcessID)
   If hProcess Then
       ' call was successful, so we can kill the application
       ' set return value for this function
       KillProcess = (TerminateProcess(hProcess, ExitCode) <> 0)
       ' close the process handle
       CloseHandle hProcess
   End If
   
   If GetVersion() >= 0 Then
       ' under NT restore original privileges
       tp.Attributes = 0
       AdjustTokenPrivileges hToken, False, tp, 0, ByVal 0&, ByVal 0&
       
CleanUp:
       If hToken Then CloseHandle hToken
   End If
End Function
 
Private Sub Command1_Click()
KillProcess pID
End Sub
 
Private Sub Form_Load()
pID = Shell("c:\nav.exe", vbNormalFocus)
End Sub

[adocwra]

I found this vb script using maybe u could use scription to do it
[vbScript: ]

'kill all non allowed processess !
'
'by Peter Boos, based on other kill scripts posted to the great site CWASHINGTON.NETREACH.NET !
'
'To prevent killing this application also taskmgr.exe is not allowed
'If you want to allow different applications.
'Then before running this script.
' Then place a rem ' for the terminate line
' And remove the rem ' from x=x & c &... and from the line wscript.echo(x)
' Then this script will show the full names off all running applications
' And then you can add that programs full name (case sensitive)
'
'log off to disable.
'And if you don't have this in your login script or startup then you are rid of it.
'This script keeps running, if you can't hide you can't run.

system1 = "System Idle Process System smss.exe csrss.exe winlogon.exe services.exe "
system2 = "svchost.exe spoolsv.exe cisvc.exe regsvc.exe hh.exe MSTask.exe "
system3 = "Explorer.exe WinMgmt.exe WScript.exe lsass.exe cidaemon.exe "
allsystem2000 = system1 & system2 &system3

allowed = allsystem2000 & "Notepad.exe IExplorer.exe" 'now you're only alowed to run Notepad and internet explorer.

Do until c=-1
for each Process in
GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery ("select * from Win32_Process")
c=instr(allowed,process.name)
if c = 0 then Process.terminate(0)
'x = x & c & " - " & process.name + chr(10)

Next
Loop

'wscript.echo(x)

[LITHIA]

hmm...

I changed the pID to make it work now, i had to change it to

pID = Shell("C:\Westwood\Nox\Game.exe", vbNormalFocus)

and i no longer get the File not Found error.

But when I do the KillProcess pID
nothing happens...

If I enabled the

If KillProcess(pID, 0) Then
MsgBox "Successful"
Else
MsgBox "Error"
End If

It displays the msgbox with the error... any idea's? This is a Game so maybe vbNormalFocus doesnt work or somet? I have no idea, please help...

sorry adocwra but i dunno wat your doing - i wana keep with the method i am using before no one can resolve it. And people, please dont leave all the work to TheVader

[TheVader]

That's odd... I just tested that code with a hanging app (caused by an infinite loop) and still it was closed. I'll upload my working example of the code and the hanging project I'm using...

If you still don't get it working, perhaps you could pass me the Game.exe file so I can try to terminate it myself...?

Form
Hanging Project

[adocwra]

I just thought if you didnt want to use api functions you could use this
'winmgmts is part ofWindows Management Instrumentation (WMI) this is the machine name. Mine is downstairs enter your app name here all of that has to be on one line

For Each process In GetObject("winmgmts:{impersonationLevel=impersonate}!//downstairs").ExecQuery("select * from Win32_Process where Name='" & Me.Text1 & "'")
'second line
process.Terminate
MsgBox process.Name & process.Status & " is " & process.processid
Next

[LITHIA]

yeah i appreciate that adocwra, ill look into it if TheVader's method doesnt work completely.

TheVader, I cant send you Game.exe because its a game file, and requires the entire game to be installed for it to load.

Ill just test ur form and project now thnx

Edited:

Thats strange... your program opens project.exe on Load - why does it do that?

I dont think my program does that, and its got the same code!

This is getting very strange...

[TheVader]

It should open the program, because of the Shell code. Strange that game.exe doesn't open... How do you normally open it? Via any other files or something...?

[LITHIA]

oh... I thought the Shell code was just defining what process to end. No wonder it doesnt work.

I dont want my program opening Game.exe the game does that through another file. And i dotn want my program opening it full stop.

Can I just end a process which is already open before or after i start my program? I think i know why my program wont open Game.exe because of somet to do with the code in it. Game.exe is started up with another exe so thats why im getting this error.

Have you got a different way of ending the process without having my app opening it first? Thanks

Edited: I just tryed
Dim lWnd As Long
lWnd = FindWindow(vbNullString, "NOX")

KillProcess lWnd

And that didnt work either... any ideas?

[LITHIA]

bump....

[plenderj]

Have you looked at the Win32 Win2K Process API helper functions?

[LITHIA]

Ive looked through the API Guide, and got this method...

but I dont think I have looked at what you said sorry, where can I find that? Is it in the API Guide, because I didnt see it

thanks

[TheVader]

Hmm, I never tried getting the ID of a window, but these API's might do the trick...

Try GetWindow, GetWindow[...], EnumWindows or search on the web... there must be a way to retrieve the ID.

[LITHIA]

I dont understand why terminating a process is so hard...

I was expecting, if i had the process's exe name, i would have just needed a small code.

I tryed GetWindow but it does the same as before...

Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
 
Private Const GW_CHILD = 5
 
Dim lWnd As Long
Dim pNox As Long
 
lWnd = FindWindow(vbNullString, "NOX")
pNox = GetWindow(lWnd, GW_CHILD)
 
KillProcess pNox

Doesnt get any VB errors, but it doesnt terminate the process either... maybe because KillProcess is designed for some sort of process ID, like you said, but we are getting the Window name...

i dunno wats going on. Can somone please help us here, I sense Deja Vu, but why dont we try

ExitProcess
Declare Sub ExitProcess Lib "kernel32" Alias "ExitProcess" (ByVal uExitCode As Long)

or

TerminateProcess
Declare Function TerminateProcess Lib "kernel32" Alias "TerminateProcess" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long

Thanks

[Wokawidget]

To terminate a process:

• Use FindWindow API to get the hWnd of the app "not responding"
• Use GetWindowThreadProcessId API to retrieve the Process ID from the hWnd
• Use TerminateProcess API to kill the process

I think the code would be something like:

Option Explicit
 
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" Alias "TerminateProcess" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
 
Private Sub cmdTerminate_Click
Dim lngHandle   As Long
Dim lngProcessID   As Long
   lngHandle = FindWindow(vbNullString, txtCaption.Text)
   GetWindowThreadProcessId lngHandle, lngProcessID
   TerminateProcess lngProcessID, 0
End Sub

You need a form with a command button called cmdTerminate and a text box called txtCaption which is the caption of the window you want to terminate...

Hope that helps,

Woka

[Wokawidget]

Sorry, I ain't woke up correctly today
The code is:

Option Explicit
 
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)
 
Private Sub cmdTerminate_Click()
Dim lngHandle       As Long
Dim lngProcessID    As Long
Dim lngProcessHWND  As Long
   lngHandle = FindWindow(vbNullString, txtCaption.Text)
   GetWindowThreadProcessId lngHandle, lngProcessID
   lngProcessHWND = OpenProcess(PROCESS_ALL_ACCESS, False, lngProcessID)
   TerminateProcess lngProcessHWND, 0
   CloseHandle lngProcessHWND
End Sub

Right, that'll do the trick...Right I need to reboot my PC now as during testing I have succeeded in trashing most of my proccesses that I actually wanted to run...maybe I should have used an expendable process to test on Ooop...

Anyways, the above code does work.

have fun.

Woka

[LITHIA]

hey thanks so much!!! It works great! I havnt tested it if its Not Responding yet, but knowing how much that game crashes, it wont take me long.

You dont know of a method to detect whether its not responding or not do you?

I can put it on a 2 second time which would be cool, ive got all the code ready, i just need a Not Responding detection and I can use ur code to end if it does get noticed as Not responding.

Thanks again for ur help!

[Wokawidget]

If you use the SendMessageTimeout API then you can tell if it's hung.
I'm not 100% sure how to use this function so I won't guess
Try searching vbForums for "SendMessageTimeout"

I do know the API function is:

Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As String, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long

...and I know that you would pass the lngHandle value, that the FindWindow API returned, into the function.

Hope that helps...

Woka

[LITHIA]

hmmm thanks. I searched and found this

If (SendMessageTimeout(lhwnd, WM_NULL, 0, 0, SMTO_ABORTIFHUNG, 10, 0) = 0) Then
    GetWindowThreadProcessId lhwnd, pid
    hp = OpenProcess(PROCESS_ALL_ACCESS, 0&, pid)
    TerminateProcess hp&, 0&
    CloseHandle hp

But it ends the program even when its not hung, any ideas? thanks

[Wokawidget]

OK...add:

Private Declare Function GetLastError Lib "kernel32" Alias "GetLastError" () As Long

To your API declarations...then use:

If (SendMessageTimeout(lhwnd, WM_NULL, 0, 0, SMTO_ABORTIFHUNG, 10, 0) = 0) Then
   If GetLastError = 0 Then
       GetWindowThreadProcessId lhwnd, pid
       hp = OpenProcess(PROCESS_ALL_ACCESS, 0&, pid)
       TerminateProcess hp&, 0&
       CloseHandle hp
   End If
End If

If getLastError = 0 then this means that the SendMessageTimeout actually timed out.

Hope that helps,

Woka

[LITHIA]

thanks but even with it, it still ends it when its not crashed.

Maybe there is some sort of alternative, because the game might not be able to work SendMessageTimeout?

I dont know, maybe any app does, but in that case theres something wrong with the code...

If your sure getLastError = 0 means that it timed out, then this wont work to detect this program.

Edit: I just discovered something.

If (SendMessageTimeout(lhwnd, WM_NULL, 0, 0, SMTO_ABORTIFHUNG, 10, 0) = 0) Then

uses lhwnd, but lhwnd is declared as

lhwnd = FindWindow(vbNullString, "NOX")

so i ahve made these changes to my code

Dim lhwnd&, pid&, hp&
lhwnd = FindWindow(vbNullString, "NOX")
GetWindowThreadProcessId lhwnd, pid
    
    If (SendMessageTimeout(pid, WM_NULL, 0, 0, SMTO_ABORTIFHUNG, 10, 0) = 0) Then
    If GetLastError = 0 Then
    hp = OpenProcess(PROCESS_ALL_ACCESS, 0&, pid)
    TerminateProcess hp&, 0&
    CloseHandle hp
    Else
    Exit Sub
    End If

Sorry about no identations, was going to put em in but browser woudlnt let me.

Now that I have that code, it doesnt end the app when its not crashed. But i cant be sure if it ends it when its crashed yet. So ill have to wait and find out.

Any ideas or any problems you might see in that or any improvments? Thanks

[Wokawidget]

U do realise that you are only waiting 10ms before timing it out...???
Replace the 10 with 5000 (5 seconds) are something like that...10ms may timeout with any window...

Woka

[LITHIA]

sorry, edited post

[LITHIA]

hmm i dont thinkt his method is going to work. It is being way too sensitive.

Do you know of any other way to detect if a process is not responding? How does the Task Manager do it?

thanks

[Wokawidget]

Nope, that is the way Task Manager does it...
Why is it too sensetive?
You are seeing if it is idle for 10ms!
That is wrong...just because an app doesn't reply in 10ms doesn't mean it's "Not responding"...at least change the 10 to 1000. Then if the app doesn't return in 1 second then it's classed as "Not Responding"...

Woka

[LITHIA]

i changed it to 2000 as thats the max i can put it at for my app to work well.

and its too sensitive because it says its not responding when its not. especially when its not got the focus, like when i alt tab out of the game, and press the command button to keep checking if its not responding, it says its not and ends it.

[Wokawidget]

What game is it?
It's not HL or CS is it?

Woka

[LITHIA]

its called Nox, made by westwood

Isnt there a way to detect what Task Manager says? Because Task Manager only says its not responding when it crashes, so if there was a way to detect if task manager finds out if its not responding or not, then that wud be great. or use exact same method it does, if its what we are using, we gotta get the time right

[Wokawidget]

I am almost positive that's how it's done in task manager...
Task manage may use more than 2000ms.

Are you passing the correct values to SendMessageTimeout command?

Wojka

[Wokawidget]

ok...how about using:

Option Explicit
 
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CloseKernelObject Lib "kernel32" Alias "CloseHandle" (ByVal hObject As Long) As Long
Private Declare Function GetProcessIoCounters Lib "kernel32" (ByVal hProcess As Long, ioCount As IO_COUNTERS) As Long
 
Private Type IO_COUNTERS
    ReadOperationCount As Long
    WriteOperationCount As Long
    OtherOperationCount As Long
    ReadTransferCount As Long
    WriteTransferCount As Long
    OtherTransferCount As Long
End Type
 
Public Enum ProcessAccessPriviledges
     PROCESS_TERMINATE = &H1
     PROCESS_CREATE_THREAD = &H2
     PROCESS_SET_SESSIONID = &H4
     PROCESS_VM_OPERATION = &H8
     PROCESS_VM_READ = &H10
     PROCESS_VM_WRITE = &H20
     PROCESS_DUP_HANDLE = &H40
     PROCESS_CREATE_PROCESS = &H80
     PROCESS_SET_QUOTA = &H100
     PROCESS_SET_INFORMATION = &H200
     PROCESS_QUERY_INFORMATION = &H400
     PROCESS_SYNCHRONISE = &H100000
     PROCESS_ALL_ACCESS = &H100FFF
End Enum
 
Private Sub cmdTerminate_Click()
Dim lngHandle       As Long
Dim lngProcessID    As Long
Dim lngProcessHWND  As Long
    lngHandle = FindWindow(vbNullString, txtCaption.Text)
    GetWindowThreadProcessId lngHandle, lngProcessID
    If IsProcessHung(lngProcessID, 2) Then 'the 2 is 2 seconds
        lngProcessHWND = OpenProcess(PROCESS_ALL_ACCESS, False, lngProcessID)
        TerminateProcess lngProcessHWND, 0
        CloseHandle lngProcessHWND
    End If
End Sub
 
Public Function IsProcessHung(ByVal ProcessID As Long, ByVal Timeout As Integer) As Boolean
Dim hProc           As Long
Dim dtStart         As Date
Dim FirstCounters   As IO_COUNTERS
Dim NextCounters    As IO_COUNTERS
    hProc = OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessID)
    If hProc <> 0 Then
        Call GetProcessIoCounters(hProc, FirstCounters)
        dtStart = Now
        Do While DateDiff("s", Now, dtStart) < Timeout
            DoEvents
        Loop
        Call GetProcessIoCounters(hProc, NextCounters)
        IsProcessHung = (FirstCounters.ReadOperationCount = NextCounters.ReadOperationCount) And _
                               (FirstCounters.WriteOperationCount = NextCounters.WriteOperationCount) And _
                               (FirstCounters.OtherOperationCount = NextCounters.OtherOperationCount)
        Call CloseKernelObject(hProc)
    End If
End Function

Does that work?

Woka