unit ConsoleReDirect;

interface
{
  Console アプリケーションを Window 非表示状態で起動し
  標準入力、標準出力、標準エラーをパラメタ文字列へーリダイレクトする。

  CreateProcess においてエラーが発生すると RaiseLastWin32Error を発生し
  戻り値として False を返す。
}
  function RedirectExec(Proc: string;
                        var StdIn,StdOut,StdErr: String): boolean;

implementation
uses
  Windows, SysUtils, Forms;

function RedirectExec;
var
  hPipe1Read,
  hPipe1Write,
  hPipe2Read,
  hPipe2Write,
  hPipe3Read,
  hPipe3Write,
  hStdin,
  hStdOut,
  hStdErr:    THandle;
  si:         TStartupInfo;
  pi:         TProcessInformation;
  Buf:        array[0..1024] of char;
  ReadCount:  integer;

begin
// Intialize StartupInfo
  fillchar(si,sizeof(si),0);
  si.cb := sizeof(si);
  si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  si.wShowWindow := SW_HIDE;
  si.hStdInput   := hStdIn;
  si.hStdOutput  := hStdOut;
  si.hStdError   := hStdErr;

// Make StdOut Pipe
  CreatePipe(hPipe1Read,hPipe1Write,Nil,0);
  DuplicateHandle(GetCurrentProcess,hPipe1Write,
                  GetCurrentProcess,@hStdOut,0,
                  True,DUPLICATE_CLOSE_SOURCE or DUPLICATE_SAME_ACCESS);

// Make StdIn Pipe
  CreatePipe(hPipe2Read,hPipe2Write,Nil,0);
  DuplicateHandle(GetCurrentProcess,hPipe2Read,
                  GetCurrentProcess,@hStdIn,0,
                  True,DUPLICATE_CLOSE_SOURCE or DUPLICATE_SAME_ACCESS);

// Make StdErr Pipe
  CreatePipe(hPipe3Read,hPipe3Write,Nil,0);
  DuplicateHandle(GetCurrentProcess,hPipe3Write,
                  GetCurrentProcess,@hStdErr,0,
                  True,DUPLICATE_CLOSE_SOURCE or DUPLICATE_SAME_ACCESS);

  StdIn := StdIn + #$1a; // EOF
  stdOut := '';
  StdErr := '';
  Result := False;
  try
    Result := Win32Check(CreateProcess(Nil,Pchar(Proc),Nil,Nil,True,
                         NORMAL_PRIORITY_CLASS or CREATE_NO_WINDOW,
                         Nil,Nil,si,pi));
    if Result
    then begin
      CloseHandle(pi.hThread);

      CloseHandle(hStdOut); // Close StdOutPut
      Closehandle(hStdIn);  // Close StdInPut
      CloseHandle(hStdErr); // Close StdError

      // Write StdInPut
      FileWrite(hPipe2Write,PChar(StdIn)^,length(StdIn));

      // Read StdOutPut
      Repeat
        Application.ProcessMessages;
        fillChar(Buf,sizeof(Buf),0);
        ReadCount := FileRead(hPipe1Read,Buf,sizeof(Buf) -1);
        StdOut := StdOut + Buf;
      until ReadCount <= 0;

      // Read StdError
      Repeat
        Application.ProcessMessages;
        fillChar(Buf,sizeof(Buf),0);
        ReadCount := FileRead(hPipe3Read,Buf,sizeof(Buf) -1);
        StdErr := StdErr + Buf;
      until ReadCount <= 0;

      WaitForSingleObject(pi.hProcess,INFINITE);
      CloseHandle(pi.hProcess);
    end{fi} ;
  finally
    if not Result
    then begin
      CloseHandle(hStdOut); // Close StdOutPut
      Closehandle(hStdIn);  // Close StdInPut
      CloseHandle(hStdErr); // Close StdError
    end{fi};
    CloseHandle(hPipe1Read);    // Close StdOut Pipe
    CloseHandle(hPipe2Write);   // Close StdIn Pipe
    Closehandle(hPipe3Read);    // Close StdError Pipe
  end{yrt} ;
end;

end.