delphi 如何识别应用程序没有响应

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, 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}

function AppFrozen(H: HWND) : Boolean;

var

dwResult: DWord;

const

timeout = 3000; // ms

begin

AppFrozen := SendMessageTimeout(H, WM_NULL, 0, 0,

SMTO_ABORTIFHUNG or SMTO_BLOCK,

timeout, dwResult) <> 0

end;

procedure TForm1.Button1Click(Sender: TObject);

var

H: HWND;

begin

H := FindWindow(nil, 'Name of Application');

if H<>0 then

if AppFrozen(H) then

ShowMessage('This Application is Frozen!');

end;

end.

推荐分享