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

Delphi , Программа и Интерфейс , Приложения чужие

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

 // The Undocumented way 

{ 
  // Translated form C to Delphi by Thomas Stutz 
  // 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 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; 

 --> 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 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 (hUser32 > 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/responding 

procedure TForm1.Button3Click(Sender: TObject);
 var
   Res: DWORD;
   h: HWND;
 begin
   // Find Winword 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;

Статья Убедиться, что приложение (окно) не отвечает 2 раздела Программа и Интерфейс Приложения чужие может быть полезна для разработчиков на Delphi и FreePascal.

Комментарии и вопросы

:: Главная :: Приложения чужие ::