How to check whether an application is running or not responding (Views: 704)
Problem/Question/Abstract: 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). procedure TForm1.Button1Click(Sender: TObject); var Res: DWORD; H: HWND; begin H := FindWindow(nil, 'FormSomeCaption'); if H = 0 then Label1.Caption := 'Window not found' else if SendMessageTimeout(H, WM_NULL, 0, 0, SMTO_NORMAL, 100, Res) <> 0 then Label1.Caption := 'Responding' else Label1.Caption := 'Not responding'; end; And to kill it, no questions asked, then procedure TForm1.ButtonClick(Sender: TObject); var ProcessHandle: THandle; WinHwnd: HWND; ProcessID, ExitCode: Integer; begin ProcessID := 0; ExitCode := 0; WinHwnd := FindWindow(nil, 'FormSomeCaption'); if not (IsWindow(WinHwnd)) then begin ShowMessage('Window not found'); exit; end; GetWindowThreadProcessID(WinHwnd, @ProcessID); ProcessHandle := OpenProcess(PROCESS_CREATE_THREAD or PROCESS_VM_OPERATION or PROCESS_VM_WRITE or PROCESS_VM_READ or PROCESS_TERMINATE, False, ProcessID); if (ProcessHandle > 0) then begin GetExitCodeProcess(ProcessHandle, ExitCode); { or GetExitCodeProcess(ProcessHandle, DWORD(ExitCode)); } TerminateProcess(ProcessHandle, ExitCode); CloseHandle(ProcessHandle); end else ShowMessage('Unable to get proccess Handle'); end; |