Capturar la salida de un comando dos.

[[escafandra]]

Empezado por Flecha

A mí me tiene manía. Se niega a funcionar.
¿Podrá ser por la versión del Delphi? Yo trabajo con Delphi 6 (arcaico, sí, pero es lo que hay)

No, no te tiene manía, ha sido un pequeño error mio al inicializar la estructura SECURITY_ATTRIBUTES, se bebe poner a cero. El no hacerlo provoca errores erráticos en la API CreatePipe que te tomaron manía .

Coloco el código de nuevo para dejarlo mas claro y optimizarlo un poco:

Código Delphi [-]
function DosCommand(CommandLine: String): String;
var
  Buffer: array [0..4096] of char;
  pipeRead, pipeWrite: THandle;
  sa: SECURITY_ATTRIBUTES;
  si: STARTUPINFO;
  pi: PROCESS_INFORMATION;
  dwRead: DWORD;
begin
  Result:= '';
  GetEnvironmentVariable('COMSPEC', Buffer, sizeof(Buffer));
  CommandLine:= String(Buffer) + ' /C ' + CommandLine;

  ZeroMemory(@sa, sizeof(SECURITY_ATTRIBUTES));
  sa.nLength:= sizeof(SECURITY_ATTRIBUTES);
  sa.bInheritHandle:= TRUE;
  if CreatePipe(pipeRead, pipeWrite, @sa, 25*1024) then
  begin
    si.cb:= sizeof(STARTUPINFO);
    ZeroMemory(@pi, sizeof(PROCESS_INFORMATION));
    si.hStdOutput:= pipeWrite;
    si.hStdError := pipeWrite;
    si.hStdInput := pipeWrite;
    si.dwFlags:= STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
    si.wShowWindow:= SW_HIDE;
    if CreateProcess(nil, PCHAR(CommandLine), nil, nil, TRUE, 0, nil, nil, si, pi) then
    begin
      CloseHandle(pi.hThread);
      if WaitForSingleObject(pi.hProcess, 9000) = WAIT_OBJECT_0 then
      begin
        dwRead:= 0;
        WriteFile(pipeWrite, '', 1, dwRead, 0);
        repeat
          ZeroMemory(@buffer, sizeof(buffer));
          ReadFile(pipeRead, buffer, sizeof(buffer), dwRead, 0);
          OemToCharBuffA(buffer, buffer, dwRead);
          Result:= Result + #13 + #10 + String(buffer);
        until dwRead < sizeof(buffer);
      end; 
      CloseHandle(pi.hProcess);
    end; 
    CloseHandle(pipeRead);
    CloseHandle(pipeWrite);
  end; 
end;

Saludos.

[roman]

¿Que este ejemplo no es básicamente lo mismo que en el mensaje #5?

Lo comento no por demeritar éste, sino porque ya el compañero mencionaba que le fallaba con algunos programas.

// Saludos

[Flecha]

No, no son iguales.
Pero todos se parecen . Éste, el del mensaje 5º, el propuesto en TrucoManía... La estructura en todos es básicamente la misma. Pero tienen algunas diferencias. Lo que no tengo ni idea es a groso modo cual de todas las opciones es la mejor...


De todos modos... que no hay manera...
Ahora, al ejecutar el CreateProcess() me salta una excepción con el mesaje "The application failed to ainitialize properly (0xc0000005). Click on OK to terminate the application."
Sin embargo, parece que sí entra en el IF. Pero no obstante, luego no entra en el siguiente IF, el del WaitForSingleObject(). Y además ahora el PC ha empezado a quedarse colgado por momentos. He tenido que cerrar el Delphi. Algo falla.

[[escafandra]]

Empezado por roman

¿Que este ejemplo no es básicamente lo mismo que en el mensaje #5?

...el compañero mencionaba que le fallaba con algunos programas...

Empezado por Flecha

No, no son iguales...

Te entiendo roman. Son códigos muy parecidos, pero si tienen diferencias, hasta en el modo de representar el texto capturado "OemToCharBuffA"

Empezado por Flecha

Muchas gracias por responder, kurono. Pero por desgracia no me vale...

... Hay órdenes cuya respuesta no es capaz de capturar...

En realidad esta es la cuestión. ¿Que comandos son los que no se capturan?, sólo Flecha sabe si le sirve.

Empezado por Flecha

...no tengo ni idea es a groso modo cual de todas las opciones es la mejor...

De todos modos... que no hay manera...
...Y además ahora el PC ha empezado a quedarse colgado por momentos. He tenido que cerrar el Delphi. Algo falla.

Si, parece que algo no está funcionando bien en el PC.

Saludos.

[[escafandra]]

Modificación para evitar problemas si se ejecutan programas que no devuelven nada a la consola:

Código Delphi [-]
function DosCommand(CommandLine: String): String;
var
  Buffer: array [0..4096] of char;
  pipeRead, pipeWrite: THandle;
  sa: SECURITY_ATTRIBUTES;
  si: STARTUPINFO;
  pi: PROCESS_INFORMATION;
  dwRead: DWORD;
begin
  Result:= '';
  GetEnvironmentVariable('COMSPEC', Buffer, sizeof(Buffer));
  CommandLine:= String(Buffer) + ' /C ' + CommandLine;

  ZeroMemory(@sa, sizeof(SECURITY_ATTRIBUTES));
  sa.nLength:= sizeof(SECURITY_ATTRIBUTES);
  sa.bInheritHandle:= TRUE;
  if CreatePipe(pipeRead, pipeWrite, @sa, 25*1024) then
  begin
    si.cb:= sizeof(STARTUPINFO);
    ZeroMemory(@pi, sizeof(PROCESS_INFORMATION));
    si.hStdOutput:= pipeWrite;
    si.hStdError := pipeWrite;
    si.hStdInput := pipeWrite;
    si.dwFlags:= STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
    si.wShowWindow:= SW_HIDE;
    if CreateProcess(nil, PCHAR(CommandLine), nil, nil, TRUE, 0, nil, nil, si, pi) then
    begin
      CloseHandle(pi.hThread);
      if WaitForSingleObject(pi.hProcess, 9000) = WAIT_OBJECT_0 then
      begin
        dwRead:= 0;
//        WriteFile(pipeWrite, '', 1, dwRead, 0);
        Buffer[0] = ' ';   // un espacio 
        WriteFile(pipeWrite, Buffer, 1, dwRead, 0);
        repeat
          ZeroMemory(@Buffer, sizeof(Buffer));
          ReadFile(pipeRead, Buffer, sizeof(Buffer), dwRead, 0);
          OemToCharBuffA(buffer, buffer, dwRead);
          Result:= Result + #13 + #10 + String(Buffer);
        until dwRead < sizeof(Buffer);
      end; 
      CloseHandle(pi.hProcess);
    end; 
    CloseHandle(pipeRead);
    CloseHandle(pipeWrite);
  end; 
end;

Saludos.

[mamcx]

Empezado por Ñuño Martínez

Free Pascal incluye la clase [url="http://www.freepascal.org/docs-html/fcl/process/tprocess.html"]TProcess[/URL

.....

Lo que no sé es si existe esta clase en Delphi, pero por lo que he leído por ahí no hay un equivalente claro.

Pues mira http://www.elmalabarista.com/es/blog...ti-plataforma/

Asi es como la porte a Delphi

Y asi se usa:

Código Delphi [-]
function TPlugin.RunDosInMemo(DosApp: String; StartDir:String): Boolean;
const
   READ_BYTES = 2048;
var
   AProcess: TProcess;
   AStringList: TStringList;
   n: Integer;
   M: TMemoryStream;
   BytesRead,BytesAvailable : LongInt;
begin
   M:=TMemoryStream.Create;
   AProcess := TProcess.Create(nil);
   AStringList := TStringList.Create;

   try
     AProcess.CommandLine := DosApp;
     AProcess.CurrentDirectory :=  StartDir;
     // We will define an option for when the program
     // is run. This option will make sure that our program
     // does not continue until the program we will launch
     // has stopped running. Also now we will tell it that
     // we want to read the output of the file.
     AProcess.Options := AProcess.Options + [poUsePipes, poNoConsole];
     BytesRead := 0;
     AProcess.Execute;
     LogMsg(IntToStr( AProcess.Handle ), msgStart );

   while AProcess.Running do
   begin
     // make sure we have room
     //M.SetSize(BytesRead + READ_BYTES);
     // try reading it
     BytesAvailable := AProcess.Output.NumBytesAvailable;
     n := AProcess.Output.Read(M.Memory^, BytesRead + BytesAvailable);
     if n > 0
     then begin
       Inc(BytesRead, n);
     end
     else begin
       // no data, wait 100 ms

     end;
       Sleep(250);
   end;
   // read last part
   repeat
     // make sure we have room
      BytesAvailable := AProcess.Output.NumBytesAvailable;
     M.SetSize(BytesRead + BytesAvailable);
     // try reading it
     n := AProcess.Output.Read(M.Memory^, BytesRead + BytesAvailable);
     if n > 0
     then begin
       Inc(BytesRead, n);
     end;
   until n <= 0;
   M.SetSize(BytesRead);

   LogMsg(IntToStr( AProcess.Handle ), msgEnd );

   AStringList.LoadFromStream(M);
      LastOutPut := AStringList.Text;
     AStringList.Clear;
     //Reading errors...
     LastErrors := '';
     AStringList.LoadFromStream(AProcess.Stderr);

     if AStringList.Count>0 then
     begin
      LastErrors := StringReplace( AStringList.Text ,#13+#10,#13,[rfReplaceAll] );
     end;//if

     Result := (AProcess.ExitStatus = 0);
   finally
     AStringList.Free;
     AProcess.Free;
   end;//try
end;

Desafortunadamente tiene un bug: Si el proceso DOS genera un output muy grande muy rapido se queda "colgado". No he podido ver todavia como arreglarlo...

[Ñuño Martínez]

Empezado por mamcx

Desafortunadamente tiene un bug: Si el proceso DOS genera un output muy grande muy rapido se queda "colgado". No he podido ver todavia como arreglarlo...

No lo he estudiado, pero quizá usando varios hilos: uno que es el que ejecuta el proceso y va guardando la salida en un buffer, y otro que es el que va obteniendo los datos desde el buffer y poniéndolos en el memo.

Ya digo que no lo he estudiado, pero se ve bien.