home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 5
/
ctrom5b.zip
/
ctrom5b
/
PROGRAM
/
PASCAL
/
NWTP06
/
NWLOCK.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-03-01
|
20KB
|
663 lines
{$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.