home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TPTREE16.ZIP / VLOGICAL.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1989-07-13  |  41.4 KB  |  993 lines
  1. (* TBTree16             Copyright (c)  1988,1989       Dean H. Farwell II    *)
  2.  
  3. unit VLogical;
  4.  
  5. (*****************************************************************************)
  6. (*                                                                           *)
  7. (* 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 *)
  8. (*                                                                           *)
  9. (*****************************************************************************)
  10.  
  11.  
  12. (* This unit is used to manipulate data files with variable length logical
  13.    records (data records).  It is much like the LOGICAL unit except that for
  14.    this unit a logical record is made of a variable number of bytes.  In other
  15.    words, every logical record can be a different size.  The number of bytes
  16.    for a given logical record is determined when the logical record is stored
  17.    and updated any time the record is stored again.  This differs from the
  18.    LOGICAL unit where the size of a logical record was determined when the
  19.    record was created.  The minimum logical record size is one byte.  The
  20.    maximum size is MAXDATASIZE (65520 bytes).  Depending on the size of
  21.    logical and physical records, many logical records could reside in a single
  22.    physical record or a logical record could use many physical records. In the
  23.    latter case contiguous physical records are used.  How logical records are
  24.    handled internally is not important to the user.
  25.  
  26.    Notice that most of the routines in this unit have similar counterparts in
  27.    the LOGICAL unit.  All of the routines in this unit begin with VRL which
  28.    stands for Variable Length Records.  This will help you differentiate these
  29.    routines from those in the LOGICAL unit.
  30.  
  31.    Note - You should never use any of these routines for any files other than
  32.    data files with variable length records.  However, you can have both fixed
  33.    length record data files and variable length record data files in the same
  34.    application.                                                              *)
  35.  
  36.  
  37. (*\*)
  38. (* Version Information
  39.  
  40.    Version 1.1 - Unit did not exist
  41.  
  42.    Version 1.2 - Unit did not exist
  43.  
  44.    Version 1.3 - Unit did not exist
  45.  
  46.    Version 1.4 - Unit did not exist
  47.  
  48.    Version 1.5 - Unit did not exist
  49.  
  50.    Version 1.6 - Unit added                                                  *)
  51.  
  52. (*\*)
  53. (*////////////////////////// I N T E R F A C E //////////////////////////////*)
  54.  
  55. interface
  56.  
  57. uses
  58.     FastMove,
  59.     FileDecs,
  60.     Files,
  61.     Logical,
  62.     LRecList,
  63.     Page;
  64.  
  65. (* This routine will create a variable length record data file with the name
  66.    specified by dFName.                                                      *)
  67.  
  68. procedure VLRCreateDataFile(dFName : FnString);
  69.  
  70.  
  71. (* This routine will delete a variable length record data file.              *)
  72.  
  73. procedure VLRDeleteDataFile(dFName : FnString);
  74.  
  75.  
  76. (* This routine will check for the existence of a particular data record in a
  77.    variable length record data file.  If the data record is in use, TRUE
  78.    will be returned.  Otherwise, FALSE will be returned.  If this routine is
  79.    called with lrNum = 0 then FALSE will be returned since the zeroth logical
  80.    record is never a valid logical record.                                   *)
  81.  
  82. function VLRDataRecordUsed(dFName : FnString;
  83.                            lrNum : LrNumber) : Boolean;
  84.  
  85.  
  86. (* This routine will delete a logical record from a variable length record
  87.    data file.  If the data record (lrNum) is not in use, then nothing will
  88.    happen.  No error will occur.                                             *)
  89.  
  90. procedure VLRDeleteDataRecord(dFName : FnString;
  91.                               lrNum : lrNumber);
  92.  
  93. (*\*)
  94. (* This routine will get a logical record from a given variable length record
  95.    data file and will put the record into a memory location.  The location
  96.    will be destination.  The number of bytes retrieved is equal to the size of
  97.    the logical record which was determined when the record was stored.  There
  98.    will be a check to ensure that the record is in use. (that it exists). If
  99.    it is in use then it is fetched.  Otherwise, nothing will be returned in
  100.    destination.  Before calling this routine, you can check to see if the
  101.    logical record exists.  If it was retrieved from an index then it exists
  102.    (unless the record was deleted and it wasn't deleted from the index).  Also,
  103.    record numbers which are stored in a logical record list as a result of
  104.    GetValidLogicalRecords also exist as long as records were not deleted after
  105.    the list was created.  If you are not sure whether a logical record exists
  106.    you can use VLRDataRecordUsed(dFName,lrNum) to check for the existence of
  107.    the record before calling this routine.
  108.  
  109.    Warning : If this routine is called with lrNum = 0 or with lrNum equal to a
  110.    record which is not in use no error will occur, but nothing will be passed
  111.    back in destination (destination will remain unchanged).  You should ensure
  112.    that lrNum is not equal to zero prior to calling this routine.
  113.  
  114.    Also, you must ensure that the destination is large enough for the number
  115.    of bytes returned (the size of the record).  If it is not, something in
  116.    memory is going to be overwritten.  This will undoubtedly cause a disaster.
  117.    You can check the size of the record which will be returned by using the
  118.    VLRGetDataRecordSize routine supplied as part of this unit.               *)
  119.  
  120. procedure VLRGetALogicalRecord(dFName : FnString;
  121.                                lrNum : LrNumber;
  122.                                var destination);
  123.  
  124. (*\*)
  125. (* This routine is exactly like VLRGetALogicalRecord except that it will only
  126.    retrieve the first part of the record (from the first byte to numOfbytes).
  127.    There is no equivalent to this routine in the LOGICAL unit.  It is really
  128.    designed for internal use, although it is available if you need it.  It may
  129.    be especially useful if you have a very large variable length record from
  130.    which you only need the first few bytes or so.                            *)
  131.  
  132. procedure VLRGetPartialLogicalRecord(dFName : FnString;
  133.                                      lrNum : LrNumber;
  134.                                      var destination;
  135.                                      numOfBytes : DataSizeRange);
  136.  
  137.  
  138. (* This routine will store a logical record for a given variable length record
  139.    data file.  The routine will set the logical record to used and will create
  140.    the appropriate physical record(s) if required.  The logical record size is
  141.    size and the data must reside in source.  This routine is only used if the
  142.    logical record number is known.  If a new record is to be stored use
  143.    StoreNewLogicalRecord rather than this routine.
  144.  
  145.    Warning : If this routine is called with lrNum = 0 no error will occur, but
  146.    nothing will be saved.  You should ensure that lrNum is not equal to zero
  147.    prior to calling this routine.  Also, if size is zero nothing will happen.
  148.    This is because it does not make sense to store a record with a size of
  149.    zero bytes.                                                               *)
  150.  
  151. procedure VLRStoreALogicalRecord(dFName : FnString;
  152.                                  lrNum : LrNumber;
  153.                                  var source;
  154.                                  size : DataSizeRange);
  155.  
  156.  
  157. (* This routine will store a new logical record for a given variable length
  158.    record data file.  The routine will set the logical record to used and will
  159.    create the appropriate physical record(s) if required.  Normally, when
  160.    inserting new records, you will not know the next unused logical record
  161.    number.  This routine will assign the appropriate logical record number so
  162.    that you won't have to worry about it. The routine will return the logical
  163.    record number which will be associated with this record upon return.  You
  164.    will need this returned logical record number if there are any indexes
  165.    associated with this data file.                                           *)
  166.  
  167. function VLRStoreNewLogicalRecord(dFName : FnString;
  168.                                   var source;
  169.                                   size : DataSizeRange) : LrNumber;
  170.  
  171.  
  172. (* This routine will return a list of logical records which are currently in
  173.    use (contain valid data) for a given variable length record data file.
  174.    This routine is necessary to be able to process all records which have not
  175.    been deleted without using an index.                                      *)
  176.  
  177. procedure VLRGetValidLogicalRecords(dFName : FnString;
  178.                                     var lrLst : LrList);
  179.  
  180. (*\*)
  181. (* This routine will return the data record size for the given logical record
  182.    for the given variable length record data file.  If lrNum is not an
  183.    existing record, then 0 will be returned.                                 *)
  184.  
  185. function VLRGetDataRecordSize(dFName : FnString;
  186.                               lrNum : LrNumber) : DataSizeRange;
  187.  
  188.  
  189. (* This routine will return the logical record number for the last logical
  190.    record in use in the file (logical record with the highest logical record
  191.    number).                                                                  *)
  192.  
  193. function VLRLastDataRecord(dFName : FnString) : LrNumber;
  194.  
  195. (*!*)
  196. (*\*)
  197. (*///////////////////// I M P L E M E N T A T I O N /////////////////////////*)
  198.  
  199. implementation
  200.  
  201. type
  202.     BytePosition = 1 .. MAXLONGINT;           (* byte position within a file *)
  203.  
  204.     FSNumber = RecordNumber;       (* used for free space entries            *)
  205.  
  206.     FileSpaceInfoRecord = record   (* this is used to keep track of the
  207.                                       position and size of a block of space
  208.                                       within a file.  The space could either
  209.                                       be free or in use.                     *)
  210.         prNum : PrNumber;
  211.         firstByte : PageRange;
  212.         size : 0 .. MAXLONGINT;   (* this large size is needed since the free
  213.                                      space records can be as large as the
  214.                                      entire file *)
  215.         end;
  216.  
  217. const
  218.     RECSINPR = PAGESIZE Div SizeOf(FileSpaceInfoRecord); (* Number of file
  219.                                                             space info records
  220.                                                             which will fit
  221.                                                             into one physical
  222.                                                             record           *)
  223. type
  224.     Direction = (UP,DOWN);                 (* used to show which direction to
  225.                                               move free space entries        *)
  226.  
  227.     FileSpaceArrayRange = 1 .. RECSINPR;
  228.  
  229.     FileSpaceArray = Array [FileSpaceArrayRange] of FileSpaceInfoRecord;
  230.                      (* used to hold a page worth of file space info records *)
  231.  
  232. (* These parameters are contained in the first record (0) in the data file
  233.  
  234.      variable        parameter                 type         range
  235.      --------        ---------                 ----         -----
  236.       userData       user data array        UserDataArray   N/A
  237.       version        version info           VersionString   N/A
  238.       nextAvail      next available lr      LrNumber        0 - MAXLONGINT
  239.       firstRURec     first record used rec  PrNumber        0 - MAXLONGINT
  240.       firstFSRec     first free space rec   PrNumber        0 - MAXLONGINT
  241.       fType          file type              FileTypes       INDEX,DATA,
  242.                                                             LLIST,VLRDATA
  243.       lastInUse      last lr in use         LrNumber        0 - MAXLONGINT
  244.       lastFSInUse    last free space in use FSNumber        0 - MAXLONGINT   *)
  245.  
  246. type
  247.     ParameterRecord = record
  248.          userData    : UserDataArray;                    (* for use by users *)
  249.          version     : VersionString;              (* version of TBTREE used
  250.                                                          to create data file *)
  251.          nextAvail   : LrNumber;               (* Next data record available *)
  252.          firstRURec  : PrNumber;                  (* first record use record *)
  253.          firstFSRec  : PrNumber;                  (* first free space record *)
  254.          fType       : FileTypes;                            (* type of file *)
  255.          lastInUse   : LrNumber;             (* Last data record in use (not
  256.                                                 last record in file          *)
  257.          lastFSInUse : FSNumber;                    (* Last free space entry *)
  258.          end;
  259.  
  260. (*\*)
  261. (* This routine will create a variable length record data file with the name
  262.    specified by dFName.                                                      *)
  263.  
  264. procedure VLRCreateDataFile(dFName : FnString);
  265.  
  266. var
  267.     pRec : ParameterRecord;
  268.     page : SinglePage;
  269.  
  270.     begin
  271.     CreateGenericFile(dFName);
  272.     FillChar(page,PAGESIZE,0);
  273.     StorePage(dFName,0,page);                            (* parameter record *)
  274.     StorePage(dFName,1,page);                           (* record use record *)
  275.     StorePage(dFName,2,page);                           (* free space record *)
  276.     pRec.version := CURRENTVERSION;
  277.     pRec.nextAvail  := 1;
  278.     pRec.firstRURec := 1;
  279.     pRec.firstFSRec  := 2;
  280.     pRec.fType := VLRDATA;
  281.     pRec.lastInUse  := 0;
  282.     pRec.lastFSInUse  := 0;
  283.     SaveFileParameters(dFName,pRec,SizeOf(pRec));        (* write parameters
  284.                                                             back to buffer   *)
  285.     end;                                 (* end of VLRCreateDataFile routine *)
  286.  
  287.  
  288. (* This routine will delete a variable length record data file.              *)
  289.  
  290. procedure VLRDeleteDataFile(dFName : FnString);
  291.  
  292.     begin
  293.     DeleteGenericFile(dFName);
  294.     end;                                 (* end of VLRDeleteDataFile routine *)
  295.  
  296. (*\*)
  297. (* This routine will return TRUE if the record is in use and will return FALSE
  298.    otherwise.  If the record is in use, the record use record will also be
  299.    returned.                                                                 *)
  300.  
  301. function FetchRecordUseRecord(var dFName : FnString;   (* var for speed only *)
  302.                               lrNum : LrNumber;
  303.                               var pRec : ParameterRecord;   (* var for speed
  304.                                                                         only *)
  305.                               var recUseRec : FileSpaceInfoRecord) : Boolean;
  306.  
  307. var
  308.     prNum : PrNumber;
  309.     byteNum : PageRange;
  310.     page : SinglePage;
  311.  
  312.     begin
  313.     if (lrNum > pRec.lastInUse) or (lrNum = 0) then
  314.         begin
  315.         FetchRecordUseRecord := FALSE;
  316.         end
  317.     else
  318.         begin
  319.         prNum := ((lrNum - 1) Div RECSINPR) + pRec.firstRURec;
  320.         byteNum := (((lrNum - 1) Mod RECSINPR) * SizeOf(recUseRec)) + 1;
  321.         FetchPage(dFName,prNum,page);
  322.         FastMover(page[byteNum],recUseRec,SizeOf(recUseRec));
  323.         FetchRecordUseRecord := recUseRec.size <> 0;(* zero denotes not used *)
  324.         end;
  325.     end;                              (* end of FetchRecordUseRecord routine *)
  326.  
  327. (*\*)
  328. (* This routine will store the record use record.   It will create a new
  329.    record use record in the file if one is required.  pRec will be returned
  330.    with updates if any occured.                                              *)
  331.  
  332. procedure StoreRecordUseRecord(var dFName : FnString;  (* var for speed only *)
  333.                                lrNum : LrNumber;
  334.                                var pRec : ParameterRecord;
  335.                                recUseRec : FileSpaceInfoRecord);
  336.  
  337. var
  338.     prNum : PrNumber;
  339.     byteNum : PageRange;
  340.     page : SinglePage;
  341.     lastFSRec : PrNumber;
  342.  
  343.     begin
  344.     prNum := ((lrNum - 1) Div RECSINPR) + pRec.firstRURec;
  345.     byteNum := (((lrNum - 1) Mod RECSINPR) * SizeOf(recUseRec)) + 1;
  346.     if prNum = pRec.firstFSRec then
  347.         begin    (* move down the free space recs and create new rec use rec *)
  348.         FillChar(page,PAGESIZE,0);
  349.         lastFSRec := ((pRec.lastFSInUse - 1) Div RECSINPR) + pRec.firstFSRec;
  350.         MoveRecords(dFName,pRec.firstFSRec,lastFSRec,1);
  351.         end
  352.     else
  353.         begin
  354.         FetchPage(dFName,prNum,page);
  355.         end;
  356.     FastMover(recUseRec,page[byteNum],SizeOf(recUseRec));
  357.     StorePage(dFName,prNum,page);
  358.     end;                              (* end of StoreRecordUseRecord routine *)
  359.  
  360. (*\*)
  361. (* This routine will return the free space entry record.  It does not check to
  362.    ensure that fsNum is valid before retrieving the free space record.  That
  363.    step is not required since this will be called only for values of fsNum
  364.    which are valid.                                                          *)
  365.  
  366. procedure FetchFreeSpaceEntry(var dFName : FnString;  (* var for speed only  *)
  367.                               fsNum : FSNumber;
  368.                               var pRec : ParameterRecord;   (* var for speed
  369.                                                                         only *)
  370.                               var fsRec : FileSpaceInfoRecord);
  371.  
  372. var
  373.     prNum : PrNumber;
  374.     byteNum : PageRange;
  375.     page : SinglePage;
  376.  
  377.     begin
  378.     prNum := ((fsNum - 1) Div RECSINPR) + pRec.firstFSRec;
  379.     byteNum := (((fsNum - 1) Mod RECSINPR) * SizeOf(fsRec)) + 1;
  380.     FetchPage(dFName,prNum,page);
  381.     FastMover(page[byteNum],fsRec,SizeOf(fsRec));
  382.     end;                               (* end of FetchFreeSpaceEntry routine *)
  383.  
  384.  
  385. (* This routine will store the free space record. It will create a new free
  386.    space record if one is required. pRec will be returned with updates if any
  387.    occured.                                                                   *)
  388.  
  389. procedure StoreFreeSpaceEntry(var dFName : FnString;   (* var for speed only  *)
  390.                               fsNum : FSNumber;
  391.                               var pRec : ParameterRecord;
  392.                               fsRec : FileSpaceInfoRecord);
  393.  
  394. var
  395.     prNum : PrNumber;
  396.     byteNum : PageRange;
  397.     page : SinglePage;
  398.  
  399.     begin
  400.     prNum := ((fsNum - 1) Div RECSINPR) + pRec.firstFSRec;
  401.     byteNum := (((fsNum - 1) Mod RECSINPR) * SizeOf(fsRec)) + 1;
  402.     if (fsNum > pRec.lastFSInUse) and
  403.        ((fsNum Mod RECSINPR) = 1) and
  404.        (fsNum <> 1) then
  405.         begin
  406.         FillChar(page,PAGESIZE,0);           (* create new free space record *)
  407.         end
  408.     else
  409.         begin
  410.         FetchPage(dFName,prNum,page);
  411.         end;
  412.     FastMover(fsRec,page[byteNum],SizeOf(fsRec));
  413.     StorePage(dFName,prNum,page);
  414.     if fsNum > pRec.lastFSInUse then
  415.         begin
  416.         pRec.lastFSInUse := FSNum;
  417.         end;
  418.     end;                               (* end of StoreFreeSpaceEntry routine *)
  419.  
  420. (*\*)
  421. (* This routine will move free space entries up (deleting one) or down
  422.    (making room for one).  pRec is modified and returned.                    *)
  423.  
  424. procedure MoveFreeSpaceEntries(var dFName : FnString;  (* var for speed only *)
  425.                                fsNum : FSNumber;
  426.                                dir : Direction;
  427.                                var pRec : ParameterRecord);
  428.  
  429. var
  430.     fsRec : FileSpaceInfoRecord;
  431.     cnt : fsNumber;
  432.  
  433.     begin
  434.     case dir of
  435.         UP :
  436.             begin
  437.             for cnt := fsNum + 1 to pRec.lastFSInUse do
  438.                 begin
  439.                 FetchFreeSpaceEntry(dFName,cnt,pRec,fsRec);
  440.                 StoreFreeSpaceEntry(dFName,cnt - 1,pRec,fsRec);
  441.                 end;
  442.             FillChar(fsRec,SizeOf(fsRec),0);
  443.             StoreFreeSpaceEntry(dFName,pRec.lastFSInUse,pRec,fsRec);
  444.             Dec(pRec.lastFSInUse);
  445.             end;
  446.         DOWN :
  447.             begin
  448.             for cnt := pRec.lastFSInUse downto fsNum do
  449.                 begin
  450.                 FetchFreeSpaceEntry(dFName,cnt,pRec,fsRec);
  451.                 StoreFreeSpaceEntry(dFName,cnt + 1,pRec,fsRec);
  452.                 end;
  453.             end;
  454.         end;                                        (* end of case statement *)
  455.     end;                              (* end of MoveFreeSpaceEntries routine *)
  456.  
  457.  
  458. (* This routine will calculate the byte position within a file (relative to
  459.    first byte = 1) for the given file space info record.  This assumes prNum=1
  460.    for first record                                                          *)
  461.  
  462. function BytePositionInFile(fSpaceRec : FileSpaceInfoRecord) : BytePosition;
  463.  
  464.     begin
  465.     BytePositionInFile := ((fSpaceRec.prNum - 1) * PAGESIZE) +
  466.                           fSpaceRec.firstByte;
  467.     end;                                (* end of BytePositionInFile routine *)
  468.  
  469.  
  470. (*\*)
  471. (* This routine will make mark space within a file as being free.  It will do
  472.    this by seeing if this space is adjacent to any existing space.  If it is,
  473.    then it will be combined with the existing free space.  If the neighboring
  474.    space is not free, then a new free space entry will be created and stored.*)
  475.  
  476. procedure AddFreeSpace(var dFName : FnString;         (* var for speed only  *)
  477.                        var pRec : ParameterRecord;
  478.                        newFsRec : FileSpaceInfoRecord);
  479.  
  480. var
  481.     fsRec : FileSpaceInfoRecord;
  482.     fsNum : FSNumber;
  483.     done,
  484.     combined : Boolean;
  485.  
  486.     begin
  487.     fsNum := pRec.lastFSInUse;
  488.     while not done do
  489.         begin      (* search right to left for first entry left of new entry *)
  490.         if fsNum = 0 then
  491.             begin
  492.             done := TRUE;
  493.             end
  494.         else
  495.             begin
  496.             FetchFreeSpaceEntry(dFName,fsNum,pRec,fsRec);
  497.             if (BytePositionInFile(fsRec) < BytePositionInFile(newFsRec)) then
  498.                 begin
  499.                 done := TRUE
  500.                 end
  501.             else
  502.                 begin
  503.                 Dec(fsNum);
  504.                 end;
  505.             end;
  506.         end;
  507.     combined := FALSE;
  508.                           (* now try to combine new entry with entry on left *)
  509.     if (fsNum <> 0) and
  510.        (BytePositionInFile(fsRec) + fsRec.size =
  511.          BytePositionInFile(newFsRec)) then
  512.         begin
  513.         Inc(fsRec.size,newFsRec.size);
  514.         StoreFreeSpaceEntry(dFName,fsNum,pRec,fsRec);
  515.         combined := TRUE;
  516.         end;
  517.                          (* now try to combine new entry with entry on right *)
  518.     if (fsNum <> pRec.lastFSInUse) then
  519.         begin                               (* right entry exist so continue *)
  520.         FetchFreeSpaceEntry(dFName,fsNum + 1,pRec,fsRec);
  521.         if (BytePositionInFile(newFsRec) + newFsRec.size =
  522.             BytePositionInFile(fsRec)) then
  523.             begin
  524.             if combined then
  525.                 begin          (* left, new and right entries all contiguous *)
  526.                 FetchFreeSpaceEntry(dFName,fsNum,pRec,newFsRec);
  527.                 Inc(newFsRec.size,fsRec.size);
  528.                 StoreFreeSpaceEntry(dFName,fsNum,pRec,newFsRec);
  529.                 MoveFreeSpaceEntries(dFName,fsNum + 1,UP,pRec);
  530.                 end
  531.             else
  532.                 begin
  533.                 fsRec.prNum := newFsRec.prNum;
  534.                 fsRec.firstByte := newFsRec.firstByte;
  535.                 Inc(fsRec.size,newFsRec.size);
  536.                 StoreFreeSpaceEntry(dFName,fsNum + 1,pRec,fsRec);
  537.                 combined := TRUE;
  538.                 end;
  539.             end;
  540.         end;
  541.     if not combined then
  542.         begin       (* new free space not contiguous with any existing space *)
  543.         MoveFreeSpaceEntries(dFName,fsNum + 1,DOWN,pRec);
  544.         StoreFreeSpaceEntry(dFName,fsNum + 1,pRec,newFsRec);
  545.         end;
  546.     end;                                      (* end of AddFreeSpace routine *)
  547.  
  548. (*\*)
  549. (* This routine will allocate space in the variable length record file so that
  550.    a record can be stored.  It will do this by starting at the end of the free
  551.    space entries and searching backwards until the first free space entry of
  552.    sufficient size is found.  If none is found, it will move down the record
  553.    use records and free space records to make room in the file.  The recUseRec
  554.    is passed back with the allocated space.                                  *)
  555.  
  556. procedure GetSpaceForRecord(var dFName : FnString;     (* var for speed only *)
  557.                             size : DataSizeRange;
  558.                             var pRec : ParameterRecord;
  559.                             var recUseRec : FileSpaceInfoRecord);
  560.  
  561. var
  562.     fsRec : FileSpaceInfoRecord;
  563.     lastFSRec,
  564.     recsToMove : PrNumber;
  565.     fsNum : FSNumber;
  566.  
  567.     begin
  568.     for fsNum := pRec.lastFSInUse downto 1 do
  569.         begin
  570.         FetchFreeSpaceEntry(dFName,fsNum,pRec,fsRec);
  571.         if fsRec.size >= size then
  572.             begin                                        (* free space found *)
  573.             recUseRec.prNum := fsRec.prNum;
  574.             recUseRec.firstByte := fsRec.firstByte;
  575.             recUseRec.size := size;
  576.             if fsRec.size = size then
  577.                 begin                                         (* perfect fit *)
  578.                 MoveFreeSpaceEntries(dFName,fsNum,UP,pRec);
  579.                 end
  580.             else
  581.                 begin            (* too big .. space left over is still free *)
  582.                 Inc(fsRec.prNum,
  583.                     (((recUseRec.firstByte - 1) + size) Div PAGESIZE));
  584.                 fsRec.firstbyte := ((recUseRec.firstByte + (size - 1)) MOD
  585.                                     PAGESIZE) + 1;
  586.                 Dec(fsRec.size,size);
  587.                 StoreFreeSpaceEntry(dFName,fsNum,pRec,fsRec);
  588.                 end;
  589.             Exit;                (* free space found and allocated so return *)
  590.             end;
  591.         end;
  592.                                 (* apparently there is no free space big
  593.                                    enough to fit the record therefore extend
  594.                                    the file                                  *)
  595.     recsToMove := ((size - 1) Div PAGESIZE) + 1;
  596.     fsRec.prNum := pRec.firstRURec;
  597.     fsRec.firstByte := 1;
  598.     fsRec.size := recsToMove * PAGESIZE;
  599.     lastFSRec := ((pRec.lastFSInUse - 1) Div RECSINPR) + pRec.firstFSRec;
  600.     MoveRecords(dFName,pRec.firstRURec,lastFSRec,recsToMove);
  601.     Inc(pRec.firstFSRec,recsToMove);
  602.     AddFreeSpace(dFName,pRec,fsRec);
  603.     GetSpaceForRecord(dFName,size,pRec,recUseRec);         (* recursive call *)
  604.     end;                                 (* end of GetSpaceForRecord routine *)
  605.  
  606. (*\*)
  607. (* This routine will return the record number for the first unused data record
  608.    (logical record) from a variable length record data file.                 *)
  609.  
  610. function VLRFirstUnusedDataRecord(var dFName : FnString;
  611.                                                        (* var for speed only *)
  612.                                   var pRec : ParameterRecord) : LrNumber;
  613.  
  614. var
  615.     recUseRec : FileSpaceInfoRecord;
  616.     done : Boolean;
  617.  
  618.     begin
  619.     VLRFirstUnUsedDataRecord := pRec.nextAvail;   (* record number to return *)
  620.     done := FALSE;
  621.     while not done do
  622.         begin
  623.         Inc(pRec.nextAvail);
  624.         done := (not FetchRecordUseRecord(dFName,
  625.                                           pRec.nextAvail,
  626.                                           pRec,
  627.                                           recUseRec));
  628.         end;
  629.     end;                             (* end of FirstUnusedDataRecord routine *)
  630.  
  631.  
  632. (* This routine will check for the existence of a particular data record in a
  633.    variable length record data file.  If the data record is in use, TRUE
  634.    will be returned.  Otherwise, FALSE will be returned.  If this routine is
  635.    called with lrNum = 0 then FALSE will be returned since the zeroth logical
  636.    record is never a valid logical record.                                   *)
  637.  
  638. function VLRDataRecordUsed(dFName : FnString;
  639.                            lrNum : LrNumber) : Boolean;
  640.  
  641. var
  642.     pRec : ParameterRecord;
  643.     recUseRec : FileSpaceInfoRecord;
  644.  
  645.     begin
  646.     FetchFileParameters(dFName,pRec,SizeOf(pRec));
  647.     VLRDataRecordUsed := FetchRecordUseRecord(dFName,lrNum,pRec,recUseRec);
  648.     end;                                 (* end of VLRDataRecordUsed routine *)
  649.  
  650. (*\*)
  651. (* This routine will delete a logical record from a variable length record
  652.    data file.  If the data record (lrNum) is not in use, then nothing will
  653.    happen.  No error will occur.                                             *)
  654.  
  655. procedure VLRDeleteDataRecord(dFName : FnString;
  656.                               lrNum : lrNumber);
  657.  
  658. var
  659.     pRec : ParameterRecord;
  660.     page : SinglePage;
  661.     recUseRec,
  662.     fsRec : FileSpaceInfoRecord;
  663.  
  664.     begin
  665.     FetchFileParameters(dFName,pRec,SizeOf(pRec));
  666.     if FetchRecordUseRecord(dFName,lrNum,pRec,recUseRec) then
  667.         begin
  668.         fsRec := recUseRec;
  669.         FillChar(recUseRec,SizeOf(recUseRec),0);
  670.         StoreRecordUseRecord(dFName,lrNum,pRec,recUseRec); (* mark as unused *)
  671.         if lrNum < pRec.nextAvail then
  672.             begin
  673.             pRec.nextAvail := lrNum;
  674.             end;
  675.         if lrNum = pRec.lastInUse then
  676.              begin
  677. {$B-}                            (* next statement depends on short circuit
  678.                                               boolean expression evaluation *)
  679.             while (pRec.lastInUse <> 0) and
  680.                   (not FetchRecordUseRecord(dFName,
  681.                                             pRec.lastInUse,pRec,
  682.                                             recUseRec)) do
  683.                 begin
  684.                 Dec(pRec.lastInUse);
  685.                 end;
  686.             end;
  687.         AddFreeSpace(dFName,pRec,fsRec);
  688.         SaveFileParameters(dFName,pRec,SizeOf(pRec));
  689.         end;
  690.     end;                               (* end of VLRDeleteDataRecord routine *)
  691.  
  692. (*\*)
  693. (* This routine will get a logical record from a given variable length record
  694.    data file and will put the record into a memory location.  The location
  695.    will be destination.  The number of bytes retrieved is equal to the size of
  696.    the logical record which was determined when the record was stored.  There
  697.    will be a check to ensure that the record is in use. (that it exists). If
  698.    it is in use then it is fetched.  Otherwise, nothing will be returned in
  699.    destination.  Before calling this routine, you can check to see if the
  700.    logical record exists.  If it was retrieved from an index then it exists
  701.    (unless the record was deleted and it wasn't deleted from the index).  Also,
  702.    record numbers which are stored in a logical record list as a result of
  703.    GetValidLogicalRecords also exist as long as records were not deleted after
  704.    the list was created.  If you are not sure whether a logical record exists
  705.    you can use VLRDataRecordUsed(dFName,lrNum) to check for the existence of
  706.    the record before calling this routine.
  707.  
  708.    Warning : If this routine is called with lrNum = 0 or with lrNum equal to a
  709.    record which is not in use no error will occur, but nothing will be passed
  710.    back in destination (destination will remain unchanged).  You should ensure
  711.    that lrNum is not equal to zero prior to calling this routine.
  712.  
  713.    Also, you must ensure that the destination is large enough for the number
  714.    of bytes returned (the size of the record).  If it is not, something in
  715.    memory is going to be overwritten.  This will undoubtedly cause a disaster.
  716.    You can check the size of the record which will be returned by using the
  717.    VLRGetDataRecordSize routine supplied as part of this unit.               *)
  718.  
  719. procedure VLRGetALogicalRecord(dFName : FnString;
  720.                                lrNum : LrNumber;
  721.                                var destination);
  722.  
  723. type
  724.     MemoryArray = Array [1 .. MAXDATASIZE] of Byte;
  725.  
  726. var
  727.     pRec : ParameterRecord;
  728.     recUseRec : FileSpaceInfoRecord;
  729.     prNum : PrNumber;
  730.     bytesToMove,
  731.     firstByte : PageRange;
  732.     page : SinglePage;
  733.     bytesLeft,
  734.     byteCnt : DataSizeRange;
  735.     memory : MemoryArray absolute destination;
  736.  
  737.     begin
  738.     FetchFileParameters(dFName,pRec,SizeOf(pRec));
  739.     if FetchRecordUseRecord(dFName,lrNum,pRec,recUseRec) then
  740.         begin
  741.         prNum := recUseRec.prNum;
  742.         firstByte := recUseRec.firstByte;
  743.         bytesLeft := recUseRec.size;
  744.         byteCnt := 1;
  745.         while bytesLeft <> 0 do      (* loop until complete record is copied *)
  746.             begin
  747.             FetchPage(dFName,prNum,page);
  748.             bytesToMove := (PAGESIZE - firstByte) + 1;
  749.             if bytesToMove > bytesLeft then
  750.                 begin
  751.                 bytesToMove := bytesLeft;
  752.                 end;
  753.             FastMover(page[firstByte],memory[byteCnt],bytesToMove);
  754.             Inc(prNum);
  755.             firstByte := 1;
  756.             Dec(bytesLeft,bytesToMove);
  757.             Inc(byteCnt,bytesToMove);
  758.             end;
  759.         end;
  760.     end;                              (* end of VLRGetALogicalRecord routine *)
  761.  
  762. (*\*)
  763. (* This routine is exactly like VLRGetALogicalRecord except that it will only
  764.    retrieve the first part of the record (from the first byte to numOfbytes).
  765.    There is no equivalent to this routine in the LOGICAL unit.  It is really
  766.    designed for internal use, although it is available if you need it.  It may
  767.    be especially useful if you have a very large variable length record from
  768.    which you only need the first few bytes or so.                            *)
  769.  
  770. procedure VLRGetPartialLogicalRecord(dFName : FnString;
  771.                                      lrNum : LrNumber;
  772.                                      var destination;
  773.                                      numOfBytes : DataSizeRange);
  774.  
  775. type
  776.     MemoryArray = Array [1 .. MAXDATASIZE] of Byte;
  777.  
  778. var
  779.     pRec : ParameterRecord;
  780.     recUseRec : FileSpaceInfoRecord;
  781.     prNum : PrNumber;
  782.     bytesToMove,
  783.     firstByte : PageRange;
  784.     page : SinglePage;
  785.     bytesLeft,
  786.     byteCnt : DataSizeRange;
  787.     memory : MemoryArray absolute destination;
  788.  
  789.     begin
  790.     FetchFileParameters(dFName,pRec,SizeOf(pRec));
  791.     if FetchRecordUseRecord(dFName,lrNum,pRec,recUseRec) then
  792.         begin
  793.         prNum := recUseRec.prNum;
  794.         firstByte := recUseRec.firstByte;
  795.         bytesLeft := numOfBytes;
  796.         byteCnt := 1;
  797.         while bytesLeft <> 0 do      (* loop until complete record is copied *)
  798.             begin
  799.             FetchPage(dFName,prNum,page);
  800.             bytesToMove := (PAGESIZE - firstByte) + 1;
  801.             if bytesToMove > bytesLeft then
  802.                 begin
  803.                 bytesToMove := bytesLeft;
  804.                 end;
  805.             FastMover(page[firstByte],memory[byteCnt],bytesToMove);
  806.             Inc(prNum);
  807.             firstByte := 1;
  808.             Dec(bytesLeft,bytesToMove);
  809.             Inc(byteCnt,bytesToMove);
  810.             end;
  811.         end;
  812.     end;                        (* end of VLRGetPartialLogicalRecord routine *)
  813.  
  814. (*\*)
  815. (* This routine will store a logical record for a given variable length record
  816.    data file.  The routine will set the logical record to used and will create
  817.    the appropriate physical record(s) if required.  The logical record size is
  818.    size and the data must reside in source.  This routine is only used if the
  819.    logical record number is known.  If a new record is to be stored use
  820.    StoreNewLogicalRecord rather than this routine.
  821.  
  822.    Warning : If this routine is called with lrNum = 0 no error will occur, but
  823.    nothing will be saved.  You should ensure that lrNum is not equal to zero
  824.    prior to calling this routine.  Also, if size is zero nothing will happen.
  825.    This is because it does not make sense to store a record with a size of
  826.    zero bytes.                                                               *)
  827.  
  828. procedure VLRStoreALogicalRecord(dFName : FnString;
  829.                                  lrNum : LrNumber;
  830.                                  var source;
  831.                                  size : DataSizeRange);
  832.  
  833. type
  834.     MemoryArray = Array [1 .. MAXDATASIZE] of Byte;
  835.  
  836. var
  837.     pRec : ParameterRecord;
  838.     recUseRec : FileSpaceInfoRecord;
  839.     prNum : PrNumber;
  840.     bytesToMove,
  841.     firstByte : PageRange;
  842.     page : SinglePage;
  843.     bytesLeft,
  844.     byteCnt : DataSizeRange;
  845.     memory : MemoryArray absolute source;
  846.  
  847.     begin
  848.     if (lrNum <> 0) and (size <> 0) then (* make sure that lrNum <> 0 else do
  849.                                             nothing -- also ensure that size
  850.                                             is a valid number else do
  851.                                             nothing                          *)
  852.  
  853.         begin
  854.         FetchFileParameters(dFName,pRec,SizeOf(pRec));
  855.         if FetchRecordUseRecord(dFName,lrNum,pRec,recUseRec) then
  856.             begin
  857.             if recUseRec.size <> size then
  858.                 begin
  859.                 VLRDeleteDataRecord(dFName,lrNum);
  860.                 FetchFileParameters(dFName,pRec,SizeOf(pRec));
  861.                 GetSpaceForRecord(dFName,size,pRec,recUseRec);
  862.                 end;
  863.             end
  864.         else
  865.             begin
  866.             GetSpaceForRecord(dFName,size,pRec,recUseRec);
  867.             end;
  868.         StoreRecordUseRecord(dFName,lrNum,pRec,recUseRec);
  869.         prNum := recUseRec.prNum;
  870.         firstByte := recUseRec.firstByte;
  871.         bytesLeft := size;
  872.         byteCnt := 1;
  873.         while bytesLeft <> 0 do
  874.             begin
  875.             FetchPage(dFName,prNum,page);
  876.             bytesToMove := (PAGESIZE - firstByte) + 1;
  877.             if bytesToMove > bytesLeft then
  878.                 begin
  879.                 bytesToMove := bytesLeft;
  880.                 end;
  881.             FastMover(memory[byteCnt],page[firstByte],bytesToMove);
  882.             StorePage(dFName,prNum,page);
  883.             Inc(prNum);
  884.             firstByte := 1;
  885.             Dec(bytesLeft,bytesToMove);
  886.             Inc(byteCnt,bytesToMove);
  887.             end;
  888.         if pRec.lastInUse < lrNum then
  889.             begin
  890.             pRec.lastInUse := lrNum;
  891.             end;
  892.         SaveFileParameters(dFName,pRec,SizeOf(pRec));
  893.         end;
  894.     end;                            (* end of VLRStoreALogicalRecord routine *)
  895.  
  896. (*\*)
  897. (* This routine will store a new logical record for a given variable length
  898.    record data file.  The routine will set the logical record to used and will
  899.    create the appropriate physical record(s) if required.  Normally, when
  900.    inserting new records, you will not know the next unused logical record
  901.    number.  This routine will assign the appropriate logical record number so
  902.    that you won't have to worry about it. The routine will return the logical
  903.    record number which will be associated with this record upon return.  You
  904.    will need this returned logical record number if there are any indexes
  905.    associated with this data file.                                           *)
  906.  
  907. function VLRStoreNewLogicalRecord(dFName : FnString;
  908.                                   var source;
  909.                                   size : DataSizeRange) : LrNumber;
  910.  
  911. var
  912.     pRec : ParameterRecord;
  913.     lrNum : LrNumber;
  914.  
  915.     begin
  916.     FetchFileParameters(dFName,pRec,SizeOf(pRec));
  917.     lrNum := VLRFirstUnUsedDataRecord(dFName,pRec);
  918.     SaveFileParameters(dFName,pRec,SizeOf(pRec));
  919.     VLRStoreALogicalRecord(dFName,lrNum,source,size);
  920.     VLRStoreNewLogicalRecord := lrNum;
  921.     end;                          (* end of VLRStoreNewLogicalRecord routine *)
  922.  
  923.  
  924. (* This routine will return a list of logical records which are currently in
  925.    use (contain valid data) for a given variable length record data file.
  926.    This routine is necessary to be able to process all records which have not
  927.    been deleted without using an index.                                      *)
  928.  
  929. procedure VLRGetValidLogicalRecords(dFName : FnString;
  930.                                     var lrLst : LrList);
  931.  
  932. var
  933.     pRec : ParameterRecord;
  934.     recUseRec : FileSpaceInfoRecord;            (* dummy parameter needed in
  935.                                                               procedure call *)
  936.     lrNum : LrNumber;
  937.  
  938.     begin
  939.     FetchFileParameters(dFName,pRec,SizeOf(pRec));
  940.     CreateLrList(lrLst);
  941.     for lrNum := 1 to pRec.lastInUse do   (* will do nothing if file empty
  942.                                              because if file is empty, then
  943.                                              pRec.lastInUse = 0              *)
  944.         begin
  945.         if FetchRecordUseRecord(dFName,lrNum,pRec,recUseRec) then
  946.             begin
  947.             AddToLrList(lrNum,lrLst);
  948.             end;
  949.         end;
  950.     end;                         (* end of VLRGetValidLogicalRecords routine *)
  951.  
  952. (*\*)
  953. (* This routine will return the data record size for the given logical record
  954.    for the given variable length record data file.  If lrNum is not an
  955.    existing record, then 0 will be returned.                                 *)
  956.  
  957. function VLRGetDataRecordSize(dFName : FnString;
  958.                               lrNum : LrNumber) : DataSizeRange;
  959.  
  960. var
  961.     pRec : ParameterRecord;
  962.     recUseRec : FileSpaceInfoRecord;
  963.  
  964.     begin
  965.     FetchFileParameters(dFName,pRec,SizeOf(pRec));
  966.     if FetchRecordUseRecord(dFName,lrNum,pRec,recUseRec) then
  967.         begin
  968.         VLRGetDataRecordSize := recUseRec.size;
  969.         end
  970.     else
  971.         begin
  972.         VLRGetDataRecordSize := 0;
  973.         end;
  974.     end;                              (* end of VLRGetDataRecordSize routine *)
  975.  
  976.  
  977. (* This routine will return the logical record number for the last logical
  978.    record in use in the file (logical record with the highest logical record
  979.    number).                                                                  *)
  980.  
  981. function VLRLastDataRecord(dFName : FnString) : LrNumber;
  982.  
  983. var
  984.     pRec : ParameterRecord;
  985.  
  986.     begin
  987.     FetchFileParameters(dFName,pRec,SizeOf(pRec));
  988.     VLRLastDataRecord := pRec.lastInUse;
  989.     end;                                 (* end of VLRLastDataRecord routine *)
  990.  
  991.  
  992. end.                                                  (* end of Logical unit *)
  993.