Capturar la salida de un comando dos.

Flecha · #1 26-01-2011

Cita:

Empezado por Casimiro Notevi

¿Un bucle infinito haciendo qué?

Lo explico más arriba.
Es referente a la solución aportada por kurono, y la presente en TrucoManía.
En ambos casos hay un REPEAT UNTIL, dentro del cual se recoge la salida MS-DOS. Se sale del bucle cuando el proceso lanzado deja de estar activo.
Pero en algunos casos, esa señal nunca llega, o no llega cuando se espera que llegue.

[escafandra] · #2 27-01-2011

Inténtalo de esta forma:

Código Delphi [-]function DosCommand(CommandLine: String): String;
var
  cmdBuffer: array [0..MAX_PATH] of char;
  Buffer: array [0..4096] of char;
  pipeRead, pipeWrite: THandle;
  sa: SECURITY_ATTRIBUTES;
  si: STARTUPINFO;
  pi: PROCESS_INFORMATION;
  dwRead: DWORD;
begin
  GetEnvironmentVariable('COMSPEC', cmdBuffer, sizeof(cmdBuffer));
  CommandLine:= String(cmdBuffer) + ' /C ' + CommandLine;
  Result:= '';
  
  sa.nLength:= sizeof(SECURITY_ATTRIBUTES);
  sa.bInheritHandle:= TRUE;
  if CreatePipe(pipeRead, pipeWrite, @sa, 0) 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.

Flecha · #3 27-01-2011

Muchas gracias..., pero no funciona.

Da igual lo que intente ejecutar.
CreateProcess() siempre devuelve FALSE, así que nunca llega a ejecutar el comando.

[escafandra] · #4 27-01-2011

Cita:

Empezado por Flecha

Muchas gracias..., pero no funciona.

Da igual lo que intente ejecutar.
CreateProcess() siempre devuelve FALSE, así que nunca llega a ejecutar el comando.

Pues a mi si. Sólo he encontrado un problemilla en tamaño del buffer del pipe, si lo asignas por defecto a veces falla. Le he dado un valor de 25k.

Ademas, ejecuta y captura comandos difíciles de capturar como el "xcopy".

Cambia la línea:

Código Delphi [-]if CreatePipe(pipeRead, pipeWrite, @sa, 0) then

por

Código Delphi [-]if CreatePipe(pipeRead, pipeWrite, @sa, 25*1024) then

Saludos.

Flecha · #5 27-01-2011

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)

[escafandra] · #6 27-01-2011

Cita:

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 · #7 27-01-2011

¿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

Ñuño Martínez · #8 27-01-2011

Free Pascal incluye la clase TProcess, que estrictamente hablando crea procesos nuevos y permite la comunicación con estos. Dado que trabaja a nivel de proceso y no de programa, permite ejecutar comandos de consola que no son programas sino funciones dentro de dicha consola (haberlos haylos, como "dir" o "cd"). Además permite capturar mensajes no sólo de la salida "normal" (stdout en POSIX) sino también por otras fuentes (como stderr, variables del sistema, etc.) que no pueden capturarse por ">" ni ">>", además de permitir la redirección de archivos y otras cosas interesantes.

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.

mamcx · #9 31-01-2011

Cita:

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 · #10 04-02-2011

Cita:

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.