Saber se um programa travou

[Fernando-M 0]

Através do "FindWindow" podemos pegar o Handle do programa para saber se ele está em execução. Mais eu gostaria de saber e o programa está travado. Ou seja o programa não está respondendo. Eu estava pensando em usar o "SendMessage"

[Fernando-M 0]

No momento estou fazendo teste o estes códigos

type
 TProgramaTravado = class(TThread)
 private
   FIdHandle: Integer;
   TimeTemp: TTimer;
   TextTemp: Array [0..255] of Char;
   procedure OnTimer(Sender: TObject);
 protected
   procedure Execute; override;
 public
   Texto: String;
   constructor Create(CreateSuspended: Boolean; IdHandle: Integer); overload;
   destructor Destroy; override;
end;

procedure TProgramaTravado.Execute;
begin
 SendMessage(FIdHandle, WM_GETTEXT, 256, Integer(@TextTemp));
 Texto:= 'OK';
 TimeTemp.Enabled := False;
end;

procedure TProgramaTravado.OnTimer(Sender: TObject);
begin
 TimeTemp.Enabled:= False;
 Texto:= 'TRAVADO';
 Terminate;
end;

constructor TProgramaTravado.Create(CreateSuspended: Boolean;
     IdHandle: Integer);
begin
 FIdHandle:= IdHandle;

 TimeTemp:= TTimer.Create(nil);
 TimeTemp.Enabled:= False;
 TimeTemp.OnTimer:= OnTimer;
 TimeTemp.Interval:= 1000;
 TimeTemp.Enabled:= True;

 FreeOnTerminate := True;
 Create(CreateSuspended);
end;

destructor TProgramaTravado.Destroy;
begin
 TimeTemp.Enabled := False;
 TimeTemp.Free;
 inherited;
end;

function ProgramaExecutandoNormal(NomeProduto: String): Boolean;
 var
   Programa: TProgramaTravado;
   ProgramaID: Integer;
begin
 ProgramaID:= FindWindow(Nil, PChar(NomeProduto));
 if ProgramaID > 0 then begin
   Programa:= TProgramaTravado.Create(True, 0);
   try
     Programa.Resume;
     while Trim(Programa.Texto) = '' do begin
       Application.ProcessMessages;
     end;
     if Programa.Texto = 'OK' then
       Result:= True
     else
       Result:= False;
   finally
     //Programa.Free;
   end;
 end else
   Result:= False;
end;