2009. január 14., szerda

Detect If an Application Has Stopped Responding


Problem/Question/Abstract:

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.

Answer:

{
  // (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 IsHungAppWindow retrieves the status (running or not responding)
of the specified application

IsHungAppWindow(Wnd: HWND): // handle to main app's window
BOOL;

--> For NT/2000/XP the IsHungAppWindow() API:

The function IsHungThread retrieves the status (running or not responding) of
the specified thread

IsHungThread(DWORD dwThreadId): // The thread's identifier of the 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 IsAppRespondig9x(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 IsAppRespondigNT(wnd: HWND): Boolean;
type
  TIsHungAppWindow = function(wnd: hWnd): BOOL; stdcall;
var
  hUser32: THandle;
  IsHungAppWindow: TIsHungAppWindow;
begin
  Result := True;
  hUser32 := GetModuleHandle('user32.dll');
  if (hKernel > 0) then
  begin
    @IsHungAppWindow := GetProcAddress(hUser32, 'IsHungAppWindow');
    if Assigned(IsHungAppWindow) then
    begin
      Result := not IsHungAppWindow(wnd);
    end;
  end;
end;

function IsAppRespondig(Wnd: HWND): Boolean;
begin
  if not IsWindow(Wnd) then
  begin
    ShowMessage('Incorrect window handle');
    Exit;
  end;
  if Win32Platform = VER_PLATFORM_WIN32_NT then
    Result := IsAppRespondigNT(wnd)
  else
    Result := IsAppRespondig9X(GetWindowThreadProcessId(wnd, nil));
end;

// Example: Check if Word is hung/responing

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 IsAppRespondig(h) then
      ShowMessage('Word is responding')
    else
      ShowMessage('Word is not responding');
  end
  else
    ShowMessage('Word is not open');
end;

Nincsenek megjegyzések:

Megjegyzés küldése