{$X+,B-,V-} {essential compiler directives}

UNIT nwLock;

{ nwLock unit as of 950301 / NwTP 0.6 API. (c) 1993,1995, R. Spronk

  This unit was based on units by

   a. Scott A. Lewis, 36 Maythorpe Drive, Windsor, CT 06095, U.S.A.
      Note: (1987) 76515,135@Compuserve.Com

   b. Erik van Heyningen, Hague Consulting Group,
      The Hague, the Netherlands.
      Note: (1994) hcg@hacktick.nl    }

{ Function:                          Interrupt:  Notes:

  Physical File locking/unlocking
  -------------------------------

* LogPhysicalFile                     EB           (6) -> F203
* LockPhysicalFileSet                 F204
* ReleasePhysicalFile                 EC               -> F205
* ReleasePhysicalFileSet              CD               -> F206
* ClearPhysicalFile                   ED           (6) -> F207
* ClearPhysicalFileSet                CF               -> F208

  Logical File Locking
  --------------------

+ LogLogicalFile                                   (5)
+ LogLogicalFileSet                                (5)
+ ReleaseLogicalFile                               (5)
+ ReleaseLogicalFileSet                            (5)
+ ClearLogicalFile                                 (5)
+ ClearLogicalFileSet                              (5)

  Logical record locking/unlocking
  --------------------------------

* LogLogicalRecord                    D0               -> F209
* LockLogicalRecordSet                D1               -> F20A
* ReleaseLogicalRecord                D2               -> F20C
* ReleaseLogicalRecordSet             D3               -> F20D
* ClearLogicalRecord                  D4               -> F20B
* ClearLogicalRecordSet               D5               -> F20E

  GetLogicalRecordInformation         F217/F0      (3)
  GetLogicalRecordsByConnection       F217/EF      (3)

  Physical record locking/unlocking
  ---------------------------------

. LogPhysicalRecord                   BC               -> F21A
. LockPhysicalRecordSet               C2               -> F21B
. ReleasePhysicalRecord               BD               -> F21C
. ReleasePhysicalRecordSet            C3               -> F21D
. ClearPhysicalRecord                 BE               -> F21E
. ClearPhysicalRecordSet              C4               -> F21F

  GetPhysRecLocksByConnectionAndFile  F217/ED      (3)
  GetPhysRecLocksByFile               F217/EE      (3)

- ControlRecordAccess                 5C (DOS)     (4)


  Not Implemented
  ---------------

- GetLockMode                         C600         (1)
- SetLockMode                         C601         (1)
- BeginLogicalFileLocking             C8  / F201   (2)
- EndLogicalFileLocking               C9  / F202   (2)

  Notes: -Semaphores can be found in the nwSema Unit
         (1) Obsolete
         (2) Not supported by (all) 3.x versions
         (3) Supported by NW 3.x and upwards
         (4) Generic physical record locking call, DOS 3.1+
             Equivalent to:
             I . LockPhysicalRecord (without logging)
             II. ReleasePhysicalrecord
         (5) Use the equivalent LogicalRecordLocking calls
             to emulate LogicalFileLocking. NOTE: remember
             that there's only ONE Log.
         (6) Includes VLM fix for filenames (GetTrueEntryName
             in the nwFile unit is called)
         -> F2xx To be rewritten to the F2 interface.
}

INTERFACE

Uses nwIntr,nwMisc;

CONST { Log Resource }
      LD_LOG             = 0;
      LD_LOG_LOCK        = 1; { Deny all access to file/record }
      LD_LOG_LOCK_RO     = 3; { Allow read / deny write (record locking only)}
      { Lock Resource }
      LD_lOCK            = 0; { Deny all access to file/record }
      LD_LOCK_RO         = 1; { Allow read / deny write (record locking only)}

Var Result:word;

{------------------- PHYSICAL FILE LOCKING OPERATIONS -----------------------}

{F204 [2.15c+]}
FUNCTION LockPhysicalFileSet(TimeoutLimit : Word) : Boolean;
{Lock a set of files that were logged by the LogFile function }

{CD.. [1.0+]}
FUNCTION ReleasePhysicalFileSet:boolean;
{ Release lock on set of files in logged table, files remain logged }

{CF   [1.0+]}
FUNCTION ClearPhysicalFileSet : Boolean;
{ Unlock and UnLog the entire logged file set }

{EB.. [1.0+]}
FUNCTION LogPhysicalFile(FileName : String; LockDirective : Byte; TimeoutLimit : Word) : Boolean;
{Log files for later use }

{EC.. [1.0+]}
FUNCTION ReleasePhysicalFile(FileName : String) : boolean;
{Release file lock, but keep logged in the table }

{ED.. [1.0+]}
FUNCTION ClearPhysicalFile(FileName : String) : boolean;
{Release a file from the file log table, unlock the file if it is locked }

{ ------------------- LOGICAL RECORD LOCKING OPERATIONS --------------------}

{D0  [1.0+]}
FUNCTION LogLogicalRecord(Name:string; LockDirective:Byte; Timeout: Word) : Boolean;
{Add a record to the lockable logical record table }

{D1.. [1.0+]}
FUNCTION LockLogicalRecordSet(LockDirective:Byte; TimeoutLimit : Word) : Boolean;
{Lock all logged records }

{D2.. [1.0+]}
FUNCTION ReleaseLogicalRecord(Name : String) : Boolean;
{Unlock a record, keep record in logtable }

{D3.. [1.0+]}
FUNCTION ReleaseLogicalRecordSet : Boolean;
{Unlock all locked records, keep records logged }

{D4.. [1.0+]}
FUNCTION ClearLogicalRecord(Name : String) : Boolean;
{Unlock and UnLog a record }

{D5.. [1.0+]}
FUNCTION ClearLogicalRecordSet : Boolean;
{Unlocks and UnLogs all logged records }

{F217/EF [2.1x+]}
Function GetLogicalRecordLocksByConnection(ConnNbr:word;
                                 {i/o} Var NextRecNbr:word;
                                       Var TaskNbr:word;
                                       Var LockStatus:Byte;
                                       Var LockName:String):Boolean;
{ You need console operator rights to use this function }


{----------------------- PHYSICAL RECORD LOCKING OPERATION -----------------}

{BC.. [1.0+]}
function LogPhysicalRecord(Handle:Word;
                           LockDirective:Byte;
                           RecordOffset,RecordLength:Longint;
                           TimeOutLimit:Word): boolean;
{Add a record to the lockable physical record logtable }

{BD.. [1.0+]}
function ReleasePhysicalRecord( Handle:Word; RecordOffset,RecordLength:Longint) : boolean;
{Unlock record, keep record logged }

{BE.. [1.0+]}
function ClearPhysicalRecord(Handle:Word; RecordOffset,RecordLength:Longint): boolean;
{Unlock and Unlog a record }

{C2.. [1.0+]}
function LockPhysicalRecordSet(LockDirective: byte; TimeoutLimit : Word): boolean;
{Lock all logged records }

{C3.. [1.0+]}
function ReleasePhysicalRecordSet : boolean;
{Unlock all logged records, keep records logged }

{C4.. [1.0+]}
function ClearPhysicalRecordSet : boolean;
{Unlocks and unLogs all logged records }


IMPLEMENTATION{==============================================================}

uses nwFile;

Var regs:TTRegisters;


Procedure SetLockMode(mode:Byte);
begin
regs.AH:=$c6;
regs.al:=mode; { 0 or 1 }
RealModeIntr($21,regs);
end;

(* THE FOLLOWING PROCEDURES ARE FOR LOGGING AND LOCKING/RELEASING FILE SETS *)
(* File locking by set can be very effective in avoiding deadly embrace *)

{F204 [3.x+]}
FUNCTION LockPhysicalFileSet(TimeoutLimit : Word) : Boolean;
Type Treq=record
          _TimeOutLimit:Word;
          end;
     TPreq=^Treq;
BEGIN
With TPreq(GlobalReqBuf)^
 do begin
    _TimeoutLimit:=swap(TimeoutLimit);
    end;
F2SystemCall($04,SizeOf(Treq),0,result);
LockPhysicalFileSet:=(result=0);
{ 00 Successful  FF Fail  FE Timeout }
END;


{CD.. [1.0+]}
FUNCTION ReleasePhysicalFileSet:boolean;
{ Release lock on set of files in logged table, files remain logged }
{ These files remain open but cannot be accessed without an error }
{ To reuse them, send another lock file set }
Type Treq=record
          end;
BEGIN
WITH Regs
  DO BEGIN
     AH := $CD;
     RealModeIntr($21,Regs);
     result:=0;
     END;
ReleasePhysicalFileSet:=true;
END;

{CF  [2.0+]}
FUNCTION ClearPhysicalFileSet : Boolean;
{ Unlock and UnLog the entire personal file set (all files are closed) }
BEGIN
WITH Regs
  DO BEGIN
     AH := $CF;
     RealModeIntr($21,Regs);
     result:=0;
     END;
ClearPhysicalFileSet:=true;
END;


{EB.. [2.0+] }
FUNCTION LogPhysicalFile(FileName : String; LockDirective : Byte; TimeoutLimit : Word) : Boolean;
{ This function allows a station to log files for later personal use }
{ After the desired files are logged, function CBh can be used to lock }
{ the entire set of files }
{ !! There is a known problem with lock directive 3 (log and lock shareable)
     use 1 instead. }
Type Treq=record
          LockDirective:Byte;
          TimeOutLimit:Word;
          FileName:string[255]; { or Asciiz ? }
          end;
Var temp1,temp2:word;
    TEname:string;
BEGIN
GetTrueEntryName(FileName,TEname); { also UpCases string }
{ IF this function isn't included and VLMs are used, this call will
  *appear* to be successful. No error code is returned, the call is
  however unsuccessful. }
WITH Regs
 DO BEGIN
     AH := $EB;
     AL := LockDirective;                  { 0 = Log Only, 1 Log and Lock }
     BP := TimeoutLimit;                   { in 1/18 seconds, 0 = No wait }
     TEname := TEName+#0;           { Terminate with a nul for asciiz }
     Move(TEname[1],GlobalReqBuf^,ord(TEname[0]));
     GetGlobalBufferAddress(DS,DX,temp1,temp2);
     { DS:DX real mode pointer to buffer in realmode-range holding Filename }
     RealModeIntr($21,Regs);
     Result:=AL;
     LogPhysicalFile := (Result = 0);
     END;
{ FE Timeout  FF hardware error }
END;


{EC.. [1.0+]}
FUNCTION ReleasePhysicalFile(FileName : String) : boolean;
{ Release file lock, but keep logged in the table }
Var temp1,temp2:word;
    TEname:string;
BEGIN
GetTrueEntryName(FileName,TEname); { also UpCases string }
{ IF this function isn't included and VLMs are used, this call will
  *appear* to be successful. No error code is returned, the call is
  however unsuccessful. }
WITH Regs
 DO BEGIN
    AH := $EC;
    UpString(FileName);
    TEName := TEName+#0;                               { null terminate }
    Move(TEname[1],GlobalReqBuf^,ord(TEname[0]));
    GetGlobalBufferAddress(DS,DX,temp1,temp2);
    { DS:DX real mode pointer to buffer in realmode-range holding Filename }
    RealModeIntr($21,Regs);
    result:=AL;
    ReleasePhysicalFile:=(result=0);
    END;
{FF File not found }
END;

{ED.. [1.0+]}
FUNCTION ClearPhysicalFile(FileName : String) : boolean;
{ Release a file from the file log table, unlock the file if it is locked }
Var temp1,temp2:word;
BEGIN
WITH Regs
 DO BEGIN
    AH := $ED;
    UpString(FileName);
    FileName := FileName+#0;                               { null terminate }
    Move(Filename[1],GlobalReqBuf^,ord(Filename[0]));
    GetGlobalBufferAddress(DS,DX,temp1,temp2);
    { DS:DX real mode pointer to buffer in realmode-range holding Filename }
    RealModeIntr($21,Regs);
    Result:=AL;
    ClearPhysicalFile := (Result = 0);
    { 0 means OK  FF File not found}
  END;
END;


(* THE FOLLOWING FUNCTIONS ARE FOR LOGICAL LOCKING OPERATIONS *)
(* Logical locks work only if all software accessing the files use the *)
(* same logical synchronization scheme.  Logical locks are much easier *)
(* and faster to implement than physical locks. *)


{D0  [1.0+]}
FUNCTION LogLogicalRecord(Name:String; LockDirective:Byte; Timeout: Word) : Boolean;
{ This function will log the specified record string in the record log table }
{ of the requesting station.  }
{ Max length of name: 99 chars }
{ LockDirective LD_LOG         = 0;
                LD_LOG_LOCK    = 1;  Deny all access to file/record
                LD_LOG_LOCK_RO = 3;  Allow read / deny write }
{ TimeOut=0 means NoWait }
Var temp1,temp2:word;
BEGIN
WITH Regs
 DO BEGIN
     AH := $D0;
     AL := LockDirective;
     UpString(Name);
     Move(Name,GlobalReqBuf^,ord(Name[0])+1);
     GetGlobalBufferAddress(DS,DX,temp1,temp2);
     { DS:DX real mode pointer to buffer in realmode-range holding Filename }
     BP := Timeout;       { In 1/18th seconds (use only with lock bit set }
     RealModeIntr($21,Regs);
     Result:=AL;
     LogLogicalRecord := (Result=0);
    { FFh  fail }
    { FEh  timeout }
    { 96h  No dynamic memory for file }
    END;
END;


{D1 [1.0+]}
FUNCTION LockLogicalRecordSet(LockDirective:Byte; TimeoutLimit : Word) : Boolean;
{ Call this to lock all records logged with Log_Logical_Record }
{ LockDirective LD_LOCK        = 0;  Deny all access to file/record
                LD_LOCK_RO     = 1;  Allow read / deny write }
BEGIN
WITH Regs
DO BEGIN
     AH := $D1;
     AL := LockDirective;
     BP := TimeoutLimit;                  { In 1/18th seconds, 0 = No wait }
     RealModeIntr($21,Regs);
     Result:=AL;
     LockLogicalRecordSet := (Result=0);
     {00 - Success
      FF - fail,
      FE - timeout }
   END;
END;

{D2.. [1.0+]}
FUNCTION ReleaseLogicalRecord(Name : String) : Boolean;
{ Call this to release a logical record lock without removing the rec }
{ from the table }
Var temp1,temp2:word;
BEGIN
WITH Regs
DO BEGIN
    AH := $D2;
    UpString(Name);
    Move(Name,GlobalReqBuf^,ord(Name[0])+1);
    GetGlobalBufferAddress(DS,DX,temp1,temp2);
    { DS:DX real mode pointer to buffer in realmode-range holding Filename }
    RealModeIntr($21,Regs);
    Result:=AL;
    ReleaseLogicalRecord := (Result=0);
    { FF No record found }
  END;
END;

{D3.. [1.0+]}
FUNCTION ReleaseLogicalRecordSet : Boolean;
{ release all locked logical records, doesn't remove them from the table }
BEGIN
WITH Regs
DO BEGIN
    AH := $D3;
    RealModeIntr($21,Regs);
    Result:=0;
    ReleaseLogicalRecordSet := True;
   END;
END;

{D4.. [1.0+]}
FUNCTION ClearLogicalRecord(Name : String) : Boolean;
{ This call unlocks and removes the Logical Record lock from the table }
Var temp1,temp2:word;
BEGIN
WITH Regs
DO BEGIN
    AH := $D4;
    UpString(Name);
    Move(Name,GlobalReqBuf^,ord(Name[0])+1);
    GetGlobalBufferAddress(DS,DX,temp1,temp2);
    { DS:DX real mode pointer to buffer in realmode-range holding Filename }
    RealModeIntr($21,Regs);
    Result:=AL;
    ClearLogicalRecord := (Result=0);
    { FF No record Found }
   END;
END;

{D5.. [1.0+]}
FUNCTION ClearLogicalRecordSet : Boolean;
{ Unlocks and removes from the table all of the stations logical record locks }
BEGIN
WITH Regs
DO BEGIN
    AH := $D5;
    RealModeIntr($21,Regs);
    Result:=0;
    ClearLogicalRecordSet := True;
  END;
END;


(************* THE FOLLOWING ARE PHYSICAL RECORD LOCK CALLS ****************)

{F:BC..:Lock (& Log) records in a file}
function LogPhysicalRecord(Handle:Word;
                           LockDirective:Byte;
                           RecordOffset,RecordLength:Longint;
                           TimeOutLimit:Word): boolean;
{ Max length of name: 99 chars }
{ LockDirective LD_LOG         = 0;
                LD_LOG_LOCK    = 1;  Deny all access to file/record
                LD_LOG_LOCK_RO = 3;  Allow read / deny write }
{ TimeOut=0 means NoWait; TimeOut not valid if logging only }
{ Handle is the file handle }
begin
with regs
do begin
    AH := $BC;
    AL := LockDirective;
    BX := Handle;
    CX := HiLong(RecordOffset);
    DX := LowLong(RecordOffset);
    BP := TimeOutLimit;
    SI := HiLong(RecordLength);
    DI := LowLong(RecordLength);
    RealModeIntr($21,Regs);
    Result:=AL;
    LogPhysicalRecord := (Result=0);
    { $FF = fail, $FE Timeout, $96 = No dynamic memory }
  end;
end;

{BD.. [1.0+]}
function ReleasePhysicalRecord( Handle:Word; RecordOffset,RecordLength:Longint) : boolean;
{ When a record is released, it is unlocked for use by someone else, but }
{ it remains in the log table }
{ Handle is the file handle, Start_Hi and Start_Lo are the boundaries of }
{ the locked region to be released }
begin
with regs
do begin
    AH := $BD;
    BX := Handle;
    CX := HiLong(RecordOffset);
    DX := LowLong(RecordOffset);
    SI := HiLong(RecordLength);
    DI := LowLong(RecordLength);
    RealModeIntr($21,Regs);
    Result:=AL;
    ReleasePhysicalRecord := (Result=0);
    { $FF = No locked record found}
   end;
end;

{BE.. [1.0+]}
function ClearPhysicalRecord(Handle: Word;
                             RecordOffset,RecordLength:Longint): boolean;
{ Handle is the file handle, Start_Hi and Start_Lo are the boundaries }
{ of the file region to be locked. Clearing a record will unlock it }
{ and remove it from the log table. }
begin
with regs
do begin
    AH := $BE;
    BX := Handle;
    CX := HiLong(RecordOffset);
    DX := LowLong(RecordOffset);
    SI := HiLong(RecordLength);
    DI := LowLong(RecordLength);
    RealModeIntr($21,Regs);
    Result:=AL;
    ClearPhysicalRecord := (Result=0);
    { $FF No locked record found }
   end;
end;

{C2.. [1.0+]}
function LockPhysicalRecordSet(LockDirective: byte; TimeoutLimit: Word): boolean;
{ flgs are the lock flags:  bit 1 set means shared (non-exclusive) lock }
{ Timeout is in 1/18 seconds, 0 = no wait, -1 means indefinite wait }
{ This function attempts to lock all of the records logged in the station's }
{ log table. }
{ LockDirective LD_LOCK        = 0;  Deny all access to file/record
                LD_LOCK_RO     = 1;  Allow read / deny write }
{ !! There is known problem when the locking directive equals 1. }
begin
with regs
do begin
    AH := $C2;
    AL := LockDirective;
    BP := TimeOutLimit;
    RealModeIntr($21,Regs);
    Result:=AL;
    LockPhysicalRecordSet := (Result=0);
    { $FF = fail, $FE = timeout fail }
   end;
end;

{C3.. [1.0+]}
function ReleasePhysicalRecordSet : boolean;
{ unlocks the entire record log table of the station.  records remain in }
{ the log table. }
begin
 regs.AH := $C3;
 RealModeIntr($21,Regs);
 Result:=0;
 ReleasePhysicalRecordSet := True;
end;

{C4.. [1.0+]}
function ClearPhysicalRecordSet : boolean;
{ unlocks and removes from the log table any records logged and locked }
begin
 regs.AH := $C4;
 RealModeIntr($21,Regs);
 Result:=0;
 ClearPhysicalRecordSet := True;
end;


{F217/EF [2.1x+]}
Function GetLogicalRecordLocksByConnection(ConnNbr:word;
                                 {i/o} Var NextRecNbr:word;
                                       Var TaskNbr:word;
                                       Var LockStatus:Byte;
                                       Var LockName:String):Boolean;
{ You need console operator rights to use this function }
Type Treq=record
          len         :Word;
          subFunc     :Byte;
          _ConnNbr    :word; {lo-hi} { !! Invalid numbers may cause an abend }
          _LastRecSeen:word; {lo-hi}
          end;
     Trep=record
          _LastRecSeen :word; {lo-hi}
          _NbrOfRecords:word; {lo-hi}
          _LockInfo    :array[1..508] of byte;
          end;
     TPreq=^Treq;
     TPrep=^Trep;
Begin
WITH TPreq(GlobalReqBuf)^
 do begin
    subFunc:=$EF;
    _ConnNbr:=ConnNbr;
    _LastRecSeen:=NextRecNbr;
    len:=SizeOf(Treq)-2;
    end;
F2SystemCall($17,SizeOf(Treq),SizeOf(Trep),result);
With TPrep(GlobalReplyBuf)^
 do begin
    Move(_LastRecSeen,NextRecNbr,2);


    end;
GetLogicalRecordLocksByConnection:=(result=0)
{ Valid completion codes:
  $00 Success
  $FF Failure
}
end;

{$IFDEF xxxx}

{F217/ [2.1x+]}
Function (   ):Boolean;
Type Treq=record
          len:Word;
          subFunc:Byte;

          end;
     Trep=record

          end;
     TPreq=^Treq;
     TPrep=^Trep;
Begin
WITH TPreq(GlobalReqBuf)^
 do begin
    subFunc:=$

    len:=SizeOf(Treq)-2;
    end;
F2SystemCall($17,SizeOf(Treq),SizeOf(Trep),result);
With TPrep(GlobalReplyBuf)^
 do begin

    end;
  :=(result=0)
{ Valid completion codes:
  $00 Success
  $FF Failure.
}
end;

{$ENDIF}

Begin
SetLockMode(1);
END.