[Back to FILES SWAG index] [Back to Main SWAG index] [Original]

    {
    This is a demonstration of a network unit capable of locking
    pascal records or any set of bytes on a file.

    Programmer: Ronen Magid, Qiyat-Ono Israel.
    Contributed to the SWAG.
    }

    Unit Network;
    Interface
    Uses Dos;

    Var
      Regs       : Registers;
      RegSize    : Byte;
      RecSize    : Longint;
      OffSet     : LongInt;
      FileHandle : word;

    Const
     SH_COMPAT   =  $0000;
     SH_DENYRW   =  $0010;
     SH_DENYWR   =  $0020;
     SH_DENYRD   =  $0030;
     SH_DENYNONE =        $0040;
     SH_DENYNO   =  SH_DENYNONE;
     O_RDONLY    =  $0;
     O_WRITE     =  $1;
     O_RDWR      =  $2;

    function  Lock(Var Handle: Word; Var  Offset, BufLen: Longint): Word;
    function  Unlock(Var Handle: Word; Var OffSet, BufLen: Longint): Word;

    Implementation

    function Lock(var  handle: word; var  offset, buflen: longint): word;
    var
      TempOffset:longint;
    begin
      Lock := 0;
      TempOffset:=1000000000+Offset;
      fillchar(regs, sizeof(regs), 0);
      regs.ah := $5C; { Lock file access }
      regs.al := 0;
      regs.bx := handle;
      regs.cx := TempOffset shr RegSize; {and $ffff;}
      regs.dx := TempOffset and $ffff;
      regs.si := buflen shr RegSize; {and $ffff;}
      regs.di := buflen and $ffff;
      MsDos(regs);
      if (regs.Flags and 1) <> 0 then
      Lock := regs.ax;
    end;

    function Unlock(var handle: word; var offset, buflen: longint): word;
    var
      TempOffset:longint;
    begin
      Unlock := 0;
      TempOffset:=1000000000+Offset;
      regs.ah := $5C; { Unlock file access }
      regs.al := 1;
      regs.bx := handle;
      regs.cx := TempOffset shr RegSize; {and $ffff;}
      regs.dx := TempOffset and $ffff;
      regs.si := buflen shr RegSize; {and $ffff;}
      regs.di := buflen and $ffff;
      MsDos(regs);
      if (regs.Flags and 1) <> 0 then
      Unlock := regs.ax;
    end;

    End.

    { ---------------------     TEST CODE ...   CUT HERE -------------------}

    {
    This demonstartion will show how to use the NETWORK file-lock
    unit to allow lock and lock-check of records in a regular
    pascal database file.

    Programmer: Ronen Magid, Qiyat-Ono Israel.
    Contributed to the SWAG.
    }

    Program NetTest;
    uses Dos,Network;

    Type
      PhoneRecord = Record
        Name    :  String[30];
        Address :  String[35];
        Phone   :  String[15];
      End;

    Var
      PhoneRec   : PhoneRecord;
      PhoneFile  : File of PhoneRecord;
      FileHandle : word;
      LockStatus : Word;
      I          : Byte;
      Ok         : Boolean;

    Function LockPhoneRec(which: LongInt): Boolean;
    Begin
      recsize := SizeOf(PhoneRec);
      OffSet :=  RecSize * Which - Recsize;
      FileHandle := FileRec(PhoneFile).handle;
      LockStatus := Lock(FileHandle, offset, recsize);
      if LockStatus = 0 then
      begin
        LockPhoneRec:=True;
      end else
      begin
        LockPhoneRec:=False;
      end;
    end;

    function UnLockPhoneRec(Which: Byte): boolean;
    var
      ok:   boolean;
    begin
      recsize := SizeOf(PhoneRec);
      OffSet := Which * RecSize - RecSize;
      FileHandle := FileRec(PhoneFile).handle;
      LockStatus := Unlock(FileHandle, offset, recsize);
      if LockStatus <> 0 then
      begin
        UnlockPhoneRec := false;
      end else
      begin
        UnlockPhoneRec := true;
      end;
    end;

    begin
      Assign(Phonefile,'PHONE.SMP');
      Rewrite(Phonefile);
      For I:=1 to 5 do Write(Phonefile,phoneRec);
      Close(Phonefile);

      FileMode := SH_DENYNO + O_RDWR;    {Important, Before RESET!}
      Reset(Phonefile);

      { And now lets begin to lock... }

      Ok:=LockPhoneRec(2);
      {Locking phone rec 2}

      {Now lets see if its locked... }

      Ok:=LockPhoneRec(2);
      {a record is already locked if we
       cant lock it. This locking procedure
       can be performed by other PCs & other
       tasks.}

      If Not Ok then writeln('#2 locked');

      Ok:=UnlockPhoneRec(2);
      { lets release it. This will enable
        other tasks or LAN PCs to lock
        (& obtain) this record again...}

      If Ok then Writeln('Rec #2 unlocked');

      {thats it...}
      Ok:=LockPhoneRec(2);
      If Ok then Writeln('And since its free we can relock it !');
      Close(phoneFile);
    End.

[Back to FILES SWAG index] [Back to Main SWAG index] [Original]