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

← →
Midaw © (2004-04-11 11:17) [0]

← →
ПЛОВ (2004-04-11 12:46) [1]

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

← →
Игорь Шевченко © (2004-04-11 13:46) [2]

IsHungAppWindow(Window: HWND): Boolean;

← →
Midaw © (2004-04-11 15:42) [3]

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

← →
VMcL © (2004-04-11 16:06) [4]

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

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

← →
Игорь Шевченко © (2004-04-11 16:57) [5]

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

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

← →
Suntechnic © (2004-04-11 19:25) [6]

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

← →
DVM © (2004-04-11 21:04) [7]

// 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 © (11.04.04 19:25)

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

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

> 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 принимает неизвестное значение

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

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