列表6.12.txt

klinux书籍的配套光盘。可以学习学习。

【列表6-12】  OneAtATime程序的主框架。
 unit frmOnce;
 interface
uses
   SysUtils, Libc, Types, Classes, Variants, QGraphics, QControls
   QForms, QDialogs, QStdCtrls,
   SemFuncs;
type
  TForml = class(TForm)
     Button1: TButton;
     Button2: TButton;
     Memo1: TMemo;
     Memo2: TMemo;
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
     procedure Button1Click(Sender: TObject);
     procedure Button2Click(Sender: TObject);
  private
      FSemID : Integer;
      FOwnSems : boolean;
     procedure DoActivity (mm: TMemo; sem: Integer);
  public
      { Public declarations }
   end;
var
   Form1: TForm1;
implementation
{SR *.xfm}
const
  AccessMode = S_IREAD or S_IWRITE or S_IRGRP or S_IWGRP;
procedure TForml. FormCreate(Sender: TObject);
var
   Key : Integer;
begin
   Key := ftok (PChar(GetModuleName (0)), 1);
   // try to create a new semaphore set
   FSemID := semget (Key, 2. IPC_CREAT or IPC_EXCL or AccessMode);
   if FSemID = -1 then
   begin
      // create failed, try to open it...
      FOwnSems := false;
      FSemID := semget (Key, 0, 0);
      if FSemID = -1 then
         raise Exception.Create (strerror (errno));
   end
   else
   begin
      // created semaphores...set values
      FOwnSems := true;
      SemSetValue (FSemID, 0, 1);
      SemSetValue (FSemID, 1, 1);
   end;
end;
procedure TForm1.FormDestory(Sender:TOject);
begin
   if FOwnSems then 
     SemRemoveSet(FSemid);
end;
function SetScreenCursor(cur:TCursor):TCursor;
begin
   Result:=Screen.Cursor;
   Screen.Cursor:=cur;
end;
procedure TForm1.DoActivity(mm:TMemo;sem:Integer);
var
    curSave:TCursor;
begin
curSave := SetScreenCursor (crHourGlass);
    try
       mm. Clear;
       mm. Lines.Add (Format ('Locking semaphore for Activity %d', [sem+1]));
       SemDoOp (FSemID, sem, -1, SEM_UNDO);
       try
          mm. Lines.Add (Fo[mat ('Semaphore %d locked', [sem]));
          mm. Lines.Add ('Pausing for 5 seconds...');
          __sleep (5);
          mm. Lines.Add ('done');
       finally
          SemDoOp (FSemID, sem, 1, SEM_UNDO);
       end;
    finally
        SetScreenCursor (curSave);
     end;
  end;
  procedure TForm1.Button1Click(Sender: TObject);
  begin
     DoActivity (Memo1, 0);
  end;
  procedure TForml.Button2Click(Sender: TObject):
  begin
     DoActivity (Memo2, 1);
  end;
  end.