Author: Jonas Bilinkevicius
I'm in the process of writing a service application that needs to check the status
of a couple of running programs - so that it can kill/ restart the programs if they
become unresponsive. I'm using CreateProcess to start the applications and
terminateprocess to kill the applications. What API call can I use to check the
status of a running application such as "Running" or "Not Responding" like
Taskmanager does?
Answer:
Use SendMessageTimeout to send a message to the window. If the message times out
after, say, 10 seconds, you can assume the applcation is not responding (the task
manager assumes this after 5 seconds).
1
2 procedure TForm1.Button1Click(Sender: TObject);
3 var
4 Res: DWORD;
5 H: HWND;
6 begin
7 H := FindWindow(nil, 'FormSomeCaption');
8 if H = 0 then
9 Label1.Caption := 'Window not found'
10 else if SendMessageTimeout(H, WM_NULL, 0, 0, SMTO_NORMAL, 100, Res) <> 0 then
11 Label1.Caption := 'Responding'
12 else
13 Label1.Caption := 'Not responding';
14 end;
And to kill it, no questions asked, then
15
16 procedure TForm1.ButtonClick(Sender: TObject);
17 var
18 ProcessHandle: THandle;
19 WinHwnd: HWND;
20 ProcessID, ExitCode: Integer;
21 begin
22 ProcessID := 0;
23 ExitCode := 0;
24 WinHwnd := FindWindow(nil, 'FormSomeCaption');
25 if not (IsWindow(WinHwnd)) then
26 begin
27 ShowMessage('Window not found');
28 exit;
29 end;
30 GetWindowThreadProcessID(WinHwnd, @ProcessID);
31 ProcessHandle := OpenProcess(PROCESS_CREATE_THREAD or PROCESS_VM_OPERATION
32 or PROCESS_VM_WRITE or PROCESS_VM_READ or PROCESS_TERMINATE,
33 False, ProcessID);
34 if (ProcessHandle > 0) then
35 begin
36 GetExitCodeProcess(ProcessHandle, ExitCode);
37 { or GetExitCodeProcess(ProcessHandle, DWORD(ExitCode)); }
38 TerminateProcess(ProcessHandle, ExitCode);
39 CloseHandle(ProcessHandle);
40 end
41 else
42 ShowMessage('Unable to get proccess Handle');
43 end;
|