How Detect If an Application Has Stopped Responding

In many situations you might like to detect if an application is blocked. For example while automating Internet Explorer, you'd like to know if Internet Explorer has stopped responding. There is no clear definition of an application hanging. Typically the application is "busy" with some processing. However from a user's perspective, the application has stopped responding. The idea is to periodically detect if the application is still responding in a timer and depending on application logic, the target application can be killed or other necessary action can be taken. Next example describes how to detect if an automated instance of Internet Explorer is hung or not.

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComObj, StdCtrls;

type
TForm1 = class(TForm)
 btnLaunch: TButton;
 btnCheck: TButton;
 btnKill: TButton;
 procedure btnLaunchClick(Sender: TObject);
 procedure btnCheckClick(Sender: TObject);
 procedure btnKillClick(Sender: TObject);
private
 { Private declarations }
public
 { Public declarations }
 modObjIE : OLEVariant;
 modlngWndIE : THandle;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.btnLaunchClick(Sender: TObject);
begin
modObjIE := CreateOleObject('InternetExplorer.Application');
modObjIE.Visible := true;
modObjIE.Navigate2('http://www.borland.com');
modlngWndIE := modObjIE.hwnd;
end;

procedure TForm1.btnCheckClick(Sender: TObject);
var
dwResult : DWORD;
lngReturnValue : longint;
begin
lngReturnValue := SendMessageTimeout(modlngWndIE, WM_NULL, 0,
   0, SMTO_ABORTIFHUNG OR SMTO_BLOCK, 1000, dwResult);
 If lngReturnValue > 0 then
     ShowMessage('Responding')
 Else
     ShowMessage('Not Responding');
end;



procedure TForm1.btnKillClick(Sender: TObject);
var
ProcessID : DWORD;
Process : THandle;
begin
GetWindowThreadProcessId(modlngWndIE, @ProcessID);
Process := OpenProcess(PROCESS_ALL_ACCESS, false, ProcessID);
TerminateProcess(Process, 0);
end;

end.

Although the code is written for Internet Explorer, the idea can be used for other applications as well.

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
 Button1: TButton;
 procedure Button1Click(Sender: TObject);
private
 { Private declarations }
public
 { Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
H : THandle;
lngReturnValue : longint;
DWResult : DWORD;
begin
H := FindWindow('Notepad', nil);
if H > 0 then
begin
 lngReturnValue := SendMessageTimeout(H, WM_NULL, 0,
   0, SMTO_ABORTIFHUNG And SMTO_BLOCK, 1000, DWResult);
 if lngReturnValue > 0 then
  ShowMessage('Responding')
   else
    ShowMessage('Not responding');
end
else
  ShowMessage('Application not found');
end;

end.