列表6.11.txt

来自「klinux书籍的配套光盘。可以学习学习。」· 文本 代码 · 共 69 行

【列表6.11】摘录自FIFORecvMain.pas的程序代码。
const
 FIFO_Name= '/tmp/FIFODEMO_FIFO';
var
   FIFORecvrForm: TFIFORecvrForm;
   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 TFIFORecvrForm. FetchIt;
var
  FileDesc : Integer;
  BytesRead : Integer;
  TotalBytesRead : Longint;
  Bur : array[0..BUFSIZ] of char;
 begin
   if ReadTypeRBGroup,Itemlndex ' 0
    then FileDesc := open(FIFO_Name, O_RDONLY)
    else FileDesc := open(FIFO_Name, O_RDONLY or O_NONBLOCK);
     if FileDesc <> -1
      then begin
               TotalBytesRead := 0;
               repeat
                 BytesRead :=__read(FileDesc, Buf, BUFSIZ);
                 TotalBytesRead  := TotalBytesRead + BytesRead;
                until BytesRead = 0;
                   __close(FileDesc);
                StatusBar. SimpleText := IntToStr(TotalBytesRead)
                   + ' bytes read';
               end
       else begin
                MessageDlg('Error', 'Unable to access FIFO!', mtError,
                  [mbOK], 0);
                 StatusBar. SimpleText := 'Unable to access FIFO';
               end;
   end;
    procedure TFiFORecvrForm. FormCreate(Sender: TObject);
    begin
     CreateFIFOIfNecessary;
      StatusBar. SimpleText := 'Ready to receive';
    end;
procedure TFiFORecvrForm. FormActivate(Sender: TObject);
begin
 if not FIFOOpen
   then begin
            FetchBtn. Enabled := False;
            MessageDlg('Error', 'FIFO is not open!'
              mtError, [mbOK], 0);
           end;
 end;
 
procedure TFIFORecvrForm. FetchBtnClick(Sender: TObject);
 begin
   FetchBtn. Enabled := False;
   ReadTypeRBGroup. Enabled := False;
   StatusBar. SimpleText := 'Fetching data from FIFO...';
   RecvMonitor. Enabled := True;
  end;
  procedure TFIFORecvrForm. RecvMonitorTimer(Sender: TObject);
  begin
    RecvMonitor.Enabled := False;
    FetchIt;
  end;