检测程序是否有响应
UNDOCUMENTED: DETECT IF AN APPLICATION HAS STOPPED
Copyright (c) 2002 by Thomas Stutz
Email: tom@swissdelphicenter.ch
URL: http://www.swissdelphicenter.com/en/showcode.php?id=910
In many situations you might like to detect if an application is
blocked. For example while automating Word, you'd like to know if Word
has stopped responding. This article describes how to detect if an
application has stopped responding using some undocumented functions.
{
// Translated from C to Delphi by Thomas Stutz
// First published at www.SwissDelphiCenter.com
// Original Code:
// (c)1999 Ashot Oganesyan K, SmartLine, Inc
// mailto:ashot@aha.ru, http://www.protect-me.com,
// http://www.codepile.com
The code doesn't use the Win32 API SendMessageTimout function to
determine if the target application is responding but calls undocumented
functions from the User32.dll.
--> For Windows 95/98/ME we call the IsHungThread() API
The function IsHungThread retrieves the status (running or not
responding) of the specified thread
IsHungThread(DWORD dwThreadId): // The thread's identifier of the
BOOL; // main app's window
--> For NT/2000/XP the IsHungAppWindow() API:
The function IsHungAppWindow retrieves the status (running or not
responding) of the specified application
IsHungAppWindow(Wnd: HWND): // handle to main app's window
BOOL;
Unfortunately, Microsoft doesn't provide us with the exports symbols
in the User32.lib for these functions, so we should load them
dynamically using the GetModuleHandle and GetProcAddress functions:
}
// For Win9x/ME
function IsAppResponding9x(dwThreadId: DWORD): Boolean;
type
TIsHungThread = function(dwThreadId: DWORD): BOOL; stdcall;
var
hUser32: THandle;
IsHungThread: TIsHungThread;
begin
Result := True;
hUser32 := GetModuleHandle('user32.dll');
if (hUser32 > 0) then
begin
@IsHungThread := GetProcAddress(hUser32, 'IsHungThread');
if Assigned(IsHungThread) then
begin
Result := not IsHungThread(dwThreadId);
end;
end;
end;
// For Win NT/2000/XP
function IsAppRespondingNT(wnd: HWND): Boolean;
type
TIsHungAppWindow = function(wnd:hWnd): BOOL; stdcall;
var
hUser32: THandle;
IsHungAppWindow: TIsHungAppWindow;
begin
Result := True;
hUser32 := GetModuleHandle('user32.dll');
if (hUser32 > 0) then
begin
@IsHungAppWindow := GetProcAddress(hUser32, 'IsHungAppWindow');
if Assigned(IsHungAppWindow) then
begin
Result := not IsHungAppWindow(wnd);
end;
end;
end;
function IsAppResponding(Wnd: HWND): Boolean;
begin
if not IsWindow(Wnd) then
begin
ShowMessage('Incorrect window handle');
Exit;
end;
if Win32Platform = VER_PLATFORM_WIN32_NT then
Result := IsAppRespondingNT(wnd)
else
Result := IsAppResponding9X(GetWindowThreadProcessId(wnd,nil));
end;
// Example: Check if Word is hung/responding
procedure TForm1.Button3Click(Sender: TObject);
var
Res: DWORD;
h: HWND;
begin
// Find Word by classname
h := FindWindow(PChar('OpusApp'), nil);
if h <> 0 then
begin
if IsAppResponding(h) then
ShowMessage('Word is responding')
else
ShowMessage('Word is not responding');
end
else
ShowMessage('Word is not open');
end;