Visual Basic Programming Code Examples

Test if an application is responding and terminate application Below are some useful routines to test if an application has stopped responding and to terminate an application. A demonstration routine can be found at the bottom of the post. 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