Windows - detectar se um aplicativo nao esta respondendo

Top  Previous  Next

  // 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 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