Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Как узнать отвечает приложение или нет, как в диспетчере задач ? [D7, WinXP]


Midaw ©   (2004-04-11 11:17:00) 

Как узнать отвечает приложение или нет, как в диспетчере задач ?


Midaw   (2004-04-12 19:17:00) [1]

Больщое спасибо !!! Все работает как надо.


Игорь Шевченко   (2004-04-11 21:16:00) [2]


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


Давить такой код.

Переменная Result принимает неизвестное значение


Игорь Шевченко   (2004-04-11 21:05:00) [3]

Suntechnic ©   (11.04.04 19:25)


> Я бы пункты 4 и 5 местами бы поменял ;)


А это специально, для тех, кто с английским языком не дружит :)


DVM   (2004-04-11 21:04:00) [4]

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

 Um zu überprüfen, ob ein anderes Fenster (Anwendung) noch reagiert,
 kann man ihr mit der SendMessageTimeout() API eine WM_NULL Nachricht schicken.
}

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


Suntechnic   (2004-04-11 19:25:00) [5]

>Игорь Шевченко ©
Я бы пункты 4 и 5 местами бы поменял ;)


Игорь Шевченко   (2004-04-11 16:57:00) [6]

Midaw ©   (11.04.04 15:42)

Типичные действия после указания имени неизвестной функции:

1) F1 - Delphi Help
2) F1 - Windows SDK
3) http://msdn.microsoft.com
4) http://www.yandex.ru
5) http://www.google.com

Если ни один из этих пяти пунктов не привел к нахождению функции и ее описания, задается вопрос в форум.


VMcL   (2004-04-11 16:06:00) [7]

>>Midaw ©  (11.04.04 15:42) [3]

Где, где... где всегда - на MSDN: http://tinyurl.com/2x8n8


Midaw   (2004-04-11 15:42:00) [8]

Где найти такую функцию (IsHungAppWindow(..)) ?
В исходниках Delphi таковой нет, или это шутка.
А вопрос этот и вправду очень даже интересен.


Игорь Шевченко   (2004-04-11 13:46:00) [9]

IsHungAppWindow(Window: HWND): Boolean;


ПЛОВ   (2004-04-11 12:46:00) [10]

Может послать какое-нть сообщение и ждать какого-нть ответа какое-нть время?
А вообще это интересный вопрос :)


Наверх

Титульная страница Поиск, карта сайта Написать письмо