【列表7.5】程序LockReader。
unit LockReaderMain;
interface
uses
   SysUtils, Types, Classes,Variants, QGraphics, QControls, QForms, Qdialogs,
   QStdCtrls, QExtCtrls, QComCtrls, Libc, QTypes;
type
   TLockReaderMainForm : class(TForm)
      StartBtn: TButton;
      ExitBtn: TButton;
      ProcLabel: TLabel;
      StatusBar: TStatusBar;
      GroupBox1: TGroupBox;
      Label4: TLabel;
      Label5: TLabel;
      Label6: TLabel;
      Label8: TLabel;
      Label9: TLabel;
      Label10: TLabel;
      Label11: TLabel;
      Label12: TLabel;
      Rec1Panel: TPanel;
      Rec2Panel: TPanel;
      Rec3Panel: TPanel;
      Rec4Panel: TPanel;
      Rec5Panel: TPanel;
      Rec1Label: TLabel;
      Rec2Label: TLabel;
      Rec3Label: TLabel;
      Rec4Label: TLabel;
      Rec5Label: TLabel;
      GroupBox2: TGroupBox;
      Panel6: TPanel;
      Label1: TLabel;
      Panel1: TPanet;
      Label2: TLabel:
      DisplayMonitor: TTimer;
      Panel2: TPanel;
      Label3: TLabel;
      ReadDelayCombo: TComboBox;
      Label7: TLabel;
      Label13: TLabel;
      SampleDelayCombo: TComboBox;
      procedure ClearStatusDisplay(Color : TColor; Visible : Boolean);
      procedure UpdateStatusDisplay;
      procedure UpdateDataDisplay;
      procedure ExitBtnClick(Sender: TObject);
      procedure FormCreate(Sender: TObject);
      procedure DisplayMonitorTimer(Sender: TObject);
      procedure StartBtnClick(Sender: TObject);
      procedure ReadDelayComboClick(Sender: TObject);
      procedure SampleDelayComboClick(Sender: TObject);
  private
      { Private declarations }
  public
      { Public declarations }
  end;

const
   DefaultSampteDelay = 250; { milliseconds }
   DefaultReadDelay = 50; { milliseconds }
   NumRecs = 5;
   RecLen = 20;
   DataFileName = '/tmp/LockRegion.data';
var
    LockReaderMainForm: TLockReaderMainForm;
    PID : pid_t;
    PIDStr : String;
    DF : Integer;
    ErrResult : Integer;
    Running : Boolean;
    SyncCntr : Integer;
    SampleDelay : Integer;
    ReadDelay : Integer;

 implementation

  {SR *.xfm}

  procedure TLockReaderMainForm. ClearStatusDisplay(Color : TColor;
                      Visible : Boolean);
  begin
    Rec1Panel.Visible := Visible:
    Rec1Panel.Color := Color:
    Rec2Panel.Visible := Visible:
    Rec2Panel.Color := Color:
    Rec3Panel.Visible := Visible;
    Rec3Panel.Color := Color;
    Rec4Panel.Visible := Visible;
    Rec4Panel.Color := Color;
    Rec5Panel.Visible := Visible;
    Rec5Panel.Color := Color;
   end;

procedure TLockReaderMainForm. UpdateStatusDisplay;
var
 i : Integer;
 Color : TColor;
 LockRec : TFlock;
begin
 for i := 1 to NumRecs do
   begin
    { Check for exclusive locks }
    LockRec.l_type := F_WRLCK;
    LockRec.l_whence := SEEK_SET;
    LockRec,l_len := RecLen;
    LockRec.l_pid := -1;
    LockRec.l_start := RecLen * (i - 1);
    ErrResutt := fcntl(DF, F_GETLK, LockRec);
    if ErrResult = -1
      then begin
               ShowMessage('Error trying to read file status!'
                     ' Closing...');
               Close;
             end;
   if lockrec.l_type = F_UNLCK
    then begin { No locks present }
             Color := clSilver;
         end
    else begin { Can't have an exclusive lock - why? }
             { See if there's a shared read lock }
             LockRec.l_type := F_RDLCK;
             LockRec.l_whence := SEEK_SET;
             LockRec.l_len := RecLen;
             LockRec.l_pid := -1;
             LockRec.l_start := RecLen = (i - 1);
             ErrResult := fcntl(DF, F_GETLK, LockRec);
             if ErrResult = -1
               then begin
                        ShowMessage('Error trying to read File status!'
                           + ' Closing.,.');
                        Close;
                      end;
             if LockRec,l_type = F_UNLCK
               then Color := clTeal { Another shared lock exists }
               else Color := clRed { Exclusive lock exists }
            end;
   case i of
     1 : ReclPanel.Color := Color;
     2 : Rec2Panel.Color := Color;
     3 : Rec3Panel.Color := Color;
     4 : Rec4Panel.Color := Color;
     5 : Rec5Panel.Color := Color;
    end; { case }
  end; { for }
 Sleep(ReadDelay);
 end;

procedure TLockReaderMainForm. UpdateDataDisplay;
var
  i : Integer;
  LockRec : TFlock;
  Buf : array [0..RecLen] of char;
begin
  for i := 1 to NumRecs do
    begin
      LockRec.l_type := F_RDLCK;
      LockRec.l_whence := SEEK_SET;
      LockRec.l_len := RecLen;
      LockRec.l_pid := -1;
      LockRec.l_start := RecLen * (i - 1);
      ErrResult := fcntl(DF, F_SETLK, LockRec);
      if ErrResult <> -1
        then begin { We've got a shared lock }
                  lseek(DF, RecLen * (i - 1), SEEK_SET);
                  __read(DF, Buf, RecLen);
                  Buf[RecLen] := chr(O);
                  case i of
                    1 : ReclLabel.Caption := Buf;
                    2 : Rec2Label.Caption := Buf;
                    3 : Rec3Label.Caption := Buf;
                    4 : Rec4Label.Caption := Buf;
                    5 : Rec5Label.Caption := Buf;
                   end; { case }

                   Sleep(ReadDelay);

                   { Let the lock go for this record }
                    LockRec.l_type := F_UNLCK;
                    LockRec.l_whence := SEEK_SET;
                    LockRec.l_len := RecLen;
                    LockRec.l_pid := -1;
                    LockRec.l_start := RecLen * (i - 1);
                    fcntl(DF, F_SETLK, LockRec);
               end;
 end; { for }
end;
procedure TLockReaderMainForm. ExitBtnClick(Sender: TObject);
begin
 Close;
end;
procedure TLockReaderMainForm. FormCreate(Sender: TObject);
var
  F : TextFile;
  i : Integer;
  s : String;
begin
  SampleDetay := DefaultSampleDelay;
  DisplayMonitor. Interval := SampleDelay;
  ReadDelay := DefaultReadDelay;

  ClearStatusDisplay(clSilver, False);
   Running := False;
   PID := getpid;
   PIDStr := IntToStr(PID);
   ProcLabel.Caption := 'Process ID: ' + PIDStr;
   if not FileExists(OataFileName)
    then begin { Create the data file }
               AssignFile(F, DataFileName);
               Rewrite(F);
               for i := 1 to NumRecs do
                 begin
                  s := PIDStr + '  :  ' + IntToStr(i) + '  : 0';
                  while Length(s) < RecLen do s := s + '  ';
                  write(F, s):
                 end; { for }
               CloseFile(F);
              end;
   DF := open(DataFileName,O_RDONLY);
    if DF = -1
     then begin
             StartBtn. Enabled := False;
             ShowMessage('Error opening data file!');
             StatusBar.SimpleText := 'Error opening data file';
            end;
end;
procedure TLockReaderMainForm. DisplayMonitorTimer(Sender: TObject);
begin
  Inc(SyncCntr);
  if SyncCntr mod 3 = 0 then UpdateDataDisplay;
 UpdateStatusDisplay;
end;

procedure TLockReaderMainForm. StartBtnClick(Sender: TObject);
begin
  if Running
   then begin
              ClearStatusDisplay(clSilver, False);
              DisplayMonitor. Enabled := False;
              StartBtn. Caption := 'Start';
              Running := False;
            end
    else begin
              ClearStatusDisplay(clSilver, True);
              StartBtn. Caption := 'Stop';
              DisplayMonitor. Enabled := True;
              Running := True;
             end;
 end;

 procedure TLockReaderMainForm. ReadDelayComboClick(Sender: TObject);
 begin
   ReadDelay :=StrToInt(ReadDelayCombo. Items[ReadDelayCombo. ItemIndex]);
 end;
 procedure TLockReaderMainForm. SampleDelayComboClick(Sender: TObject);
 begin
   SampleDelay :=
      StrToInt(SampleDelayCombo. Items[SampleDelayCombo. ItemIndex]);
   DisplayMonitor. Interval := SampleDelay;
 end;
 end.