Ver Mensaje Individual
  #5  
Antiguo 11-08-2005
Avatar de delphi.com.ar
delphi.com.ar delphi.com.ar is offline
Federico Firenze
 
Registrado: may 2003
Ubicación: Buenos Aires, Argentina *
Posts: 5.932
Reputación: 27
delphi.com.ar Va por buen camino
A ver si les gusta:
Código Delphi [-]
const
  BUFFER_SIZE = 2400;

function GetConsoleText(ACommandLine: string): string;
var
  lSecAttr: TSecurityAttributes;
  hReadPipe,
  hWritePipe: THandle;
  Buffer: PChar;
  lStartupInfo: TStartUpInfo;
  lProcessInfo: TProcessInformation;
  dwBytesRead,
  dwExitCode: DWORD;
begin
  Result := '';
  with lSecAttr do
  begin
    nlength := SizeOf(TSecurityAttributes) ;
    bInheritHandle := True; { Para que tenga la el mismo profile
                              de quien ejecuta el proceso }
    lpSecurityDescriptor := nil;
  end;

  { Crea los canales de comunicación }
  if CreatePipe(hReadPipe, hWritePipe, @lSecAttr, 0) then
    try
      Buffer := AllocMem(BUFFER_SIZE + 1);
      try
        FillChar(lStartupInfo, Sizeof(lStartupInfo), #0);

        with lStartupInfo do
        begin
          cb := SizeOf(lStartupInfo);
          hStdOutput := hWritePipe;
          hStdInput := hReadPipe;
          dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
          wShowWindow := SW_HIDE;
        end;

        { Crea el proceso oculto y con herencia de descriptores }
        if CreateProcess(nil, PChar(ACommandLine), @lSecAttr, @lSecAttr, TRUE,
                         NORMAL_PRIORITY_CLASS, nil, nil, lStartupInfo, lProcessInfo) then
          try
            { Espera que termine el proceso }
            repeat
              dwExitCode := WaitForSingleObject(lProcessInfo.hProcess, 1000);
              Application.ProcessMessages;
            until dwExitCode <> WAIT_TIMEOUT;
            {
            repeat
              Application.HandleMessage;
              GetExitCodeProcess(lProcessInfo.hProcess, dwExitCode);
            until dwExitCode <> STILL_ACTIVE;
            }

            { Lee lo que se escribió en el pipeline hReadPipe }
            repeat
              dwBytesRead := 0;
              ReadFile(hReadPipe, Buffer[0], BUFFER_SIZE, dwBytesRead, nil);
              Buffer[dwBytesRead] := #0;
              OemToAnsi(Buffer, Buffer);
              Result := Result + string(Buffer);
            until (dwBytesRead < BUFFER_SIZE);

          finally
            CloseHandle(lProcessInfo.hProcess);
            CloseHandle(lProcessInfo.hThread);
          end;
      finally
        FreeMem(Buffer);
      end;
    finally
      CloseHandle(hReadPipe);
      CloseHandle(hWritePipe);
    end;
end;

{ Ejemplo de uso }
procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Lines.Text := GetConsoleText('CMD /C DIR C:\*.*');
end;
Este ejemplo lee lo que se ha generado en un proceso de consola, este código lo utilizo hace un tiempo, en un "Extended Procedure" de SqlServer 2000 para leer unas claves generadas por programas de consola...

Saludos!
__________________
delphi.com.ar

Dedique el tiempo suficiente para formular su pregunta si pretende que alguien dedique su tiempo en contestarla.
Responder Con Cita