Ver Mensaje Individual
  #8  
Antiguo 02-05-2022
Avatar de escafandra
[escafandra] escafandra is offline
Miembro Premium
 
Registrado: nov 2007
Posts: 2.203
Reputación: 20
escafandra Tiene un aura espectacularescafandra Tiene un aura espectacular
Mira a ver si esta unit te sirve:
Código Delphi [-]
unit PipeShell3;
 
 
interface
 
uses
  Windows, Messages, SysUtils, Classes;
 
const
  BUFFERSIZE = 4*1024;
 
type
  TPipeShell = class
  private
    PipeIn, PipeOut, PipeWrite, PipeRead: THANDLE;
    hProcess: THANDLE;
    Buffer: PAnsiChar;
  protected
  public
    constructor Create;
    destructor  Destroy; override;
    function Write(S: AnsiString): DWORD;
    function Read: AnsiString;
  end;
 
implementation
 
constructor TPipeShell.Create;
var
  sd: SECURITY_DESCRIPTOR;
  sa: SECURITY_ATTRIBUTES;
  si: STARTUPINFOA;
  pi: PROCESS_INFORMATION;
begin
  PipeIn:= 0;
  PipeOut:= 0;
  PipeWrite:= 0;
  PipeRead:= 0;
  hProcess:= 0;
 
  GetMem(Buffer, BUFFERSIZE);
  InitializeSecurityDescriptor(@sd, SECURITY_DESCRIPTOR_REVISION);
  sa.lpSecurityDescriptor:= @sd;
//  sa.lpSecurityDescriptor:= nil;
  sa.nLength:= sizeof(SECURITY_ATTRIBUTES);
  sa.bInheritHandle:= TRUE;
  // Tuberia de entrada
  if CreatePipe(PipeIn, PipeWrite, @sa, 0) then
  begin
    // Tuberia de salida
    if CreatePipe(PipeRead, PipeOut, @sa, 0) then
    begin
      GetStartupInfoA(Si);
      // Indicamos tuberias del proceso
      si.hStdOutput:= PipeOut;
      si.hStdError:= PipeOut;
      si.hStdInput:= PipeIn;
      si.dwFlags:= STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
      si.wShowWindow:= SW_HIDE;
      //si.wShowWindow:= SW_SHOW;
      // Ruta del shell
      ZeroMemory(Buffer, BUFFERSIZE);
      GetEnvironmentVariableA('COMSPEC', Buffer, BUFFERSIZE - 1);
      // Ejecutamos el shell
      if CreateProcessA(nil, Buffer, nil, nil, TRUE, CREATE_NEW_CONSOLE, nil, nil, si, pi) then
      begin
         hProcess:= pi.hProcess;
         CloseHandle(pi.hThread);
      end;
    end;
  end;
end;
 
destructor TPipeShell.Destroy;
var
  ExitCode: DWORD;
begin
  // Tratamos de terminar el shell
  repeat
    Write('quit'); Read;
    Write('q'); Read;
    Write('exit'); Read;
    GetExitCodeProcess(hProcess, ExitCode);
  until ExitCode <> STILL_ACTIVE;
 
  if PipeIn <> 0    then CloseHandle(PipeIn);
  if PipeOut <> 0   then CloseHandle(PipeOut);
  if PipeWrite <> 0 then CloseHandle(PipeWrite);
  if PipeRead <> 0  then CloseHandle(PipeRead);
  if hProcess <> 0  then CloseHandle(hProcess);
  if Buffer <> nil  then FreeMem(Buffer);
  if WaitForSingleObject(hProcess, 9000) <> WAIT_OBJECT_0 then
    TerminateProcess(hProcess, DWORD(-1));
  //GetExitCodeProcess(hProcess, ExitCode);
  //inherited;
end;
 
function TPipeShell.Write(S: AnsiString): DWORD;
begin
  if PipeWrite = 0 then exit;
  lstrcpyA(Buffer, PAnsiCHAR(S + #10));
  WriteFile(PipeWrite, Buffer^, lstrlenA(Buffer), Result, nil);
end;
 
function TPipeShell.Read: AnsiString;
var
  dwRead, dwBytesAvail: DWORD;
begin
  if PipeRead = 0 then exit;
 
  dwRead:= 0;
  // Esperamos a que tengamos algo que leer en PipeRead
  repeat
    sleep(100);
    PeekNamedPipe(PipeRead, Buffer, BUFFERSIZE, @dwRead, @dwBytesAvail, nil);
    if dwRead > 0 then
    begin
      // Leemos y vaciamos el PipeRead
      ZeroMemory(Buffer, BUFFERSIZE);
      ReadFile(PipeRead, Buffer^, dwRead, PDWORD(0)^, nil);
      OemToCharBuffA(Buffer, Buffer, dwRead);
      Result:= Result + AnsiString(Buffer);
    end;
  until dwBytesAvail = 0;
end;  
 
end.

Para más información el código original lo publiqué aquí.


Saludos.
Responder Con Cita