Problema corriendo un proceso
 

hola companneros

tengo el siguiente codigo para crear un nuevo proceso de consola, donde si se ejecuta algo como "DIR" o "netstat" , pues esta muy bien y siempre funciona.

Ahora, necesito correr un comando que luego de correrlo se queda con un prompt esperando mas comandos de mi parte. Como esto lo hago desde dentro de mi programa, entro en un ciclo infinito.

Lo que necesito es poder controlar el nuevo proceso creado, que no afecte mi propio programa y lo mas importante que pueda seguir mandandole comandos hasta que decida cerrarlo, mandandole el comando adecuado.

muchas gracias de antemano

Código Delphi [-]
Procedure TFormMain.EjecutaComando(C:String);
var
  buf: array[0..4095] of byte;
  si: STARTUPINFO;
  sa: SECURITY_ATTRIBUTES;
  sd: SECURITY_DESCRIPTOR;
  pi: PROCESS_INFORMATION;
  newstdin,newstdout,read_stdout,write_stdin: THandle;
  exitcod,bread,avail: Cardinal;
  count:integer;
begin
  count:= 0 ;
  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;
  // Tuberias
  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(buf,sizeof(buf),0);
           GetEnvironmentVariable('COMSPEC',@buf,sizeof(buf)-1);
           strcat(@buf,' /c ');
           strcat(@buf,PAnsiChar(C));
           if CreateProcess(nil,@buf,nil,nil,TRUE,CREATE_NEW_CONSOLE,nil,nil,si,pi) then
             begin
               memo1.lines.Clear;
               GetExitCodeProcess(pi.hProcess,exitcod);
               PeekNamedPipe(read_stdout,@buf,sizeof(buf)-1,@bread,@avail,nil);
               while (exitcod = STILL_ACTIVE) or (bread > 0) do
                  begin
                    if (bread > 0) then
                      begin
                        fillchar(buf,sizeof(buf),0);
                        if (avail > sizeof(buf)-1) then
                          while (bread >= sizeof(buf)-1)  do
                            begin
                              ReadFile(read_stdout,buf,sizeof(buf)-1,bread,nil);
                              memo1.lines.text := memo1.lines.Text + StrPas(@buf);
                              fillchar(buf,sizeof(buf),0);
                            end else
                            begin
                              ReadFile(read_stdout,buf,sizeof(buf)-1,bread,nil);
                              memo1.lines.text := memo1.lines.Text + StrPas(@buf);
                            end;
                      end;
                    GetExitCodeProcess(pi.hProcess,exitcod);
                    PeekNamedPipe(read_stdout,@buf,sizeof(buf)-1,@bread,@avail,nil);
                  end;
             end;
            CloseHandle(read_stdout);
            CloseHandle(newstdout);
         end;
      CloseHandle(newstdin);
      CloseHandle(write_stdin);
    end;
end;

:rolleyes: ¿de donde sacaste ese código?

internet
 

de Internet

sabes, una solucion seria cerrar el handle del proceso, de esa forma tendria control de mi aplicacion de nuevo. pero luego no sabria como restablecer la comunicacion de nuevo con el proceso y continuar enviando comandos :-(.

Ya me parecía ... :rolleyes:
http://www.clubdelphi.com/foros/show...9&postcount=18

Volviendo a tu problema. Si te entiendo bien, el programas que ejecutas se queda esperando una entrada por tu parte, y lo que tu quieres es poder mandarle comandos. No es difícil hacer lo que tu quieres, pero vas a tener que replantear todo el código, ten en cuenta que no puedes meter todo dentro de una función, vas a tener que repartir el código a lo largo de los eventos de tu aplicación. Quizá si explicas un poco que es lo que hace tu aplicación, podemos decidir cual es el mejor sitio para colocar el código.

ok, gracias. Me parece increible que reconozcas el codigo, tomando en cuenta todo lo que escribes de codigo y de ayuda a otros en este foro. pero bien , yendo al tema en cuestion.


basicamente necesito ejecutar el comando kd (kernel debugger) pero no desde la consola lo que seria obvio; sino desde mi programa en delphi. Cuando abro el "crash dump" que necesito analizar el kd me presenta el prompt para seguir mandandole los comandos como por ejemplo "!process 0 0" para ver los procesos que hay en "memory dump".

Al hacer esto desde delphi, pierdo todo control sobre mi aplicacio hasta que el proceso que llame no termina y regresa. Pero resulta que este en cuestion no termina y no regresa nunca.

que hacer?

gracias.

Vamos partir de la versión revisada del código que puedes encontrar en la sección de trucos (truco 54), y la vamos a modificar para enviar un "retorno de carro" para poder asi finalizar el comando "time".

Código Delphi [-]
uses
  Windows, SysUtils;

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;
  Str: string;
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
// ***********************
// Para mandar caracteres al proceso hijo, solo tenemos que usar la función
// WriteFile con el handle de la tubería de entrada (write_stdin) 
        // Puedes mandar cualquier texto, yo aqui solo mando el "retorno de carro"
        Str:= #13;
        WriteFile(write_stdin,PChar(Str)^,Length(Str),bread,nil);

//  *********************
        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;
          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;

begin
  Writeln(CmdExec('Time'));
end.

El código anterior no tiene mucha utilidad pero ilustra perfectamente como comunicarte con el proceso hijo.

Hola y perdón por la intromisión.
Yo hace tiempo que utilicé esa técnica con varios motores de ajedrez, a los que les mandaba diferentes comandos , esperaba su respuesta y teniendo un control absoluto sobre la entrada y salida...

Código Delphi [-]
procedure TFormMain.Launch(cmdline : string; ShowWindow : integer);
var ProcessInfo : TProcessInformation;
    StartupInfo : TStartupInfo;
begin
    CreatePipe(hOutReadPipe, hOutWritePipe, nil, 2024);
    DuplicateHandle(GetCurrentProcess(),
                              hOutWritePipe,  GetCurrentProcess(),
                              @hDupWritePipe, 0, True,
DUPLICATE_CLOSE_SOURCE or  DUPLICATE_SAME_ACCESS);

    CreatePipe(hInReadPipe, hInWritePipe, nil, 2024);
    DuplicateHandle(GetCurrentProcess(),
hInReadPipe,GetCurrentProcess(),
                    @hDupReadPipe, 0, True, DUPLICATE_CLOSE_SOURCE or
DUPLICATE_SAME_ACCESS);


  FillChar(StartupInfo,Sizeof(StartupInfo),#0);
  StartupInfo.cb := Sizeof(StartupInfo);
  StartupInfo.hStdOutput := hDupWritePipe;
  StartupInfo.hStdError  := hDupWritePipe;
  StartupInfo.hStdInput  := hDupReadPipe;
  StartupInfo.wShowWindow := ShowWindow;
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;

  CreateProcess(nil, PChar(cmdline), nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil,StartupInfo, ProcessInfo);

end;

Luego un par de funciones accesorias de control

Código Delphi [-]
function TFormMain.ReadPipe(var S : string): Boolean;
var
  dwAvail, dwRead : Cardinal;
  PipeHandle : THandle;
begin
  Result := False;
  PipeHandle := hOutReadPipe;
  dwAvail := 0;
  PeekNamedPipe(PipeHandle, nil, 0, nil, @dwAvail, nil);
  if dwAvail > 0 then
  begin
    SetLength(S, dwAvail);
    ReadFile(PipeHandle, Pointer(S)^, dwAvail, dwRead, nil);
    Result := True;
  end;
  Application.ProcessMessages;
end;

procedure TFormMain.WritePipe(s: string);
var Pstr : array[0..255] of char;
    len : cardinal;
    PipeHandle : THandle;
begin
  PipeHandle := hInWritePipe;
  StrPCopy(Pstr, s);
  len := length(s);
  WriteFile(PipeHandle, Pstr, len, len, nil);
  Sleep(10);
end;

Otra alternativa es esta:

Código Delphi [-]


{---------------------------CreateDOSProcessRedirected--------------------------
 Description    : executes a (DOS!) app defined in the CommandLine parameter
                  redirected to take input from InputFile (optional) and give
                  output to OutputFile
 Result         : True on success
 Parameters     : CommandLine : the command line for app, including full path
                  InputFile   : the ascii file where from the app takes input,
                                 empty if no input needed/required.
                  OutputFile  : the ascii file to which the output is redirected
                  ErrMsg      : additional error message string. Can be empty
 Error checking : YES
 Target         : Delphi 2, 3, 4
 Author         : Theodoros Bebekis, email bebekis@otenet.gr
 Notes          :
 Example call   : CreateDOSProcessRedirected('C:\MyDOSApp.exe',
                                             'C:\InputPut.txt',
                                             'C:\OutPut.txt',
                                             'Please, record this message')
-------------------------------------------------------------------------------}

function TFormMain.CreateDOSProcessRedirected(const CommandLine, InputFile,OutputFile: string): boolean;
var OldCursor: TCursor;
    pCommandLine: array[0..MAX_PATH] of char;
    pInputFile, pOutPutFile: array[0..MAX_PATH] of char;
    StartupInfo: TStartupInfo;
    ProcessInfo: TProcessInformation;
    SecAtrrs: TSecurityAttributes;
    hAppProcess, hAppThread, hInputFile, hOutputFile: THandle;
begin
  result := false;
  if ((InputFile <> '') and (not fileexists(InputFile))) then exit;
  hAppProcess := 0;
  hAppThread := 0;
  hInputFile := 0;
  hOutputFile := 0;
  OldCursor := Screen.Cursor;
  Screen.Cursor := crHourglass;
  try
    StrPCopy(pCommandLine, CommandLine);
    StrPCopy(pInputFile, InputFile);
    StrPCopy(pOutPutFile, OutputFile);
    FillChar(SecAtrrs, SizeOf(SecAtrrs), #0);
    SecAtrrs.nLength := SizeOf(SecAtrrs);
    SecAtrrs.lpSecurityDescriptor := nil;
    SecAtrrs.bInheritHandle := true;
    if (InputFile <> '') then
    begin
      hInputFile := CreateFile(pInputFile, GENERIC_READ or GENERIC_WRITE,
         FILE_SHARE_READ or FILE_SHARE_WRITE, @SecAtrrs, OPEN_ALWAYS,
         FILE_ATTRIBUTE_NORMAL or FILE_FLAG_WRITE_THROUGH, 0);
      if (hInputFile = INVALID_HANDLE_VALUE) then exit;
    end else hInputFile := 0;
    hOutputFile := CreateFile(pOutPutFile, GENERIC_READ or GENERIC_WRITE,
       FILE_SHARE_READ or FILE_SHARE_WRITE, @SecAtrrs, CREATE_ALWAYS,
       FILE_ATTRIBUTE_NORMAL or FILE_FLAG_WRITE_THROUGH, 0);
    if (hOutputFile = INVALID_HANDLE_VALUE) then exit;
    FillChar(StartupInfo, SizeOf(StartupInfo), #0);
    StartupInfo.cb := SizeOf(StartupInfo);
    StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
    StartupInfo.wShowWindow := SW_HIDE;
    StartupInfo.hStdOutput := hOutputFile;
    StartupInfo.hStdInput := hInputFile;
    Application.ProcessMessages;
    result := CreateProcess(nil, pCommandLine, nil, nil, TRUE,
                            HIGH_PRIORITY_CLASS  ,
                            nil, nil, StartupInfo, ProcessInfo);
    Application.ProcessMessages;
    if (result) then
    begin
      WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
      hAppProcess := ProcessInfo.hProcess;
      hAppThread := ProcessInfo.hThread;
    end else exit;
  finally
    Application.ProcessMessages;
    if (hOutputFile <> 0) then CloseHandle(hOutputFile);
    if (hInputFile <> 0) then CloseHandle(hInputFile);
    if (hAppThread <> 0) then CloseHandle(hAppThread);
    if (hAppProcess <> 0) then CloseHandle(hAppProcess);
    Screen.Cursor := OldCursor;
  end;
end;

Uno de los casos en los que también lo utilicé, fue para ejecutar y leer el comando NETSTAT. Pena que cuando me hacía falta, seoane todavía no había insertado su código su post, y a mí me hacía falta hace tiempo

wow, muchas gracias
 

super, ahora mismo trato de ajustar mi codigo a lo que me han dado.

muchas gracias,
suerte

Ya nos contarás algo de como fue ;)