Проверить приложение на зависание?

// 1. The Documented way
{
 An application can check if a window is responding to messages by
 sending the WM_NULL message with the SendMessageTimeout function.
}

function AppIsResponding(ClassName: string): Boolean;
const
 { Specifies the duration, in milliseconds, of the time-out period }
 TIMEOUT = 50;
var
 Res: DWORD;
 h: HWND;
begin
 h := FindWindow(PChar(ClassName), nil);
 if h <> 0 then
  Result := SendMessageTimeOut(H,
  WM_NULL,
  0,
  0,
  SMTO_NORMAL or SMTO_ABORTIFHUNG,
  TIMEOUT,
  Res) <> 0
 else
  ShowMessage(Format('%s not found!', [ClassName]));
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 if AppIsResponding('OpusApp') then
  { OpusApp is the Class Name of WINWORD }
  ShowMessage('App. responding');
end;
// 2. The Undocumented way
{
 // Translated form C to Delphi by Thomas Stutz
 // Original <code>
 // (c)1999 Ashot Oganesyan K, SmartLine, Inc
 // <a href="mailto:ashot@aha.ru" title="mailto:ashot@aha.ru">mailto:ashot@aha.ru</a>, <a href="http://www.protect-me.com" title="http://www.protect-me.com">http://www.protect-me.com</a>, <a href="http://www.codepile.com
" title="http://www.codepile.com
">http://www.codepile.com
</a> 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;

Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...