【列表6.8】摘錄自PipeParentMain.pas的程序代碼。
const
 StrIndexLen = 4;
 LF= ^J; { ASCII linefeed/newline }
var
   PipeParentMainForm: TPipeParentMainForm;
   SigActionRec : TSigAction;
   PipeOpen : Boolean;
   ParentPipe : TPipeDescriptors;
   PReadDesStr : String;
    ChildPID : pid_t;
    ChildDone : Boolean;
 implementation

 {SR *.xfm}

procedure Handler(Sig : Integer); cdecl;
begin
  case Sig of
   SIGCHLD : ChildDone := waitpid(ChildPID, nil, WNOHANG) = ChildPID;
  end; { case }
end;
procedure InstallHandler;
begin
 with SigActionRec do
   begin
    __sigaction_handler := Handler;
    sigemptyset(sa_mask);
    sa_flags := 0;
    sigaction(SIGCHLD, @SigActionRec, nil);
   end; { with }
end;
procedure LaunchChild;
var
 i : Integer;
 FName : String;
 Open_max : Integer;
begin
 ChildDone := True;
 PReadDesStr := IntToStr(ParentPipe. ReadDes);
 FName := 'PipeChild';
 if not FileExists(FName)
  then begin
           MessageDlg('Error', 'Cannot locate the file ' + FName + ' ' + LF
             + 'Make sure a copy is present in your' + LF
             + 'home directory.',
             mtError, [mbOK], 0);
           Exit;
          end;
ChildPID := fork;
case ChildPID of
-1 : { This is still the parent }
          MessageDlg('Error', 'Could not launch child process.',
          mtError, [mbOK], 0);
   0 : begin { This is the child }
           { Close the open files }
          open_max := sysconf(_SC_OPEN_MAX);
           for i := stderr +1 to open_max - 1 do
            if (i <> ParentPipe. ReadDes) and (i <> ParentPipe.WriteDes)
              then fcntl(i, F_SETFD, FD_CLOEXEC);
           execlp(PChar(FName), PChar(FName), PReadDesStr, nil);
           { If execlp failed then bail the child }
           _exit(EXIT_FAILURE);
          end;
  else ChildDone := False;
 end { case }
end;
procedure TPipeParentMainForm. ExitBtnClick(Sender: TObject);
begin
 if not ChildDone then kill(ChildPID, SIGTERM);
 Close;
end;
procedure TPipeParentMainForm. FormCreate(Sender: TObject);
begin
  InstallHandler;
  PipeOpen := pipe(ParentPipe) = 0;
  if PipeOpen then LaunchChild;
 end;
 procedure TPipeParentMainForm. FormActivate(Sender: TObject);
 begin
  if PipeOpen then Labell.Caption := '[ Pipe is open ]';
 end;
 procedure TPipeParentMainForm. SendBtnClick(Sender: TObject);
 var
   StrBuf : array[0..BUFSIZ] of Char;
   s : String;
   slen : String;
  begin
   if PipeOpen
     then begin
s := MsgEdit.Text;
    slen := IntToStr(Length(s));
    while Length(slen) < StrIndexLen do slen := '0' + slen;
    s := slen + s;
    StrPCopy(StrBuf, s);
    __write(ParentPipe.WriteDes, StrBuf, Length(s));
    kill(ChildPID, SIGUSR1);
    end;
end;