Cargando un proceso desde una aplicación Delphi y esperando a que éste finalice con la función API WaitForSingleObject

Esperando a que una aplicación termine

Copyright © 2000 Ernesto De Spirito

Help & Manual authoring tool

WaitForSingleObject

Si alguna vez necesitamos ejecutar una aplicación externa y esperar a que termine, entonces tendríamos que arreglárnoslas sin ShellExecute y apelar a funciones más básicas, como CreateProcess, WaitForSingleObject y CloseHandle.

uses Forms, Windows;

procedure TForm1.Button1Click(Sender: TObject);
var
  proc_info: TProcessInformation;
  startinfo: TStartupInfo;
  ExitCode: longword;
begin
  // Inicializamos las estructuras
  FillChar(proc_info, sizeof(TProcessInformation), 0);
  FillChar(startinfo, sizeof(TStartupInfo), 0);
  startinfo.cb := sizeof(TStartupInfo);

  // Intentamos crear el proceso
  if CreateProcess('c:\windows\notepad.exe', nil, nil,
      nil, false, NORMAL_PRIORITY_CLASS, nil, nil,
       startinfo, proc_info) <> False then begin
    // El proceso se creó exitosamente
    // Ahora esperemos a que termine...
    WaitForSingleObject(proc_info.hProcess, INFINITE);
    // Proceso finalizado. Ahora debemos cerrarlo.
    GetExitCodeProcess(proc_info.hProcess, ExitCode);  // Opcional
    CloseHandle(proc_info.hThread);
    CloseHandle(proc_info.hProcess);
    Application.MessageBox((PChar(Format(
      '¡Bloc de notas finalizado! (Código de retorno=%d)', [ExitCode])),
      'Aviso', MB_ICONINFORMATION);
  end else begin
    // Fracasó la creación del proceso
    Application.MessageBox('No se pudo ejecutar la '
      + 'aplicación', 'Error', MB_ICONEXCLAMATION);
  end;//if
end;

Problemas

Hemos experimentado problemas con WaitForSingleObject en combinación con ciertas aplicaciones y nos hemos visto obligados a finalizarlas con el Administrador de Tareas. Otras aplicaciones no se cierran bien y WaitForSingleObject nunca vuelve. Aparte de eso, una aplicación no responde a eventos mientras espera y por ejemplo los formularios no se repintan...

Una posible solución a estos problemas es verificar el estado de la aplicación lanzada (llamando a GetExitCodeProcess) a intervalos de tiempo (en un evento Timer).

uses Forms, Windows, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
  btnExecute: TButton;
  btnCancel: TButton;
  Timer1: TTimer;
  procedure FormCreate(Sender: TObject);
  procedure btnExecuteClick(Sender: TObject);
  procedure Timer1Timer(Sender: TObject);
  procedure btnCancelClick(Sender: TObject);
  procedure FormCloseQuery(Sender: TObject;
    var CanClose: Boolean);
private
  proc_info: TProcessInformation;
  startinfo: TStartupInfo;
  ExitCode: LongWord;
end;

implementation

procedure TForm1.FormCreate(Sender: TObject);
begin
  btnCancel.Enabled := False;
  Timer1.Enabled := False;
  Timer1.Interval := 200;
end;

procedure TForm1.btnExecuteClick(Sender: TObject);
begin
  FillChar(proc_info, sizeof(TProcessInformation), 0);
  FillChar(startinfo, sizeof(TStartupInfo), 0);
  startinfo.cb := sizeof(TStartupInfo);
  if CreateProcess(nil, 'c:\windows\notepad.exe', nil,
      nil, false, CREATE_DEFAULT_ERROR_MODE
      + NORMAL_PRIORITY_CLASS, nil, nil, startinfo,
      proc_info) then begin
    btnExecute.Enabled := False;
    btnCancel.Enabled := True;
    Timer1.Enabled := True;
  end else begin
    CloseHandle(proc_info.hProcess);
    Application.MessageBox('No se pudo ejecutar la'
     + ' aplicación', 'Error', MB_ICONEXCLAMATION);
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := False;
  if GetExitCodeProcess(proc_info.hProcess, ExitCode)
  then
    if ExitCode = STILL_ACTIVE then
      Timer1.Enabled := True
    else begin
      btnCancel.Enabled := False;
      btnExecute.Enabled := True;
      CloseHandle(proc_info.hProcess);
    end
  else begin
    btnCancel.Enabled := False;
    btnExecute.Enabled := True;
    TerminateProcess(proc_info.hProcess, 0);
    CloseHandle(proc_info.hProcess);
  end;
end;

procedure TForm1.btnCancelClick(Sender: TObject);
begin
  Timer1.Enabled := False;
  if Application.MessageBox('Debería intentar finali'
  + 'zar la aplicación normalmente.'#13#13'¿Seguro '
  + 'que desea terminarla?', 'Warning', MB_YESNO +
  MB_DEFBUTTON2 + MB_ICONQUESTION + MB_TASKMODAL)
  = ID_YES then begin
    TerminateProcess(proc_info.hProcess, 0);
    CloseHandle(proc_info.hProcess);
    btnCancel.Enabled := False;
    btnExecute.Enabled := True;
  end else begin
    Timer1.Enabled := True;
  end;
end;

procedure TForm1.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  if btnCancel.Enabled then begin
    btnCancelClick(Sender);
    if btnCancel.Enabled then CanClose := False;
  end;
end;
JfControls Library - para Delphi y C++ Builder