19 respuestas en este tema

[escafandra]

Este tema no es nuevo, se han publicado numerosos trucos que tratan de realizar esta tarea. Algunos códigos no capturan o no ejecutan todos los comandos, como puede ser el problema que algunos tienen con "xcopy".

Propongo otra versión, DosCommand:

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;
        Buffer[0]:= ' ';
        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;

Un ejemplo de uso:

delphi

Memo1.Text:= DosCommand(Edit1.Text);

Saludos.

PD.
Modifico el código:

delphi

// cambio
WriteFile(pipeWrite, '', 1, dwRead, 0);
// por
Buffer[0]:= ' '; //un espacio.
WriteFile(pipeWrite, Buffer, 1, dwRead, 0);

Para evitar problemas con programas que no devuelvan nada a la consola.

[enecumene]

A ver si entendí, ese código sirve para utilizar comandos DOS desde Delphi??.

[escafandra]

A ver si entendí, ese código sirve para utilizar comandos DOS desde Delphi??.

Exacto, ejecutarlo y obtener la salida en un String. 


Saludos.

[felipe]

Lo probé y obtuve un "Acces Violation", ejemplo, si uso el comando "dir", veo que en la variable CommandLine aparece "C:\WINDOWS\system32\cmd.exe /C dir"


Saludos!

[egostar]

Lo probé y obtuve un "Acces Violation", ejemplo, si uso el comando "dir", veo que en la variable CommandLine aparece "C:\WINDOWS\system32\cmd.exe /C dir"


Saludos!

No amigo felipe.co  ese código es para cosas más complejas, no intentes observarnos el rostro

Salud OS

[felipe]

Lo probé y obtuve un "Acces Violation", ejemplo, si uso el comando "dir", veo que en la variable CommandLine aparece "C:\WINDOWS\system32\cmd.exe /C dir"


Saludos!

No amigo felipe.co  ese código es para cosas más complejas, no intentes observarnos el rostro

Salud OS

jaja... bueno no tenía más opción, a este equipo le pasa algo raro y hace mucho dejaron de funcionar los comandos importantes, creo que desde la última actualización 


Saludos!

[egostar]

Bueno, creo que es tu maquina mi amigo, he hecho la misma prueba y a mi no me da error

DIR E:

********************************************
El volumen de la unidad E es RODGAB
El número de serie del volumen es: 31F4-0BF5

Directorio de E:\

22/01/2011  14:14    <DIR>          VIDEO
22/01/2011  14:14    <DIR>          AUDIO
              0 archivos              0 bytes
              2 dirs              0 bytes libres
********************************************

Salud OS

[felipe]

Bueno, creo que es tu maquina mi amigo, he hecho la misma prueba y a mi no me da error
...
Salud OS

Creería lo mismo, lo tendré que probar en otra máquina.


Saludos!

[escafandra]

Lo probé y obtuve un "Acces Violation", ejemplo, si uso el comando "dir", veo que en la variable CommandLine aparece "C:WINDOWSsystem32cmd.exe /C dir"

Claro, se ejecuta una consola invisible, se le pasa el comando y se captura el resultado.
Subo un ejemplo.



Saludos.

[felipe]

Claro, se ejecuta una consola invisible, se le pasa el comando y se captura el resultado.

Sí, y efectivamente quería mostrar eso, porque si lo uso desde el editor de comandos normalmente no me da ningún problema, pero si lo uso desde esta función obtengo un Access violation:

Access violation at address 784966C3 in module "ntdll.dll". Read of address FFFFFFFF.

Pero como dice egostar y cuya idea apoyo es que posiblemente este equipo tenga problemas.


Saludos!

[madiazg]

Hola,he intentado combinar el código descrito con el siguiente código que ejecuta una aplicación y espera a que termine el proceso pero no lo he conseguido (entre otras cosas porque mis conocimientos de delphi no son suficientes para comprender el código).

delphi

function WinExecAndWait32(FileName:String; Visibility:integer):integer;
 var
   zAppName:array[0..512] of char;
   zCurDir:array[0..255] of char;
   WorkDir:String;
   StartupInfo:TStartupInfo;
   ProcessInfo:TProcessInformation;
   Resultado,exitCode: DWord;
 begin
   StrPCopy(zAppName,FileName);
   GetDir(0,WorkDir);
   StrPCopy(zCurDir,WorkDir);
   FillChar(StartupInfo,Sizeof(StartupInfo),#0);
   StartupInfo.cb := Sizeof(StartupInfo);
   StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
   StartupInfo.wShowWindow := Visibility;
   CreateProcess(nil,
     zAppName,                      { pointer to command line string }
     nil,                           { pointer to process security attributes}
     nil,                           { pointer to thread security attributes}
     false,                         { handle inheritance flag }
     CREATE_NEW_CONSOLE or          { creation flags }
     NORMAL_PRIORITY_CLASS,
     nil,                           { pointer to new environment block }
     nil,                           { pointer to current directory name }
     StartupInfo,                   { pointer to STARTUPINFO }
     ProcessInfo);
   {Espera a que termine la ejecucion}
   {Wait until execution finish}
   Repeat
     exitCode := WaitForSingleObject( ProcessInfo.hProcess,1000);
     Application.ProcessMessages;
   Until (exitCode <> WAIT_TIMEOUT);
   GetExitCodeProcess(ProcessInfo.hProcess,Resultado);
   CloseHandle(ProcessInfo.hProcess );   Result:=Resultado;
 end;

(No recuerdo donde obtuve este código)

¿Alguien puede ayudarme a adaptar el DosCommand para que espere a que termine el proceso?

Saludos...Miguel Angel

[escafandra]

¿Alguien puede ayudarme a adaptar el DosCommand para que espere a que termine el proceso?

La API que provoca la espera es WaitForSingleObject. Si te fijas, en la función DosCommand encuentras:

delphi

if WaitForSingleObject(pi.hProcess, 9000) = WAIT_OBJECT_0 then
 .....

Esto significa que va a esperar hasta 9 segundos a que termine, si se cumple este timeout, la función continúa, y si si termina antes, también continuará. Si quieres que no tenga timeout, entonces:

delphi

if WaitForSingleObject(pi.hProcess, INFINITE) = WAIT_OBJECT_0 then
 .....

Pero no es muy recomendable.


Saludos.

[madiazg]

Pues no me funciona como yo querría. Lo que yo hago es ejecutar un programa DOS con la función:

delphi

WinExecAndWait32(NombrePrograma,True);

Esta función muestra una ventana DOS y ejecuta el programa. Cuando termina la ejecución se cierra la ventana DOS y pasa a la siguiente línea de código de mi programa. En cambio, con la función:

delphi

Memo1.Text:= DosCommand(NombrePrograma);

no ocurre lo mismo y no espera a que termine la ejecución del programa y se ejecuta la siguiente línea de código inmediatamente.

Saludos...
Miguel Angel

[escafandra]

Pues no se que modificación hiciste a la función...

Prueba esta modificación, en la que se espera no 9 segundos, sino hasta que termine y visualizando la consola para ver que pasa con ella. Cuando termine la aplicación se cierra la consola y continua con la linea siguiente, si no termina, DosCommand queda bloqueado.

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;
    si.wShowWindow:= SW_SHOW;
    if CreateProcess(nil, PCHAR(CommandLine), nil, nil, TRUE, 0, nil, nil, si, pi) then
    begin
      CloseHandle(pi.hThread);
      if WaitForSingleObject(pi.hProcess, INFINITE) = WAIT_OBJECT_0 then
      begin
        dwRead:= 0;
        Buffer[0]:= ' ';
        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; //WaitForSingleObject
      CloseHandle(pi.hProcess);
    end; //CreateProcess
    CloseHandle(pipeRead);
    CloseHandle(pipeWrite);
  end; //CreatePipe
end;

Saludos.

[egostar]

Hola amigo

 

Vaya, después de 6 años he requerido utilizar éste proceso

 

Bueno, estoy intentando utilizar este truco en Delphi 10.2 Tokyo Starter, pero en la siguiente línea:

delphi

OemToCharBuffA(buffer, buffer, dwRead);

Me salta el siguiente error:

 

 

 

[dcc32 Error] Unit1.pas(61): E2010 Incompatible types: 'PAnsiChar' and 'array[0..4096] of Char'

 

 

Pensé en hacer un Cast a la variable Buffer:

delphi

OemToCharBuffA(PAnsiChar(buffer), buffer, dwRead);

Pero no acepta el Cast

 

 

 

[dcc32 Error] Unit1.pas(61): E2089 Invalid typecast

 

 

¿Algo que pueda hacer para solucionarlo?

 

 

Saludos.

 

 

[egostar]

Me respondo.

 

Así me ha compilado:

php

OemToCharBuffA(PAnsiChar(String(buffer)), PAnsiChar(String(buffer)), dwRead);

Solo que no lo he podido probar porque no estoy ejecutando un comando DOS, pensé que era para obtener la salida de cualquier programa en la Consola

 

Salta un error en la siguiente línea

delphi

if CreateProcess(nil, PCHAR(CommandLine), nil, nil, TRUE, 0, nil, nil, si, pi) then

 

---------------------------

Project1

---------------------------

Access violation at address 77C88100 in module 'ntdll.dll'. Read of address 0036005F.

---------------------------

Aceptar   

---------------------------

 

 

 

Saludos

[escafandra]

El problema es el unicode si quieres usas el antiguo CHAR deber tipificarlo cono AnsiCHAR y PCHAR como PAnsiChar, pues el compilador ahora asume que CHAR = WCHAR y PCHAR = PWCHAR

 

Revisa esta pregunta

 

 

Saludos.

[escafandra]

También te puede ser de utilidad este hilo donde se trata de ejecutar comandos de consola encadenados
 
Saludos.

[egostar]

Muchas gracias amigo escafandra, vaya que la edad no me perdona, ya no me acordaba de ese hilo.

 

Finalmente utilicé la rutina de esperar a que termine un programa, 

 

http://delphiallimit...sperar-que.html

 

 

Saludos

[escafandra]

Muchas gracias amigo escafandra, vaya que la edad no me perdona, ya no me acordaba de ese hilo.
 
Finalmente utilicé la rutina de esperar a que termine un programa, 
 
http://delphiallimit...sperar-que.html
 
 
Saludos

También te hubiese servido alguna de las propuestas de este otro hilo: Ejecutar un programa y esperar hasta recibir su respuesta  

 

Saludos.