Power-Programmierung/CD1.mdf/pascal/library/dos/btree/tree/files.pas

Pascal/Delphi Source File | 1989-07-13 | 23.1 KB | 586 lines

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

unit Files;

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

(* This unit is used to create, delete and check the existence of files. There
   are currently three types of files: DATA, INDEX and LLIST.  The data files
   are used to hold user data.  The INDEX files can be used to hold an index
   for a given DATA file.  The LLIST files are for holding logical record
   lists which take up more than one disk page and must be stored on disk (or
   in the page buffer).

   This unit also serves another purpose.  It has routines for handling the
   bitmap records for files requiring them.  DATA files and INDEX files both
   require bitmaps which serve to mark records as being either used or unused.
   The bitmap records are always the last records in the file and are moved
   down to make space as new records are added to the file.  This is all
   accomplished automatically without user intervention.  You should never
   need to access bitmap records explicitly.

   Most of the routines provided are for internal use only and should not be
   used within applications.  There are several exceptions however.  The first
   exception to this is the FileExists routine which is handy and can be used
   freely without problems.  The other exceptions are the FetchUserDataArray,
   SaveUserDataArray and FetchFileVersion routines.                          *)

(*\*)
(* Version Information

   Version 1.1 - No Changes

   Version 1.2 - No Changes

   Version 1.3 - No Changes

   Version 1.4 - Added FileExists routine

               - Totally redefined the role of the unit.  The purpose of the
                 unit is as stated above.  Most routines have been removed or
                 replaced.  Fully read and understand the comments provided
                 with the unit

   Version 1.5 - Changed code internally to use Inc and Dec where practical

               - Changed code internally to use newly added FastMove unit

   Version 1.6 - Changed CreateGenericFile such that it will delete the file
                 (if it exists) before creating it.  If the file is being
                 recreated, the buffer will be purged of any lingering pages
                 from the old file

               - Moved the parameter record routines from the LOGICAL unit and
                 BTREE unit to this unit.  This will slightly reduce
                 redundancy and the overall code for an application.  This is
                 completely transparent to the user.

               - Fixed an error to MoveRecords (used only internally) which
                 would cause catestrophic problems with large files.  Also
                 made routine more generic.  This routine is not normally used
                 except internally.

               - Added FetchFileType routine                                 *)

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

interface

uses
    Dos,
    FastMove,
    FileBuff,
    FileDecs,
    Math,
    Numbers,
    Page;


(* This creates a file.  This routine should NEVER be used (except
   internally by TBTREE).  There are specific routines available designed to
   create DATA, VLRDATA and INDEX files.  Do not use this routine!!!!        *)

procedure CreateGenericFile(var fName : FnString);


(* This routine will delete a file.  This routine should NEVER be used (except
   internally by TBTREE).  There are specific routines available designed to
   delete DATA, VLRDATA and INDEX files.  Do not use this routine!!!!        *)

procedure DeleteGenericFile(fName : FnString);


(* This routine will check to see if a given file exists.  It is safe to use
   this routine for checking the existence of any file.  The routine is handy
   for an application which must work whther the file has already been created
   on not.  Two examples of use follow:

            if not FileExists(myDataFile) then
                begin
                CreateDataFile(myDataFile,SizeOf(myDataRecord));
                end;


            if not FileExists(myIndexFile) then
                begin
                CreateIndexFile(myIndexFile,SizeOf(Byte),BYTEVALUE);
                end;

    Notice the difference in usage for a DATA file and an INDEX file         *)

function FileExists(fName : FnString) : Boolean;

(*\*)
(* This routine will fetch and return the user data array from the given DATA,
   VLRDATA or INDEX file.  The array will be returned via the userData
   parameter passed in.                                                      *)

procedure FetchUserDataArray(fName : FnString;
                             var userData : UserDataArray);


(* This routine will store the user data array into the parameter record of
   the given DATA, VLRDATA or INDEX file.                                    *)

procedure SaveUserDataArray(fName : FnString;
                             userData : UserDataArray);


(* This routine will return a string which tells which version of TBTREE was
   used to create the DATA or INDEX.  It should only be used for a file of
   type DATA, VLRDATA or INDEX.                                              *)

procedure FetchFileVersion(fName : FnString;
                           var verString : VersionString);


(* This routine will return the file type for the given file.  The returned
   value is of type FileTypes.                                               *)

function FetchFileType(fName : FnString) : FileTypes;


(* **********      **********       **********        **********     *********
   All of the following routines are for internal use only!!!!!  Do not use
   these routines!!!!!!!!!
   **********      **********       **********        **********     *********)

(* This procedure will read the zeroth physical record from the given file and
   return the number of bytes requested in the variable pRec.                *)

procedure FetchFileParameters(var dFName : FnString;   (* var for speed only *)
                              var pRec;
                              size : PageRange);


(* This procedure will copy the contents of pRec and save it to the zeroth
   physical record in the data file.                                         *)

procedure SaveFileParameters(var dFName : FnString;    (* var for speed only *)
                             var pRec;
                             size : PageRange);

(*\*)
(* This routine will calculate the physical record number corresponding to the
   given record number (rNum).  firstBMRec is needed as the starting
   location.                                                                 *)

function CalculateBitmapRecord(firstBMRec : PrNumber;
                               rNum : RecordNumber) : PrNumber;


(* This routine will perform two important functions.  First, it will set the
   bit corresponding to rNum to show that the record is used.  Second, it will
   find the next available record number and will return that record number.
   It may require the addition of one bitmap record to do that.  If this is
   required, it will be performed automatically.                             *)

function FindNextAvailInBitmap(fName : FnString;
                               firstBMRec : PrNumber;
                               var lastBMRec : PrNumber;
                               rNum : RecordNumber) : RecordNumber;


(* This routine will move records for the given file down n records.  This
   will free up n physical records for use.  The first record to be moved is
   passed in firstRec and the last record to move is lastRec.  lastRec must be
   the last physical record in the file.  firstRec and lastRec will be
   returned with values updated to reflect where the records now reside.     *)

procedure MoveRecords(fName : FnString;
                      var firstRec : PrNumber;
                      var lastRec : PrNumber;
                      n : PrNumber);


(* This routine will set the bit associated with rNum in the file fName to
   the desired value. It will calculate the correct bitmap record and read it
   in, set the bit to the value specified by bit (the parameter of type
   BitValue passed in) and store the bitmap record.                          *)

procedure SetBitInBitmap(fName : FnString;
                         firstBMRec : PrNumber;
                         rNum : RecordNumber;
                         bit : BitValue);


(* This routine will check to see if the bit associated with rNum in the file
   fName is set or not.  The routine will return TRUE if the bit is set.     *)

function CheckBitInBitmap(fName : FnString;
                          firstBMRec : PrNumber;
                          rNum : RecordNumber) : Boolean;

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

implementation

const
    FILETYPELOC = 276;

(* This creates a file.  This routine should NEVER be used (except
   internally by TBTREE).  There are specific routines available designed to
   create DATA, VLRDATA and INDEX files.  Do not use this routine!!!!        *)

procedure CreateGenericFile(var fName : FnString);

var
    tempFile : File;

    begin
    DeleteGenericFile(fName);   (* This will delete the file and clear any
                                   pages for this file out of the buffer.
                                   This will only happen if the file exists  *)
    RewriteUntypedFile(fName,tempFile,PAGESIZE);  (* force creation of new
                                                     file
                                                     - will rewrite old file
                                                     if it exists            *)
    end;                                 (* end of CreateGenericFile routine *)


(* This routine will delete a file.  This routine should NEVER be used (except
   internally by TBTREE).  There are specific routines available designed to
   delete DATA, VLRDATA and INDEX files.  Do not use this routine!!!!        *)

procedure DeleteGenericFile(fName : FnString);

var
    tempFile : File;

    begin
    if FileExists(fName) then
        begin
        ReleaseAllPages(fName);                (* release all pages for this
                                                        file from the buffer *)
        OpenUntypedFile(fName,tempFile,PAGESIZE);  (* needed to get the file
                                                        id (tempFile)        *)
        CloseFile(fName);
        Erase(tempFile);
        end;
    end;                                        (* end of DeleteFile routine *)

(*\*)
(* This routine will check to see if a given file exists.  It is safe to use
   this routine for checking the existence of any file.  The routine is handy
   for an application which must work whether the file has already been
   created on not.  Two examples of use follow:

            if not FileExists(myDataFile) then
                begin
                CreateDataFile(myDataFile,SizeOf(myDataRecord));
                end;

            if not FileExists(myIndexFile) then
                begin
                CreateIndexFile(myIndexFile,SizeOf(Byte),BYTEVALUE);
                end;

    Notice the difference in usage for a DATA file and an INDEX file         *)

function FileExists(fName : FnString) : Boolean;

var
    dummy : SearchRec;                   (* SearchRec is defined in DOS unit *)

    begin
    FindFirst(fName,ANYFILE,dummy);
    if DosError = 0 then
        begin
        FileExists := TRUE;
        end
    else
        begin
        FileExists := FALSE;
        end;
    end;                                        (* end of FileExists routine *)

(*\*)
(* This routine will fetch and return the user data array from the given DATA,
   VLRDATA or INDEX file.  The array will be returned via the userData
   parameter passed in.                                                      *)

procedure FetchUserDataArray(fName : FnString;
                             var userData : UserDataArray);

var
    page : SinglePage;

    begin
    FetchPage(fName,0,page);
    FastMover(page,userData,SizeOf(userData));
    end;                                (* end of FetchUserDataArray routine *)


(* This routine will store the user data array into the parameter record of
   the given DATA, VLRDATA or INDEX file.                                    *)

procedure SaveUserDataArray(fName : FnString;
                             userData : UserDataArray);

var
    page : SinglePage;

    begin
    FetchPage(fName,0,page);
    FastMover(userData,page,SizeOf(userData));
    StorePage(fName,0,page);
    end;                                 (* end of SaveUserDataArray routine *)

(*\*)
(* This routine will return a string which tells which version of TBTREE was
   used to create the DATA or INDEX.  It should only be used for a file of
   type DATA, VLRDATA or INDEX.                                              *)

procedure FetchFileVersion(fName : FnString;
                           var verString : VersionString);

var
    page : SinglePage;

    begin
    FetchPage(fName,0,page);
    FastMover(page[SizeOf(UserDataArray) + 1],verString,SizeOf(verString));
    end;                                (* end of FetchVersionFile procedure *)


(* This routine will return the file type for the given file.  The returned
   value is of type FileTypes.                                               *)

function FetchFileType(fName : FnString) : FileTypes;

var
    page : SinglePage;

    begin
    FetchPage(fName,0,page);
    FetchFileType := FileTypes(page[FILETYPELOC]);
    end;                                     (* end of FetchFileType routine *)

(*\*)
(* This routine will move records for the given file down n records.  This
   will free up n physical records for use.  The first record to be moved is
   passed in firstRec and the last record to move is lastRec.  lastRec must be
   the last physical record in the file.  firstRec and lastRec will be
   returned with values updated to reflect where the records now reside.     *)

procedure MoveRecords(fName : FnString;
                      var firstRec : PrNumber;
                      var lastRec : PrNumber;
                      n : PrNumber);

var
    zeroPage,
    page : SinglePage;
    cnt : PrNumber;

    begin
    FillChar(zeroPage,PAGESIZE,0);                      (* zero out old page *)
    for cnt := lastRec downto firstRec do
        begin
        FetchPage(fName,cnt,page);
        StorePage(fName,cnt + n,page);
        StorePage(fName,cnt,zeroPage);      (* store empty page in old place *)
        end;
    Inc(firstRec,n);
    Inc(lastRec,n);
    end;                                       (* end of MoveRecords routine *)


(* This routine will calculate the bit location for the given record
   number (rNum).  firstBMRec is needed as the starting location.  The
   location is returned in prNum, byteNum and bitNum.  The routine does not
   affect the bitmaps themselves.                                            *)

procedure CalculateBitmapBitLocation(firstBMRec : PrNumber;
                                     rNum : RecordNumber;
                                     var prNum : PrNumber;
                                     var byteNum : PageRange;
                                     var bitNum : BytePosition);

    begin
    prNum := ((rNum - 1) Div (8 * PAGESIZE)) + firstBMRec;
    byteNum := (((rNum - 1) Mod (8 * PAGESIZE)) Div 8) + 1;
    bitNum := (rNum - 1) Mod 8;
    bitNum := (bitNum Xor 7) And 7;    (* this will yield the correct bit
                                          position within the byte. This is
                                          necessary because bit 7 (most
                                          significant) in the byte is the
                                          existence bit for the first record
                                          not the eighth *)
    end;                        (* end of CalculateBitmapBitLocation routine *)

(*\*)
(* This procedure will read the zeroth physical record from the given file and
   return the number of bytes requested in the variable pRec.                *)

procedure FetchFileParameters(var dFName : FnString;   (* var for speed only *)
                              var pRec;
                              size : PageRange);

var
    page : SinglePage;

    begin
    FetchPage(dFName,0,page);
    FastMover(page,pRec,size);
    end;                            (* end of FetchFileParameters procedure *)


(* This procedure will copy the contents of pRec and save it to the zeroth
   physical record in the data file.                                         *)

procedure SaveFileParameters(var dFName : FnString;    (* var for speed only *)
                             var pRec;
                             size : PageRange);

var
    page : SinglePage;

    begin
    FetchPage(dFName,0,page);
    FastMover(pRec,page,size);
    StorePage(dFName,0,page);
    end;                              (* end of SaveFileParameters procedure *)


(* This routine will calculate the physical record number corresponding to the
   given record number (rNum).  firstBMRec is needed as the starting
   location.                                                                 *)

function CalculateBitmapRecord(firstBMRec : PrNumber;
                               rNum : RecordNumber) : PrNumber;

    begin
    CalculateBitmapRecord := ((rNum - 1) Div (8 * PAGESIZE)) + firstBMRec;
    end;                          (* end of CalculateBitmapBitRecord routine *)

(*\*)
(* This routine will perform two important functions.  First, it will set the
   bit corresponding to rNum to show that the record is used.  Second, it will
   find the next available record number and will return that record number.
   It may require the addition of one bitmap record to do that.  If this is
   required, it will be performed automatically.                             *)

function FindNextAvailInBitmap(fName : FnString;
                               firstBMRec : PrNumber;
                               var lastBMRec : PrNumber;
                               rNum : RecordNumber) : RecordNumber;

var
    page : SinglePage;                             (* copy of page in buffer *)
    prNum : PrNumber;
    byteNum : PageRange;                        (* byte position within page *)
    bitNum : BytePosition;                       (* bit position within byte *)
    done : Boolean;                                             (* byte loop *)

    begin
    CalculateBitmapBitLocation(firstBMRec,rNum,prNum,byteNum,bitNum);
    FetchPage(fName,prNum,page);
    SetBit(page[byteNum],bitNum,1);
    StorePage(fName,prNum,page);
    while TRUE do                                      (* BITMAP record loop *)
        begin
        done := FALSE;
        while not done do                                       (* byte loop *)
            begin
            if page[byteNum] <> MAXBYTE then
                              (* the check against MAXBYTE is for efficiency
                               since it will preclude checking individual
                               bits for a byte in which all bits are set
                               to one                                        *)
                begin
                bitNum := 7;
                while TRUE do
                    begin                                        (* bit loop *)
                    if not BitOn(page[byteNum],bitNum) then
                        begin
                        FindNextAvailInBitmap := ((prNum - firstBMRec) *
                                                  PAGESIZE * 8) +
                                                 ((byteNum - 1) * 8) +
                                                 (8 - bitNum);
                        Exit;                     (* only way out of routine *)
                        end
                    else
                        begin
                        Dec(bitNum);
                        end;
                    end;
                end;
            if byteNum = PAGESIZE then
                begin
                done := TRUE;
                end
            else
                begin
                Inc(byteNum);
                end;
            end;
        Inc(prNum);
        byteNum := 1;
        if PageExists(fName,prNum) then           (* if not past last record *)
            begin
            FetchPage(fName,prNum,page);              (* get next b m record *)
            end
        else
            begin
            FillChar(page,PAGESIZE,0);              (* create new record page
                                                     for this bit map record *)
            StorePage(fName,prNum,page);              (* store the new page *)
            lastBMRec := prNum;                (* update value of lastBMRec *)
            end;
        end;
    end;                             (* end of FindNextAvailInBitmap routine *)

(*\*)
(* This routine will set the bit associated with rNum in the file fName to
   the desired value. It will calculate the correct bitmap record and read it
   in, set the bit to the value specified by bit (the parameter of type
   BitValue passed in) and store the bitmap record.                          *)

procedure SetBitInBitmap(fName : FnString;
                         firstBMRec : PrNumber;
                         rNum : RecordNumber;
                         bit : BitValue);

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

    begin
    CalculateBitmapBitLocation(firstBMRec,rNum,prNum,byteNum,bitNum);
    FetchPage(fName,prNum,page);
    SetBit(page[byteNum],bitNum,bit);
    StorePage(fName,prNum,page);
    end;                                    (* end of SetBitInBitmap routine *)

(*\*)
(* This routine will check to see if the bit associated with rNum in the file
   fName is set or not.  The routine will return TRUE if the bit is set.     *)

function CheckBitInBitmap(fName : FnString;
                          firstBMRec : PrNumber;
                          rNum : RecordNumber) : Boolean;

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

    begin
    CalculateBitmapBitLocation(firstBMRec,rNum,prNum,byteNum,bitNum);
    FetchPage(fName,prNum,page);
    CheckBitInBitmap := BitOn(page[byteNum],bitNum);
    end;                                    (* end of SetBitInBitmap routine *)

end.                                                    (* end of Files unit *)