Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   API de Windows (https://www.clubdelphi.com/foros/forumdisplay.php?f=7)
-   -   Capturar la salida de un comando dos. (https://www.clubdelphi.com/foros/showthread.php?t=27895)

spab 02-12-2005 18:55:27

Capturar la salida de un comando dos.
 
¿Cómo puedo capturar la salida de un comando al ejecutarlo? para mostrarlo en un memo por ejemplo.

ElKurgan 02-12-2005 19:06:27

Aqui esta lo que buscas http://www.q3.nu/trucomania/ftesp.html

La pagina de Trucomania hace tiempo que no se actualiza, y algunos trucos han quedado obsoletos, pero sigue siendo una de las primeras paginas que debiera conocer todo principiante en Delphi

Un saludo

spab 02-12-2005 19:09:02

Gracias
 
Muchisimas gracias !

Flecha 14-01-2011 15:15:25

Hola a todos.

Estoy también en busca de algo que me ayude a capturar la salida para mostrarla en TMemo. Ese enlace que puso ElKurgan ya está obsoleto. El link correcto es este: http://www.trucomania.org/trucomania/truco.cgi?320&esp

No obstante, lo he probado y no vale ese truco porque en ocasiones no logra capturar la respuesta.

¿Alguien conoce otro método que sea más eficaz?

Muchas gracias.

kurono 16-01-2011 01:47:11

este te permite ejecutar comando de Ms-dos y ver sus resultados quisas seas lo que busca

Código Delphi [-]
function IsWinNT: boolean;
var
  OSV: OSVERSIONINFO;
begin
  OSV.dwOSVersionInfoSize := sizeof(osv);
  GetVersionEx(OSV);
  result := OSV.dwPlatformId = VER_PLATFORM_WIN32_NT;
end;

function CmdExec(Cmd: string): string;
var
  Buffer: array[0..4096] of Char;
  si: STARTUPINFO;
  sa: SECURITY_ATTRIBUTES;
  sd: SECURITY_DESCRIPTOR;
  pi: PROCESS_INFORMATION;
  newstdin, newstdout, read_stdout, write_stdin: THandle;
  exitcod, bread, avail: Cardinal;
begin
  Result:= '';
  if IsWinNT then
  begin
    InitializeSecurityDescriptor(@sd, SECURITY_DESCRIPTOR_REVISION);
    SetSecurityDescriptorDacl(@sd, true, nil, false);
    sa.lpSecurityDescriptor := @sd;
  end
  else sa.lpSecurityDescriptor := nil;
  sa.nLength := sizeof(SECURITY_ATTRIBUTES);
  sa.bInheritHandle := TRUE;
  if CreatePipe(newstdin, write_stdin, @sa, 0) then
  begin
    if CreatePipe(read_stdout, newstdout, @sa, 0) then
    begin
      GetStartupInfo(si);
      with si do
      begin
        dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
        wShowWindow := SW_HIDE;
        hStdOutput := newstdout;
        hStdError := newstdout;
        hStdInput := newstdin;
      end;
      Fillchar(Buffer, SizeOf(Buffer), 0);
      GetEnvironmentVariable('COMSPEC', @Buffer, SizeOf(Buffer) - 1);
      StrCat(@Buffer,PChar(' /c ' + Cmd));
      if CreateProcess(nil, @Buffer, nil, nil, TRUE, CREATE_NEW_CONSOLE, nil, nil, si, pi) then
      begin
        repeat
          PeekNamedPipe(read_stdout, @Buffer, SizeOf(Buffer) - 1, @bread, @avail, nil);
          if bread > 0 then
          begin
            Fillchar(Buffer, SizeOf(Buffer), 0);
            ReadFile(read_stdout, Buffer, bread, bread, nil);
            Result:= Result + String(PChar(@Buffer));
          end;
          Application.ProcessMessages;
          GetExitCodeProcess(pi.hProcess, exitcod);
        until (exitcod <> STILL_ACTIVE) and (bread = 0);
      end;
      CloseHandle(read_stdout);
      CloseHandle(newstdout);
    end;
    CloseHandle(newstdin);
    CloseHandle(write_stdin);
  end;
end;

ejemplo de uso

begin

ShowMessage(CmdExec('dir c:\'));
ShowMessage(CmdExec('netstat -a -n'));

end;
end.

Flecha 17-01-2011 10:56:47

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

También he provado ese código que me ofreces. Pero no deja de ser una variante del truco de Trucomanía. Hay órdenes cuya respuesta no es capaz de capturar.

¿Alguien conoce otra alternativa?

Muchas Gracias.

newtron 25-01-2011 21:05:32

Hola.

Igual digo una tontería pero los comandos de msdos si los acabas con el signo > seguido de un nombre crea un archivo con la salida del comando. Unicamente tendrías que ejecutar el comando msdos con el signo y el nombre del fichero y después leer el fichero que es un fichero de txt normal.

Saludos

Casimiro Notevi 25-01-2011 21:25:35

Cita:

Empezado por newtron (Mensaje 388769)
Hola.

Igual digo una tontería pero los comandos de msdos si los acabas con el signo > seguido de un nombre crea un archivo con la salida del comando. Unicamente tendrías que ejecutar el comando msdos con el signo y el nombre del fichero y después leer el fichero que es un fichero de txt normal.

Saludos

Exacto, y si en lugar de '>' pones '>>' lo que hace es añadirlo al final del fichero indicado.

mcs 26-01-2011 10:14:56

Cita:

Empezado por Casimiro Notevi (Mensaje 388772)
Exacto, y si en lugar de '>' pones '>>' lo que hace es añadirlo al final del fichero indicado.

siempre y cuando usen las funciones del DOS para escribir en pantalla, cosa que pocas aplicaciones hacían debido a que era muy lento... (lo fácil y rápido era escribir directamente a la memoria de la VGA... dirección $B8000000, si no recuerdo mal! :p)

newtron 26-01-2011 10:37:08

Cita:

Empezado por mcs (Mensaje 388855)
siempre y cuando usen las funciones del DOS para escribir en pantalla, cosa que pocas aplicaciones hacían debido a que era muy lento... (lo fácil y rápido era escribir directamente a la memoria de la VGA... dirección $B8000000, si no recuerdo mal! :p)

....juer... 10 años programando en msdos y otros 10 en guindoun y ahora me entero de eso de escribir en la memoria de la vga.... dirección qué dices? jajajajajaja

Flecha 26-01-2011 10:54:09

Espero no tener que vigilar las escrituras directas en VGA, porque para lo que necesito capturar la salida..., sería un auténtico engorro tener que andarme con esas cosas... :(


Ya sabía lo del > y el >> ;). Es lo más básico de lo más mínima programación elemental :rolleyes:. Pero preferiría no tener que recurrir a ese truco. :p


De todos modos, muchas gracias a todos.
La captura de la salida a MS-DOS que necesito hacer, es sólo una pequeña parte de un problema mayor que debo resolver. Si consigo perfeccionar el resto de los puntos de mi problema, quizá no necesite ser "tan exigente" con la captura. Y en este caso, la solución presente en TrucoManía, y la presentada por kurono, cualquiera de las dos podría valerme.


No obstante. Debo reseñar una cosa al respecto de sendas soluciones. Ambas tienen un bucle, dentro del cual se va capturando la salida a MS-DOS mientras que el proceso sigue activo...
En ocasiones, dependiendo de qué se quiera ejecutar, nunca se detecta el fin de la actividad del proceso. En esos casos el bucle se convierte en infinito.
Por lo tanto, aconsejo a quien vaya a utilizar esos trucos, que incorpore en dicho bucle un Time-Out, el que cada cual estime más oportuno...

Por ejemplo..., éste es el bucle al que hago referencia en la solución aportada por kurono:
Código Delphi [-]
[...]
begin
[...]
        repeat
          PeekNamedPipe(read_stdout, @Buffer, SizeOf(Buffer) - 1, @bread, @avail, nil);
          if bread > 0 then
          begin
            Fillchar(Buffer, SizeOf(Buffer), 0);
            ReadFile(read_stdout, Buffer, bread, bread, nil);
            Result:= Result + String(PChar(@Buffer));
          end;
          Application.ProcessMessages;
          GetExitCodeProcess(pi.hProcess, exitcod);
        until (exitcod <> STILL_ACTIVE) and (bread = 0);
[...]
end;


Conviene declarar una variable TDateTime para controlar el tiempo transcurrido. Primero la inicializamos reflejando en ella el TimeOut a respetar, y luego añadimos el control del TimeOut dentro de la condición de salida del bucle.
Código Delphi [-]
var
  TimeOut : TDateTime;  // esta variable servirá para controlar el TimeOut
[...]
begin
[...]
        TimeOut := Now + EncodeTime(0,0,30,0);   // esto es un TimeOut de 30 segundos

        repeat
          PeekNamedPipe(read_stdout, @Buffer, SizeOf(Buffer) - 1, @bread, @avail, nil);
          if bread > 0 then
          begin
            Fillchar(Buffer, SizeOf(Buffer), 0);
            ReadFile(read_stdout, Buffer, bread, bread, nil);
            Result:= Result + String(PChar(@Buffer));
          end;
          Application.ProcessMessages;
          GetExitCodeProcess(pi.hProcess, exitcod);

        until ((exitcod <> STILL_ACTIVE) and (bread = 0))
           or (timeout < now);  // añadir esta condición para controlar el TimeOut
[...]
end;

roman 26-01-2011 16:43:00

Cita:

Empezado por Flecha (Mensaje 388860)
En ocasiones, dependiendo de qué se quiera ejecutar, nunca se detecta el fin de la actividad del proceso. En esos casos el bucle se convierte en infinito.

¿Podrías mencionar un caso en que suceda esto?

// Saludos

Flecha 26-01-2011 18:56:23

Por suerte, son casos muy rebuscados, pero algunos hay.


Por ejemplo, un caso absurdo, pero que como ejemplo puede valer.
Si queremos ejecutar "notepad.exe", todo funciona OK. Se abre un NotePad con un documento en blanco sin problemas. Pero el programa se queda atrapado en el bucle infinito hasta que cerremos el NotePad.

Como digo, es un caso absurdo, porque el NotePad no da salida a MS-DOS. Pero como ejemplo, puede valer.



Sin embargo hay otros casos nada absurdos y que sí tienen salidas a MS-DOS que, ejecutados desde una ventana de comandos, quedan igualmente atrapados en ese bucle infinito.

Como ejemplo, puedo comentar lo que más me afecta a mí, particularmente. En otro hilo ( http://www.clubdelphi.com/foros/showthread.php?p=387845 ) explico mi necesidad de "reinventar la rueda" para hacer ejecuciones en remoto. Logré localizar por internet un programa (PSExec.exe) capaz de ejecutar cosas en remoto (no me soluciona el problema, pero es lo que tengo).
Por ejemplo..., con ésto se ejecutaría DIR en una máquina remota:
psexec.exe \\DirecciónIP -u usuario -p password cmd /c dir

Esa línea de comando funciona perfectamente desde una ventana de comandos MS-DOS. Pero si la lanzas desde Delphi, e intentas capturar su salida MS-DOS, entra en bucle infinito.



No obstante, otras ejecuciones en remoto con PSExec.exe sí que son capturables sus salidas MS-DOS. Así que el problema no es 100% de PSExec.exe.

Es un caso rebuscado, sí. :rolleyes: Pero es el que me afecta. :(

Muchas gracias.
Un saludo.

Casimiro Notevi 26-01-2011 18:57:57

¿Un bucle infinito haciendo qué?

Flecha 26-01-2011 19:17:54

Cita:

Empezado por Casimiro Notevi (Mensaje 388919)
¿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 27-01-2011 14:24:30

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 27-01-2011 15:30:15

Muchas gracias..., pero no funciona. :(:(:(:(

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

Ñuño Martínez 27-01-2011 15:33:48

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.

escafandra 27-01-2011 17:18:08

Cita:

Empezado por Flecha (Mensaje 389041)
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 27-01-2011 17:39:55

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

escafandra 27-01-2011 19:11:19

Cita:

Empezado por Flecha (Mensaje 389062)
:(:(:(
A mí me tiene manía. Se niega a funcionar.
¿Podrá ser por la versión del Delphi? Yo trabajo con Delphi 6 :o (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 :p.

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 27-01-2011 19:15:07

¿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 27-01-2011 19:41:26

No, no son iguales.
Pero todos se parecen :D. É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 27-01-2011 20:48:36

Cita:

Empezado por roman (Mensaje 389082)
¿Que este ejemplo no es básicamente lo mismo que en el mensaje #5?

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

Cita:

Empezado por Flecha (Mensaje 389085)
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"

Cita:

Empezado por Flecha (Mensaje 387758)
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.

Cita:

Empezado por Flecha (Mensaje 389085)
...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 31-01-2011 02:00:21

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 31-01-2011 17:03:38

Cita:

Empezado por Ñuño Martínez (Mensaje 389042)
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 04-02-2011 14:05:08

Cita:

Empezado por mamcx (Mensaje 389419)
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. :)


La franja horaria es GMT +2. Ahora son las 01:18:51.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi