How to check whether an application is running or not responding

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;