【列表6.10】  摘錄自FIFOSendMain.pas的程序代碼。
const
  MIN_BYTES_TO_SEND = 10000000; { 10 million }
  FIFO_Name = '/tmp/FIFODEMO_FIFO';
var
   FIFOSendForm: TFIFOSendForm;
   FIFOOpen : Boolean;
implementation
{SR *.xfm}
procedure CreateFIFOIfNecessary;
begin
 FIFOOpen := access(FIFO_Name, F_OK) = 0;
 if not FIFOOpen
   then FIFOOpen := mkfifo(FIFO_Name, 511) = 0; { octal 777 }
end;
procedure TFtFOSendForm. SendIt;
var
 FileDesc : Integer;
 BytesSent : Integer;
 TotalBytesSent : Longint;
 Buf : array[0..BUFSIZ] of char;
begin
   FileDesc := open(FIFO_Name, O_WRONLY);
   if FileDesc <> -1
    then begin
             TotalBytesSent := 0;
             while TotalBytesSent < MIN_BYTES_TO_SEND do
              begin
                BytesSent := __write(FileDesc, Buf, BUFSIZ);
                if BytesSent = -1
                 then begin
                          MessageDlg('Error','Error writing to FIFO!',
                           mtError, [mbOK], 0);
                          StatusBar. SimpleText := 'Ready to send';
                          Exit;
                         end;
                TotalBytesSent := TotalBytesSent + BytesSent;
              end; { while }
             __close(FileDesc);
             StatusBar.SimpleText := IntToStr(TotalBytesSent)
                + ' bytes sent';
           end
    else begin
             MessageDlg('Error', 'Unable to access FIFO!', mtErr
               [mbOK], 0);
             StatusBar. SimpleText := 'Unable to access FIFO';
            end;
end;
procedure TFIFOSendForm. FormCreate(Sender: TObject);
begin
 CreateFIFOIfNecessary;
 StatusBar. SimpleText := 'Ready to send';
end;
procedure TFIFOSendForm. FormActivate(Sender: TObject);
begin
 if not FIFOOpen
   then begin
            SendBtn. Enabted := False;
            MessageDlg('Error', 'FIFO is not open!',
             mtError, [mbOK], 0);
           end;
end;
procedure TFIFOSendForm. SendBtnClick(Sender: TObject);
begin
  SendBtn. Enabled := False;
  StatusBar.SimpleText := 'Waiting to send data to FIFO...';
  SendMonitor. Enabled := True;
end;
procedure TFIFOSendForm. SendMonitorTimer(Sender: TObject);
begin
  SendMonitor. Enabled := False;
  SendIt;
end;