Start two processes and connect them with a pipe in Delphi

Question

I need to launch two external programs in my program and connect the STDOUT of the first one to the STDIN of the second program. How can you achieve this in Delphi (RAD Studio 2

Answer 1

CreateProcess() allows you to redirect both stdin and stdout of application launched. Your application can read from the first app stdout and write to the second app stdin.

Answer 2

A quick test which seems to work (inspired heavily by JCL):

child1: say 'Hello, world!' 3x to standard output

program child1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

procedure Main;
var
  I: Integer;
begin
  for I := 0 to 2 do
    Writeln('Hello, world!');
  Write(^Z);
end;

begin
  try
    Main;
  except
    on E: Exception do
    begin
      ExitCode := 1;
      Writeln(ErrOutput, Format('[%s] %s', [E.ClassName, E.Message]));
    end;
  end;
end.

child2: echo whatever comes on standard input to OutputDebugString (can be viewed by DebugView)

program child2;

{$APPTYPE CONSOLE}

uses
  Windows, SysUtils, Classes;

procedure Main;
var
  S: string;
begin
  while not Eof(Input) do
  begin
    Readln(S);
    if S <> '' then
      OutputDebugString(PChar(S));
  end;
end;

begin
  try
    Main;
  except
    on E: Exception do
    begin
      ExitCode := 1;
      Writeln(ErrOutput, Format('[%s] %s', [E.ClassName, E.Message]));
    end;
  end;
end.

parent: launch child1 redirected to child2

program parent;

{$APPTYPE CONSOLE}

uses
  Windows, Classes, SysUtils;

procedure ExecutePiped(const CommandLine1, CommandLine2: string);
var
  StartupInfo1, StartupInfo2: TStartupInfo;
  ProcessInfo1, ProcessInfo2: TProcessInformation;
  SecurityAttr: TSecurityAttributes;
  PipeRead, PipeWrite: THandle;
begin
  PipeWrite := 0;
  PipeRead := 0;
  try
    SecurityAttr.nLength := SizeOf(SecurityAttr);
    SecurityAttr.lpSecurityDescriptor := nil;
    SecurityAttr.bInheritHandle := True;
    Win32Check(CreatePipe(PipeRead, PipeWrite, @SecurityAttr, 0));

    FillChar(StartupInfo1, SizeOf(TStartupInfo), 0);
    StartupInfo1.cb := SizeOf(TStartupInfo);
    StartupInfo1.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
    StartupInfo1.wShowWindow := SW_HIDE;
    StartupInfo1.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
    StartupInfo1.hStdOutput := PipeWrite;
    StartupInfo1.hStdError := GetStdHandle(STD_ERROR_HANDLE);

    FillChar(StartupInfo2, SizeOf(TStartupInfo), 0);
    StartupInfo2.cb := SizeOf(TStartupInfo);
    StartupInfo2.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
    StartupInfo2.wShowWindow := SW_HIDE;
    StartupInfo2.hStdInput := PipeRead;
    StartupInfo2.hStdOutput := GetStdHandle(STD_OUTPUT_HANDLE);
    StartupInfo2.hStdError := GetStdHandle(STD_ERROR_HANDLE);

    FillChar(ProcessInfo1, SizeOf(TProcessInformation), 0);
    FillChar(ProcessInfo2, SizeOf(TProcessInformation), 0);

    Win32Check(CreateProcess(nil, PChar(CommandLine2), nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo2,
      ProcessInfo2));

    Win32Check(CreateProcess(nil, PChar(CommandLine1), nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo1,
      ProcessInfo1));

    WaitForSingleObject(ProcessInfo2.hProcess, INFINITE);
  finally
    if PipeRead <> 0 then
      CloseHandle(PipeRead);
    if PipeWrite <> 0 then
      CloseHandle(PipeWrite);
    if ProcessInfo2.hThread <> 0 then
      CloseHandle(ProcessInfo2.hThread);
    if ProcessInfo2.hProcess <> 0 then
      CloseHandle(ProcessInfo2.hProcess);
    if ProcessInfo1.hThread <> 0 then
      CloseHandle(ProcessInfo1.hThread);
    if ProcessInfo1.hProcess <> 0 then
      CloseHandle(ProcessInfo1.hProcess);
  end;
end;

procedure Main;
begin
  ExecutePiped('child1.exe', 'child2.exe');
end;

begin
  try
    Main;
  except
    on E: Exception do
    begin
      ExitCode := 1;
      Writeln(Error, Format('[%s] %s', [E.ClassName, E.Message]));
    end;
  end;
end.

Answer 3

Here is the corrected code to work in Delphi XE. The CommandLine Strings must be variables and also defined above the ExecutePiped function.

    program Parent;

    {$APPTYPE CONSOLE}

    uses
      Windows, SysUtils, Classes;

    var cmd1, cmd2 :string;

    function ExecutePiped(CommandLine1: string; CommandLine2: string):string;
    var
      StartupInfo1, StartupInfo2 : TStartupInfo;
      ProcessInfo1, ProcessInfo2 : TProcessInformation;
      SecurityAttr               : TSecurityAttributes;
      PipeRead, PipeWrite        : THandle;
      Handle                     : Boolean;
      WorkDir                    : String;
    begin
      PipeWrite := 0;
      PipeRead  := 0;
      try
        SecurityAttr.nLength              := SizeOf(SecurityAttr);
        SecurityAttr.bInheritHandle       := True;
        SecurityAttr.lpSecurityDescriptor := nil;

        CreatePipe(PipeRead, PipeWrite, @SecurityAttr, 0);

        FillChar(StartupInfo1, SizeOf(TStartupInfo), 0);
        StartupInfo1.cb          := SizeOf(TStartupInfo);
        StartupInfo1.dwFlags     := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
        StartupInfo1.wShowWindow := SW_HIDE;
        StartupInfo1.hStdInput   := GetStdHandle(STD_INPUT_HANDLE);
        StartupInfo1.hStdOutput  := PipeWrite;
        StartupInfo1.hStdError   := GetStdHandle(STD_ERROR_HANDLE);

        FillChar(StartupInfo2, SizeOf(TStartupInfo), 0);
        StartupInfo2.cb          := SizeOf(TStartupInfo);
        StartupInfo2.dwFlags     := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
        StartupInfo2.wShowWindow := SW_HIDE;
        StartupInfo2.hStdInput   := PipeRead;
        StartupInfo2.hStdOutput  := GetStdHandle(STD_OUTPUT_HANDLE);
        StartupInfo2.hStdError   := GetStdHandle(STD_ERROR_HANDLE);

        FillChar(ProcessInfo1, SizeOf(TProcessInformation), 0);
        FillChar(ProcessInfo2, SizeOf(TProcessInformation), 0);

        WorkDir := '';

        Handle := CreateProcess(nil, PChar(CommandLine2), nil, nil, True, 0, nil, PChar(WorkDir), StartupInfo2, ProcessInfo2);
        Handle := CreateProcess(nil, PChar(CommandLine1), nil, nil, True, 0, nil, PChar(WorkDir), StartupInfo1, ProcessInfo1);

        WaitForSingleObject(ProcessInfo2.hProcess, INFINITE);

      finally

        if PipeRead              <> 0 then CloseHandle(PipeRead);
        if PipeWrite             <> 0 then CloseHandle(PipeWrite);

        if ProcessInfo2.hThread  <> 0 then CloseHandle(ProcessInfo2.hThread);
        if ProcessInfo2.hProcess <> 0 then CloseHandle(ProcessInfo2.hProcess);

        if ProcessInfo1.hThread  <> 0 then CloseHandle(ProcessInfo1.hThread);
        if ProcessInfo1.hProcess <> 0 then CloseHandle(ProcessInfo1.hProcess);

      end;

    end;

    procedure Main;
    begin
      cmd1 := '"child1.exe"';
      cmd2 := '"child2.exe"';
      ExecutePiped(cmd1, cmd2);
    end;

    begin
      try
        Main;
      except
        on E: Exception do
        begin
          ExitCode := 1;
          Writeln(Error, Format('[%s] %s', [E.ClassName, E.Message]));
        end;
      end;
    end.

To test I have modified Child2.pas to write the received text into a file.

    program Child2;

    {$APPTYPE CONSOLE}

    uses
    Windows, SysUtils, Classes;

    procedure Main;
    var S: string;
        OutFile : TextFile;
    begin
      AssignFile(OutFile, 'test.txt');
      Rewrite(OutFile);
      while not Eof(Input) do
      begin
        Readln(S);
        Writeln(OutFile,S);
        //if S <> '' then OutputDebugString(PChar(S));
      end;
      CloseFile(OutFile);
    end;

    begin
      try
        Main;
      except
        on E: Exception do
        begin
          ExitCode := 1;
          Writeln(ErrOutput, Format('[%s] %s', [E.ClassName, E.Message]));
        end;
      end;
    end.

Answer 4

That approach should work. Before worrying about calling it from Delphi, get the command line worked out by running in a command prompt window (DOS window).
Then just call that command from Delphi with WinExec or ShellExecute. There are options for calling and waiting, or just "fire and forget".