World of Shareware - Software Farm 2/wosw_2.zip/wosw_2/PASCAL/TBTREE16.ZIP/BTREE3.INC

Text File | 1989-04-01 | 23KB | 544 lines

(******************************************************************************)
(*                                                                           *)
(*               B T R E E   C U R S O R   R O U T I N E S                   *)
(*                                                                           *)
(*****************************************************************************)


(* The following routines are provided as an alternate method to retrieve
   logical record numbers from an index.  Originally, TBTREE was developed
   with very powerful retrieval capabilities.  However, all retrievals
   required the creation of a logical record list.  This lists provide
   excellent flexibility and power.  In some cases, they are overkill and an
   alternate method is now provided.

   As of version 1.4, all indexes have one internal cursor associated with it.
   This cursor can be used to perform several types of retrievals.  Their use
   parallels the use of the retrieval routines found in the LrList unit
   although there are several important distinctions.

   One prime distinction is that you do not create nor destroy cursors as you
   would a logical record list.  The cursor always exists, although it may not
   be valid.  It will not be valid until you use one of these retrieval
   routines.  These routines set the cursor to a location (loaction depends on
   which routine you use) thus making it valid.  It will continue to be valid
   until you either delete the entry at the cursor or you use the routine
   provided to make the cursor invalid.  It is important to note that the
   cursor will actually live after the program terminates. This is because the
   cursor is stored as part of the parameter record for the index.  Since the
   parameter record always exists, the cursor always exists.  This does not
   cause any great problems, but you should be aware of it.

   Another distinction is that the cursor is dynamic rather than static (which
   the logical record lists are).  In other words, once a logical record list
   is created, there is no longer a relationship between the list and the
   index. The list can be sorted, manipulated, etc without affecting the
   index. Likewise, if the index is changed, the logical record list is
   unaware of it. On the other hand, the cursor remembers where it is and
   keeps up with changes to the index.  Even if you add or delete index
   entries, the cursor continues to point to the same entry.  The only
   exception is if you delete the entry at which the cursor is precsently
   pointing.  In this case, the cursor will be set to invalid. This precludes
   it from pointing off to never-never land.  The capability to remeber where
   it is gives the cursor some unique capabilities which the logical record
   list does not have.  Specifically, you can walk through an index, add
   something, and contiue walking through the index, etc.

   One use of these routines follows.  Assume the following declarations and
   also assume that myIndexFile is an index which is on field1 of myDataFile.
   MyRecord corresponds to myDataFile.  To perform a retrieval for the first
   record which has field1 = 20 follows:

         type
             MyRecord = record
                 field1 : Byte;
                 field2 : Word;
                 field3 : String[50];
                 end;

             myDataFile,
             myIndexFile : FnString;
             key : Byte;

             begin
             .
             .
             .
             key := 20;
             lrNum := UsingCursorAndValueGetLr(myIndexFile,key);
             if lrNum = 0 then
                 begin
                 { no matching record found }
                 end
             else
                 begin
                 {  process record as desired
                    probably retrieve the record using GetALogicalRecord  }
                 end;

   You could also put the above in a loop and move the cursor along
   retrieving logical record numbers until you wanted to quit.  For example

             key := 20;
             lrNum := UsingCursorAndValueGetLr(myIndexFile,key);
             while lrNum <> 0 do
                 begin
                 {  process record as desired
                    probably retrieve the record using GetALogicalRecord  }
                 lrNum := UsingCursorGetNextLr(iFName : FnString);
                 end;

   These routines are really well suited for either quick and dirty retrievals
   or retrievals that don't work well using logical record lists (for whatever
   reason).  For folks more familiar with other products, this method may feel
   more comfortable than using logical record lists.                         *)

(*\*)
(* This routine will return the logical record associated with the cursor.
   If the cursor in not valid, 0 will be returned.                           *)

function LrNumToReturn(var pg : SinglePage;            (* var for speed only *)
                       var pRec : ParameterRecord      (* var for speed only *)
                       ) : LrNumber;

var
    lrNum : LrNumber;

    begin
    if pRec.cursor.valid then
        begin
        Move(pg[((pRec.cursor.entryNum - 1) * (pRec.vSize + RNSIZE)) + 1],
             lrNum,
             RNSIZE);
        end
    else
        begin
        lrNum := 0;
        end;
    LrNumToReturn := lrNum;
    end;                                     (* end of LrNumToReturn routine *)

(*\*)
(* This routine will set the tree cursor to the front of the index.  In
   other words, it will point to the first entry in the index.  Remember, the
   index is ordered by the value of each entry.  It will also return the
   logical record associated with the first entry in the index.  It will
   return 0 only if there is no first entry (the index is empty).  This
   routine should be called if you want to start at the beginning of an index
   and want to retrieve logical record numbers in order of entry.            *)

function UsingCursorGetFirstLr(iFName : FnString) : LrNumber;

var
    pRec : ParameterRecord;
    pg : SinglePage;

    begin
    FetchFileParameters(iFName,pRec,SizeOf(pRec));
    FetchPage(iFName,pRec.fSNode,pg);
    if pg[VCNTLOC] > 0 then
        begin
        pRec.cursor.prNum := pRec.fSNode;
        pRec.cursor.entryNum := 1;
        pRec.cursor.valid := TRUE;
        end
    else
        begin
        pRec.cursor.valid := FALSE;
        end;
    SaveFileParameters(iFName,pRec,SizeOf(pRec));
    UsingCursorGetFirstLr := LrNumToReturn(pg,pRec);
    end;                             (* end of UsingCursorGetFirstLr routine *)

(*\*)
(* This routine will set the tree cursor to the end of the index.  In other
   words, it will point to the last entry in the index.  Remember, the index
   is ordered by the value of each entry.  It will also return the logical
   record associated with the last entry in the index.  It will return 0 only
   if there is no first entry (the index is empty).  This routine should be
   called if you want to start at the end of an index and want to retrieve
   logical record numbers in order of entry.                                 *)

function UsingCursorGetLastLr(iFName : FnString) : LrNumber;

var
    pRec : ParameterRecord;
    pg : SinglePage;

    begin
    FetchFileParameters(iFName,pRec,SizeOf(pRec));
    FetchPage(iFName,pRec.lSNode,pg);
    if pg[VCNTLOC] > 0 then
        begin
        pRec.cursor.prNum := pRec.lSNode;
        pRec.cursor.entryNum := pg[VCNTLOC];
        pRec.cursor.valid := TRUE;
        end
    else
        begin
        pRec.cursor.valid := FALSE;
        end;
    SaveFileParameters(iFName,pRec,SizeOf(pRec));
    UsingCursorGetLastLr := LrNumToReturn(pg,pRec);
    end;                              (* end of UsingCursorGetLastLr routine *)

(*\*)
(* This routine will set the tree cursor to the location in the index where
   the first occurence of the desired value (paramValue) is located.  It will
   also return the logical record associated with this entry. It will return 0
   if there is no entry associated with this value.  This routine should be
   called if you want to start at a certain location (at a certain value)
   within the index and want to retrieve logical record numbers in forward or
   reverse order.                                                            *)

function UsingCursorAndValueGetLr(iFName : FnString;
                                  var paramValue) : LrNumber;

var
    pRec : ParameterRecord;
    pg : SinglePage;
    cnt : Byte;               (* used to count number of values *)
    bytePtr : PageRange;      (* used to keep track of current byte *)
    thisNode : NodePtrType;

    begin
    FetchFileParameters(iFName,pRec,SizeOf(pRec));
    thisNode := FindSNode(iFName,pRec.rNode,paramValue,pRec);
    FetchPage(iFName,thisNode,pg);
    cnt := BinarySearchEntry(pg,paramValue,pRec);
    if (cnt <> 0) and (cnt <= pg[VCNTLOC]) then
        begin
        bytePtr := BytePointerPosition(cnt,pRec.vsize);
        if CompareValues(paramValue,pg[bytePtr + RNSIZE],pRec.vType) =
           EQUALTO then
            begin
            pRec.cursor.prNum := thisNode;
            pRec.cursor.entryNum := cnt;
            pRec.cursor.valid := TRUE;
            end
        else
            begin
            pRec.cursor.valid := FALSE;
            end;
        end
    else
        begin
        pRec.cursor.valid := FALSE;
        end;
    SaveFileParameters(iFName,pRec,SizeOf(pRec));
    UsingCursorAndValueGetLr := LrNumToReturn(pg,pRec);
    end;                          (* end of UsingCursorAndValueGetLr routine *)

(*\*)
(* This routine is the same as UsingCursorAndValueGetLr except that this
   routine will set the tree cursor to the location of the first value in the
   index which is greater than or equal to paramValue.  It will also return
   the logical record associated with this entry.  It will return 0 if there
   is no entry which is greater than or equal to this value.                 *)

function UsingCursorAndGEValueGetLr(iFName : FnString;
                                    var paramValue) : LrNumber;

var
    pRec : ParameterRecord;
    pg : SinglePage;
    cnt : Byte;               (* used to count number of values *)
    bytePtr : PageRange;      (* used to keep track of current byte *)
    thisNode : NodePtrType;

    begin
    FetchFileParameters(iFName,pRec,SizeOf(pRec));
    thisNode := FindSNode(iFName,pRec.rNode,paramValue,pRec);
    FetchPage(iFName,thisNode,pg);
    cnt := BinarySearchEntry(pg,paramValue,pRec);
    if (cnt <> 0) and (cnt <= pg[VCNTLOC]) then
        begin
        bytePtr := BytePointerPosition(cnt,pRec.vsize);
        pRec.cursor.prNum := thisNode;
        pRec.cursor.entryNum := cnt;
        pRec.cursor.valid := TRUE;
        end
    else
        begin
        pRec.cursor.valid := FALSE;
        end;
    SaveFileParameters(iFName,pRec,SizeOf(pRec));
    UsingCursorAndGEValueGetLr := LrNumToReturn(pg,pRec);
    end;                         (* end of UsingCursorAndGEValueGetLr routine *)

(*\*)
(* This routine will move the cursor to the right one entry and return the
   value associated with this entry.  It will return 0 if the cursor was not
   valid (not pointing to an entry) or if there is no next entry (you are at
   end of index).  This routine should be called if you want to move the
   cursor to the next larger entry from the present cursor position and
   retrieve the associated logical record number.  This routine should not
   normally be used until the cursor has been positioned using one of the
   three previous positioning routines.                                      *)

function UsingCursorGetNextLr(iFName : FnString) : LrNumber;

var
    pRec : ParameterRecord;
    pg : SinglePage;

    begin
    FetchFileParameters(iFName,pRec,SizeOf(pRec));
    if pRec.cursor.valid then
        begin
        FetchPage(iFName,pRec.cursor.prNum,pg);
        Inc(pRec.cursor.entryNum);
        if pRec.cursor.entryNum > pg[VCNTLOC] then
            begin
            Move(pg[NEXTLOC],pRec.cursor.prNum,RNSIZE);
            if pRec.cursor.prNum = NULL then
                begin
                pRec.cursor.valid := FALSE;
                end
            else
                begin
                FetchPage(iFName,pRec.cursor.prNum,pg);
                if pg[VCNTLOC] = 0 then
                    begin
                    pRec.cursor.valid := FALSE;
                    end
                else
                    begin
                    pRec.cursor.entryNum := 1;
                    end;
                end;
            end;
        SaveFileParameters(iFName,pRec,SizeOf(pRec));
        end;
    UsingCursorGetNextLr := LrNumToReturn(pg,pRec);
    end;                              (* end of UsingCursorGetNextLr routine *)

(*\*)
(* This routine will move the cursor to the left one entry and return the
   value associated with this entry.  It will return 0 if the cursor was not
   valid (not pointing to an entry) or if there is no previous entry (you are
   at beginning of the index).  This routine should be called if you want to
   move the cursor to the next smaller entry from the present cursor position
   and retrieve the associated logical record number.  This routine should not
   normally be used until the cursor has been positioned using one of the
   three previous positioning routines.                                      *)

function UsingCursorGetPrevLr(iFName : FnString) : LrNumber;

var
    pRec : ParameterRecord;
    pg : SinglePage;

    begin
    FetchFileParameters(iFName,pRec,SizeOf(pRec));
    if pRec.cursor.valid then
        begin
        FetchPage(iFName,pRec.cursor.prNum,pg);
        Dec(pRec.cursor.entryNum);
        if pRec.cursor.entryNum = 0 then
            begin
            Move(pg[PREVLOC],pRec.cursor.prNum,RNSIZE);
            if pRec.cursor.prNum = NULL then
                begin
                pRec.cursor.valid := FALSE;
                end
            else
                begin
                FetchPage(iFName,pRec.cursor.prNum,pg);
                pRec.cursor.entryNum := pg[VCNTLOC];
                end;
            end;
        SaveFileParameters(iFName,pRec,SizeOf(pRec));
        end;
    UsingCursorGetPrevLr := LrNumToReturn(pg,pRec);
    end;                              (* end of UsingCursorGetPrevLr routine *)

(*\*)
(* This routine will move the cursor to the right.  It will move the cursor
   to the next entry in which the value is not equal to the current entry and
   return the associated logical record number.  In other words, it will skip
   the cursor over all matching values.  It will return 0 if the cursor was
   not valid (not pointing to an entry) or if there is no next entry (you are
   at beginning of the index).  This routine should be used if you only want
   to process the first entry of a given value etc.  This routine should not
   normally be used until the cursor has been positioned using one of the
   three previous positioning routines.                                      *)

function UsingCursorSkipAndGetNextLr(iFName : FnString) : LrNumber;

var
    pRec : ParameterRecord;
    pg1,
    pg2 : SinglePage;
    done : boolean;
    oldNode : NodePtrType;

    begin
    FetchFileParameters(iFName,pRec,SizeOf(pRec));
    if pRec.cursor.valid then
        begin
        FetchPage(iFName,pRec.cursor.prNum,pg1);
        done := FALSE;
        while not done do
            begin
            Inc(pRec.cursor.entryNum);
            if pRec.cursor.entryNum > pg1[VCNTLOC] then
                begin
                oldNode := pRec.cursor.prNum;
                Move(pg1[NEXTLOC],pRec.cursor.prNum,RNSIZE);
                if pRec.cursor.prNum = NULL then
                    begin
                    pRec.cursor.valid := FALSE;
                    done := TRUE;
                    end
                else
                    begin
                    pg2 := pg1;
                    FetchPage(iFName,pRec.cursor.prNum,pg1);
                    if pg1[VCNTLOC] = 0  then
                        begin
                        pRec.cursor.valid := FALSE;
                        end
                    else
                        begin
                        pRec.cursor.entryNum := 1;
                        if CompareValues(pg1[1 + RNSIZE],
                                         pg2[((pg2[VCNTLOC] - 1) *
                                              (pRec.vSize + RNSIZE)) +
                                             1 + RNSIZE],
                                         pRec.vType) <> EQUALTO then
                            begin
                            done := TRUE;
                            end;
                        end;
                    end;
                end
            else
                begin
                if CompareValues(pg1[((pRec.cursor.entryNum - 1) *
                                      (pRec.vSize + RNSIZE)) + 1 + RNSIZE],
                                 pg1[((pRec.cursor.entryNum - 2) *
                                      (pRec.vSize + RNSIZE)) + 1 + RNSIZE],
                                 pRec.vType) <> EQUALTO then
                    begin
                    done := TRUE;
                    end;
                end;
            end;
        SaveFileParameters(iFName,pRec,SizeOf(pRec));
        end;
    UsingCursorSkipAndGetNextLr := LrNumToReturn(pg1,pRec);
    end;                       (* end of UsingCursorSkipAndGetNextLr routine *)

(*\*)
(* This routine will move the cursor to the left.  It will move the cursor to
   the previous entry in which the value is not equal to the current entry and
   return the associated logical record number.  In other words, it will skip
   the cursor over all matching values.  It will return 0 if the cursor was
   not valid (not pointing to an entry) or if there is no previous entry (you
   are at beginning of the index).  This routine should be used if you only
   want to process the first entry of a given value etc.  This routine should
   not normally be used until the cursor has been positioned using one of the
   three previous positioning routines.                                      *)

function UsingCursorSkipAndGetPrevLr(iFName : FnString) : LrNumber;

var
    pRec : ParameterRecord;
    pg1,
    pg2 : SinglePage;
    done : boolean;
    oldNode : NodePtrType;

    begin
    FetchFileParameters(iFName,pRec,SizeOf(pRec));
    if pRec.cursor.valid then
        begin
        FetchPage(iFName,pRec.cursor.prNum,pg1);
        done := FALSE;
        while not done do
            begin
            Dec(pRec.cursor.entryNum);
            if pRec.cursor.entryNum = 0 then
                begin
                oldNode := pRec.cursor.prNum;
                Move(pg1[PREVLOC],pRec.cursor.prNum,RNSIZE);
                if pRec.cursor.prNum = NULL then
                    begin
                    pRec.cursor.valid := FALSE;
                    done := TRUE;
                    end
                else
                    begin
                    pg2 := pg1;
                    FetchPage(iFName,pRec.cursor.prNum,pg1);
                    pRec.cursor.entryNum := pg1[VCNTLOC];
                    if CompareValues(pg2[1 + RNSIZE],
                                     pg1[((pg1[VCNTLOC] - 1) *
                                          (pRec.vSize + RNSIZE)) +
                                         1 + RNSIZE],
                                     pRec.vType) <> EQUALTO then
                        begin
                        done := TRUE;
                        end;
                    end;
                end
            else
                begin
                if CompareValues(pg1[((pRec.cursor.entryNum - 1) *
                                      (pRec.vSize + RNSIZE)) + 1 + RNSIZE],
                                 pg1[(pRec.cursor.entryNum  *
                                     (pRec.vSize + RNSIZE)) + 1 + RNSIZE],
                                 pRec.vType) <> EQUALTO then
                    begin
                    done := TRUE;
                    end;
                end;
            end;
        SaveFileParameters(iFName,pRec,SizeOf(pRec));
        end;
    UsingCursorSkipAndGetPrevLr := LrNumToReturn(pg1,pRec);
    end;                       (* end of UsingCursorSkipAndGetPrevLr routine *)

(*\*)
(* This routine will not move the cursor.  It will return the logical record
   number asociated with the current cursor position.  It will return 0 only
   if the current cursor position is not valid.                              *)

function UsingCursorGetCurrLr(iFName : FnString) : LrNumber;

var
    pRec : ParameterRecord;
    pg : SinglePage;
    lrNum : LrNumber;

    begin
    FetchFileParameters(iFName,pRec,SizeOf(pRec));
    if pRec.cursor.valid then
        begin
        FetchPage(iFName,pRec.cursor.prNum,pg);
        end;
    UsingCursorGetCurrLr := LrNumToReturn(pg,pRec);
    end;                              (* end of UsingCursorGetCurrLr routine *)


(* This routine will set the cursor to invalid.  This is never required,
   but can be used once the cursor use is completed and the cursor won't be
   used until it is repositioned using one of the three positioning
   routines. Using this routine will slightly speed up inserts and deletes.
   This is because, on an insert or delete, the cursor position must be
   kept correct if the cursor is valid.  This requires a small amount of
   extra processing.  This processing is extraneous if you don't care about
   the cursor position.                                                      *)

procedure UsingCursorMakeCursorInvalid(iFName : FnString);

var
    pRec : ParameterRecord;

    begin
    FetchFileParameters(iFName,pRec,SizeOf(pRec));
    pRec.cursor.valid := FALSE;
    SaveFileParameters(iFName,pRec,SizeOf(pRec));
    end;                      (* end of UsingCursorMakeCursorInvalid routine *)