Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/OPBONUS.ZIP/FBROWSE.LZH/OOPSEMA.PAS

Pascal/Delphi Source File | 1990-06-19 | 5.9 KB | 210 lines

{
  OOPSEMA 1.0 - NetWare semaphore related objects

  by Richard S. Sadowsky
  Released to the public domain

  Please address questions and comments about this unit to ALL in section 6 of
  the PCVENB forum on Compuserve.
}

{$I-,V-,S-,R-}
unit OopSema;

interface

uses NetSema;

const
  MaxSemaphores = 100; {maximum number of semaphores managed by FilerSemaphore}

type
  SimpleSemaphorePtr = ^SimpleSemaphore;
  {The following object type simply encapsulates all the NetWare semaphore
   functions into an object}
  SimpleSemaphore =
    object
      ssName       : SemaphoreName;
      ssHandle     : LongInt;
      constructor Init(Name : SemaphoreName;
                       InitValue : Byte;
                       var OpenCount : Byte);
        {-Open a semaphore}
      destructor Done; Virtual;
        {-Close a semaphore}
      function Examine(var Value : ShortInt; var OpenCount : Byte) : Boolean;
        {-Examine Value and OpenCount for this semaphore}
      function Signal(var Overflow : Boolean) : Boolean;
        {-Increment Value of semaphore}
      function WaitOn(TimeOutValue : Word;
                      var TimeOut : Boolean) : Boolean;
        {-Decrement a semaphore}
      function GetName : SemaphoreName;
        {-Return the name of this semaphore}
    end;

  SemaphoreRec   = record
                     Sema : SimpleSemaphorePtr;
                     Valu : ShortInt;
                     Cnt  : Byte;
                   end;
  SemaphoreList  = Array[1..MaxSemaphores] of SemaphoreRec;

  {This is a higher level semaphore object used to provide synchronization
   between workstations. See TurboPower's FBDEMO for an example usage of this
   object type.}
  FilerSemaphore =
    object
      fsNrOfKeys   : Integer;
      fsSemaphores : ^SemaphoreList;
      constructor Init(Name : String; NrOfKeys : Integer);
        {-create the semaphores}
      destructor Done; Virtual;
        {-destroy the semaphores}
      procedure IndicateDirty(KeyNr : Integer);
        {-Indicate to others that a file has been modified}
      function IsDirty(KeyNr : Integer) : Boolean;
        {-see if the file has been modified}
      function NumberOpen(KeyNr : Integer) : Byte;
        {-Return the number of stations currently using the semaphore}
    end;

implementation

  constructor SimpleSemaphore.Init(Name : SemaphoreName;
                                   InitValue : Byte;
                                   var OpenCount : Byte);
    {-Open a semaphore}
  begin
    if OpenSemaphore(Name, InitValue, OpenCount, ssHandle) then
      ssName := Name
    else
      Fail;
  end;

  destructor SimpleSemaphore.Done;
    {-Close a semaphore}
  begin
    if CloseSemaphore(ssHandle) then ;
  end;

  function SimpleSemaphore.Examine(var Value : ShortInt; var OpenCount : Byte) : Boolean;
    {-Examine Value and OpenCount for this semaphore}
  begin
    Examine := ExamineSemaphore(ssHandle, Value, OpenCount);
  end;

  function SimpleSemaphore.Signal(var Overflow : Boolean) : Boolean;
    {-Increment Value of semaphore}
  begin
    Signal := SignalSemaphore(ssHandle, Overflow);
  end;

  function SimpleSemaphore.WaitOn(TimeOutValue : Word;
                           var TimeOut : Boolean) : Boolean;
    {-Decrement a semaphore}
  begin
    WaitOn := WaitOnSemaphore(ssHandle, TimeOutValue, TimeOut);
  end;

  function SimpleSemaphore.GetName : SemaphoreName;
  begin
    GetName := ssName;
  end;

  function IntToStr(I : Integer) : String;
  var
    S : String;
  begin
    Str(I, S);
    IntToStr := S;
  end;

  constructor FilerSemaphore.Init(Name : String; NrOfKeys : Integer);
    {-create the semaphore}
  var
    I, II : Integer;
    Size  : Word;
  begin
    if (NrOfKeys = 0) or (NrOfKeys > MaxSemaphores) then
      Fail;
    fsNrOfKeys := NrOfKeys;
    Size := NrOfKeys * SizeOf(SemaphoreRec);
    if MaxAvail < LongInt(Size) then
      Fail;
    GetMem(fsSemaphores, Size);
    for I := 1 to NrOfKeys do begin
      with fsSemaphores^[I] do begin
        New(Sema, Init('fs__'+Name+IntToStr(I), 0 , Cnt));
        if Sema = Nil then begin
          for II := Pred(I) downto 1 do
            Dispose(fsSemaphores^[II].Sema, Done);
          FreeMem(fsSemaphores, Size);
          Fail;
        end
        else
          if Sema^.Examine(Valu, Cnt) then ;
      end;
    end;
  end;

  destructor FilerSemaphore.Done;
  var
    I : Integer;
  begin
    for I := 1 to fsNrOfKeys do
      Dispose(fsSemaphores^[I].Sema, Done);
    FreeMem(fsSemaphores, fsNrOfKeys * SizeOf(SemaphoreRec));
  end;

  procedure FilerSemaphore.IndicateDirty(KeyNr : Integer);
    {-Indicate to others that a file has been modified}
  var
    Overflow : Boolean;
    I  : Byte;

  begin
    if (KeyNr < 1) or (KeyNr > fsNrOfKeys) then
      Exit;
    with fsSemaphores^[KeyNr] do
      if Sema^.Signal(Overflow) then begin
        if Overflow then
          {if overflow, then reset downto 1}
          for I := 127 downto 1 do
            if Sema^.WaitOn(0, Overflow) then ;
        if not Sema^.Examine(Valu, Cnt) then ;
      end;
  end;

  function FilerSemaphore.IsDirty(KeyNr : Integer) : Boolean;
    {-see if the file has been modified}
  var
    NewValue : ShortInt;
  begin
    IsDirty := False;
    if (KeyNr < 1) or (KeyNr > fsNrOfKeys) then
      Exit;
    with fsSemaphores^[KeyNr] do
      if Sema^.Examine(NewValue, Cnt) then begin
        if NewValue <> Valu then begin
          IsDirty := True;
          Valu := NewValue;
        end;
      end;
  end;

  function FilerSemaphore.NumberOpen(KeyNr : Integer) : Byte;
  var
    C : Byte;
    V : ShortInt;
  begin
    NumberOpen := 0;
    if (KeyNr < 1) or (KeyNr > fsNrOfKeys) then
      Exit;
    with fsSemaphores^[KeyNr] do
      if Sema^.Examine(V, C) then
        NumberOpen := C;
  end;

end.