Detecting 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.

This tutorial was kindly provided by Serge Perevoznyk


Google
Web www.Delphi-Central.com
Delphi Central - Delphi Programming Tutorials, Hints and Tips