Убедиться, что приложение (окно) не отвечает

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

// The Documented way

{

An application can check if a window is responding to messages by

sending the WM_NULL message with the SendMessageTimeout function.

Um zu uberprufen, ob ein anderes Fenster (Anwendung) noch reagiert,

kann man ihr mit der SendMessageTimeout() API eine WM_NULL Nachricht schicken.

}

function AppIsResponding(ClassName: string): Boolean;

const

{ Specifies the duration, in milliseconds, of the time-out period }

TIMEOUT = 50;

var

Res: DWORD;

h: HWND;

begin

h := FindWindow(PChar(ClassName), nil);

if h 0 then

Result := SendMessageTimeOut(H,

WM_NULL,

0,

0,

SMTO_NORMAL or SMTO_ABORTIFHUNG,

TIMEOUT,

Res) 0

else

ShowMessage(Format(‘%s not found!’, [ClassName]));

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

if AppIsResponding(‘OpusApp’) then

{ OpusApp is the Class Name of WINWORD }

ShowMessage(‘App. responding’);

end;

{/codecitation}

Добавить комментарий