home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / database / gsdb28 / gs_dbndx.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-01  |  54.9 KB  |  1,312 lines
  1. unit GS_DBNdx;
  2. {-----------------------------------------------------------------------------
  3.                            dBase III Index Handler
  4.  
  5.        GS_DBNdx Copyright (c)  Richard F. Griffin
  6.  
  7.        15 November 1990
  8.  
  9.        102 Molded Stone Pl
  10.        Warner Robins, GA  31088
  11.  
  12.        -------------------------------------------------------------
  13.        This unit handles the objects for all dBase III index (.NDX)
  14.        operations.
  15.  
  16.        changes:
  17.  
  18.           16 Nov 90 - Modified KeyUpdate sub-procedure KeyInsert to
  19.                       test for end-of-file during search for key.
  20.  
  21.           22 Apr 91 - Modified SetMatchValue to be a method.  This will
  22.                       ensure consistency in building character and numeric
  23.                       values.  Also modified throughout to ensure the full
  24.                       length was loaded into Ndx_Key_St for a field rather
  25.                       than just moving length(Work_Key) characters.
  26.                       Also added comments for KeyUpdate procedures.
  27.  
  28.           02 May 91 - Added an IndexSignature constant so the GS_dBase unit
  29.                       can confirm this unit is the dBase III index unit.
  30.  
  31.           01 Aug 91 -  Replaced string compare in DoMatchValue with call to
  32.                        GS_Sort_Compare for speed increase.
  33.  
  34.           15 Dec 91 - Fixed error in Ndx_GetRecPage that caused error in
  35.                       attempt to read Bttm_Record.
  36.  
  37.           02 Feb 92 - Added call to KeyLocRec in main part of KeyUpdate.
  38.                       This allows multiple indexes to be used.  In the past,
  39.                       the program assumed the index was pointing to the
  40.                       current record.  There is a sacrifice in update
  41.                       speed, however.
  42.  
  43.           19 Feb 92 - Embedded cache into Ndx_Get and Ndx_Put.  A number
  44.                       of node images will be stored to memory.  This will
  45.                       be treated as a stack, where the last page accessed
  46.                       will be pushed to the top and new nodes will use the
  47.                       bottom image.  They will replace the old image and
  48.                       push to the top.  This allows the most active nodes to
  49.                       remain in memory, with less active nodes being swapped
  50.                       out.  This also added a Ndx_Flush method to write all
  51.                       updated nodes to disk on demand, such as at closing.
  52.  
  53.                       Added KeyBOF flag for test for access beyond top of
  54.                       file.
  55.  
  56.           25 Feb 92 - Added call to unit GS_DBL.PAS to handle the routines
  57.                       to create and compare floating point types used in
  58.                       dBase indexes.  These routines save 10K of memory over
  59.                       the $N,E option for numeric coprocessor emulation.
  60.  
  61. ------------------------------------------------------------------------------}
  62.  
  63. {$D-}
  64. interface
  65.  
  66. uses
  67.    GS_Dbl,                            {handle double types}
  68.    GS_Strng,                          {String handler routines}
  69.    GS_Sort,                           {Sort/Compare routine}
  70.    GS_Error,                          {Error handler routines}
  71.    GS_FileH;                          {File handler routines}
  72.  
  73. const
  74.    NdxBufSize = 4096;
  75.    NdxBufferedPages = 32;
  76.    IndexSignature = 'NDX3';
  77.  
  78. type
  79.  
  80. {
  81.          ┌──────────────────────────────────────────────────────────┐
  82.          │  This record type describes the index file header.       │
  83.          │  This is a 512-byte block that is located at the         │
  84.          │  beginning of the index file.  Refer to Appendix C       │
  85.          │  for a description of the fields.                        │
  86.          └──────────────────────────────────────────────────────────┘
  87. }
  88.    GS_Indx_Head = Record
  89.                             Root        : Longint;
  90.                             Next_Blk    : Longint;
  91.                             Unknwn1     : Longint;
  92.                             Key_Lgth    : Integer;
  93.                             Max_Keys    : Integer;
  94.                             Data_Typ    : Integer;
  95.                             Entry_Sz    : Integer;
  96.                             Unknwn2     : Longint;
  97.                             Key_Form    : array [0..487] of char;
  98.                   end;
  99.  
  100. {
  101.          ┌──────────────────────────────────────────────────────────┐
  102.          │  This record type describes the index file node header.  │
  103.          │  Each node is a 512-byte block that is used as nodes     │
  104.          │  to store keys and pointers.  Refer to Appendix C        │
  105.          │  for a description of the fields.                        │
  106.          └──────────────────────────────────────────────────────────┘
  107. }
  108.  
  109.    GS_Indx_Data = Record
  110.                      Entry_Ct    : Integer;
  111.                      Unknwn1     : Integer;
  112.                      Data_Ary    : array [0..507] of byte;
  113.                                       {Memory array holding key entries}
  114.                      Filler1     : array [0..255] of byte;
  115.                                       {Filler for possible overflow during}
  116.                                       {insert mode.}
  117.                   end;
  118.  
  119.    GS_Indx_EntPtr = ^GS_Indx_Etry;    {Pointer of type GS_Indx_Etry.  Will}
  120.                                       {be used to reference key entries  }
  121.                                       {from GS_Indx_Data.Data_Ary.}
  122.  
  123. {
  124.          ┌──────────────────────────────────────────────────────────┐
  125.          │  This record type describes the index file key entries.  │
  126.          │  Refer to Appendix C for a description of each field.    │
  127.          └──────────────────────────────────────────────────────────┘
  128. }
  129.  
  130.    GS_Indx_Etry = Record
  131.                      Block_Ax : Longint;
  132.                      Recrd_Ax : Longint;
  133.                      Char_Fld : array [1..255] of char;
  134.                   end;
  135.  
  136. {
  137.           ┌────────────────────────────────────────────────────────┐
  138.           │  Work table used to step through nodes.  The previous  │
  139.           │  nodes must be saved for finding the next or previous  │
  140.           │  record during sequential reads.                       │
  141.           └────────────────────────────────────────────────────────┘
  142. }
  143.     GS_Indx_Tabl = Record
  144.                       Page_No  : Longint;   {Disk block holding node info}
  145.                       Etry_No  : Longint;   {Last entry used in node}
  146.                       Last_One : Longint;   {Number of keys in this node }
  147.                       Node_Pag : Boolean;   {True for non-leaf nodes}
  148.                    end;
  149.  
  150.    GS_DiskPagPtr = ^GS_DiskPagBfr;
  151.    GS_DiskPagBfr = array[0..511] of byte;
  152.  
  153.    GS_DiskTblPtr = ^GS_DiskTblPag;
  154.    GS_DiskTblPag = record
  155.       BlkNum : longint;
  156.       BlkWrt : boolean;
  157.       BlkPtr : GS_DiskPagPtr;
  158.    end;
  159.  
  160.    GS_Indx_LPtr = ^GS_dBase_IX;       {Pointer to object.  Used by GS_dBase_DB}
  161.  
  162. {
  163.                       ┌─────────────────────────────────┐
  164.                       │  GS_dBase_IX Object Definition  │
  165.                       └─────────────────────────────────┘
  166. }
  167.  
  168.    GS_dBase_IX = object
  169.       Ndx_Name     : String[64];      {File name of index file}
  170.       Ndx_Hdr      : GS_Indx_Head;    {Index header information}
  171.       Ndx_File     : file;            {File type for index file}
  172.       Ndx_Tabl     : array [0..25] of GS_Indx_Tabl;
  173.                                       {Array of 25 table entries to hold}
  174.                                       {the trail of non-leaf nodes that are}
  175.                                       {traversed during a key search.  This }
  176.                                       {table is needed to track positions for}
  177.                                       {sequential reads (next and previous).}
  178.  
  179.       Ndx_Lvl      : integer;         {Holds counter into Ndx_Tabl}
  180.       Ndx_Data     : GS_Indx_Data;    {Node header information}
  181.       Ndx_Pntr     : GS_Indx_EntPtr;  {Pointer to key entry information}
  182.       Ndx_Key_St   : string[127];     {Holds last key value found on call to}
  183.                                       {either KeyRead or KeyFind}
  184.  
  185.       Ndx_Key_Num  : longint;         {Holds last physical record number for a}
  186.                                       {key value found on call to either}
  187.                                       {KeyRead or KeyFind}
  188.       Ndx_Key_Form : string[127];     {Holds the key formula in type string}
  189.       KeyBOF       : boolean;
  190.       KeyEOF       : boolean;         {True if last KeyRead attempted to read}
  191.                                       {beyond the range of index keys - either}
  192.                                       {beyond beginning or end of file}
  193.       ExactMatch   : boolean;         {Flag for type of test to use in KeyFind}
  194.                                       {It will force a match against an entire}
  195.                                       {key if true, and only for the length of}
  196.                                       {the passed argument if false.  It is}
  197.                                       {initialized true.}
  198.  
  199.       Ndx_PagArray : array[0..NdxBufferedPages-1] of GS_DiskTblPag;
  200.  
  201.       CONSTRUCTOR Init(IName : String);
  202.       CONSTRUCTOR Ndx_Make(filname, formla: string; lth: integer; typ: char);
  203.       DESTRUCTOR Done;
  204.       FUNCTION  KeyFind(st : String) : longint;
  205.       FUNCTION  KeyLocRec(rec : longint) : boolean;
  206.       FUNCTION  KeyRead(a : LongInt) : longint;
  207.       PROCEDURE KeyUpdate (st : string; rec, crec : longint);
  208.       PROCEDURE Ndx_Close;
  209.       PROCEDURE Ndx_Flush;
  210.       PROCEDURE Ndx_Get(blk : longint);
  211.       PROCEDURE Ndx_GetRecEntry;
  212.       PROCEDURE Ndx_GetRecPage(Ascnd : boolean);
  213.       FUNCTION  Ndx_LastEntry : boolean;
  214.       PROCEDURE Ndx_NodeData(pn, en, lo : longint; np : boolean);
  215.       PROCEDURE Ndx_Put(blk : longint);
  216.       Procedure KeyList(st : string);
  217.       FUNCTION  SetMatchValue(st : string): string;
  218.    end;
  219.  
  220. implementation
  221.  
  222.  
  223. const
  224.  
  225.    Next_Record = -1;   {Token value passed to read next record}
  226.    Prev_Record = -2;   {Token value passed to read previous record}
  227.    Top_Record  = -3;   {Token value passed to read first record}
  228.    Bttm_Record = -4;   {Token value passed to read final record}
  229.  
  230.    ValueHigh   = 1;    {Token value passed for key comparison high}
  231.    ValueLow    = -1;   {Token value passed for key comparison low}
  232.    ValueEqual  = 0;    {Token value passed for key comparison equal}
  233.  
  234. var
  235.    Work_Key : string;               {Holds key passed in Find and KeyUpdate}
  236.    RPag     : Longint;              {Work variable to hold current index block}
  237.    RNum     : Longint;              {Work variable for record number}
  238.    IsAscend : Boolean;              {Flag for ascending/descending status.}
  239.                                     {Set based on Next/Previous Record read}
  240.  
  241. constructor GS_dBase_IX.Init(IName : String);
  242. var
  243.    i : integer;
  244. begin
  245.    for i := 0 to NdxBufferedPages-1 do
  246.    begin
  247.       Ndx_PagArray[i].BlkNum := -1;
  248.       Ndx_PagArray[i].BlkWrt := false;
  249.       Ndx_PagArray[i].BlkPtr := nil;
  250.    end;
  251.    Ndx_Name := IName + '.NDX';
  252.    if GS_FileExists(Ndx_File, Ndx_Name) then
  253.    begin
  254.       GS_FileAssign(Ndx_File,Ndx_Name);
  255.       GS_FileReset(Ndx_File,1);
  256.    end
  257.    else
  258.    begin
  259.       ShowError(2,Ndx_Name);
  260.    end;
  261.    Ndx_Get(0);                        {Read first block of file for header info}
  262.    move(Ndx_Data, Ndx_Hdr, 512);      {Store in header info area}
  263.    Ndx_Lvl := 0;                      {Initialize the node step table}
  264.    Ndx_Tabl[0].Page_No := 0;
  265.    Ndx_Tabl[0].Etry_No := 0;
  266.    Ndx_Tabl[0].Last_One := 0;
  267.    KeyEOF := false;                   {Initialize EOF Flag to false}
  268.    ExactMatch := true;                {Initialize to use an exact match test}
  269.    move(Ndx_Hdr.Key_Form[0], Ndx_Key_Form[1],100);
  270.    i := 1;
  271.    while Ndx_Key_Form[i] <> #0 do inc(i);
  272.    Ndx_Key_Form[0] := chr(pred(i));
  273.    Ndx_Key_Form := TrimR(Ndx_Key_Form);
  274.    Ndx_Key_Form := TrimL(Ndx_Key_Form);
  275. end;
  276.  
  277.  
  278. Destructor GS_dBase_IX.Done;
  279. var
  280.    i : integer;
  281. begin
  282.    Ndx_Close;
  283.    for i := 0 to NdxBufferedPages-1 do
  284.       if Ndx_PagArray[i].BlkPtr <> nil then Dispose(Ndx_PagArray[i].BlkPtr);
  285. end;
  286.  
  287. Constructor GS_dBase_IX.Ndx_Make(filname, formla : string; lth : integer;
  288.                                  typ : char);
  289. var
  290.    i : integer;
  291. begin
  292.    for i := 0 to NdxBufferedPages-1 do
  293.    begin
  294.       Ndx_PagArray[i].BlkNum := -1;
  295.       Ndx_PagArray[i].BlkWrt := false;
  296.       Ndx_PagArray[i].BlkPtr := nil;
  297.    end;
  298.    Ndx_Name := filname+'.NDX';        {Setup file name}
  299.    GS_FileAssign(Ndx_File,Ndx_Name);
  300.    GS_FileRewrite(Ndx_File,1);
  301.    FillChar(Ndx_Hdr, SizeOf(Ndx_Hdr),#0);
  302.    Ndx_Hdr.Root := 1;
  303.    Ndx_Hdr.Next_Blk := 2;
  304.    case typ of
  305.       'N',
  306.       'D'  : begin
  307.                 Ndx_Hdr.Data_Typ := 1;
  308.                 lth := 8;
  309.              end;
  310.       else Ndx_Hdr.Data_Typ := 0;
  311.    end;
  312.    Ndx_Hdr.Key_Lgth := lth;
  313.    i := lth+8;
  314.    while (i mod 4) <> 0 do i := i + 1;
  315.    Ndx_Hdr.Max_Keys := ((SizeOf(Ndx_Hdr)-8) div i);
  316.    Ndx_Hdr.Entry_Sz := i;
  317.    CnvStrToAsc(formla,Ndx_Hdr.Key_Form, length(formla)+1);
  318.    move(Ndx_Hdr, Ndx_Data, SizeOf(Ndx_Hdr));
  319.    Ndx_Put(0);
  320.    FillChar(Ndx_Data, SizeOf(Ndx_Data),#0);
  321.    Ndx_Put(1);
  322. end;
  323.  
  324.  
  325.  
  326. {
  327.                     ┌─────────────────────────────────────┐
  328.                     │  This routine sets up the match     │
  329.                     │  string.  It sets the length of the │
  330.                     │  match for full or partial, and     │
  331.                     │  converts to numeric if needed.     │
  332.                     └─────────────────────────────────────┘
  333. }
  334.  
  335. function GS_dBase_IX.SetMatchValue(st : string): string;
  336. var
  337.    Work_Key : string;
  338.    Work_Num : gsDouble;
  339.    rl : integer;
  340. begin
  341.    if Ndx_Hdr.Data_Typ = 0 then
  342.    begin                              {if a character key field then --}
  343.       FillChar(Work_Key, SizeOf(Work_Key), ' '); {Fill with blanks}
  344.       Work_Key := st;
  345.       if ExactMatch then
  346.       Work_Key[0] := chr(Ndx_Hdr.Key_Lgth);
  347.    end
  348.    else
  349.    begin
  350.       MakeDouble(st,Work_Num,rl);
  351.       if rl <> 0 then ShowError(501,st);
  352.       move(Work_Num, Work_Key[1], 8);
  353.       Work_Key[0] := #8;
  354.    end;
  355.    SetMatchValue := Work_Key;
  356. end;
  357.  
  358. {.pa}
  359. {
  360.                                    KEYFIND
  361.  
  362.  
  363.      ╔══════════════════════════════════════════════════════════════════╗
  364.      ║                                                                  ║
  365.      ║   The KeyFind method will return the physical record location    ║
  366.      ║   of the record matching the key value passed as the argument.   ║
  367.      ║   ExactMatch controls the length of the match check.  If         ║
  368.      ║   ExactMatch is true, the entire key in the .NDX entry must      ║
  369.      ║   match the value passed.  If false, the check will only be      ║
  370.      ║   for the length of the string passed.                           ║
  371.      ║                                                                  ║
  372.      ║       Calling the Method:                                        ║
  373.      ║                                                                  ║
  374.      ║           longintvalu := objectname.KeyFind(string)              ║
  375.      ║                                                                  ║
  376.      ║               ( where objectname is of type GS_dBase_IX,         ║
  377.      ║                       string is a value used to search the       ║
  378.      ║                       .NDX file looking for a match.             ║
  379.      ║                                                                  ║
  380.      ║       Result:                                                    ║
  381.      ║                                                                  ║
  382.      ║       1.  longintvalu will point to the physical record,         ║
  383.      ║           or will be zero if no match.                           ║
  384.      ║       2.  Ndx_Key_St will contain the key value.                 ║
  385.      ║       3.  Ndx_Key_Num will contain the record number.            ║
  386.      ║                                                                  ║
  387.      ╚══════════════════════════════════════════════════════════════════╝
  388. }
  389.  
  390.  
  391. function GS_dBase_IX.KeyFind(st : string) : LongInt;
  392. var
  393.    i         : integer;               {Work variable}
  394.    rl        : integer;               {Result code for Val procedure}
  395.    ct        : integer;               {Variable to hold BlockRead byte count}
  396.    Less_Than : boolean;               {Flag to hunt for key match}
  397.    Loop_Cnt  : longint;
  398.    Match_Cnd : integer;
  399.  
  400.    procedure StoreMatchValue;
  401.    begin
  402.       move(Ndx_Pntr^.Char_Fld,Ndx_Key_St[1],Ndx_Hdr.Key_Lgth);
  403.                                       {Move the key field to Ndx_Key_St.}
  404.       Ndx_Key_St[0] := Work_Key[0];   {Now insert the length into Ndx_Key_St}
  405.    end;
  406.  
  407.    function DoMatchValue : integer;
  408.    begin
  409.       if Ndx_Hdr.Data_Typ = 0 then    {Character key field}
  410.          Match_Cnd := GS_Sort_Compare(Ndx_Key_St, Work_Key)
  411.       else                            {Numeric key field}
  412.          Match_Cnd := CmprDouble(Ndx_Key_St[1], Work_Key[1]);
  413.       DoMatchValue := Match_Cnd;
  414.    end;
  415.  
  416. begin
  417.    KeyEOF := false;                   {Reset End-of-File to false}
  418.    Ndx_Key_Num := 0;                  {Initialize}
  419.    Ndx_Key_St := '';                  {Initialize}
  420.    Ndx_Lvl := 0;                      {Initialize index level}
  421.    Work_Key := SetMatchValue(st);     {Set key comparison value}
  422.    RPag := Ndx_Hdr.Root;              {Get root node address}
  423.    while RPag <> 0 do                 {While a non-leaf node, do this}
  424.    begin
  425.       Ndx_Get(RPag);                  {Get Node using RPag as block number}
  426.       Ndx_Pntr :=  Addr(Ndx_Data.Data_Ary[0]);
  427.                                       {Get pointer to first entry}
  428.       Loop_Cnt := Ndx_Pntr^.Block_Ax; {Get the next node pointer to see if it}
  429.                                       {is zero, meaning a leaf node}
  430.       i := 0;                         {Initialize i as counter}
  431.       Less_Than := Ndx_Data.Entry_Ct > 0;
  432.                                       {Start out with less than flag true}
  433.                                       {Will be false if Entry Count is 0}
  434.                                       {which means an empty node}
  435.       while (less_than) and (i <= Ndx_Data.Entry_Ct) do
  436.                                       {Hunt for a match.  If i = last entry in}
  437.                                       {the node, the last entry is used for}
  438.                                       {the next node search}
  439.       begin
  440.          Ndx_Pntr :=  Addr(Ndx_Data.Data_Ary[i *  Ndx_Hdr.Entry_Sz]);
  441.                                       {Get pointer to entry indexed by i}
  442.  
  443.          inc(i);                      {Increment the counter}
  444.          StoreMatchValue;             {Put the key value in Ndx_Key_St for}
  445.                                       {matching}
  446.  
  447.          Less_Than := DoMatchValue = ValueLow;
  448.                                       {Test looking for greater or equal than}
  449.                                       {the key value.  Less_Than will be set}
  450.                                       {false when found, setting the condition}
  451.                                       {to leave this portion of the routine}
  452.       end;
  453. {
  454.                  ┌──────────────────────────────────────────┐
  455.                  │  Save the node data for this node as:    │
  456.                  │  1.  Block Number from RPag.             │
  457.                  │  2.  Entry number of match or last one.  │
  458.                  │  3.  Set total number of entries.  This  │
  459.                  │      is entry count+1 for non-leaf nodes │
  460.                  │  4.  Set non-leaf flag to true.          │
  461.                  └──────────────────────────────────────────┘
  462. }
  463.       Ndx_NodeData(RPag,i,Ndx_Data.Entry_Ct+1,true);
  464.       if Loop_Cnt = 0 then RPag := 0
  465.          else RPag := Ndx_Pntr^.Block_Ax;
  466.                                       {Get the next node in the tree}
  467.    end;
  468.    Ndx_Tabl[Ndx_Lvl].Node_Pag := false;
  469.                                       {Set non-leaf flag to false for this}
  470.                                       {last level}
  471.    dec(Ndx_Tabl[Ndx_Lvl].Last_One);
  472.                                       {Set total number of entries to the }
  473.                                       {correct value for a leaf node}
  474.  
  475.  
  476.    if Ndx_Data.Entry_Ct = 0 then
  477.    begin
  478.       KeyFind := 0;
  479.       exit;
  480.    end;
  481.  
  482.    if (DoMatchValue <> ValueEqual) or
  483.       (Ndx_Tabl[Ndx_Lvl].Last_One < Ndx_Tabl[Ndx_Lvl].Etry_No)
  484.             then Ndx_Key_Num := 0     {if unable to find a match, the above}
  485.                                       {routine would have stopped when a}
  486.                                       {greater key was found, or would have}
  487.                                       {continued to Last_One.  Since the entry}
  488.                                       {count is one less for leaf nodes, even}
  489.                                       {if there was a match at Last_one, it is}
  490.                                       {not valid, and was only a coincidence.}
  491.                                       {In either case, set record number = 0.}
  492.    else
  493.       Ndx_Key_Num := Ndx_Pntr^.Recrd_Ax;
  494.                                       {When there is a match with the key,}
  495.                                       {get the physical record number}
  496.    KeyFind := Ndx_Key_Num;            {Return with the record number}
  497. end;
  498. {.pa}
  499. {
  500.                                   KEYLOCREC
  501.  
  502.  
  503.      ╔══════════════════════════════════════════════════════════════════╗
  504.      ║                                                                  ║
  505.      ║   The KeyLocRec method will search the .NDX file to find the     ║
  506.      ║   matching index entry pointing to the physical record location  ║
  507.      ║   of the record requested.                                       ║
  508.      ║                                                                  ║
  509.      ║       Calling the Method:                                        ║
  510.      ║                                                                  ║
  511.      ║           flag := objectname.KeyLocRec(key, position)            ║
  512.      ║                                                                  ║
  513.      ║               ( where objectname is of type GS_dBase_IX,         ║
  514.      ║                       key is the key string                      ║
  515.      ║                       position is the physical record number     ║
  516.      ║                          of the matching .DBF record.)           ║
  517.      ║                                                                  ║
  518.      ║       Result:                                                    ║
  519.      ║                                                                  ║
  520.      ║           Boolean True is returned if a match is found.          ║
  521.      ║           The current index entry will be set to the record      ║
  522.      ║           if a match does exist.                                 ║
  523.      ║                                                                  ║
  524.      ╚══════════════════════════════════════════════════════════════════╝
  525. }
  526.  
  527.  
  528. Function GS_dBase_IX.KeyLocRec (rec : longint) : boolean;
  529. var
  530.    lr : longint;
  531. begin
  532.    if rec = Ndx_Key_Num then
  533.    begin                              {Exit if already at the record}
  534.       KeyLocRec := true;
  535.       exit;
  536.    end;
  537.    lr := KeyRead(Top_Record);
  538.    while (not KeyEOF) and (lr <> rec) do lr := KeyRead(Next_Record);
  539.    if (KeyEOF) then KeyLocRec := false
  540.       else KeyLocRec := true;
  541. end;
  542. {.pa}
  543. {
  544.                                    KEYREAD
  545.  
  546.  
  547.      ╔══════════════════════════════════════════════════════════════════╗
  548.      ║                                                                  ║
  549.      ║   The KeyRead method will return the physical record location    ║
  550.      ║   of the record requested.  The only options that may be asked   ║
  551.      ║   for are Top, Bottom, Next, and Previous.                       ║
  552.      ║                                                                  ║
  553.      ║       Calling the Method:                                        ║
  554.      ║                                                                  ║
  555.      ║           longintvalu := objectname.KeyRead(position)            ║
  556.      ║                                                                  ║
  557.      ║               ( where objectname is of type GS_dBase_IX,         ║
  558.      ║                       position is in -1 to -4,                   ║
  559.      ║                       longintvalu is physical record number      ║
  560.      ║                          of the matching .DBF record.            ║
  561.      ║                                                                  ║
  562.      ║       Result:                                                    ║
  563.      ║                                                                  ║
  564.      ║           longintvalu will point to the physical record.         ║
  565.      ║                                                                  ║
  566.      ╚══════════════════════════════════════════════════════════════════╝
  567. }
  568.  
  569.  
  570. FUNCTION  GS_dBase_IX.KeyRead(a : longint) : longint;
  571. var
  572.    N_L_Hold   : Integer;              {Tempory variable for index level}
  573.    ct         : Integer;              {Work variable for Blockread count}
  574.  
  575.  
  576.  
  577. {
  578.                ┌───────────────────────────────────────────────┐
  579.                │  Start of KeyRead function.  This will        │
  580.                │  accomplish the following:                    │
  581.                │                                               │
  582.                │  1.  If first time for index, set any call    │
  583.                │      for a Next or Previous read to a Top     │
  584.                │      read command.                            │
  585.                │  2.  Use case select for Top/Bttm/Next/Prev.  │
  586.                │      Return physical .DBF record in RNum.     │
  587.                │  3.  If not a valid action, set RNum to 0.    │
  588.                │  4.  Move key value to Ndx_Key_St.            │
  589.                │  5.  Move RNum to Ndx_Key_Num.                │
  590.                │  6.  Return RNum value to calling procedure.  │
  591.                └───────────────────────────────────────────────┘
  592. }
  593.  
  594.  
  595. { Start of KeyRead }
  596.  
  597. begin
  598.    RNum := a;                         {Get action command}
  599.    if ((a = Next_Record) or (a = Prev_Record)) and
  600.       (Ndx_Lvl = 0) then RNum := Top_Record;
  601.                                       {if first time through, use Top_Record}
  602.                                       {command instead}
  603.    KeyBOF := false;
  604.    KeyEOF := false;                   {End-of-File initially set false}
  605.    case RNum of                       {Select KeyRead Action}
  606.  
  607.       Next_Record : begin
  608.                        IsAscend := true;
  609.                                       {Will be an ascending read}
  610.                        N_L_Hold := Ndx_Lvl;
  611.                                       {Save old index level}
  612. {
  613.                     ┌─────────────────────────────────────┐
  614.                     │  If the last record read was the    │
  615.                     │  last entry in the node, you have   │
  616.                     │  to step back through the index     │
  617.                     │  levels to find the next node.      │
  618.                     └─────────────────────────────────────┘
  619. }
  620.                        if Ndx_LastEntry then
  621.                                       {If last entry in node already used,}
  622.                                       {go find the next node}
  623.                        begin
  624.                           while (Ndx_LastEntry) and (Ndx_Lvl > 0) do
  625.                              dec(Ndx_Lvl);
  626.                                       {Step back through the levels until you}
  627.                                       {find a good one, or run out of levels.}
  628.  
  629.                           if Ndx_Lvl = 0 then
  630.                                       {if out of levels, process for EOF}
  631.                           begin
  632.                              Ndx_Lvl := N_L_Hold;
  633.                                       {Get old level number to restore}
  634.                              KeyEOF := true;
  635.                                       {Set End-of-File true}
  636.                           end else
  637.  
  638.                           begin       {Otherwise, get next entry data}
  639.                              inc(Ndx_Tabl[Ndx_Lvl].Etry_No);
  640.                                       {Step to next Entry Number}
  641.                              Ndx_GetRecEntry;
  642.                                       {Go search for next good record}
  643.                           end;
  644.                        end
  645.  
  646.                        else inc(Ndx_Tabl[Ndx_Lvl].Etry_No);
  647.                                       {Otherwise, just step to next entry}
  648.                        Ndx_Pntr :=
  649.                                     Addr(Ndx_Data.Data_Ary[(
  650.                                     (Ndx_Tabl[Ndx_Lvl].Etry_No - 1) *
  651.                                     Ndx_Hdr.Entry_Sz)]);
  652.                                       {Get pointer to the key entry}
  653.                        RNum := Ndx_Pntr^.Recrd_Ax;
  654.                                       {Get record number for the key entry}
  655.                     end;
  656.  
  657.       Prev_Record : begin
  658.                        IsAscend := false;
  659.                                       {Will be a descending read}
  660.                        N_L_Hold := Ndx_Lvl;
  661.                                       {Save old index level}
  662. {
  663.                     ┌─────────────────────────────────────┐
  664.                     │  If the last record read was the    │
  665.                     │  first entry in the node, you have  │
  666.                     │  to step back through the index     │
  667.                     │  levels to find the next node.      │
  668.                     └─────────────────────────────────────┘
  669. }
  670.                        if Ndx_Tabl[Ndx_Lvl].Etry_No = 1 then
  671.                                       {If last entry in node already used,}
  672.                                       {go find the next node}
  673.                        begin
  674.                           while (Ndx_Tabl[Ndx_Lvl].Etry_No = 1) and
  675.                                 (Ndx_Lvl > 0) do
  676.                              dec(Ndx_Lvl);
  677.                                       {Step back through the levels until you}
  678.                                       {find a good one, or run out of levels.}
  679.  
  680.                           if Ndx_Lvl = 0 then
  681.                                       {if out of levels, process for EOF}
  682.                           begin
  683.                              Ndx_Lvl := N_L_Hold;
  684.                                       {Get old level number to restore}
  685.                              KeyBOF := true;
  686.                                       {Set Top-of-File true}
  687.                           end else
  688.  
  689.                           begin       {Otherwise, get next entry data}
  690.                              dec(Ndx_Tabl[Ndx_Lvl].Etry_No);
  691.                                       {Step to next Entry Number}
  692.                              Ndx_GetRecEntry;
  693.                                       {Go search for next good record}
  694.                           end;
  695.                        end
  696.                        else dec(Ndx_Tabl[Ndx_Lvl].Etry_No);
  697.                                       {Otherwise, just step to next entry}
  698.                        Ndx_Pntr :=
  699.                                     Addr(Ndx_Data.Data_Ary[(
  700.                                     (Ndx_Tabl[Ndx_Lvl].Etry_No - 1) *
  701.                                     Ndx_Hdr.Entry_Sz)]);
  702.                                       {Get pointer to the key entry}
  703.                        RNum := Ndx_Pntr^.Recrd_Ax;
  704.                                       {Get record number for the key entry}
  705.                     end;
  706.  
  707.       Top_Record,
  708.       Bttm_Record : begin
  709.                        IsAscend := Top_Record = RNum;
  710.                                       {Ascending search if Top, otherwise}
  711.                                       {descending.  An ascending search will}
  712.                                       {return the first index key as the Top.}
  713.                                       {A descending search will return the}
  714.                                       {last index key as the 'Top'}
  715.                        Ndx_Lvl := 0;  {Clear index levels for new stack}
  716.                        RPag := Ndx_Hdr.Root;
  717.                                       {Get root node address}
  718.                        Ndx_GetRecPage(IsAscend);
  719.                                       {Go get valid record}
  720.                     end;
  721.  
  722.       else          RNum := 0;        {If no valid action, return zero}
  723.    end;
  724.    move(Ndx_Pntr^.Char_Fld,Ndx_Key_St[1],Ndx_Hdr.Key_Lgth);
  725.                                       {Move the key field to Ndx_Key_St.}
  726.                                       {The Move procedure must be used since}
  727.                                       {Char_Fld is not a true Pascal string.}
  728.    Ndx_Key_St[0] := chr(Ndx_Hdr.Key_Lgth);
  729.                                       {Now insert the length into Ndx_Key_St}
  730.                                       {so it is a valid string we can use}
  731.  
  732.    Ndx_Key_Num := RNum;               {Save RNum in Ndx_Key_Num}
  733.    KeyRead := RNum;                   {Return RNum}
  734. end;
  735.  
  736. Procedure GS_dBase_IX.Ndx_Close;
  737. begin
  738.    Ndx_Flush;
  739.    GS_FileClose(Ndx_File);
  740. end;
  741.  
  742.  
  743. Procedure GS_dBase_IX.Ndx_Flush;
  744. var
  745.    r : word;
  746.    v : integer;
  747. begin
  748.    for v := 0 to NdxBufferedPages-1 do
  749.    begin
  750.       if v >= 0 then
  751.       begin
  752.          if Ndx_PagArray[v].BlkWrt then
  753.          begin
  754.             GS_FileWrite(Ndx_File,Ndx_PagArray[v].BlkNum*512,
  755.             Ndx_PagArray[v].BlkPtr^,512,r);
  756.             if r < 512 then ShowError(100,'Ndx_Get/Put');
  757.          end;
  758.          Ndx_PagArray[v].BlkWrt := false;
  759.       end;
  760.    end;
  761. end;
  762.  
  763. Procedure GS_dBase_IX.Ndx_Get(blk : longint);
  764. var
  765.    d : GS_DiskTblPag;
  766.    r : word;
  767.    i : integer;
  768.    v : integer;
  769. begin
  770.    v := -1;
  771.    for i := 0 to NdxBufferedPages-1 do
  772.       if Ndx_PagArray[i].BlkNum = blk then v := i;
  773.    if v < 0 then
  774.    begin
  775.       v := NdxBufferedPages-1;
  776.       if Ndx_PagArray[v].BlkWrt then
  777.       begin
  778.          GS_FileWrite(Ndx_File,Ndx_PagArray[v].BlkNum*512,
  779.          Ndx_PagArray[v].BlkPtr^,512,r);
  780.          if r < 512 then ShowError(100,'Ndx_Get/Put');
  781.       end;
  782.       Ndx_PagArray[v].BlkNum := blk;
  783.       Ndx_PagArray[v].BlkWrt := false;
  784.       if Ndx_PagArray[v].BlkPtr = nil then New(Ndx_PagArray[v].BlkPtr);
  785.       GS_FileRead(Ndx_File,blk*512,Ndx_PagArray[v].BlkPtr^,512,r);
  786.       if r < 512 then ShowError(100,'Ndx_Get');
  787.    end;
  788.    d := Ndx_PagArray[v];
  789.    if v <> 0 then move(Ndx_PagArray[0],Ndx_PagArray[1],SizeOf(d)*v);
  790.    Ndx_PagArray[0] := d;
  791.    move(d.BlkPtr^,Ndx_Data,512);
  792. end;
  793.  
  794. Procedure GS_dBase_IX.Ndx_NodeData(pn, en, lo : longint; np : boolean);
  795. begin
  796.    inc(Ndx_Lvl);                      {Prepare to store node information as}
  797.                                       {part of the Ndx_Lvl hierarchy}
  798.    with Ndx_Tabl[Ndx_Lvl] do          {Use the index level entry}
  799.    begin
  800.       Page_No := pn;                  {Save Block number}
  801.       Etry_No := en;                  {Set entry number}
  802.       Last_One := lo;                 {Set total number of entries.}
  803.       Node_Pag := np;                 {Set non-leaf flag}
  804.    end;
  805. end;
  806.  
  807. {
  808.                     ┌─────────────────────────────────────┐
  809.                     │  This procedure will locate the     │
  810.                     │  starting page to search for an     │
  811.                     │  entry.  It selects the entry       │
  812.                     │  number contained at the present    │
  813.                     │  index level and passes its node    │
  814.                     │  pointer to Get_PageRec.  This is   │
  815.                     │  needed to read the index blocks in │
  816.                     │  the correct sequence.              │
  817.                     └─────────────────────────────────────┘
  818. }
  819.  
  820. procedure GS_dBase_IX.Ndx_GetRecEntry;
  821. begin
  822.    RPag := Ndx_Tabl[Ndx_Lvl].Page_No;
  823.                                       {Get page number for this index level}
  824.    Ndx_Get(RPag);                     {Get Node using RPag as block number}
  825.    Ndx_Pntr := Addr(Ndx_Data.Data_Ary[(Ndx_Tabl[Ndx_Lvl].Etry_No- 1)
  826.                                           * Ndx_Hdr.Entry_Sz]);
  827.                                       {Get pointer to key entry (relative zero)}
  828.    RPag := Ndx_Pntr^.Block_Ax;        {Get Next node number in RPag}
  829.    Ndx_GetRecPage(IsAscend);          {Go get the next record from a non-leaf}
  830.                                       {node.  Pass the argument for either an}
  831.                                       {ascending or descending search}
  832. end;
  833. {
  834.                     ┌─────────────────────────────────────┐
  835.                     │  This procedure will step the nodes │
  836.                     │  until it finds a leaf node.  The   │
  837.                     │  starting node is contained in the  │
  838.                     │  variable RPag; the record number   │
  839.                     │  of the first or last key (based)   │
  840.                     │  on Ascnd) will be placed in RNum.  │
  841.                     └─────────────────────────────────────┘
  842. }
  843. procedure GS_dBase_IX.Ndx_GetRecPage(Ascnd : boolean);
  844. var
  845.    ec : integer;                      {Work variable for entry count}
  846. begin
  847.     while RPag <> 0 do                {Next node number in RPag will be zero}
  848.                                       {when taken from a leaf node.}
  849.     begin
  850.        Ndx_Get(RPag);                 {Get Node using RPag as block number}
  851.        Ndx_NodeData(RPag,0,Ndx_Data.Entry_Ct+1,true);
  852.                                       {Store Node data}
  853. {
  854.                ┌───────────────────────────────────────────────┐
  855.                │  This portion of code checks to see if called │
  856.                │  by Next/Top or Bttm/Prev, and sets the entry │
  857.                │  to 1 or last node entry, based on Ascnd      │
  858.                └───────────────────────────────────────────────┘
  859. }
  860.        if Ascnd then
  861.        begin
  862.           ec := 0;                    {Set ec = first entry (relative zero)}
  863.           Ndx_Tabl[Ndx_Lvl].Etry_No := 1;
  864.                                       {Set Entry Number in table to first one}
  865.        end else
  866.        begin
  867.           ec := Ndx_Data.Entry_Ct;    {Set ec to last entry (relative zero)}
  868.                                       {Note there are Entry_Ct+1 entries for}
  869.                                       {non-leaf nodes.  It will be adjusted}
  870.                                       {later if it is a leaf node}
  871.           Ndx_Tabl[Ndx_Lvl].Etry_No := ec+1;
  872.                                       {Set Entry Number in table to last one}
  873.        end;
  874.  
  875.        Ndx_Pntr := Addr(Ndx_Data.Data_Ary[ec * Ndx_Hdr.Entry_Sz]);
  876.                                       {Get pointer to correct entry in node}
  877.        RPag := Ndx_Pntr^.Block_Ax;    {Get Next node number in RPag}
  878.     end;
  879.     if Ndx_Data.Entry_Ct = 0 then
  880.     begin
  881.        KeyEOF := true;
  882.        RNum := 0;
  883.        exit;
  884.     end;
  885.     Ndx_Tabl[Ndx_Lvl].Node_Pag := false;
  886.                                       {Set non-leaf flag to false for leaf}
  887.     if not Ascnd then
  888.     begin
  889.        dec(Ndx_Tabl[Ndx_Lvl].Etry_No);
  890.                                       {Set Entry Number in table to last one}
  891.                                       {for a non-leaf node}
  892.        Ndx_Pntr := Addr(Ndx_Data.Data_Ary[(ec-1) * Ndx_Hdr.Entry_Sz]);
  893.                                       {Get pointer to correct leaf entry for}
  894.                                       {the last entry in the node}
  895.     end;
  896.     Ndx_Tabl[Ndx_Lvl].Node_Pag := false;
  897.                                       {Set non-leaf flag to false for this}
  898.                                       {last level}
  899.     dec(Ndx_Tabl[Ndx_Lvl].Last_One);  {Set total number of entries to the }
  900.                                       {correct value for a leaf node}
  901.     RNum := Ndx_Pntr^.Recrd_Ax;       {Get the physical record number for}
  902.                                       {the first key entry}
  903. end;
  904.  
  905. function GS_dBase_IX.Ndx_LastEntry : boolean;
  906. begin
  907.    if Ndx_Tabl[Ndx_Lvl].Etry_No = Ndx_Tabl[Ndx_Lvl].Last_One then
  908.        Ndx_LastEntry := true else Ndx_LastEntry := false;
  909. end;
  910.  
  911.  
  912. Procedure GS_dBase_IX.Ndx_Put(blk : longint);
  913. var
  914.    d : GS_DiskTblPag;
  915.    r : word;
  916.    i : integer;
  917.    v : integer;
  918. begin
  919.    v := -1;
  920.    for i := 0 to NdxBufferedPages-1 do
  921.       if Ndx_PagArray[i].BlkNum = blk then v := i;
  922.    if v < 0 then
  923.    begin
  924.       v := NdxBufferedPages-1;
  925.       if Ndx_PagArray[v].BlkWrt then
  926.       begin
  927.          GS_FileWrite(Ndx_File,Ndx_PagArray[v].BlkNum*512,
  928.          Ndx_PagArray[v].BlkPtr^,512,r);
  929.          if r < 512 then ShowError(100,'Ndx_Put');
  930.       end;
  931.       Ndx_PagArray[v].BlkNum := blk;
  932.       if Ndx_PagArray[v].BlkPtr = nil then New(Ndx_PagArray[v].BlkPtr);
  933.       GS_FileWrite(Ndx_File,blk*512,Ndx_Data,512,r);
  934.       if r < 512 then ShowError(100,'Ndx_Put/New');
  935.    end;
  936.    d := Ndx_PagArray[v];
  937.    if v <> 0 then move(Ndx_PagArray[0],Ndx_PagArray[1],SizeOf(d)*v);
  938.    d.BlkWrt := true;
  939.    Ndx_PagArray[0] := d;
  940.    move(Ndx_Data,d.BlkPtr^,512);
  941. end;
  942.  
  943.  
  944. Procedure GS_dBase_IX.KeyUpdate (st : string; rec, crec : longint);
  945. var
  946.    ct : integer;
  947.    nu_key : longint;
  948.    em_hold : boolean;                 {holds ExactMatch flag during this}
  949.    lr,
  950.    b1,
  951.    b2  : longint;
  952.    rlst,
  953.    e1,
  954.    e2,
  955.    n1,
  956.    n2  : integer;
  957.    s1,
  958.    s2  : string[127];
  959.    r1  : GS_Indx_Data;
  960.  
  961. {
  962.    This routine deletes the current entry by overlaying the remaining entries
  963.    over the entry location, and then decrementing the entry count
  964. }
  965.    Procedure DeleteEntry;
  966.    begin
  967.       with Ndx_Tabl[Ndx_Lvl] do
  968.       begin
  969.          move(Ndx_Data.Data_Ary[(Etry_No)*Ndx_Hdr.Entry_Sz],
  970.               Ndx_Data.Data_Ary[(Etry_No-1)*Ndx_Hdr.Entry_Sz],
  971.               Ndx_Hdr.Entry_Sz*(Last_One-Etry_No));
  972.          dec(Last_One);
  973.          dec(Ndx_Data.Entry_Ct);
  974.       end;
  975.    end;
  976.  
  977.  
  978. {  This routine inserts an entry by making room in the current data array
  979.    and inserting the new entry.  The entry count is then incremented.
  980. }
  981.    Procedure InsertEntry;
  982.    begin
  983.       with Ndx_Tabl[Ndx_Lvl] do
  984.       begin
  985.          if (Etry_No <> 0) and (not KeyEOF) then
  986.          begin                        {If at a valid entry number and not}
  987.                                       {at EOF, make room for the entry.  }
  988.             move(Ndx_Data.Data_Ary[(Etry_No-1)*Ndx_Hdr.Entry_Sz],
  989.                  Ndx_Data.Data_Ary[(Etry_No)*Ndx_Hdr.Entry_Sz],
  990.                  Ndx_Hdr.Entry_Sz*(((Last_One-Etry_No)+1)));
  991.             Ndx_Pntr := Addr(Ndx_Data.Data_Ary[(Etry_No-1) * Ndx_Hdr.Entry_Sz]);
  992.          end
  993.          else
  994.          begin                        {else put entry at end of array}
  995.             Ndx_Pntr := Addr(Ndx_Data.Data_Ary[Etry_No*Ndx_Hdr.Entry_Sz]);
  996.             inc(Etry_No);
  997.          end;
  998.          inc(Last_One);               {account for additional entry}
  999.          inc(Ndx_Data.Entry_Ct);      {account for additional entry}
  1000.          move(Work_Key[1],Ndx_Pntr^.Char_Fld,Ndx_Hdr.Key_Lgth)
  1001.                                       {Move the key field from Work_Key.}
  1002.                                       {The Move procedure must be used since}
  1003.                                       {Char_Fld is not a true Pascal string.}
  1004.       end;
  1005.    end;
  1006.  
  1007. {  This routine searches back through the nodes to replace the key value in
  1008.    the non-leaf node.
  1009. }
  1010.    procedure ReplacePointerEntry;
  1011.    begin
  1012.       while (Ndx_LastEntry) and (Ndx_Lvl > 0) do dec(Ndx_Lvl);
  1013.                                       {Search for entry that requires the key}
  1014.                                       {value.  Value is not needed for the   }
  1015.                                       {last entry in a non-leaf node.  Thus, }
  1016.                                       {this searches until it finds a pointer}
  1017.                                       {that is not the last entry in a node, }
  1018.                                       {or until the root node is reached.    }
  1019.       if Ndx_Lvl > 0 then
  1020.       begin                           {Replace key value with new one if not }
  1021.                                       {the last entry in the root node.      }
  1022.          Ndx_Get(Ndx_Tabl[Ndx_Lvl].Page_No);
  1023.                                       {Get the correct index node.}
  1024.          Ndx_Pntr := Addr(Ndx_Data.Data_Ary
  1025.                           [(Ndx_Tabl[Ndx_Lvl].Etry_No-1) * Ndx_Hdr.Entry_Sz]);
  1026.                                       {Get entry that pointed to the leaf node}
  1027.          move(Ndx_Key_St[1],Ndx_Pntr^.Char_Fld,Ndx_Hdr.Key_Lgth);
  1028.                                       {Move the key field from Ndx_Key_St.}
  1029.          Ndx_Put(Ndx_Tabl[Ndx_Lvl].Page_No);
  1030.                                       {Write updated node to disk}
  1031.       end;
  1032.    end;
  1033.  
  1034.  
  1035. {  This routine is used to delete all references to a record key.  It will
  1036.    delete the key from the leaf node, and then search the non-leaf node and
  1037.    replace the pointer if it was the last entry in the non-leaf node.
  1038. }
  1039.    Procedure KeyDelete;
  1040.    begin
  1041.       DeleteEntry;                    {delete the key from this node.}
  1042.       Ndx_Put(Ndx_Tabl[Ndx_Lvl].Page_No);
  1043.                                       {write the updated node.}
  1044.       if Ndx_Tabl[Ndx_Lvl].Last_One = 0 then
  1045.       begin                           {if this was the only entry, then }
  1046.                                       {go delete any previous references}
  1047.                                       {to the node.                     }
  1048.          dec(Ndx_Lvl);
  1049.          if Ndx_Lvl > 0 then
  1050.          begin                        {this will be recursive until it  }
  1051.                                       {steps past the root node.        }
  1052.             Ndx_Get(Ndx_Tabl[Ndx_Lvl].Page_No);
  1053.                                       {Get the node.}
  1054.             KeyDelete;                {and delete the pointer.}
  1055.          end;
  1056.          exit;                        {leave this procedure when all the}
  1057.                                       {references are deleted.          }
  1058.       end;
  1059.  
  1060.       if Ndx_Tabl[Ndx_Lvl].Etry_No > Ndx_Tabl[Ndx_Lvl].Last_One then
  1061.       begin                           {if this was the last entry in the node,}
  1062.                                       {make sure non-leaf node pointers use   }
  1063.                                       {the predecessor key value.             }
  1064.          Ndx_Pntr := Addr(Ndx_Data.Data_Ary
  1065.                            [(Ndx_Tabl[Ndx_Lvl].Last_One-1) * Ndx_Hdr.Entry_Sz]);
  1066.                                       {point to the predecessor entry.}
  1067.          move(Ndx_Pntr^.Char_Fld,Ndx_Key_St[1],Ndx_Hdr.Key_Lgth);
  1068.                                       {Move the key field to Ndx_Key_St.}
  1069.                                       {The Move procedure must be used since}
  1070.                                       {Char_Fld is not a true Pascal string.}
  1071.          Ndx_Key_St[0] := chr(length(Work_Key));
  1072.                                       {Now insert the length into Ndx_Key_St}
  1073.                                       {so it is a valid string we can use}
  1074.          dec(Ndx_Lvl);
  1075.          if Ndx_Lvl > 0 then ReplacePointerEntry;
  1076.                                       {replace the node pointer with this new key}
  1077.       end;
  1078.    end;
  1079.  
  1080.  
  1081. {  This routine will divide a block into two equal blocks and then store the
  1082.    index levels (n1 and n2), entry counts (e1 and e2), and block numbers
  1083.    (b1 and b2) for later node pointer updates.  The new key (from the middle
  1084.    of the block's entries) will be saved in s1.
  1085. }
  1086.    Procedure SplitBlock;
  1087.    begin
  1088.       b1 := Ndx_Hdr.Next_Blk;         {Get the next available block.}
  1089.       inc(Ndx_Hdr.Next_Blk);          {Update the next available block.}
  1090.       Ndx_NodeData(b1,1,Ndx_Tabl[Ndx_Lvl].Last_One,Ndx_Tabl[Ndx_Lvl].Node_Pag);
  1091.                                       {make a new index table entry}
  1092.       with Ndx_Tabl[Ndx_Lvl] do
  1093.       begin                           {put the first half of the block in the}
  1094.                                       {new block.  Adjust the entry and last }
  1095.                                       {one counts accordingly.               }
  1096.          n1 := Ndx_Lvl;
  1097.          Ndx_Data.Entry_Ct := Last_One div 2;
  1098.                                       {Number of entries in first half.}
  1099.          e2 := Last_One - Ndx_Data.Entry_Ct;
  1100.                                       {Number of entries in second half.}
  1101.          Last_One := Ndx_Data.Entry_Ct;
  1102.          e1 := Last_One;
  1103.          if Node_Pag then dec(Ndx_Data.Entry_Ct);
  1104.          Ndx_Pntr := Addr(Ndx_Data.Data_Ary
  1105.                           [(Ndx_Tabl[Ndx_Lvl].Last_One-1) * Ndx_Hdr.Entry_Sz]);
  1106.          move(Ndx_Pntr^.Char_Fld,s1[1],Ndx_Hdr.Key_Lgth);
  1107.          s1[0] := chr(Ndx_Hdr.Key_Lgth);
  1108.                                       {Save the last key entry in the block.}
  1109.          Ndx_Put(Page_No);            {Save the block.}
  1110.       end;
  1111.       dec(Ndx_Lvl);
  1112.       with Ndx_Tabl[Ndx_Lvl] do
  1113.       begin
  1114.          b2 := Page_No;
  1115.          n2 := Ndx_Lvl;
  1116.          Last_One := e2;
  1117.          Ndx_Data.Entry_Ct := e2;
  1118.          if Node_Pag then dec(Ndx_Data.Entry_Ct);
  1119.          move(Ndx_Data.Data_Ary[e1*Ndx_Hdr.Entry_Sz],
  1120.               Ndx_Data.Data_Ary[0],Ndx_Hdr.Entry_Sz*(e2));
  1121.                                       {Shift second half to beginning of the}
  1122.                                       {buffer array.}
  1123.          Ndx_Put(Page_No);            {Save the block}
  1124.          move(Ndx_Hdr, Ndx_Data, 512);
  1125.                                       {Store from header info area}
  1126.          Ndx_Put(0);
  1127.          dec(Ndx_Lvl);                {Step back to previous node.}
  1128.       end;
  1129.    end;
  1130.  
  1131.  
  1132. {  This routine is used to create a new root node when the split block
  1133.    pointers will not fit in the current root node.
  1134. }
  1135.    Procedure MakeRootNode;
  1136.    begin
  1137.       Ndx_Lvl := 0;
  1138.       with Ndx_Tabl[Ndx_Lvl] do
  1139.       begin
  1140.          Page_No := Ndx_Hdr.Next_Blk; {Get next available block.}
  1141.          inc(Ndx_Hdr.Next_Blk);       {Increment the next available block.}
  1142.          Ndx_Hdr.Root := Page_No;     {Set root pointer to this block.}
  1143.          move(Ndx_Hdr, Ndx_Data, 512);
  1144.                                       {Store from header info area}
  1145.          Ndx_Put(0);                  {Write updated header block.}
  1146.          FillChar(Ndx_Data, SizeOf(Ndx_Data),#0);
  1147.          Ndx_Pntr := Addr(Ndx_Data.Data_Ary[0]);
  1148.          Ndx_Data.Entry_Ct := 0;
  1149.          Ndx_Pntr^.Recrd_Ax := 0;
  1150.          Ndx_Pntr^.Block_Ax := b2;
  1151.          Last_One := 1;
  1152.          Etry_No := 1;
  1153.          Ndx_Put(Page_No);
  1154.       end;
  1155.    end;
  1156.  
  1157.  
  1158. {  This routine will split the current node, create a new root node if needed,
  1159.    and then insert the newly created block in the proper sequence in the node.
  1160. }
  1161.    procedure ExpandIndex;
  1162.    var
  1163.       kEOF : boolean;
  1164.    begin
  1165.       SplitBlock;
  1166.       if Ndx_Lvl = 0 then MakeRootNode;
  1167.       Work_Key := s1;
  1168.       Ndx_Get(Ndx_Tabl[Ndx_Lvl].Page_No);
  1169.                                       {Get the proper non-leaf node}
  1170.       kEOF := KeyEOF;
  1171.       KeyEOF := false;                {temporarily turn off EOF flag}
  1172.       InsertEntry;
  1173.       KeyEOF := kEOF;
  1174.       Ndx_Pntr^.Recrd_Ax := 0;
  1175.       Ndx_Pntr^.Block_Ax := b1;
  1176.       if Ndx_Tabl[Ndx_Lvl].Last_One <= Ndx_Hdr.Max_Keys then
  1177.                                       {test to see if more entries than the}
  1178.                                       {maximum allowed.                    }
  1179.       begin                           {write the block if below the max.   }
  1180.          Ndx_Put(Ndx_Tabl[Ndx_Lvl].Page_No);
  1181.       end else
  1182.       begin
  1183.          ExpandIndex;                 {Keep expanding recursively as long as}
  1184.                                       {is necessary.                        }
  1185.       end;
  1186.    end;
  1187.  
  1188.  
  1189. {  This routine will insert the new key into the index.  It will search for
  1190.    matching keys and insert the new key after any existing matches.  It will
  1191.    then check to see if the node is filled, and split the block if necessary.
  1192. }
  1193.    Procedure KeyInsert;
  1194.    begin
  1195.       nu_key := KeyFind(st);          {Find a matching key.}
  1196.       if nu_key <> 0 then             {If there is a match, continue looking}
  1197.          while (Ndx_Key_St = Work_Key) and (not KeyEOF) do
  1198.                nu_key := KeyRead(Next_Record);
  1199.       InsertEntry;                    {Insert the key here}
  1200.       Ndx_Pntr^.Recrd_Ax := rec;
  1201.       Ndx_Pntr^.Block_Ax := 0;
  1202.       if Ndx_Tabl[Ndx_Lvl].Etry_No > Ndx_Tabl[Ndx_Lvl].Last_One then
  1203.                                       {See if this is the last entry in the }
  1204.                                       {leaf node.  If so, go replace the old}
  1205.                                       {pointer in the non-leaf node.        }
  1206.       begin
  1207.          r1 := Ndx_Data;
  1208.          n1 := Ndx_Lvl;
  1209.          Ndx_Key_St := Work_Key;
  1210.          ReplacePointerEntry;
  1211.          Ndx_Lvl := n1;
  1212.          Ndx_Data := r1;
  1213.       end;
  1214.       if Ndx_Tabl[Ndx_Lvl].Last_One <= Ndx_Hdr.Max_Keys then
  1215.                                       {if fewer than the maximum number of key}
  1216.                                       {entries allowed, write the updated node}
  1217.       begin
  1218.          Ndx_Put(Ndx_Tabl[Ndx_Lvl].Page_No);
  1219.       end else
  1220.       begin
  1221.          ExpandIndex;                 {otherwise, split the block.}
  1222.       end;
  1223.    end;
  1224.  
  1225. begin
  1226.    Work_Key := SetMatchValue(st);     {Set key comparison value}
  1227.    if rec = crec then                 {Tests for Append vs Update}
  1228.    begin
  1229.       if KeyLocRec(rec) then
  1230.       begin
  1231.          if Work_Key = Ndx_Key_St then exit;
  1232.          KeyDelete;
  1233.       end;
  1234.    end;
  1235.    em_hold := ExactMatch;
  1236.    ExactMatch := true;
  1237.    KeyInsert;
  1238.    ExactMatch := em_hold;
  1239.    if crec < 0 then exit;
  1240.    lr := KeyFind(st);
  1241.    while lr <> rec do lr := KeyRead(Next_Record);
  1242. end;
  1243.  
  1244.  
  1245.  
  1246. Procedure GS_dBase_IX.KeyList(st : string);
  1247. var
  1248.    ofil      : text;
  1249.    RPag      : LongInt;
  1250.    Lst_One,
  1251.    i,j,k,v   : integer;
  1252.    rl        : integer;
  1253.    ct        : integer;
  1254.    recnode,
  1255.    Less_Than : boolean;
  1256. begin
  1257.    assign(ofil, st);
  1258.    ReWrite(ofil);
  1259.    with Ndx_Hdr do
  1260.    begin
  1261.       writeln(ofil,'--------------------------------------------------');
  1262.       writeln(ofil,'File Name = ',Ndx_Name);
  1263.       writeln(ofil,'Key Expression = ',Ndx_Key_Form);
  1264.       writeln(ofil,'Key Length = ',Key_Lgth,
  1265.                    '   Maximum Keys/Block = ',Max_Keys);
  1266.       writeln(ofil,'Root =',Root:3,'   Next Block Available:',Next_Blk:3);
  1267.    end;
  1268.    RPag := 1;
  1269.    while RPag <> Ndx_Hdr.Next_Blk do
  1270.    begin
  1271.       Ndx_Get(RPag);
  1272.       Lst_One := Ndx_Data.Entry_Ct+1;
  1273.       write(ofil,RPag:2,'  [',Ndx_Data.Entry_Ct,']');
  1274.       Ndx_Pntr :=  Addr(Ndx_Data.Data_Ary[0]);
  1275.       recnode := Ndx_Pntr^.Block_Ax = 0;
  1276.       k := Lst_One;
  1277.       if recnode then dec(k);
  1278.       v := 1;
  1279.       i := 1;
  1280.       while (i <= k) do
  1281.       begin
  1282.          Ndx_Pntr :=  Addr(Ndx_Data.Data_Ary[((i-1) *  Ndx_Hdr.Entry_Sz)]);
  1283.          with Ndx_Pntr^ do
  1284.          begin
  1285.             write(ofil,'':v,Block_Ax:5);
  1286.             v := 9;
  1287.             if i = Lst_One then write(ofil,'    0 - empty')
  1288.             else
  1289.                begin
  1290.                   write(ofil,Recrd_Ax:5,' ');
  1291.                   if Ndx_Hdr.Data_Typ <> 0 then
  1292.                      write(ofil,CnvrtDouble(Char_Fld))
  1293.                   else
  1294.                      for j := 1 to Ndx_Hdr.Key_Lgth do
  1295.                         write(ofil,Char_Fld[j]);
  1296.                end;
  1297.          WRITELN(OFIL);
  1298.          end;
  1299.          inc(i);
  1300.       end;
  1301.       writeln(ofil);
  1302.       inc(RPag);
  1303.    end;
  1304.    System.Close(ofil);
  1305. end;
  1306.  
  1307. end.
  1308. {-----------------------------------------------------------------------------}
  1309.                                       END
  1310.  
  1311.  
  1312.