Obtener resultados de una aplicación shell/dos en una aplicación Delphi

pipe windows-shell

Question

Tengo una aplicación de línea de comandos codificada en delphi que debo llamar desde una aplicación de escritorio normal (también codificada en Delphi). En resumen, quiero llamar a la aplicación de línea de comandos y mostrar el texto que emite "en vivo" en un cuadro de lista.

Han pasado años desde que jugué con el shell, pero recuerdo claramente que para tomar el texto de una aplicación de línea de comandos, tengo que usar el símbolo de la tubería ">". Me gusta esto:

C: /mycmdapp.exe> ​​c: /result.txt

Esto tomará cualquier texto impreso en el shell (usando writeLn) y lo volcará en un archivo de texto llamado "result.txt".

Pero ... (y aquí viene el pickle), quiero un resultado en vivo en lugar de un archivo de atrasos. Un ejemplo típico es el propio compilador Delphi, que se las arregla para informar al IDE lo que está sucediendo. Si mi memoria me sirve correctamente, parece recordar que debo crear un canal de "canalización" (?) Y luego asignar el nombre de canal a la llamada de shell.

Intenté googlear esto pero honestamente no estaba seguro de cómo formularlo. Espero que alguien de la comunidad pueda señalarme en la dirección correcta.

Actualizado : Esta pregunta puede ser idéntica a ¿Cómo ejecuto un programa de línea de comandos en Delphi? . Algunas de las respuestas se ajustan a lo que estoy buscando, aunque el título y la pregunta en sí no son idénticos.

Answer 1

Como siempre, Zarco Gajic tiene una solución: capturar el resultado de una ventana DOS (comando / consola) . Esta es una copia de su artículo para referencia futura:

El ejemplo ejecuta ''chkdsk.exe c: /' y muestra el resultado en Memo1. Coloque un TMemo (Memo1) y un TButton (Button1) en su formulario. Coloque este código en el procedimiento de evento OnCLick para Button1 :

procedure RunDosInMemo(DosApp: string; AMemo:TMemo);
const
    READ_BUFFER_SIZE = 2400;
var
    Security: TSecurityAttributes;
    readableEndOfPipe, writeableEndOfPipe: THandle;
    start: TStartUpInfo;
    ProcessInfo: TProcessInformation;
    Buffer: PAnsiChar;
    BytesRead: DWORD;
    AppRunning: DWORD;
begin
    Security.nLength := SizeOf(TSecurityAttributes);
    Security.bInheritHandle := True;
    Security.lpSecurityDescriptor := nil;

    if CreatePipe({var}readableEndOfPipe, {var}writeableEndOfPipe, @Security, 0) then
    begin
        Buffer := AllocMem(READ_BUFFER_SIZE+1);
        FillChar(Start, Sizeof(Start), #0);
        start.cb := SizeOf(start);

        // Set up members of the STARTUPINFO structure.
        // This structure specifies the STDIN and STDOUT handles for redirection.
        // - Redirect the output and error to the writeable end of our pipe.
        // - We must still supply a valid StdInput handle (because we used STARTF_USESTDHANDLES to swear that all three handles will be valid)
        start.dwFlags := start.dwFlags or STARTF_USESTDHANDLES;
        start.hStdInput := GetStdHandle(STD_INPUT_HANDLE); //we''re not redirecting stdInput; but we still have to give it a valid handle
        start.hStdOutput := writeableEndOfPipe; //we give the writeable end of the pipe to the child process; we read from the readable end
        start.hStdError := writeableEndOfPipe;

        //We can also choose to say that the wShowWindow member contains a value.
        //In our case we want to force the console window to be hidden.
        start.dwFlags := start.dwFlags + STARTF_USESHOWWINDOW;
        start.wShowWindow := SW_HIDE;

        // Don''t forget to set up members of the PROCESS_INFORMATION structure.
        ProcessInfo := Default(TProcessInformation);

        //WARNING: The unicode version of CreateProcess (CreateProcessW) can modify the command-line "DosApp" string. 
        //Therefore "DosApp" cannot be a pointer to read-only memory, or an ACCESS_VIOLATION will occur.
        //We can ensure it''s not read-only with the RTL function: UniqueString
        UniqueString({var}DosApp);

        if CreateProcess(nil, PChar(DosApp), nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil, start, {var}ProcessInfo) then
        begin
            //Wait for the application to terminate, as it writes it''s output to the pipe.
            //WARNING: If the console app outputs more than 2400 bytes (ReadBuffer),
            //it will block on writing to the pipe and *never* close.
            repeat
                Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 100);
                Application.ProcessMessages;
            until (Apprunning <> WAIT_TIMEOUT);

            //Read the contents of the pipe out of the readable end
            //WARNING: if the console app never writes anything to the StdOutput, then ReadFile will block and never return
            repeat
                BytesRead := 0;
                ReadFile(readableEndOfPipe, Buffer[0], READ_BUFFER_SIZE, {var}BytesRead, nil);
                Buffer[BytesRead]:= #0;
                OemToAnsi(Buffer,Buffer);
                AMemo.Text := AMemo.text + String(Buffer);
            until (BytesRead < READ_BUFFER_SIZE);
        end;
        FreeMem(Buffer);
        CloseHandle(ProcessInfo.hProcess);
        CloseHandle(ProcessInfo.hThread);
        CloseHandle(readableEndOfPipe);
        CloseHandle(writeableEndOfPipe);
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin {button 1 code}
   RunDosInMemo(''chkdsk.exe c:/',Memo1);
end;

Actualización: el ejemplo anterior lee la salida en un solo paso. Aquí hay otro ejemplo de DelphiDabbler muestra cómo se puede leer el resultado mientras el proceso aún se está ejecutando:

function GetDosOutput(CommandLine: string; Work: string = ''C:/'): string;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of AnsiChar;
  BytesRead: Cardinal;
  WorkDir: string;
  Handle: Boolean;
begin
  Result := '''';
  with SA do begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
  try
    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don''t redirect stdin
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;
    WorkDir := Work;
    Handle := CreateProcess(nil, PChar(''cmd.exe /C '' + CommandLine),
                            nil, nil, True, 0, nil,
                            PChar(WorkDir), SI, PI);
    CloseHandle(StdOutPipeWrite);
    if Handle then
      try
        repeat
          WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
          if BytesRead > 0 then
          begin
            Buffer[BytesRead] := #0;
            Result := Result + Buffer;
          end;
        until not WasOK or (BytesRead = 0);
        WaitForSingleObject(PI.hProcess, INFINITE);
      finally
        CloseHandle(PI.hThread);
        CloseHandle(PI.hProcess);
      end;
  finally
    CloseHandle(StdOutPipeRead);
  end;
end;

Answer 2

Probablemente ya tenga el código en su disco duro: la función Execute en la unidad JclSysUtils del JCL (Biblioteca de códigos JEDI) hace lo que necesita:

function Execute(const CommandLine: string; OutputLineCallback: TTextHandler; 
  RawOutput: Boolean = False; AbortPtr: PBoolean = nil): Cardinal;

Puede proporcionarle un procedimiento de devolución de llamada:
TTextHandler = procedure(const Text: string) of object;