【列表7.3】程序 LockFile的代碼。
unit LockFileMain;
interface
uses
   SysUtils, Types. Classes, Variants, QGraphics, QControls, QForms. QDialogs.
   QStdCtrls. QExtCtrls. QTypes, Libc. QButtons;
type
  TLockFileMainForm = class(TForm)
      ExitBtn: TButton;
      PIDLabel: TLabel;
     GroupBox1: TGroupBox;
     StatusPanel: TPanel;
     Label1: TLabel;
     LockBtn: TButton;
     ReleaseBtn: TButton;
     Monitor: TTimer;
     procedure UpdateControls;
     procedure ExitBtnClick(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure LockBtnClick(Sender: TObject);
     procedure ReleaseBtnClick(Sender: TObject);
     procedure MonitorTimer(Sender: TObject);

   private
           { Private declarations }
   public
           { Public declarations }
   end;
   type
       TLockStatus = (tsdUnlocked, tsdPending, tsdLocked);
   const
       LockFileName = '/tmp/LCK.LockFileDemo';
   var
      LockFileMainForm: TLockFileMainForm;
      LockStatus : TLockStatus;
      FD : Integer;
   implementation
   {SR *,xfm}
  function FileLocked : Integer;
  begin
    Result := open(LockFileName, O_RDWR or O_CREAT or O_EXCL. 438);
  end;
  procedure TLockFileMainForm. UpdateControls;
  begin
   case LockStatus of
     tsdUnlocked : begin
                           StatusPanel.Color := clRed;
                           LockBtn,Enabled := True;
                           ReleaseBtn. Enabled:= False;
                         end;
     tsdPending  : begin
                          StatusPanel.Color := clYellow;
                          LockBtn. Enabled := False;
                          ReleaseBtn. Enabled := False;
                         end;
     tsdLocked   : begin
                          StatusPanel,Color := clGreen;
                          LockBtn. Enabled := False;
                         ReleaseBtn. Enabled := True;
                        end;
 end; { case }
end;
  procedure TLockFileMainForm. ExitBtnClick(Sender: TObject);
  begin
    { We do this housekeeping just for this demo! }
   if FileExists(LockFileName) then unlink(LockFileName);
   Close;
  end;
  procedure TLockFileMainForm. FormCreate(Sender: TObject);
  begin
   PIDLabel.Caption := 'Process ID: ' + IntToStr(getpid);
   LockStatus := tsdUnlocked;
   UpdateControls;
 end;
 procedure TLockFileMainForm. LockBtnClick(Sender: TObject);
 begin
   FD := FileLocked;
   if FD <> -1
    then LockStatus := tsdLocked
    else begin
             LockStatus := tsdPending;
             Monitor. Enabled := True;
           end;
  UpdateControls;
 end;
 procedure TLockFileMainForm. ReleaseBtnClick(Sender: TObject);
begin
  close(FD);
  unlink(LockFileName);
  LockStatus := tsdUnlocked;
  UpdateControls;
end;
procedure TLockFileMainForm. MonitorTimer(Sender: TObject);
begin
  FD := FileLocked;
  if FD <> -1
   then begin
            LockStatus := tsdLocked;
            UpdateControls;
            Monitor. Enabled := False;
          end;
end;
end.