Category : Pascal Source Code
Archive   : TBTREE16.ZIP
Filename : VLOGICAL.PAS

(* TBTree16 Copyright (c) 1988,1989 Dean H. Farwell II *)

unit VLogical;

(*****************************************************************************)
(* *)
(* V A R I A B L E L E N G T H L O G I C A L R E C O R D R O U T I N E S *)
(* *)
(*****************************************************************************)


(* This unit is used to manipulate data files with variable length logical
records (data records). It is much like the LOGICAL unit except that for
this unit a logical record is made of a variable number of bytes. In other
words, every logical record can be a different size. The number of bytes
for a given logical record is determined when the logical record is stored
and updated any time the record is stored again. This differs from the
LOGICAL unit where the size of a logical record was determined when the
record was created. The minimum logical record size is one byte. The
maximum size is MAXDATASIZE (65520 bytes). Depending on the size of
logical and physical records, many logical records could reside in a single
physical record or a logical record could use many physical records. In the
latter case contiguous physical records are used. How logical records are
handled internally is not important to the user.

Notice that most of the routines in this unit have similar counterparts in
the LOGICAL unit. All of the routines in this unit begin with VRL which
stands for Variable Length Records. This will help you differentiate these
routines from those in the LOGICAL unit.

Note - You should never use any of these routines for any files other than
data files with variable length records. However, you can have both fixed
length record data files and variable length record data files in the same
application. *)


(*\*)
(* Version Information

Version 1.1 - Unit did not exist

Version 1.2 - Unit did not exist

Version 1.3 - Unit did not exist

Version 1.4 - Unit did not exist

Version 1.5 - Unit did not exist

Version 1.6 - Unit added *)

(*\*)
(*////////////////////////// I N T E R F A C E //////////////////////////////*)

interface

uses
FastMove,
FileDecs,
Files,
Logical,
LRecList,
Page;

(* This routine will create a variable length record data file with the name
specified by dFName. *)

procedure VLRCreateDataFile(dFName : FnString);


(* This routine will delete a variable length record data file. *)

procedure VLRDeleteDataFile(dFName : FnString);


(* This routine will check for the existence of a particular data record in a
variable length record data file. If the data record is in use, TRUE
will be returned. Otherwise, FALSE will be returned. If this routine is
called with lrNum = 0 then FALSE will be returned since the zeroth logical
record is never a valid logical record. *)

function VLRDataRecordUsed(dFName : FnString;
lrNum : LrNumber) : Boolean;


(* This routine will delete a logical record from a variable length record
data file. If the data record (lrNum) is not in use, then nothing will
happen. No error will occur. *)

procedure VLRDeleteDataRecord(dFName : FnString;
lrNum : lrNumber);

(*\*)
(* This routine will get a logical record from a given variable length record
data file and will put the record into a memory location. The location
will be destination. The number of bytes retrieved is equal to the size of
the logical record which was determined when the record was stored. There
will be a check to ensure that the record is in use. (that it exists). If
it is in use then it is fetched. Otherwise, nothing will be returned in
destination. Before calling this routine, you can check to see if the
logical record exists. If it was retrieved from an index then it exists
(unless the record was deleted and it wasn't deleted from the index). Also,
record numbers which are stored in a logical record list as a result of
GetValidLogicalRecords also exist as long as records were not deleted after
the list was created. If you are not sure whether a logical record exists
you can use VLRDataRecordUsed(dFName,lrNum) to check for the existence of
the record before calling this routine.

Warning : If this routine is called with lrNum = 0 or with lrNum equal to a
record which is not in use no error will occur, but nothing will be passed
back in destination (destination will remain unchanged). You should ensure
that lrNum is not equal to zero prior to calling this routine.

Also, you must ensure that the destination is large enough for the number
of bytes returned (the size of the record). If it is not, something in
memory is going to be overwritten. This will undoubtedly cause a disaster.
You can check the size of the record which will be returned by using the
VLRGetDataRecordSize routine supplied as part of this unit. *)

procedure VLRGetALogicalRecord(dFName : FnString;
lrNum : LrNumber;
var destination);

(*\*)
(* This routine is exactly like VLRGetALogicalRecord except that it will only
retrieve the first part of the record (from the first byte to numOfbytes).
There is no equivalent to this routine in the LOGICAL unit. It is really
designed for internal use, although it is available if you need it. It may
be especially useful if you have a very large variable length record from
which you only need the first few bytes or so. *)

procedure VLRGetPartialLogicalRecord(dFName : FnString;
lrNum : LrNumber;
var destination;
numOfBytes : DataSizeRange);


(* This routine will store a logical record for a given variable length record
data file. The routine will set the logical record to used and will create
the appropriate physical record(s) if required. The logical record size is
size and the data must reside in source. This routine is only used if the
logical record number is known. If a new record is to be stored use
StoreNewLogicalRecord rather than this routine.

Warning : If this routine is called with lrNum = 0 no error will occur, but
nothing will be saved. You should ensure that lrNum is not equal to zero
prior to calling this routine. Also, if size is zero nothing will happen.
This is because it does not make sense to store a record with a size of
zero bytes. *)

procedure VLRStoreALogicalRecord(dFName : FnString;
lrNum : LrNumber;
var source;
size : DataSizeRange);


(* This routine will store a new logical record for a given variable length
record data file. The routine will set the logical record to used and will
create the appropriate physical record(s) if required. Normally, when
inserting new records, you will not know the next unused logical record
number. This routine will assign the appropriate logical record number so
that you won't have to worry about it. The routine will return the logical
record number which will be associated with this record upon return. You
will need this returned logical record number if there are any indexes
associated with this data file. *)

function VLRStoreNewLogicalRecord(dFName : FnString;
var source;
size : DataSizeRange) : LrNumber;


(* This routine will return a list of logical records which are currently in
use (contain valid data) for a given variable length record data file.
This routine is necessary to be able to process all records which have not
been deleted without using an index. *)

procedure VLRGetValidLogicalRecords(dFName : FnString;
var lrLst : LrList);

(*\*)
(* This routine will return the data record size for the given logical record
for the given variable length record data file. If lrNum is not an
existing record, then 0 will be returned. *)

function VLRGetDataRecordSize(dFName : FnString;
lrNum : LrNumber) : DataSizeRange;


(* This routine will return the logical record number for the last logical
record in use in the file (logical record with the highest logical record
number). *)

function VLRLastDataRecord(dFName : FnString) : LrNumber;

(*!*)
(*\*)
(*///////////////////// I M P L E M E N T A T I O N /////////////////////////*)

implementation

type
BytePosition = 1 .. MAXLONGINT; (* byte position within a file *)

FSNumber = RecordNumber; (* used for free space entries *)

FileSpaceInfoRecord = record (* this is used to keep track of the
position and size of a block of space
within a file. The space could either
be free or in use. *)
prNum : PrNumber;
firstByte : PageRange;
size : 0 .. MAXLONGINT; (* this large size is needed since the free
space records can be as large as the
entire file *)
end;

const
RECSINPR = PAGESIZE Div SizeOf(FileSpaceInfoRecord); (* Number of file
space info records
which will fit
into one physical
record *)
type
Direction = (UP,DOWN); (* used to show which direction to
move free space entries *)

FileSpaceArrayRange = 1 .. RECSINPR;

FileSpaceArray = Array [FileSpaceArrayRange] of FileSpaceInfoRecord;
(* used to hold a page worth of file space info records *)

(* These parameters are contained in the first record (0) in the data file

variable parameter type range
-------- --------- ---- -----
userData user data array UserDataArray N/A
version version info VersionString N/A
nextAvail next available lr LrNumber 0 - MAXLONGINT
firstRURec first record used rec PrNumber 0 - MAXLONGINT
firstFSRec first free space rec PrNumber 0 - MAXLONGINT
fType file type FileTypes INDEX,DATA,
LLIST,VLRDATA
lastInUse last lr in use LrNumber 0 - MAXLONGINT
lastFSInUse last free space in use FSNumber 0 - MAXLONGINT *)

type
ParameterRecord = record
userData : UserDataArray; (* for use by users *)
version : VersionString; (* version of TBTREE used
to create data file *)
nextAvail : LrNumber; (* Next data record available *)
firstRURec : PrNumber; (* first record use record *)
firstFSRec : PrNumber; (* first free space record *)
fType : FileTypes; (* type of file *)
lastInUse : LrNumber; (* Last data record in use (not
last record in file *)
lastFSInUse : FSNumber; (* Last free space entry *)
end;

(*\*)
(* This routine will create a variable length record data file with the name
specified by dFName. *)

procedure VLRCreateDataFile(dFName : FnString);

var
pRec : ParameterRecord;
page : SinglePage;

begin
CreateGenericFile(dFName);
FillChar(page,PAGESIZE,0);
StorePage(dFName,0,page); (* parameter record *)
StorePage(dFName,1,page); (* record use record *)
StorePage(dFName,2,page); (* free space record *)
pRec.version := CURRENTVERSION;
pRec.nextAvail := 1;
pRec.firstRURec := 1;
pRec.firstFSRec := 2;
pRec.fType := VLRDATA;
pRec.lastInUse := 0;
pRec.lastFSInUse := 0;
SaveFileParameters(dFName,pRec,SizeOf(pRec)); (* write parameters
back to buffer *)
end; (* end of VLRCreateDataFile routine *)


(* This routine will delete a variable length record data file. *)

procedure VLRDeleteDataFile(dFName : FnString);

begin
DeleteGenericFile(dFName);
end; (* end of VLRDeleteDataFile routine *)

(*\*)
(* This routine will return TRUE if the record is in use and will return FALSE
otherwise. If the record is in use, the record use record will also be
returned. *)

function FetchRecordUseRecord(var dFName : FnString; (* var for speed only *)
lrNum : LrNumber;
var pRec : ParameterRecord; (* var for speed
only *)
var recUseRec : FileSpaceInfoRecord) : Boolean;

var
prNum : PrNumber;
byteNum : PageRange;
page : SinglePage;

begin
if (lrNum > pRec.lastInUse) or (lrNum = 0) then
begin
FetchRecordUseRecord := FALSE;
end
else
begin
prNum := ((lrNum - 1) Div RECSINPR) + pRec.firstRURec;
byteNum := (((lrNum - 1) Mod RECSINPR) * SizeOf(recUseRec)) + 1;
FetchPage(dFName,prNum,page);
FastMover(page[byteNum],recUseRec,SizeOf(recUseRec));
FetchRecordUseRecord := recUseRec.size <> 0;(* zero denotes not used *)
end;
end; (* end of FetchRecordUseRecord routine *)

(*\*)
(* This routine will store the record use record. It will create a new
record use record in the file if one is required. pRec will be returned
with updates if any occured. *)

procedure StoreRecordUseRecord(var dFName : FnString; (* var for speed only *)
lrNum : LrNumber;
var pRec : ParameterRecord;
recUseRec : FileSpaceInfoRecord);

var
prNum : PrNumber;
byteNum : PageRange;
page : SinglePage;
lastFSRec : PrNumber;

begin
prNum := ((lrNum - 1) Div RECSINPR) + pRec.firstRURec;
byteNum := (((lrNum - 1) Mod RECSINPR) * SizeOf(recUseRec)) + 1;
if prNum = pRec.firstFSRec then
begin (* move down the free space recs and create new rec use rec *)
FillChar(page,PAGESIZE,0);
lastFSRec := ((pRec.lastFSInUse - 1) Div RECSINPR) + pRec.firstFSRec;
MoveRecords(dFName,pRec.firstFSRec,lastFSRec,1);
end
else
begin
FetchPage(dFName,prNum,page);
end;
FastMover(recUseRec,page[byteNum],SizeOf(recUseRec));
StorePage(dFName,prNum,page);
end; (* end of StoreRecordUseRecord routine *)

(*\*)
(* This routine will return the free space entry record. It does not check to
ensure that fsNum is valid before retrieving the free space record. That
step is not required since this will be called only for values of fsNum
which are valid. *)

procedure FetchFreeSpaceEntry(var dFName : FnString; (* var for speed only *)
fsNum : FSNumber;
var pRec : ParameterRecord; (* var for speed
only *)
var fsRec : FileSpaceInfoRecord);

var
prNum : PrNumber;
byteNum : PageRange;
page : SinglePage;

begin
prNum := ((fsNum - 1) Div RECSINPR) + pRec.firstFSRec;
byteNum := (((fsNum - 1) Mod RECSINPR) * SizeOf(fsRec)) + 1;
FetchPage(dFName,prNum,page);
FastMover(page[byteNum],fsRec,SizeOf(fsRec));
end; (* end of FetchFreeSpaceEntry routine *)


(* This routine will store the free space record. It will create a new free
space record if one is required. pRec will be returned with updates if any
occured. *)

procedure StoreFreeSpaceEntry(var dFName : FnString; (* var for speed only *)
fsNum : FSNumber;
var pRec : ParameterRecord;
fsRec : FileSpaceInfoRecord);

var
prNum : PrNumber;
byteNum : PageRange;
page : SinglePage;

begin
prNum := ((fsNum - 1) Div RECSINPR) + pRec.firstFSRec;
byteNum := (((fsNum - 1) Mod RECSINPR) * SizeOf(fsRec)) + 1;
if (fsNum > pRec.lastFSInUse) and
((fsNum Mod RECSINPR) = 1) and
(fsNum <> 1) then
begin
FillChar(page,PAGESIZE,0); (* create new free space record *)
end
else
begin
FetchPage(dFName,prNum,page);
end;
FastMover(fsRec,page[byteNum],SizeOf(fsRec));
StorePage(dFName,prNum,page);
if fsNum > pRec.lastFSInUse then
begin
pRec.lastFSInUse := FSNum;
end;
end; (* end of StoreFreeSpaceEntry routine *)

(*\*)
(* This routine will move free space entries up (deleting one) or down
(making room for one). pRec is modified and returned. *)

procedure MoveFreeSpaceEntries(var dFName : FnString; (* var for speed only *)
fsNum : FSNumber;
dir : Direction;
var pRec : ParameterRecord);

var
fsRec : FileSpaceInfoRecord;
cnt : fsNumber;

begin
case dir of
UP :
begin
for cnt := fsNum + 1 to pRec.lastFSInUse do
begin
FetchFreeSpaceEntry(dFName,cnt,pRec,fsRec);
StoreFreeSpaceEntry(dFName,cnt - 1,pRec,fsRec);
end;
FillChar(fsRec,SizeOf(fsRec),0);
StoreFreeSpaceEntry(dFName,pRec.lastFSInUse,pRec,fsRec);
Dec(pRec.lastFSInUse);
end;
DOWN :
begin
for cnt := pRec.lastFSInUse downto fsNum do
begin
FetchFreeSpaceEntry(dFName,cnt,pRec,fsRec);
StoreFreeSpaceEntry(dFName,cnt + 1,pRec,fsRec);
end;
end;
end; (* end of case statement *)
end; (* end of MoveFreeSpaceEntries routine *)


(* This routine will calculate the byte position within a file (relative to
first byte = 1) for the given file space info record. This assumes prNum=1
for first record *)

function BytePositionInFile(fSpaceRec : FileSpaceInfoRecord) : BytePosition;

begin
BytePositionInFile := ((fSpaceRec.prNum - 1) * PAGESIZE) +
fSpaceRec.firstByte;
end; (* end of BytePositionInFile routine *)


(*\*)
(* This routine will make mark space within a file as being free. It will do
this by seeing if this space is adjacent to any existing space. If it is,
then it will be combined with the existing free space. If the neighboring
space is not free, then a new free space entry will be created and stored.*)

procedure AddFreeSpace(var dFName : FnString; (* var for speed only *)
var pRec : ParameterRecord;
newFsRec : FileSpaceInfoRecord);

var
fsRec : FileSpaceInfoRecord;
fsNum : FSNumber;
done,
combined : Boolean;

begin
fsNum := pRec.lastFSInUse;
while not done do
begin (* search right to left for first entry left of new entry *)
if fsNum = 0 then
begin
done := TRUE;
end
else
begin
FetchFreeSpaceEntry(dFName,fsNum,pRec,fsRec);
if (BytePositionInFile(fsRec) < BytePositionInFile(newFsRec)) then
begin
done := TRUE
end
else
begin
Dec(fsNum);
end;
end;
end;
combined := FALSE;
(* now try to combine new entry with entry on left *)
if (fsNum <> 0) and
(BytePositionInFile(fsRec) + fsRec.size =
BytePositionInFile(newFsRec)) then
begin
Inc(fsRec.size,newFsRec.size);
StoreFreeSpaceEntry(dFName,fsNum,pRec,fsRec);
combined := TRUE;
end;
(* now try to combine new entry with entry on right *)
if (fsNum <> pRec.lastFSInUse) then
begin (* right entry exist so continue *)
FetchFreeSpaceEntry(dFName,fsNum + 1,pRec,fsRec);
if (BytePositionInFile(newFsRec) + newFsRec.size =
BytePositionInFile(fsRec)) then
begin
if combined then
begin (* left, new and right entries all contiguous *)
FetchFreeSpaceEntry(dFName,fsNum,pRec,newFsRec);
Inc(newFsRec.size,fsRec.size);
StoreFreeSpaceEntry(dFName,fsNum,pRec,newFsRec);
MoveFreeSpaceEntries(dFName,fsNum + 1,UP,pRec);
end
else
begin
fsRec.prNum := newFsRec.prNum;
fsRec.firstByte := newFsRec.firstByte;
Inc(fsRec.size,newFsRec.size);
StoreFreeSpaceEntry(dFName,fsNum + 1,pRec,fsRec);
combined := TRUE;
end;
end;
end;
if not combined then
begin (* new free space not contiguous with any existing space *)
MoveFreeSpaceEntries(dFName,fsNum + 1,DOWN,pRec);
StoreFreeSpaceEntry(dFName,fsNum + 1,pRec,newFsRec);
end;
end; (* end of AddFreeSpace routine *)

(*\*)
(* This routine will allocate space in the variable length record file so that
a record can be stored. It will do this by starting at the end of the free
space entries and searching backwards until the first free space entry of
sufficient size is found. If none is found, it will move down the record
use records and free space records to make room in the file. The recUseRec
is passed back with the allocated space. *)

procedure GetSpaceForRecord(var dFName : FnString; (* var for speed only *)
size : DataSizeRange;
var pRec : ParameterRecord;
var recUseRec : FileSpaceInfoRecord);

var
fsRec : FileSpaceInfoRecord;
lastFSRec,
recsToMove : PrNumber;
fsNum : FSNumber;

begin
for fsNum := pRec.lastFSInUse downto 1 do
begin
FetchFreeSpaceEntry(dFName,fsNum,pRec,fsRec);
if fsRec.size >= size then
begin (* free space found *)
recUseRec.prNum := fsRec.prNum;
recUseRec.firstByte := fsRec.firstByte;
recUseRec.size := size;
if fsRec.size = size then
begin (* perfect fit *)
MoveFreeSpaceEntries(dFName,fsNum,UP,pRec);
end
else
begin (* too big .. space left over is still free *)
Inc(fsRec.prNum,
(((recUseRec.firstByte - 1) + size) Div PAGESIZE));
fsRec.firstbyte := ((recUseRec.firstByte + (size - 1)) MOD
PAGESIZE) + 1;
Dec(fsRec.size,size);
StoreFreeSpaceEntry(dFName,fsNum,pRec,fsRec);
end;
Exit; (* free space found and allocated so return *)
end;
end;
(* apparently there is no free space big
enough to fit the record therefore extend
the file *)
recsToMove := ((size - 1) Div PAGESIZE) + 1;
fsRec.prNum := pRec.firstRURec;
fsRec.firstByte := 1;
fsRec.size := recsToMove * PAGESIZE;
lastFSRec := ((pRec.lastFSInUse - 1) Div RECSINPR) + pRec.firstFSRec;
MoveRecords(dFName,pRec.firstRURec,lastFSRec,recsToMove);
Inc(pRec.firstFSRec,recsToMove);
AddFreeSpace(dFName,pRec,fsRec);
GetSpaceForRecord(dFName,size,pRec,recUseRec); (* recursive call *)
end; (* end of GetSpaceForRecord routine *)

(*\*)
(* This routine will return the record number for the first unused data record
(logical record) from a variable length record data file. *)

function VLRFirstUnusedDataRecord(var dFName : FnString;
(* var for speed only *)
var pRec : ParameterRecord) : LrNumber;

var
recUseRec : FileSpaceInfoRecord;
done : Boolean;

begin
VLRFirstUnUsedDataRecord := pRec.nextAvail; (* record number to return *)
done := FALSE;
while not done do
begin
Inc(pRec.nextAvail);
done := (not FetchRecordUseRecord(dFName,
pRec.nextAvail,
pRec,
recUseRec));
end;
end; (* end of FirstUnusedDataRecord routine *)


(* This routine will check for the existence of a particular data record in a
variable length record data file. If the data record is in use, TRUE
will be returned. Otherwise, FALSE will be returned. If this routine is
called with lrNum = 0 then FALSE will be returned since the zeroth logical
record is never a valid logical record. *)

function VLRDataRecordUsed(dFName : FnString;
lrNum : LrNumber) : Boolean;

var
pRec : ParameterRecord;
recUseRec : FileSpaceInfoRecord;

begin
FetchFileParameters(dFName,pRec,SizeOf(pRec));
VLRDataRecordUsed := FetchRecordUseRecord(dFName,lrNum,pRec,recUseRec);
end; (* end of VLRDataRecordUsed routine *)

(*\*)
(* This routine will delete a logical record from a variable length record
data file. If the data record (lrNum) is not in use, then nothing will
happen. No error will occur. *)

procedure VLRDeleteDataRecord(dFName : FnString;
lrNum : lrNumber);

var
pRec : ParameterRecord;
page : SinglePage;
recUseRec,
fsRec : FileSpaceInfoRecord;

begin
FetchFileParameters(dFName,pRec,SizeOf(pRec));
if FetchRecordUseRecord(dFName,lrNum,pRec,recUseRec) then
begin
fsRec := recUseRec;
FillChar(recUseRec,SizeOf(recUseRec),0);
StoreRecordUseRecord(dFName,lrNum,pRec,recUseRec); (* mark as unused *)
if lrNum < pRec.nextAvail then
begin
pRec.nextAvail := lrNum;
end;
if lrNum = pRec.lastInUse then
begin
{$B-} (* next statement depends on short circuit
boolean expression evaluation *)
while (pRec.lastInUse <> 0) and
(not FetchRecordUseRecord(dFName,
pRec.lastInUse,pRec,
recUseRec)) do
begin
Dec(pRec.lastInUse);
end;
end;
AddFreeSpace(dFName,pRec,fsRec);
SaveFileParameters(dFName,pRec,SizeOf(pRec));
end;
end; (* end of VLRDeleteDataRecord routine *)

(*\*)
(* This routine will get a logical record from a given variable length record
data file and will put the record into a memory location. The location
will be destination. The number of bytes retrieved is equal to the size of
the logical record which was determined when the record was stored. There
will be a check to ensure that the record is in use. (that it exists). If
it is in use then it is fetched. Otherwise, nothing will be returned in
destination. Before calling this routine, you can check to see if the
logical record exists. If it was retrieved from an index then it exists
(unless the record was deleted and it wasn't deleted from the index). Also,
record numbers which are stored in a logical record list as a result of
GetValidLogicalRecords also exist as long as records were not deleted after
the list was created. If you are not sure whether a logical record exists
you can use VLRDataRecordUsed(dFName,lrNum) to check for the existence of
the record before calling this routine.

Warning : If this routine is called with lrNum = 0 or with lrNum equal to a
record which is not in use no error will occur, but nothing will be passed
back in destination (destination will remain unchanged). You should ensure
that lrNum is not equal to zero prior to calling this routine.

Also, you must ensure that the destination is large enough for the number
of bytes returned (the size of the record). If it is not, something in
memory is going to be overwritten. This will undoubtedly cause a disaster.
You can check the size of the record which will be returned by using the
VLRGetDataRecordSize routine supplied as part of this unit. *)

procedure VLRGetALogicalRecord(dFName : FnString;
lrNum : LrNumber;
var destination);

type
MemoryArray = Array [1 .. MAXDATASIZE] of Byte;

var
pRec : ParameterRecord;
recUseRec : FileSpaceInfoRecord;
prNum : PrNumber;
bytesToMove,
firstByte : PageRange;
page : SinglePage;
bytesLeft,
byteCnt : DataSizeRange;
memory : MemoryArray absolute destination;

begin
FetchFileParameters(dFName,pRec,SizeOf(pRec));
if FetchRecordUseRecord(dFName,lrNum,pRec,recUseRec) then
begin
prNum := recUseRec.prNum;
firstByte := recUseRec.firstByte;
bytesLeft := recUseRec.size;
byteCnt := 1;
while bytesLeft <> 0 do (* loop until complete record is copied *)
begin
FetchPage(dFName,prNum,page);
bytesToMove := (PAGESIZE - firstByte) + 1;
if bytesToMove > bytesLeft then
begin
bytesToMove := bytesLeft;
end;
FastMover(page[firstByte],memory[byteCnt],bytesToMove);
Inc(prNum);
firstByte := 1;
Dec(bytesLeft,bytesToMove);
Inc(byteCnt,bytesToMove);
end;
end;
end; (* end of VLRGetALogicalRecord routine *)

(*\*)
(* This routine is exactly like VLRGetALogicalRecord except that it will only
retrieve the first part of the record (from the first byte to numOfbytes).
There is no equivalent to this routine in the LOGICAL unit. It is really
designed for internal use, although it is available if you need it. It may
be especially useful if you have a very large variable length record from
which you only need the first few bytes or so. *)

procedure VLRGetPartialLogicalRecord(dFName : FnString;
lrNum : LrNumber;
var destination;
numOfBytes : DataSizeRange);

type
MemoryArray = Array [1 .. MAXDATASIZE] of Byte;

var
pRec : ParameterRecord;
recUseRec : FileSpaceInfoRecord;
prNum : PrNumber;
bytesToMove,
firstByte : PageRange;
page : SinglePage;
bytesLeft,
byteCnt : DataSizeRange;
memory : MemoryArray absolute destination;

begin
FetchFileParameters(dFName,pRec,SizeOf(pRec));
if FetchRecordUseRecord(dFName,lrNum,pRec,recUseRec) then
begin
prNum := recUseRec.prNum;
firstByte := recUseRec.firstByte;
bytesLeft := numOfBytes;
byteCnt := 1;
while bytesLeft <> 0 do (* loop until complete record is copied *)
begin
FetchPage(dFName,prNum,page);
bytesToMove := (PAGESIZE - firstByte) + 1;
if bytesToMove > bytesLeft then
begin
bytesToMove := bytesLeft;
end;
FastMover(page[firstByte],memory[byteCnt],bytesToMove);
Inc(prNum);
firstByte := 1;
Dec(bytesLeft,bytesToMove);
Inc(byteCnt,bytesToMove);
end;
end;
end; (* end of VLRGetPartialLogicalRecord routine *)

(*\*)
(* This routine will store a logical record for a given variable length record
data file. The routine will set the logical record to used and will create
the appropriate physical record(s) if required. The logical record size is
size and the data must reside in source. This routine is only used if the
logical record number is known. If a new record is to be stored use
StoreNewLogicalRecord rather than this routine.

Warning : If this routine is called with lrNum = 0 no error will occur, but
nothing will be saved. You should ensure that lrNum is not equal to zero
prior to calling this routine. Also, if size is zero nothing will happen.
This is because it does not make sense to store a record with a size of
zero bytes. *)

procedure VLRStoreALogicalRecord(dFName : FnString;
lrNum : LrNumber;
var source;
size : DataSizeRange);

type
MemoryArray = Array [1 .. MAXDATASIZE] of Byte;

var
pRec : ParameterRecord;
recUseRec : FileSpaceInfoRecord;
prNum : PrNumber;
bytesToMove,
firstByte : PageRange;
page : SinglePage;
bytesLeft,
byteCnt : DataSizeRange;
memory : MemoryArray absolute source;

begin
if (lrNum <> 0) and (size <> 0) then (* make sure that lrNum <> 0 else do
nothing -- also ensure that size
is a valid number else do
nothing *)

begin
FetchFileParameters(dFName,pRec,SizeOf(pRec));
if FetchRecordUseRecord(dFName,lrNum,pRec,recUseRec) then
begin
if recUseRec.size <> size then
begin
VLRDeleteDataRecord(dFName,lrNum);
FetchFileParameters(dFName,pRec,SizeOf(pRec));
GetSpaceForRecord(dFName,size,pRec,recUseRec);
end;
end
else
begin
GetSpaceForRecord(dFName,size,pRec,recUseRec);
end;
StoreRecordUseRecord(dFName,lrNum,pRec,recUseRec);
prNum := recUseRec.prNum;
firstByte := recUseRec.firstByte;
bytesLeft := size;
byteCnt := 1;
while bytesLeft <> 0 do
begin
FetchPage(dFName,prNum,page);
bytesToMove := (PAGESIZE - firstByte) + 1;
if bytesToMove > bytesLeft then
begin
bytesToMove := bytesLeft;
end;
FastMover(memory[byteCnt],page[firstByte],bytesToMove);
StorePage(dFName,prNum,page);
Inc(prNum);
firstByte := 1;
Dec(bytesLeft,bytesToMove);
Inc(byteCnt,bytesToMove);
end;
if pRec.lastInUse < lrNum then
begin
pRec.lastInUse := lrNum;
end;
SaveFileParameters(dFName,pRec,SizeOf(pRec));
end;
end; (* end of VLRStoreALogicalRecord routine *)

(*\*)
(* This routine will store a new logical record for a given variable length
record data file. The routine will set the logical record to used and will
create the appropriate physical record(s) if required. Normally, when
inserting new records, you will not know the next unused logical record
number. This routine will assign the appropriate logical record number so
that you won't have to worry about it. The routine will return the logical
record number which will be associated with this record upon return. You
will need this returned logical record number if there are any indexes
associated with this data file. *)

function VLRStoreNewLogicalRecord(dFName : FnString;
var source;
size : DataSizeRange) : LrNumber;

var
pRec : ParameterRecord;
lrNum : LrNumber;

begin
FetchFileParameters(dFName,pRec,SizeOf(pRec));
lrNum := VLRFirstUnUsedDataRecord(dFName,pRec);
SaveFileParameters(dFName,pRec,SizeOf(pRec));
VLRStoreALogicalRecord(dFName,lrNum,source,size);
VLRStoreNewLogicalRecord := lrNum;
end; (* end of VLRStoreNewLogicalRecord routine *)


(* This routine will return a list of logical records which are currently in
use (contain valid data) for a given variable length record data file.
This routine is necessary to be able to process all records which have not
been deleted without using an index. *)

procedure VLRGetValidLogicalRecords(dFName : FnString;
var lrLst : LrList);

var
pRec : ParameterRecord;
recUseRec : FileSpaceInfoRecord; (* dummy parameter needed in
procedure call *)
lrNum : LrNumber;

begin
FetchFileParameters(dFName,pRec,SizeOf(pRec));
CreateLrList(lrLst);
for lrNum := 1 to pRec.lastInUse do (* will do nothing if file empty
because if file is empty, then
pRec.lastInUse = 0 *)
begin
if FetchRecordUseRecord(dFName,lrNum,pRec,recUseRec) then
begin
AddToLrList(lrNum,lrLst);
end;
end;
end; (* end of VLRGetValidLogicalRecords routine *)

(*\*)
(* This routine will return the data record size for the given logical record
for the given variable length record data file. If lrNum is not an
existing record, then 0 will be returned. *)

function VLRGetDataRecordSize(dFName : FnString;
lrNum : LrNumber) : DataSizeRange;

var
pRec : ParameterRecord;
recUseRec : FileSpaceInfoRecord;

begin
FetchFileParameters(dFName,pRec,SizeOf(pRec));
if FetchRecordUseRecord(dFName,lrNum,pRec,recUseRec) then
begin
VLRGetDataRecordSize := recUseRec.size;
end
else
begin
VLRGetDataRecordSize := 0;
end;
end; (* end of VLRGetDataRecordSize routine *)


(* This routine will return the logical record number for the last logical
record in use in the file (logical record with the highest logical record

number). *)

function VLRLastDataRecord(dFName : FnString) : LrNumber;

var
pRec : ParameterRecord;

begin
FetchFileParameters(dFName,pRec,SizeOf(pRec));
VLRLastDataRecord := pRec.lastInUse;
end; (* end of VLRLastDataRecord routine *)


end. (* end of Logical unit *)