Io uso questa unit, automatizza la gestione delle named pipes:

codice:
unit Redirect;

interface

uses
  Windows, SysUtils, Classes;

type
  TRedirector = class;
  TPriorityClass = (pcDefault, pcIdle, pcNormal, pcHigh, pcRealtime);
  TDataEvent = procedure(Sender: TRedirector; Buffer: Pointer; Size: Integer) of object;

  TPipeError = record
    hRead: DWORD;
    hWrite: DWORD;
  end;

  TRedirector = class{$IFDEF COMPONENT}(TComponent){$ENDIF}
  private
    FAvailable: Integer;
    procedure ReadStdOutput;
    procedure ReadStdError;
    procedure ProcessTerminated;
  protected
    FProcessInfo: TProcessInformation;
    FExitCode: Integer;
    FExecutable: string;
    FCommandline: string;
    FDefaultErrorMode: Boolean;
    FStartSuspended: Boolean;
    FKillOnDestroy: Boolean;
    FDirectory: string;
    FEnvironment: Pointer;
    FInitialPriority: TPriorityClass;
    FPipeInput: TPipeError;
    FPipeOutput: TPipeError;
    FPipeError: TPipeError;
    FThread: TThread;
    FOnData: TDataEvent;

    FOnErrorData: TDataEvent;
    FOnTerminated: TNotifyEvent;
    FShowWindow: Integer;
    FLastData: Boolean;
    procedure Error(msg: string);
    procedure WinError(msg: string);
    procedure CreatePipes;
    procedure ClosePipes;
    function GetRunning: Boolean;
    function GetExitCode: Integer;
    function GetProcessID: Integer;
    function GetThreadID: Integer;
    function GetProcessHandle: Integer;
    procedure SetShowWindow(Value: Integer);
    function GetThreadHandle: Integer;
    procedure SetExecutable(Value: string);
    function GetCommandLine: string;
    procedure SetCommandLine(Value: string);
    procedure SetDefaultErrorMode(Value: Boolean);
    procedure SetStartSuspended(Value: Boolean);
    procedure SetInitialPriority(Value: TPriorityClass);
    procedure SetDirectory(Value: string);
    procedure SetEnvironment(Value: Pointer);
    property ProcessHandle: Integer read GetProcessHandle;
    property ThreadHandle: Integer read GetThreadHandle;
  public
    destructor Destroy; override;
    procedure Terminate(dwExitCode: Integer);
    procedure Execute;

    procedure SendData(Buffer: Pointer; BufferSize: Integer);
    procedure SendText(s: string);
    property Running: Boolean read GetRunning;
    property ExitCode: Integer read GetExitCode;
    property ProcessID: Integer read GetProcessID;
    property ThreadID: Integer read GetThreadID;
    property Environment: Pointer read FEnvironment write SetEnvironment;
    property LastData: boolean read FLastData;
  published
    property KillOnDestroy: Boolean read FKillOnDestroy write FKillOnDestroy;
    property Executable: string read FExecutable write SetExecutable;
    property CommandLine: string read GetCommandLine write SetCommandLine;
    property ShowWindow: Integer read FShowWindow write SetShowWindow default SW_SHOWDEFAULT;
    property DefaultErrorMode: Boolean read FDefaultErrorMode write SetDefaultErrorMode;
    property StartSuspended: Boolean read FStartSuspended write SetStartSuspended;
    property InitialPriority: TPriorityClass read FInitialPriority write SetInitialPriority;
    property Directory: string read FDirectory write SetDirectory;
    property OnData: TDataEvent read FOnData write FOnData;

    property OnErrorData: TDataEvent read FOnErrorData write FOnErrorData;
    property OnTerminated: TNotifyEvent read FOnTerminated write FOnTerminated;
  end;

implementation

const
  DUPLICATE_CLOSE_SOURCE = 1;
  DUPLICATE_SAME_ACCESS = 2;

type
  TRedirectorThread = class(TThread)
  protected
    FRedirector: TRedirector;
    procedure Execute; override;
    constructor Create(ARedirector: TRedirector);
  end;

////////////////////////////////////////////////////////////////////////////////
// Misc. internal methods
////////////////////////////////////////////////////////////////////////////////

procedure TRedirector.Error(msg: string);
begin
  raise Exception.Create(msg);
  TerminateProcess(ProcessHandle, 0)
end;

procedure TRedirector.WinError(msg: string);
begin
  Error(msg + IntToStr(GetLastError));
end;

procedure TRedirector.CreatePipes;
var
  SecAttr: TSecurityAttributes;
const
  PIPE_SIZE = 0; //--was: 1024;
begin
  SecAttr.nLength := SizeOf(SecAttr);
  SecAttr.lpSecurityDescriptor := nil;
  SecAttr.bInheritHandle := true;

  with FPipeInput do
  begin
    if not CreatePipe(hRead, hWrite, @SecAttr, PIPE_SIZE)
      then WinError('Error on STDIN pipe creation : ');
    if not DuplicateHandle(GetCurrentProcess, hRead, GetCurrentProcess,
      @hRead, 0, true, DUPLICATE_CLOSE_SOURCE or DUPLICATE_SAME_ACCESS)
      then WinError('Error on STDIN pipe duplication : ');
  end;
  with FPipeOutput do
  begin
    if not CreatePipe(hRead, hWrite, @SecAttr, PIPE_SIZE)
      then WinError('Error on STDOUT pipe creation : ');
    if not DuplicateHandle(GetCurrentProcess, hWrite, GetCurrentProcess,
      @hWrite, 0, true, DUPLICATE_CLOSE_SOURCE or DUPLICATE_SAME_ACCESS)
      then WinError('Error on STDOUT pipe duplication : ');
  end;
  with FPipeError do
  begin
    if not CreatePipe(hRead, hWrite, @SecAttr, PIPE_SIZE)
      then WinError('Error on STDERR pipe creation : ');
    if not DuplicateHandle(GetCurrentProcess, hWrite, GetCurrentProcess,
      @hWrite, 0, true, DUPLICATE_CLOSE_SOURCE or DUPLICATE_SAME_ACCESS)
      then WinError('Error on STDERR pipe duplication : ');
  end;
end;

procedure TRedirector.ClosePipes;
begin
  with FPipeInput do
  begin
    if hRead <> 0 then CloseHandle(hRead);
    if hWrite <> 0 then CloseHandle(hWrite);
    hRead := 0;
    hWrite := 0;
  end;
  with FPipeOutput do
  begin
    if hRead <> 0 then CloseHandle(hRead);
    if hWrite <> 0 then CloseHandle(hWrite);
    hRead := 0;
    hWrite := 0;
  end;
  with FPipeError do
  begin
    if hRead <> 0 then CloseHandle(hRead);
    if hWrite <> 0 then CloseHandle(hWrite);
    hRead := 0;
    hWrite := 0;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// Property implementations
////////////////////////////////////////////////////////////////////////////////

function TRedirector.GetRunning: Boolean;
begin
  Result := ProcessHandle <> 0;
end;

function TRedirector.GetExitCode: Integer;
begin
  if Running then
    Result := STILL_ACTIVE
  else
    Result := FExitCode;
end;

function TRedirector.GetProcessID: Integer;
begin
  Result := FProcessInfo.dwProcessID;
end;

function TRedirector.GetThreadID: Integer;
begin
  Result := FProcessInfo.dwThreadID;
end;

function TRedirector.GetProcessHandle: Integer;
begin
  Result := FProcessInfo.hProcess;
end;

function TRedirector.GetThreadHandle: Integer;
begin
  Result := FProcessInfo.hThread;
end;

procedure TRedirector.SetExecutable(Value: string);
begin
  if (ANSICompareText(Value, Executable) = 0) or not Running
    then
    FExecutable := Value
  else if Running
    then
    Error('Cannot change Executable while process is active');
end;

procedure TRedirector.SetCommandLine(Value: string);
begin
  if (ANSICompareText(Value, Commandline) = 0) or not Running
    then
    FCommandline := Value
  else if Running
    then
    Error('Cannot change Commandline while process is active');
end;

function TRedirector.GetCommandLine: string;
begin
  Result := FExecutable;
  if Result = ''
    then
    Result := FCommandline
  else
    Result := FExecutable + ' ' + FCommandline;
end;
{
procedure TRedirector.XSetCommandLine (value : string);
var
  n1,
  n2      : integer;
begin
  if (ANSICompareText (value, CommandLine) = 0) or (not Running) then begin
    n1 := Length(value)+1;
    n2 := Pos(' ', value);
    if (n2>0) and (n2<n1) then n1 := n2;
    n2 := Pos('-', value);
    if (n2>0) and (n2<n1) then n1 := n2;
    n2 := Pos('/', value);
    if (n2>0) and (n2<n1) then n1 := n2;
    FExecutable := Copy (value, 1, n1-1);
    //FCommandline := Copy (value, 1, n1-1);
   // FParameters := Trim(Copy (value, Length(FExecutable)+1, Length(value)));
    FCommandline := Trim(Copy (value, Length(FExecutable)+1, Length(value)));
  end else if Running then Error('Cannot change CommandLine while process is active');
end;
}

procedure TRedirector.SetDefaultErrorMode(Value: Boolean);
begin
  if (Value = DefaultErrorMode) or not Running then
    FDefaultErrorMode := Value
  else if Running then

    Error('Cannot change DefaultErrorMode while process is active');
end;

procedure TRedirector.SetStartSuspended(Value: Boolean);
begin
  if (Value = DefaultErrorMode) or not Running then
    FStartSuspended := Value
  else if Running then

    Error('Cannot change StartSuspended while process is active');
end;

procedure TRedirector.SetInitialPriority(Value: TPriorityClass);
begin
  if (Value <> InitialPriority) and not Running then
    FInitialPriority := Value
  else if Running then

    Error('Cannot change InititalPriority while process is active');
end;

procedure TRedirector.SetDirectory(Value: string);
begin
  if (ANSICompareText(Value, Directory) = 0) or (not Running) then
    FDirectory := Value
  else if Running then

    Error('Cannot change Directory while process is active');
end;

procedure TRedirector.SetEnvironment(Value: Pointer);
begin
  if (Value = Environment) or not Running then
    FEnvironment := Value
  else if Running then

    Error('Cannot change Environment while process is active');
end;

procedure TRedirector.SetShowWindow(Value: Integer);
begin
  if (Value = ShowWindow) or not Running then
    FShowWindow := Value
  else if Running then

    Error('Cannot change ShowWindow while process is active');
end;
<continua>