检测程序是否有响应

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;