Solved

Detect Hanging Process

Posted on 2006-07-06
18
755 Views
Last Modified: 2012-08-13
I have seen some solutions that allow you to detect if a single process is hanging and that is great but I need a way to loop through all running processes and check if they are responding or not...
0
Comment
Question by:justchat_1
  • 6
  • 6
  • 2
  • +2
18 Comments
 
LVL 86

Expert Comment

by:jkr
ID: 17055629
You could use "EnumWindows()" and send each top level window a message using "SendMessageTimeout()", e.g.

BOOL CALLBACK CheckHangingWindowsProc(
  HWND hwnd,      // handle to parent window
  LPARAM lParam   // application-defined value
)
{
    char acText[MAX_PATH];
    DWORD dwRes;

    if (!SendMessageTimeout(hWnd,(WPARAM)MAX_PATH,(LPARAMacText,SMTO_ABORTIFHUNG,&dwRes))
    {
        DWORD dwPid;

        GetWindowThreadProcessId(hWnd,&dwPID);

        printf("PID %d is not responding\n",dwPid);
    }
}


EnumWindows(CheckHangingWindowsProc,0);
0
 
LVL 9

Author Comment

by:justchat_1
ID: 17055646
Wrong TA...sorry-this was supposed to be vb
0
 
LVL 86

Expert Comment

by:jkr
ID: 17055673
The same works in VB ;o)
0
 
LVL 9

Author Comment

by:justchat_1
ID: 17055728
Post some vb code and the points are yours... its a little over my head
0
 
LVL 9

Author Comment

by:justchat_1
ID: 17055855
That would be great-thanks...
0
 
LVL 26

Expert Comment

by:EDDYKT
ID: 17056371
0
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
ID: 17057099

here is some demonstration code:


Option Explicit
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, pdwResult As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
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 FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

'Purpose     :  Terminates an application by finding the process ID of a windows handle.
'Inputs      :  lHwnd               The application window handle
'Outputs     :  Returns True if succeeds
'Notes       :  If you know the applications process ID then you need only call the last three lines of this routine.

Function ApplicationTerminate(lHwnd As Long) As Boolean
    Dim lPid As Long, lReturn As Long, lhwndProcess As Long
    Const PROCESS_ALL_ACCESS = &H1F0FFF
    'Get the PID (process ID) from the application handle
    lReturn = GetWindowThreadProcessId(lHwnd, lPid)
    'Terminate the application
    lhwndProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, lPid)
    ApplicationTerminate = (TerminateProcess(lhwndProcess, 0&) <> 0)
    lReturn = CloseHandle(lhwndProcess)
End Function


'Purpose     :  Tests the status of an application
'Inputs      :  lHwnd               The application window handle
'               [lWaitTimeOut]      The time in ms to wait for the application to respond
'Outputs     :  Returns True if application is responding, else returns
'               false if the application is not responding
'Notes       :  SMTO_ABORTIFHUNG Returns without waiting for the time-out period to elapse if the receiving
'               process appears to be in a "hung" state.
'               SMTO_BLOCK Prevents the calling thread from processing any other requests until the function returns.

Function ApplicationResponding(lHwnd As Long, Optional lWaitTimeOut As Long = 2000) As Boolean
    Dim lResult As Long
    Dim lReturn As Long
    Const SMTO_BLOCK = &H1, SMTO_ABORTIFHUNG = &H2, WM_NULL = &H0
    lReturn = SendMessageTimeout(lHwnd, WM_NULL, 0&, 0&, SMTO_ABORTIFHUNG And SMTO_BLOCK, lWaitTimeOut, lResult)
    If lReturn Then
        ApplicationResponding = True
    Else
        ApplicationResponding = False
    End If
End Function

'Demonstration routine
Sub Test()
    Dim lHwnd As Long
    'Find an instance of internet explorer
    'I used IE to test it as it only takes about 2 mins before it hangs!
    lHwnd = FindWindow("IEFrame", vbNullString)
    If lHwnd Then
        If ApplicationResponding(lHwnd) = False Then
            'Application is not responding
            If ApplicationTerminate(lHwnd) = True Then
                MsgBox "Successfully terminated application"
            End If
        End If
    End If
End Sub
0
 
LVL 29

Expert Comment

by:nffvrxqgrcfqvvc
ID: 17057163
' Here is another approach for Windows 2000 and XP.

If you want to test this create a seperate Standard EXE and add the code below. Then compile, run the EXE. Then run the other program that checks if the application is hung. It should return (MyHungAppTest!)

'Hang app code for a test
Private Sub Form_Load()
Me.Show
Me.Caption = "MyHungAppTest!"
Do
    'This will hand the app.
Loop
End Sub


'Check if hung app code
'--- Module1.bas ---

Option Explicit

Private Declare Function IsHungAppWindow Lib "user32" ( _
    ByVal hwnd As Long) As Boolean

Private Declare Function EnumWindows Lib "user32" ( _
    ByVal lpEnumFunc As Long, _
    ByVal lParam As Long) As Boolean
   
Private Declare Function GetWindowTextW Lib "user32" ( _
    ByVal hwnd As Long, _
    ByVal lpString As Long, _
    ByVal cch As Long) As Long

Dim wt(512) As Byte
Dim rt      As Long

Public Sub FindHungApp()
    EnumWindows AddressOf EnumWindowsProc, 0
End Sub

Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
   
    If IsHungAppWindow(hwnd) Then
        rt = GetWindowTextW(hwnd, ByVal VarPtr(wt(0)), 512)
        Debug.Print Left$(wt, rt)
    End If
   
    EnumWindowsProc = True
End Function


'--- Form1 ---

Option Explicit

Private Sub Command1_Click()
    FindHungApp
End Sub
0
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 
LVL 29

Expert Comment

by:nffvrxqgrcfqvvc
ID: 17057193
Whoops, here is updated procedure made mistake in EnumWindowsProc


Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
   
    If IsHungAppWindow(hwnd) Then
        rt = GetWindowTextW(hwnd, ByVal VarPtr(wt(0)), 512)
        wnd = Left$(wt, rt)
        If LenB(wnd) Then
            Debug.Print wnd
        End If
    End If
   
    EnumWindowsProc = True
End Function
0
 
LVL 9

Author Comment

by:justchat_1
ID: 17061017
This is great...but how do I loop through all running processes and check them?
0
 
LVL 29

Expert Comment

by:nffvrxqgrcfqvvc
ID: 17061273
You can use the psapi.dll API, once your armed with the PID you can then gain access to the process handle, when you know the process handle you can then pass this to the GetProcessImageFileNameW API which will return the process name and location
0
 
LVL 29

Expert Comment

by:nffvrxqgrcfqvvc
ID: 17061415
So basically instead of a caption you want to show process name, below is how you can accomplish this...


Option Explicit

Private Declare Function OpenProcess Lib "kernel32" _
    (ByVal dwDesiredAccessas As Long, _
    ByVal bInheritHandle As Long, _
    ByVal dwProcId As Long) As Long

Private Declare Function GetWindowThreadProcessId Lib "user32" ( _
    ByVal hwnd As Long, _
    lpdwProcessId As Long) As Long

Private Declare Function GetProcessImageFileNameW Lib "psapi" _
    (ByVal hProcess As Long, _
    lpImageFileName As Long, _
    ByVal nSize As Long) As Long
   
Private Declare Function IsHungAppWindow Lib "user32" ( _
    ByVal hwnd As Long) As Boolean

Private Declare Function EnumWindows Lib "user32" ( _
    ByVal lpEnumFunc As Long, _
    ByVal lParam As Long) As Boolean

Dim PID As Long
Dim hProcess As Long
Dim ProcessName(512) As Byte
Dim tSize As Long

Private Function GetProcessRealName(hwnd As Long) As String
Const PROCESS_ALL_ACCESS = &H1F0FFF
    GetWindowThreadProcessId hwnd, PID
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, PID)
    tSize = GetProcessImageFileNameW(hProcess, _
        ByVal VarPtr(ProcessName(0)), 512)
    GetProcessRealName = Left$(ProcessName, tSize)
End Function

Public Sub FindHungApp()
    EnumWindows AddressOf EnumWindowsProc, 0
End Sub

Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
   
    If IsHungAppWindow(hwnd) Then
        Debug.Print GetProcessRealName(hwnd)
    End If
    EnumWindowsProc = True
End Function
0
 
LVL 29

Expert Comment

by:nffvrxqgrcfqvvc
ID: 17061463
Whoops made small  mistake, I forgot to take care of cleaning up the process handle.

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

Private Function GetProcessRealName(hwnd As Long) As String
Const PROCESS_ALL_ACCESS = &H1F0FFF
    GetWindowThreadProcessId hwnd, PID
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, PID)
    tSize = GetProcessImageFileNameW(hProcess, _
        ByVal VarPtr(ProcessName(0)), 512)
    CloseHandle (hProcess)
    GetProcessRealName = Left$(ProcessName, tSize)
End Function
0
 
LVL 9

Author Comment

by:justchat_1
ID: 17062140
Excellant Code!!  Thats exactly what I am looking for...

One last question:
it says "\Device\HarddiskVolume1"  can that be formatted as "C:\" or is that too complex to be worth it?
0
 
LVL 29

Accepted Solution

by:
nffvrxqgrcfqvvc earned 500 total points
ID: 17062780
Sure it can be done, The way I do this is to use GetLogicalDriveStrings, and QueryDosDevice.

First GetLogicalDriveStrings lists the drives on your computer in the format of ( C:\, D:\ )
Then you call QueryDosDevice which takes the regulare format of C:\,D:\ and returns the dos device path ( \Device\HarddiskVolume1)

The basic idea is that you pass the regular drive letter to QueryDosDevice and in return it will tell you the Dos device path which you can then match up.
The need for GetLogicalDriveStrings is used so you don't have to hardcode the actual C:\ this is all done for you in my code.

There might be an easier alternative, but according to microsoft this seems to be the correct approach.

'---- code ----

Option Explicit

Private Declare Function GetLogicalDriveStringsW Lib "kernel32.dll" ( _
    ByVal nBufferLength As Long, _
    ByVal lpBuffer As Long) As Long

Private Declare Function QueryDosDeviceW Lib "kernel32.dll" ( _
    ByVal lpDeviceName As Long, _
    ByVal lpTargetPath As Long, _
    ByVal ucchMax As Long) As Long

Private Const QueryDosBytes As Long = 68
Private Const LogicalBytes  As Long = 208

Dim Qdb(QueryDosBytes)  As Byte
Dim Lds(LogicalBytes)   As Byte

Dim Device      As String
Dim Drive       As String

Dim Pos         As Long
Dim lSize       As Long

Private Const ByteLen       As Long = 2

Private Function Convert(arg As String) As String
    lSize = QueryDosDeviceW(StrPtr(arg), ByVal VarPtr(Qdb(0)), QueryDosBytes)
    Convert = Left$(Qdb, lSize - ByteLen)
    Erase Qdb
End Function

Private Function ConvertDosPath(DosDevice As String, _
    Optional AddSlash As String = vbNullString) As String
   
    Call GetLogicalDriveStringsW(LogicalBytes, _
        ByVal VarPtr(Lds(0)))
    Pos = 1
    Do While Not Mid$(Lds, Pos, 1) = Chr(0)
        Drive = Mid$(Lds, Pos, 2)
        Device = Convert(Drive)
        If InStr(1, Device, DosDevice, vbTextCompare) Then
            ConvertDosPath = Drive & AddSlash
            Erase Lds
        Exit Do
        End If
        Pos = Pos + 4
    Loop
   
End Function


'---- Form ----

Private Sub Command1_Click()

MsgBox ConvertDosPath("\Device\HarddiskVolume1")

End Sub
0
 
LVL 9

Author Comment

by:justchat_1
ID: 17063025
That code cant take the full path it needs to be cut down to only the "\Device\HarddiskVolume1" (no slash)...
but I got that working...

Otherwise FLAWLESS code-thanks...
0

Featured Post

Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Suggested Solutions

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

705 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now