home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / GSDBASE.ZIP / GS_DB_IX.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-01-08  |  10.3 KB  |  326 lines
  1. unit GS_DB_IX;
  2.  
  3. {      GS_DB_IX Copyright (c)  Richard F. Griffin
  4.  
  5.        8 January 1990
  6.  
  7.        102 Molded Stone Pl
  8.        Warner Robins, GA  31088
  9.  
  10.        -------------------------------------------------------------
  11.        This unit handles the objects for all dBase III index (.NDX)
  12.        operations.
  13.  
  14. }
  15.  
  16. {$N+,E+}
  17. interface
  18. uses dos;
  19.  
  20. type
  21.  
  22.    GS_Indx_Head = Record
  23.                      Root        : Longint;
  24.                      Next_Blk    : Longint;
  25.                      Unknwn1     : Longint;
  26.                      Key_Lgth    : Integer;
  27.                      Max_Keys    : Integer;
  28.                      Data_Typ    : Integer;
  29.                      Entry_Sz    : Integer;
  30.                      Unknwn2     : Longint;
  31.                      Key_Form    : array [0..487] of char;
  32.                   end;
  33.  
  34.    GS_Indx_Data = Record
  35.                      Entry_Ct    : Integer;
  36.                      Unknwn1     : Integer;
  37.                      Data_Ary    : array [0..507] of byte;
  38.                   end;
  39.  
  40.    GS_Indx_EntPtr = ^GS_Indx_Etry;
  41.  
  42.    GS_Indx_Etry = Record
  43.                      Block_Ax : Longint;
  44.                      Recrd_Ax : Longint;
  45.                      case Integer of
  46.                          0    : (Char_Fld : array [1..255] of char);
  47.                          1    : (Numb_Fld : double);
  48.                   end;
  49.  
  50.    GS_Indx_Tabl = Record
  51.                      Page_No  : Longint;
  52.                      Etry_No  : integer;
  53.                      Last_One : integer;
  54.                      Node_Pag : Boolean;
  55.                   end;
  56.  
  57.    GS_Indx_LPtr = ^GS_dBase_IX;
  58.  
  59.    GS_dBase_IX = object
  60.                     Ndx_Name     : String[64];
  61.                     Ndx_Hdr      : GS_Indx_Head;
  62.                     Ndx_File     : file;
  63.                     Ndx_Tabl     : array [1..25] of GS_Indx_Tabl;
  64.                     Ndx_Lvl      : integer;
  65.                     Ndx_Data     : GS_Indx_Data;
  66.                     Ndx_Pntr     : GS_Indx_EntPtr;
  67.                     PROCEDURE Init(IName : String);
  68.                     FUNCTION  KeyEOF : boolean;
  69.                     FUNCTION  KeyRead(a : LongInt) : longint;
  70.                     FUNCTION  KeyFind(st : String) : longint;
  71.                  end;
  72.  
  73. implementation
  74.  
  75. const
  76.    Next_Record = -1;
  77.    Prev_Record = -2;
  78.    Top_Record  = -3;
  79.    Bttm_Record = -4;
  80.  
  81. procedure GS_dBase_IX.Init(IName : String);
  82. var
  83.    ct : word;
  84. begin
  85.    Ndx_Name := IName + '.NDX';
  86.    assign(Ndx_File,Ndx_Name);
  87.    reset(Ndx_File,1);
  88.    BlockRead(Ndx_File,Ndx_Hdr,512,ct);
  89.    Ndx_Lvl := 0;
  90. end;
  91.  
  92. function GS_dBase_IX.KeyEOF : boolean;
  93. var
  94.    eflg : boolean;
  95.    i    : integer;
  96. begin
  97.    eflg := true;
  98.    if Ndx_Lvl = 0 then eflg := false
  99.    else
  100.       for i := 1 to Ndx_Lvl do
  101.          if Ndx_Tabl[i].Etry_No < Ndx_Tabl[i].Last_One then
  102.             eflg := false;
  103.    KeyEOF := eflg;
  104. end;
  105.  
  106.  
  107. FUNCTION  GS_dBase_IX.KeyRead(a : longint) : longint;
  108. var
  109.    RNum       : Longint;
  110.    Result     : Integer;
  111.    RPag       : Longint;
  112.    N_L_Hold   : Integer;
  113.    ct         : Integer;
  114.  
  115.    function Last_Entry(ix : longint) : boolean;
  116.    begin
  117.       if Ndx_Tabl[ix].Etry_No = Ndx_Tabl[ix].Last_One then
  118.          Last_Entry := true else Last_entry := false;
  119.    end;
  120.  
  121.  
  122.    procedure Get_Next_RecPage;
  123.    begin
  124.       while RPag <> 0 do
  125.       begin
  126.          Seek(Ndx_File,RPag*512);
  127.          BlockRead(Ndx_File,Ndx_Data,512,ct);
  128.          inc(Ndx_Lvl);
  129.          Ndx_Tabl[Ndx_Lvl].Page_No := RPag;
  130.          Ndx_Tabl[Ndx_Lvl].Etry_No := 1;
  131.          Ndx_Tabl[Ndx_Lvl].Last_One := Ndx_Data.Entry_Ct+1;
  132.          Ndx_Tabl[Ndx_Lvl].Node_Pag := true;
  133.          Ndx_Pntr :=  Addr(Ndx_Data.Data_Ary);
  134.          RPag := Ndx_Pntr^.Block_Ax;
  135.       end;
  136.       Ndx_Tabl[Ndx_Lvl].Node_Pag := false;
  137.       dec(Ndx_Tabl[Ndx_Lvl].Last_One);
  138.       RNum := Ndx_Pntr^.Recrd_Ax;
  139.    end;
  140.  
  141.    procedure Get_Prev_RecPage;
  142.    begin
  143.       while RPag <> 0 do
  144.       begin
  145.          Seek(Ndx_File,RPag*512);
  146.          BlockRead(Ndx_File,Ndx_Data,512,ct);
  147.          inc(Ndx_Lvl);
  148.          Ndx_Tabl[Ndx_Lvl].Page_No := RPag;
  149.          Ndx_Tabl[Ndx_Lvl].Etry_No := Ndx_Data.Entry_Ct+1;
  150.          Ndx_Tabl[Ndx_Lvl].Last_One := Ndx_Data.Entry_Ct+1;
  151.          Ndx_Tabl[Ndx_Lvl].Node_Pag := true;
  152.          Ndx_Pntr :=
  153.                       Addr(Ndx_Data.Data_Ary[(
  154.                       (Ndx_Data.Entry_Ct)*Ndx_Hdr.Entry_Sz)]);
  155.          RPag := Ndx_Pntr^.Block_Ax;
  156.       end;
  157.       Ndx_Pntr :=
  158.                    Addr(Ndx_Data.Data_Ary[(
  159.                    (Ndx_Data.Entry_Ct-1)*Ndx_Hdr.Entry_Sz)]);
  160.       Ndx_Tabl[Ndx_Lvl].Etry_No := Ndx_Data.Entry_Ct;
  161.       Ndx_Tabl[Ndx_Lvl].Node_Pag := false;
  162.       dec(Ndx_Tabl[Ndx_Lvl].Last_One);
  163.       RNum := Ndx_Pntr^.Recrd_Ax;
  164.    end;
  165.  
  166. { Start of KeyRead }
  167.  
  168. begin
  169.    RNum := a;
  170.    if ((a = Next_Record) or (a = Prev_Record)) and
  171.       (Ndx_Lvl = 0) then RNum := Top_Record;
  172.    case RNum of
  173.       Next_Record : begin
  174.                        N_L_Hold := Ndx_Lvl;
  175.                        if Last_Entry(Ndx_Lvl) then
  176.                        begin
  177.                           while (Last_Entry(Ndx_Lvl)) and (Ndx_Lvl > 0) do
  178.                              dec(Ndx_Lvl);
  179.                           if Ndx_Lvl = 0 then
  180.                           begin
  181.                              Ndx_Lvl := N_L_Hold;
  182.                           end else
  183.                           begin
  184.                              RPag := Ndx_Tabl[Ndx_Lvl].Page_No;
  185.                              Seek(Ndx_File,RPag*512);
  186.                              inc(Ndx_Tabl[Ndx_Lvl].Etry_No);
  187.                              BlockRead(Ndx_File,Ndx_Data,512,ct);
  188.                              Ndx_Pntr :=
  189.                                       Addr(Ndx_Data.Data_Ary[(
  190.                                       (Ndx_Tabl[Ndx_Lvl].Etry_No - 1) *
  191.                                       Ndx_Hdr.Entry_Sz)]);
  192.                              RPag := Ndx_Pntr^.Block_Ax;
  193.                              Get_Next_RecPage;
  194.                           end;
  195.                           dec(Ndx_Tabl[Ndx_Lvl].Etry_No);
  196.                        end;
  197.                        inc(Ndx_Tabl[Ndx_Lvl].Etry_No);
  198.                        Ndx_Pntr :=
  199.                                     Addr(Ndx_Data.Data_Ary[(
  200.                                     (Ndx_Tabl[Ndx_Lvl].Etry_No - 1) *
  201.                                     Ndx_Hdr.Entry_Sz)]);
  202.                        RNum := Ndx_Pntr^.Recrd_Ax;
  203.                     end;
  204.       Prev_Record : begin
  205.                        N_L_Hold := Ndx_Lvl;
  206.                        if Ndx_Tabl[Ndx_Lvl].Etry_No = 1 then
  207.                        begin
  208.                           while (Ndx_Tabl[Ndx_Lvl].Etry_No = 1) and
  209.                                 (Ndx_Lvl > 0) do
  210.                              dec(Ndx_Lvl);
  211.                           if Ndx_Lvl = 0 then
  212.                           begin
  213.                              Ndx_Lvl := N_L_Hold ;
  214.                           end else
  215.                           begin
  216.                              RPag := Ndx_Tabl[Ndx_Lvl].Page_No;
  217.                              Seek(Ndx_File,RPag*512);
  218.                              dec(Ndx_Tabl[Ndx_Lvl].Etry_No);
  219.                              BlockRead(Ndx_File,Ndx_Data,512,ct);
  220.                              Ndx_Pntr :=
  221.                                       Addr(Ndx_Data.Data_Ary[(
  222.                                       (Ndx_Tabl[Ndx_Lvl].Etry_No - 1) *
  223.                                       Ndx_Hdr.Entry_Sz)]);
  224.                              RPag := Ndx_Pntr^.Block_Ax;
  225.                              Get_Prev_RecPage;
  226.                           end;
  227.                           inc(Ndx_Tabl[Ndx_Lvl].Etry_No);
  228.                        end;
  229.                        dec(Ndx_Tabl[Ndx_Lvl].Etry_No);
  230.                        Ndx_Pntr :=
  231.                                     Addr(Ndx_Data.Data_Ary[(
  232.                                     (Ndx_Tabl[Ndx_Lvl].Etry_No - 1) *
  233.                                     Ndx_Hdr.Entry_Sz)]);
  234.                        RNum := Ndx_Pntr^.Recrd_Ax;
  235.                     end;
  236.       Top_Record  : begin
  237.                        Ndx_Lvl := 0;
  238.                        RPag := Ndx_Hdr.Root;
  239.                        Get_Next_RecPage;
  240.                     end;
  241.       Bttm_Record : begin
  242.                        Ndx_Lvl := 0;
  243.                        RPag := Ndx_Hdr.Root;
  244.                        Get_Prev_RecPage;
  245.                     end;
  246.    end;
  247.    KeyRead := RNum;
  248. end;
  249.  
  250.  
  251. function GS_dBase_IX.KeyFind(st : string) : LongInt;
  252. var
  253.    long_st   : string[255];
  254.    key_st    : string[255];
  255.    m_num     : double;
  256.    st_Lth    : integer;
  257.    RPag      : LongInt;
  258.    i         : integer;
  259.    rl        : integer;
  260.    ct        : integer;
  261.    Less_Than : boolean;
  262. begin
  263.    FillChar(long_st[1], 255, ' ');
  264.    long_st := st;
  265.    st_Lth := Ndx_Hdr.Key_Lgth;
  266.    long_st[0] := chr(st_Lth);
  267.    if Ndx_Hdr.Data_Typ <> 0 then val(st,m_num,rl);
  268.    Ndx_Lvl := 0;
  269.    RPag := Ndx_Hdr.Root;
  270.    while RPag <> 0 do
  271.    begin
  272.       Seek(Ndx_File,RPag*512);
  273.       BlockRead(Ndx_File,Ndx_Data,512,ct);
  274.       inc(Ndx_Lvl);
  275.       with Ndx_Tabl[Ndx_Lvl] do
  276.       begin
  277.          Page_No := RPag;
  278.          Etry_No := 0;
  279.          Last_One := Ndx_Data.Entry_Ct+1;
  280.          Node_Pag := true;
  281.          i := 1;
  282.          Less_Than := true;
  283.          while (less_than) and (i <= Last_One) do
  284.          begin
  285.             Etry_No := i;
  286.             Ndx_Pntr :=  Addr(Ndx_Data.Data_Ary[((i-1) *  Ndx_Hdr.Entry_Sz)]);
  287.             if Ndx_Hdr.Data_Typ = 0 then
  288.             begin
  289.                move(Ndx_Pntr^.Char_Fld,key_st[1],st_Lth);
  290.                key_st[0] := chr(st_Lth);
  291.                if key_st >= long_st then Less_Than := false;
  292.             end else
  293.             begin
  294.                if Ndx_Pntr^.Numb_Fld >= m_num then Less_Than := false;
  295.             end;
  296.             inc(i);
  297.          end;
  298.          RPag := Ndx_Pntr^.Block_Ax;
  299.       end;
  300.    end;
  301.    Ndx_Tabl[Ndx_Lvl].Node_Pag := false;
  302.    dec(Ndx_Tabl[Ndx_Lvl].Last_One);
  303.    if Ndx_Hdr.Data_Typ = 0 then
  304.    begin
  305.       if (key_st <> long_st) or
  306.          (Ndx_Tabl[Ndx_Lvl].Last_One < Ndx_Tabl[Ndx_Lvl].Etry_No)
  307.             then KeyFind := 0
  308.          else
  309.             KeyFind := Ndx_Pntr^.Recrd_Ax;
  310.    end else
  311.    begin
  312.       if (Ndx_Pntr^.Numb_Fld <> m_num) or
  313.          (Ndx_Tabl[Ndx_Lvl].Last_One < Ndx_Tabl[Ndx_Lvl].Etry_No)
  314.             then KeyFind := 0
  315.          else
  316.             KeyFind := Ndx_Pntr^.Recrd_Ax;
  317.    end;
  318. end;
  319.  
  320.  
  321.  
  322.  
  323.  
  324. end.
  325.  
  326.