MecaNet

En esta sección de Código Fuente en Delphi vamos a explicar cómo podemos ejecutar un programa de consola y capturar su salida de texto para mostrarla en nuestra app.

Para ello, he escrito esta pequeña app de ejemplo.

Para poder realizar esta tarea debemos utilizar las siguientes funciones de la api de Windows: CreatePipe, CreateProcess, PeekNamedPipe, ReadFile, MsgWaitForMultipleObjects

Voy a intentar explicar los pasos en líneas generales que debemos realizar:

1. En primer lugar, debemos utilizar la función CreatePipe, que crea una tubería (pipe) anónima y devuelve identificadores a los extremos de lectura y escritura de la tubería. Es a esta tubería, a donde el programa de consola enviará su salida, y de donde podremos leerla desde nuestra app.
2. Tendrémos que ejecutar el programa con la función CreateProcess a la que debemos pasarle los datos adecuados para que la salida de la aplicación de consola sea enviada a la tubería que podamos leer.

3. Cuando la aplicación tipo consola se esté ejecutando, tendremos que ir leyendo su salida y mostrandola en nuestra app o realizando las acciones oportunas que necesitemos. En la demo, solamente he ido mostrando la salida en un objeto tipo Tmemo.
4. En un bucle que se ejecuta indefinidamente mientras la app de consola esté produciendo salida, nuestra app deberá ir leyendo esa salida y realizando las acciones que necesitemos. Para ello, a la función principal "ExecAndCapture", además de pasarle el string con el comando a ejecutar, le pasamos un puntero a una función que será llamada para cada línea de salida que produzca la app de consola, y esa función será la que realice las acciones que nuestra app necesite. En nuestro caso, solamente reescribe la salida de la app de consola a un Memo. La espera hasta que el proceso consola termine su ejecución se realiza con la función "MsgWaitForMultipleObjects"

En la siguiente imagen puedes ver un ejemplo de uso de esta app en el que realizamos el comando "dir" sobre la misma carpeta en la que está el ejecutable.

A continuación, puedes ver el código completo de la app, y si lo deseas puedes descargarlo todo (código y app) en un archivo "zip".

unit Unit1;


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons;

type
  TAnoPipe = record
    Input: THandle;
    Output: THandle;
  end;

  TForm1 = class(TForm)
    Memo1: TMemo;
    BitBtn1: TBitBtn;
    Edit1: TEdit;
    procedure BitBtn1Click(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;


implementation

{$R *.dfm}


type
  TOutLn = procedure(s: string);

procedure OutLn(s: string);
begin
  form1.memo1.lines.add(s);
end;


procedure ExecAndCapture(const ACmdLine: string; fn: TOutLn);
const
  cBufferSize = 2048;
var
  vStartupInfo: TStartUpInfo;
  vSecurityAttributes: TSecurityAttributes;
  vBytesLegibles, vBytesLeidos: DWord;
  vProcessInfo: TProcessInformation;
  vStdOutPipe: TAnoPipe;
  Buf: AnsiString;
  OutputLine: AnsiString;
  LineStart, i: integer;
begin
  with vSecurityAttributes do
  begin
    nlength := SizeOf(TSecurityAttributes);
    binherithandle := True;
    lpsecuritydescriptor := nil;
  end;
  SetLength(Buf, cbufferSize);
  OutputLine := '';
  try
    if not CreatePipe(vStdOutPipe.Output, vStdOutPipe.Input, @vSecurityAttributes, 0) then
      raise Exception.Create('Failed to create pipe for standard output.' +
        ' System error message: ' +
        SysErrorMessage(GetLastError));

    FillChar(vStartupInfo, Sizeof(TStartUpInfo), #0);
    vStartupInfo.cb := SizeOf(TStartUpInfo);
    vStartupInfo.wShowWindow := SW_HIDE;
    vStartupInfo.hStdOutput := vStdOutPipe.Input;
    vStartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
    try
      if not CreateProcess(nil
        , PChar(ACmdLine)
        , @vSecurityAttributes
        , @vSecurityAttributes
        , True
        , NORMAL_PRIORITY_CLASS
        , nil
        , nil
        , vStartupInfo
        , vProcessInfo) then
        raise Exception.Create('Failed creating the console process.' +
          ' System error msg: ' +
          SysErrorMessage(GetLastError));

      repeat
        vBytesLeidos := 0;
        if PeekNamedPipe(vStdOutPipe.Output, nil, 0, nil, @vBytesLegibles, nil) then
          if vBytesLegibles > 0 then
            ReadFile(vStdOutPipe.Output, Buf[1], cBufferSize, vBytesLeidos, nil);
        if vBytesLeidos > 0 then
        begin
          LineStart := 1;
          i := 1;
          while i <= vBytesLeidos do
          begin
            if Buf[i] in [#10, #13] then
            begin
              OutputLine := OutputLine + Copy(Buf, LineStart, i - LineStart);
              fn(OutputLine);
              OutputLine := '';
              if (i < vBytesLeidos) and
                (Buf[i] in [#10, #13]) and
                (Buf[i] <> Buf[i + 1]) then
                inc(i);
              LineStart := i + 1;
            end;
            inc(i);
          end;
          OutputLine := Copy(Buf, LineStart, vBytesLeidos - LineStart + 1);
        end;
        Application.ProcessMessages;
      until (MsgWaitForMultipleObjects(1, vProcessInfo.hProcess, False,
                                   INFINITE, QS_ALLINPUT) <> WAIT_OBJECT_0 + 1);
    finally
      CloseHandle(vProcessInfo.hProcess);
      CloseHandle(vProcessInfo.hThread);
    end;
  finally
    CloseHandle(vStdOutPipe.Input);
    CloseHandle(vStdOutPipe.Output);
  end;
end;




procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  memo1.clear;
  ExecAndCapture(Edit1.Text, OutLn);
end;


end.