--- ---
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.
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); public 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('https://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); 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.