home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / NEWS / 552 / GSOB_DBS.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-07  |  42KB  |  1,370 lines
  1. unit GSOB_DBS;
  2. {-----------------------------------------------------------------------------
  3.                         dBase III/IV DataBase Handler
  4.  
  5.        GSOB_DBS Copyright (c)  Richard F. Griffin
  6.  
  7.        27 January 1993
  8.  
  9.        102 Molded Stone Pl
  10.        Warner Robins, GA  31088
  11.  
  12.        -------------------------------------------------------------
  13.        This unit contains the objects to manipulate the data, index, and
  14.        memo files that constitute a database.
  15.  
  16.                    SHAREWARE  -- COMMERCIAL USE RESTRICTED
  17.  
  18.    Changes:
  19.  
  20.       19 Apr 93 - Corrected Skip procedure to correctly handle end-of-file
  21.                   and top-of-file conditions in an indexed database.
  22.  
  23.       02 May 93 - Routines used for conversion to/from numbers have been
  24.                   modified to be of type FloatNum.  This allows numbers to
  25.                   have up to 20 significant digits.  Note that the $N+ and
  26.                   $E+ switches must be set (Alt O,C,8,E in IDE) to compile
  27.                   using this feature.  Otherwise, 11-12 digits will be used.
  28.                   The use of the $N+,E+ switch adds 10K to program size.
  29.  
  30.                   When you compile a program in the $N+,E+ state, the
  31.                   compiler links with the full 80x87 emulator.  The resulting
  32.                   .EXE file can be run on any machine, regardless of whether
  33.                   that machine has an 80x87. If an 80x87 is present, the
  34.                   program will use it; otherwise, the run-time library
  35.                   emulates it.  This gives you access to four additional
  36.                   real types: Single, Double, Extended, and Comp.  The $E+
  37.                   directive will emulate the 80x87. This gives you access
  38.                   to the IEEE floating-point types without requiring that you
  39.                   install an 80x87 chip.
  40.  
  41.       30 Jun 93 - Replaced the call to IndexUpdate in Append to eliminate the
  42.                   call to Formula.
  43.  
  44.       15 Jul 93 - Added Global variable DBFCacheSize to allow the programmer
  45.                   to adjust the size of the cache used.
  46.  
  47.       24 Jul 93 - Modified Find to go to the end of file if no match.  This
  48.                   makes it compatible with the dBase Find procedure.
  49.  
  50.       24 Jul 93 - Added a FindNear function to find either the matching key
  51.                   or position the file to the record with the next greater
  52.                   key if not found.  The Found flag will be set if a key
  53.                   is matched.
  54.  
  55.       25 Jul 93 - Improved the speed of switching indexes in the IndexOrder
  56.                   method.  Replaced routine to do a sequential search for the
  57.                   index key with record number matching the current number.
  58.                   New routine Finds matching record key and then confirms the
  59.                   record number matches.  Provides significant reduction in
  60.                   time required.
  61.  
  62.       07 Aug 93 - Fixed Skip method to properly load the first record or the
  63.                   ending record in the file if the skip count resulted in a
  64.                   skip distance that caused access beyond file limits.
  65.  
  66. ------------------------------------------------------------------------------}
  67. {$V-}
  68.  
  69. interface
  70. uses
  71.    GSOB_Var,
  72.    GSOB_Dte,
  73.    GSOB_MMo,
  74.    GSOB_DBF,
  75.    GSOB_Dsk,
  76.    GSOB_Inx,
  77.    GSOB_Str,
  78.    {$IFDEF CLIPPER}
  79.       GSOB_Ntx,
  80.    {$ELSE}
  81.       GSOB_Ndx,
  82.    {$ENDIF}
  83.    {$IFDEF WINDOWS}
  84.       Objects;
  85.    {$ELSE}
  86.       GSOB_Obj;
  87.    {$ENDIF}
  88.  
  89. const
  90.    IndexesAvail    = 64;
  91.    DBFCacheSize    : word = 32768;
  92.  
  93. type
  94.  
  95.    GSP_FormRec = ^GSR_FormRec;
  96.    GSR_FormRec = record
  97.       FType : Char;
  98.       FDcml : byte;
  99.       FSize : integer;
  100.       FPosn : array[0..32] of integer;
  101.       FAlias: string[10];
  102.    end;
  103.  
  104.    GSP_dBHandler = ^GSO_dBHandler;
  105.  
  106.    GSP_dBIndex     = ^GSO_dBIndex;
  107.    GSO_dBIndex     = object(GSO_IndexFile)
  108.       DBFObj       : GSP_dBHandler;
  109.       PassCount    : integer;
  110.       FormRec      : GSR_FormRec;
  111.       Constructor  Init(dbfilobj : GSP_dBHandler; IName : string);
  112.       Constructor  NewInit(dbfilobj : GSP_dBHandler; filname,
  113.                            formla : string; lth, dcl : integer; typ : char);
  114.       Procedure    IndexUpdate(rnum: longint; fml: GSR_FormRec; apnd: boolean);
  115.       Procedure    WriteStatus(RNum : longint); virtual;
  116.    end;
  117.  
  118.    GSO_dBHandler = object(GSO_dBaseFld)
  119.       IndexHandle : integer;
  120.       IndexMaster : GSP_dBIndex;
  121.       IndexStack  : array[1..IndexesAvail] of GSP_dBIndex;
  122.       MemoFile    : GSP_dBMemo;
  123.       CacheFirst  : Longint;
  124.       CacheLast   : Longint;
  125.       CachePtr    : PByteArray;
  126.       CacheRecs   : integer;
  127.       CacheSize   : LongInt;
  128.       CacheRead   : boolean;
  129.       Found       : boolean;
  130.  
  131.       constructor Init(FName : string);
  132.       destructor  Done; virtual;
  133.       procedure   Append; virtual;
  134.       procedure   Close; virtual;
  135.       procedure   CopyFile(filname: string);
  136.       procedure   CopyFromIndex(ixColl: GSP_IndxColl; filname: string);
  137.       procedure   CopyMemoRecord(df : GSP_dBHandler);
  138.       procedure   CopyStructure(filname : string);
  139.       Function    Find(st : string) : boolean; virtual;
  140.       Function    FindNear(st : string) : boolean; virtual;
  141.       Procedure   Formula(st : string; var fmrec: GSR_FormRec); virtual;
  142.       Function    FormXtract(fmrec : GSR_FormRec) : string; virtual;
  143.       procedure   GetRec(RecNum : LongInt); virtual;
  144.       Procedure   Index(IName : string);
  145.       Function    IndexOrder(AIndexHandle : integer) : boolean;
  146.       function    IndexInsert(ix : GSP_dBIndex) : integer;
  147.       function    IndexMore(IName : string) : integer;
  148.       Function    IndexTo(filname, formla : string) : integer;
  149.       Procedure   LoadToIndex(ixColl: GSP_IndxColl; zfld: string);
  150.       Procedure   MemoClear;
  151.       function    MemoGetLine(linenum : integer) : string;
  152.       Procedure   MemoInsLine(linenum : integer; st : string); virtual;
  153.       procedure   MemoGet(st : string);
  154.       procedure   MemoGetN(n : integer);
  155.       Procedure   MemoWidth(l : integer);
  156.       function    MemoLines : integer;
  157.       procedure   MemoPut(st : string);
  158.       procedure   MemoPutN(n : integer);
  159.       procedure   Open; virtual;
  160.       Procedure   Pack;
  161.       Procedure   ReIndex;
  162.       procedure   PutRec(RecNum : LongInt); virtual;
  163.       Procedure   Read(blk : longint; var dat; len : word); virtual;
  164.       procedure   SetDBFCache(tf: boolean); virtual;
  165.       procedure   Skip(RecCnt : LongInt); virtual;
  166.       procedure   SortFile(filname, zfld: string; isascend : SortStatus);
  167.       Procedure   StatusUpdate(stat1,stat2,stat3 : longint); virtual;
  168.       function    TestFilter : boolean; virtual;
  169.       Procedure   Write(blk : longint; var dat; len : word); virtual;
  170.       Procedure   Zap;
  171.       Procedure   ZapIndexes;
  172.    end;
  173.  
  174.    GSP_dbTable = ^GSO_dbTable;
  175.    GSO_dBTable = Object(GSO_IndxColl)
  176.       dbas        : GSP_dBHandler;     {Object to refer to}
  177.       Sel_Item    : longint;            {Last entry selected}
  178.       Scn_Key     : string;             {Holds select key formula}
  179.       fmRec       : GSR_FormRec;
  180.       fmType      : char;
  181.       tbEntry     : GSP_IndxEtry;
  182.       tbSorted    : boolean;
  183.  
  184.       Constructor Init(var Fil : GSO_dBHandler; zfld : string;
  185.                        sortseq : SortStatus);
  186.       procedure   Build_dBTabl; virtual;
  187.       function    FilterKey : string; virtual;
  188.       function    FindKey_dBTabl(pcnd : string) : boolean; virtual;
  189.       function    FindRec_dBTabl(pcnd : string) : boolean; virtual;
  190.       function    GetKey_dBTabl(keynum: longint): boolean; virtual;
  191.       function    GetRec_dBTabl(keynum: longint): boolean; virtual;
  192.    end;
  193.  
  194. implementation
  195.  
  196. var
  197.    FieldPtr : GSP_DBFField;
  198.    IxOrder  : integer;
  199. constructor GSO_dBHandler.Init(FName : string);
  200. var
  201.    i : integer;
  202. begin
  203.    GSO_dBaseFld.Init(FName);
  204.    if WithMemo then
  205.       case FileVers of
  206.          DB3WithMemo : MemoFile := New(GSP_dBMemo3, Init(FName,FileVers));
  207.          DB4WithMemo : MemoFile := New(GSP_dBMemo4, Init(FName,FileVers));
  208.       end
  209.    else MemoFile := nil;
  210.    IndexHandle := -1;
  211.    IndexMaster := nil;
  212.    for i := 1 to IndexesAvail do IndexStack[i] := nil;
  213.    CacheRead := false;
  214.    CachePtr := nil;
  215.    Found := false;
  216. end;
  217.  
  218. destructor GSO_dBHandler.Done;
  219. var
  220.    i : integer;
  221. begin
  222.    GSO_dBHandler.Close;
  223.    if WithMemo then
  224.    begin
  225.       Dispose(MemoFile, Done);
  226.       WithMemo := false;
  227.    end;
  228.    GSO_dBaseFld.Done;
  229. end;
  230.  
  231. {------------------------------------------------------------------------------
  232.                               Record Processing
  233. ------------------------------------------------------------------------------}
  234.  
  235. procedure GSO_dBHandler.Append;
  236. var
  237.    i    : integer;
  238.    ftyp : char;
  239. begin
  240.    GSO_dBaseFld.Append;
  241.    if (IndexHandle > 0) then
  242.    begin
  243.       for i := 1 to IndexesAvail do
  244.       begin
  245.          if IndexStack[i] <> nil then
  246.          begin
  247.             IndexStack[i]^.IndexUpdate(RecNumber,IndexStack[i]^.FormRec,true);
  248.          end;
  249.       end;
  250.    end;
  251. end;                        {Append}
  252.  
  253. procedure GSO_dBHandler.Close;
  254. var
  255.    i : integer;
  256.    ix : GSP_dBIndex;
  257. begin
  258.    if WithMemo then MemoFile^.Close;
  259.    for i := 1 to IndexesAvail do
  260.       if IndexStack[i] <> nil then
  261.       begin
  262.          Dispose(IndexStack[i], Done);
  263.          IndexStack[i] := nil;
  264.       end;
  265.    IndexMaster := nil;               {Set index active flag to false}
  266.    IndexHandle := -1;
  267.    if CachePtr <> nil then FreeMem(CachePtr, CacheSize);
  268.    CachePtr := nil;
  269.    CacheSize := 0;
  270.    GSO_dBaseFld.Close;
  271. end;
  272.  
  273. Function GSO_dBHandler.Find(st : string) : boolean;
  274. var
  275.    RNum   : longint;
  276. begin
  277.    if (IndexMaster <> nil) then
  278.    begin
  279.       RNum := IndexMaster^.KeyFind(st);
  280.       if RNum > 0 then                {RNum = 0 if no match, otherwise}
  281.                                       {it holds the valid record number}
  282.       begin
  283.          GetRec(RNum);                {If match found, read the record}
  284.          Found := True;               {Set Match Found flag true}
  285.       end else
  286.       begin                           {If no matching index key, then}
  287.          Found := False;              {Set Match Found Flag False}
  288.          GetRec(Bttm_Record);
  289.          File_EOF := True;
  290.       end;
  291.    end else                           {If there is no index file, then}
  292.       Found := False;                 {Set Match Found Flag False}
  293.    Find := Found;
  294. end;                  {Find}
  295.  
  296. Function GSO_dBHandler.FindNear(st : string) : boolean;
  297. var
  298.    RNum   : longint;
  299. begin
  300.    if (IndexMaster <> nil) then
  301.    begin
  302.       RNum := IndexMaster^.KeyFind(st);
  303.       if RNum > 0 then                {RNum = 0 if no match, otherwise}
  304.                                       {it holds the valid record number}
  305.       begin
  306.          GetRec(RNum);                {If match found, read the record}
  307.          Found := True;               {Set Match Found flag true}
  308.       end else
  309.       begin                           {If no matching index key, then}
  310.          Found := False;              {Set Match Found Flag False}
  311.          if IndexMaster^.ixEOF then
  312.          begin
  313.             GetRec(Bttm_Record);
  314.             File_EOF := True;
  315.          end
  316.          else
  317.          begin
  318.             RNum := IndexMaster^.KeyRead(-5);    {Read current index pos}
  319.             GetRec(RNum);                        {read the record}
  320.          end;
  321.       end;
  322.    end else                           {If there is no index file, then}
  323.       Found := False;                 {Set Match Found Flag False}
  324.    FindNear := Found;
  325. end;                  {Find}
  326.  
  327.  
  328. procedure GSO_dBHandler.GetRec(RecNum : LongInt);
  329. var
  330.    rnum  : longint;
  331.    cread : boolean;
  332.    okread: boolean;
  333. begin
  334.    cread := CacheRead;
  335.    okread := false;
  336.    File_EOF := false;
  337.    File_TOF := false;
  338.    rnum := RecNum;
  339.    case RecNum of
  340.       Top_Record  : RecNum := Next_Record;
  341.       Bttm_Record : RecNum := Prev_Record;
  342.    end;
  343.    repeat
  344.       if (IndexMaster <> nil) and (RecNum < 0) then
  345.       begin
  346.          CacheRead := false;
  347.          rnum := IndexMaster^.KeyRead(rnum);
  348.          File_EOF := IndexMaster^.ixEOF;
  349.          File_TOF := IndexMaster^.ixBOF;
  350.       end;
  351.       if (not File_EOF) and (not File_TOF) then   {done if EOF reached}
  352.       begin
  353.          GSO_dBaseDBF.GetRec(rnum);
  354.          if RecNum > 0 then okread := true     {done if physical record access}
  355.             else okread := TestFilter;
  356.          rnum := RecNum;
  357.       end;
  358.    until okread or File_EOF or File_TOF;
  359.    CacheRead := cread;
  360. end;
  361.  
  362. procedure GSO_dBHandler.Open;
  363. begin
  364.    GSO_dBaseFld.Open;
  365.    if WithMemo then MemoFile^.Open;
  366. end;
  367.  
  368. procedure GSO_dBHandler.PutRec(RecNum : LongInt);
  369. var
  370.    i    : integer;
  371.    ftyp : char;
  372. begin
  373.    GSO_dBaseFld.PutRec(RecNum);
  374.    if (IndexHandle > 0) then
  375.    begin
  376.       for i := 1 to IndexesAvail do
  377.       begin
  378.          if IndexStack[i] <> nil then
  379.          begin
  380.             IndexStack[i]^.IndexUpdate(RecNumber,IndexStack[i]^.FormRec,false);
  381.          end;
  382.       end;
  383.    end;
  384. end;                        {PutRec}
  385.  
  386. Procedure GSO_DBHandler.Read(blk : longint; var dat; len : word);
  387. begin
  388.    if (not CacheRead) or (blk < HeadLen) then
  389.       GSO_DiskFile.Read(blk,dat,len)
  390.    else
  391.    begin
  392.       if (CacheFirst = -1) or
  393.          (blk < CacheFirst) or
  394.          (blk > CacheLast) then
  395.       begin
  396.          GSO_DiskFile.Read(blk,CachePtr^,CacheSize);
  397.          CacheFirst := blk;
  398.          CacheLast := (blk + (dfGoodRec-RecLen));
  399.       end;
  400.       if blk > CacheLast then dfGoodRec := 0
  401.       else
  402.       begin
  403.          dfGoodRec := RecLen;
  404.          Move(CachePtr^[blk - CacheFirst],dat,RecLen);
  405.       end;
  406.    end;
  407. end;
  408.  
  409. Procedure GSO_DBHandler.SetDBFCache(tf: boolean);
  410. begin
  411.    if tf and CacheRead then exit;
  412.    CacheRead := tf;
  413.    if not tf then
  414.    begin
  415.       if CachePtr <> nil then FreeMem(CachePtr, CacheSize);
  416.       CachePtr := nil;
  417.       CacheSize := 0;
  418.    end
  419.    else
  420.    begin
  421.       CacheSize := MaxAvail;
  422.       if CacheSize > DBFCacheSize then
  423.          CacheSize := DBFCacheSize
  424.       else CacheSize := CacheSize - 16384;
  425.       CacheSize := CacheSize - (CacheSize mod RecLen);
  426.       if CacheSize < RecLen then CacheSize := RecLen;
  427.       GetMem(CachePtr, CacheSize);
  428.       CacheFirst := -1;
  429.       CacheRecs := CacheSize div RecLen;
  430.    end;
  431. end;
  432.  
  433. PROCEDURE GSO_dBHandler.Skip(RecCnt : LongInt);
  434. VAR
  435.    i  : integer;
  436.    rs : word;
  437.    rn : longint;
  438.    de : longint;
  439.    dr : longint;
  440.    rl : longint;
  441.    rc : longint;
  442. begin;
  443.    If RecCnt <> 0 then
  444.    begin
  445.       if RecCnt < 0 then de := Top_Record else de := Bttm_Record;
  446.       rl := RecNumber;
  447.       rn := abs(RecCnt);
  448.       if RecCnt > 0 then dr := Next_Record else dr := Prev_Record;
  449.       if (IndexMaster <> nil) then
  450.       begin
  451.          i := 1;
  452.          repeat
  453.             rc := IndexMaster^.KeyRead(dr);
  454.             if rc > 0 then
  455.             begin
  456.                rl := rc;
  457.                File_EOF := IndexMaster^.ixEOF;
  458.                File_TOF := IndexMaster^.ixBOF;
  459.             end
  460.             else
  461.             begin
  462.                rl := IndexMaster^.KeyRead(de);
  463.                GetRec(rl);                        {restore top/bottom record}
  464.                File_EOF := RecCnt > 0;            {set EOF flag}
  465.                File_TOF := RecCnt < 0;
  466.             end;
  467.             inc(i);
  468.          until (i > rn) or (File_EOF) or (File_TOF);
  469.       end
  470.       else
  471.       begin
  472.          rl := Recnumber + RecCnt;
  473.          File_EOF := (rl > NumRecs);
  474.          File_TOF := (rl < 1);
  475.          if rl < 1 then rl := 1;
  476.          if rl > NumRecs then rl := NumRecs;
  477.       end;
  478.       if File_EOF or File_TOF then
  479.       begin
  480.          if File_EOF then
  481.          begin
  482.             GetRec(rl);
  483.             File_EOF := true;
  484.          end
  485.          else
  486.          begin
  487.             GetRec(rl);
  488.             File_TOF := true;
  489.          end;
  490.       end
  491.       else
  492.       begin
  493.          GetRec(rl);
  494.          if not TestFilter then
  495.          repeat
  496.             GetRec(dr);
  497.          until TestFilter or File_EOF or File_TOF;
  498.       end;
  499.    end;
  500. end;
  501.  
  502.  
  503. function GSO_dBHandler.TestFilter: boolean;
  504. begin
  505.    TestFilter := not(DelFlag and (not UseDelRecord));
  506. end;
  507.  
  508. Procedure GSO_DBHandler.Write(blk : longint; var dat; len : word);
  509. begin
  510.    GSO_DiskFile.Write(blk,dat,len);
  511.    if (CacheRead) then CacheFirst := -1;
  512. end;
  513.  
  514.  
  515. {------------------------------------------------------------------------------
  516.                               Formula Processing
  517. ------------------------------------------------------------------------------}
  518.  
  519.  
  520. Procedure GSO_dBHandler.Formula(st : string; var fmrec : GSR_FormRec);
  521. var
  522.    FldVal,
  523.    FldWrk : string;
  524.    FldPos : integer;
  525.    FldCnt : integer;
  526.  
  527.    Procedure EvalField(fldst : string);
  528.    var
  529.       fldp  : GSP_DBFField;
  530.       strf  : boolean;
  531.       prnd  : integer;
  532.    begin
  533.       fldst := TrimL(TrimR(fldst));
  534.       if fldst = '' then exit;
  535.       fldst := AllCaps(fldst);
  536.       prnd := 0;
  537.       strf := false;
  538.       if pos('STR(',fldst) = 1 then prnd := 4
  539.          else
  540.             if pos('DTOC(',fldst) = 1 then prnd := 5
  541.             else
  542.                if pos('DTOS(',fldst) = 1 then prnd := 5;
  543.       if prnd > 0 then
  544.       begin
  545.          strf := true;
  546.          system.Delete(fldst,1,prnd);
  547.          prnd := pos(')',fldst);
  548.          if prnd > 0 then fldst[0] := chr(prnd-1);
  549.       end;
  550.       fldp := AnalyzeField(fldst);
  551.       if fldp <> nil then
  552.       begin
  553.          if not strf and (fldp^.FieldType <> 'C') and (FldCnt = 0) then
  554.          begin
  555.             fmrec.FType := fldp^.FieldType;
  556.             fmrec.FDcml := fldp^.FieldDec;
  557.          end;
  558.          fmrec.FSize := fmrec.FSize + fldp^.FieldLen;
  559.          fmrec.FPosn[FldCnt] := fldp^.FieldNum;
  560.       end
  561.       else
  562.          Error(gsBadFormula, dbsFormulaError);
  563.    end;
  564.  
  565. begin
  566.    for FldCnt := 0 to 32 do fmrec.FPosn[FldCnt] := 0;
  567.    fmrec.FType := 'C';
  568.    fmrec.FDcml := 0;
  569.    fmrec.FSize := 0;
  570.    FldCnt := 0;
  571.    FldVal := '';                      {Initialize the return string value}
  572.    FldWrk := st;                      {Move the input string to a work field}
  573.    while (FldWrk <> '') and
  574.          (FldCnt < 32) and
  575.          (fmrec.FType = 'C') do       {Repeat while there is still}
  576.                                       {something in the work field.}
  577.    begin
  578.       FldPos := pos('+', FldWrk);     {Search for a '+' delimiter}
  579.       if FldPos = 0 then FldPos := length(FldWrk)+1;
  580.                                       {If no '+' then simulate for this pass}
  581.                                       {by setting position to one beyond the}
  582.                                       {end of the target field string.}
  583.       EvalField(SubStr(FldWrk,1,FldPos-1));
  584.                                       {Go find the field using the substring}
  585.                                       {from the string's beginning to one }
  586.                                       {position before the '+' character.}
  587.       system.delete(FldWrk,1,FldPos); {Delete the string up through the '+'};
  588.       FldWrk := TrimL(FldWrk);        {Remove leading spaces}
  589.       inc(FldCnt);
  590.    end;
  591. end;
  592.  
  593. Function  GSO_dBHandler.FormXtract(fmrec : GSR_FormRec) : string;
  594. var
  595.    s : string;
  596.    i : integer;
  597. begin
  598.    s := '';
  599.    i := 0;
  600.    while fmrec.FPosn[i] <> 0 do
  601.    begin
  602.       s := s + FieldGetN(fmRec.FPosn[i]);
  603.       inc(i);
  604.    end;
  605.    FormXtract := s;
  606. end;
  607.  
  608.  
  609. {------------------------------------------------------------------------------
  610.                               Index Processing
  611. ------------------------------------------------------------------------------}
  612.  
  613. Procedure GSO_dBHandler.Index(IName : String);
  614. var
  615.    i,j : integer;                     {Local working variable  }
  616.    st  : String[64];                  {Local working variable}
  617.    ix  : GSP_dBIndex;
  618. begin
  619.    for i := 1 to IndexesAvail do
  620.       if IndexStack[i] <> nil then
  621.       begin
  622.          Dispose(IndexStack[i], Done);
  623.          IndexStack[i] := nil;
  624.       end;
  625.    IndexMaster := nil;               {Set index active flag to false}
  626.    IName := StripChar(' ',IName);
  627.    while (IName <> '') do
  628.    begin
  629.       j := pos(',',IName);
  630.       if j = 0  then j := ord(IName[0]) + 1;
  631.       st := copy(IName,1,j-1);
  632.       System.Delete(IName,1,j);
  633.       if st <> '' then
  634.       begin
  635.          ix := New(GSP_dBIndex, Init(@Self,st));
  636.          i := IndexInsert(ix);
  637.       end;
  638.    end;
  639. end;
  640.  
  641. Function GSO_dBHandler.IndexInsert(ix : GSP_dBIndex) : integer;
  642. var
  643.    i   : integer;                     {Local working variable  }
  644. begin
  645.    i := 1;
  646.    while (IndexStack[i] <> nil) and (i <= IndexesAvail) do inc(i);
  647.    if i <= IndexesAvail then
  648.    begin
  649.       IndexStack[i] := ix;
  650.       IndexInsert := i;
  651.       if IndexMaster = nil then
  652.       begin
  653.          IndexMaster := ix;
  654.          IndexHandle := i;
  655.       end;
  656.    end else IndexInsert := -1;
  657. end;
  658.  
  659. Function GSO_dBHandler.IndexOrder(AIndexHandle : integer) : boolean;
  660. var
  661.    s  : string;
  662.    b  : longint;
  663.    i  : byte;
  664.    ix : GSP_dBIndex;
  665. begin
  666.    IndexOrder := true;
  667.    case AIndexHandle of
  668.       0               : begin
  669.                            IndexMaster := nil;
  670.                            IndexHandle := 0;
  671.                         end;
  672.       1..IndexesAvail : begin
  673.                            IndexMaster := IndexStack[AIndexHandle];
  674.                            IndexHandle := AIndexHandle;
  675.                            if IndexMaster <> nil then
  676.  
  677.                               if RecNumber = 0 then GetRec(Top_Record)
  678.                               else
  679.  
  680.                               begin
  681.                                  s := FormXtract(IndexMaster^.FormRec);
  682.                                  b := IndexMaster^.KeyFind(s);
  683.                                  while (b <> RecNumber) and (b <> 0) do
  684.                                     b := IndexMaster^.KeyRead(Next_Record);
  685.                               end;
  686.                         end;
  687.       else              IndexOrder := false;
  688.    end;
  689. end;
  690.  
  691. Function GSO_dBHandler.IndexMore(IName : String) : integer;
  692. var
  693.    ix : GSP_dBIndex;
  694. begin
  695.    ix := nil;
  696.    IName := StripChar(' ',IName);
  697.    if IName <> '' then ix := New(GSP_dBIndex, Init(@Self,IName));
  698.    if ix <> nil then IndexMore := IndexInsert(ix)
  699.       else IndexMore := -1;
  700. end;
  701.  
  702. Function GSO_dBHandler.IndexTo(filname, formla : string) : integer;
  703. var
  704.    i,
  705.    j,
  706.    fl : integer;                      {Local working variable}
  707.    ftyp : char;
  708.    fval : longint;
  709.    fkey : string;
  710.    s    : string;
  711.    ix   : GSP_dBIndex;
  712.    excl : boolean;
  713.    delf : boolean;
  714.    fmrec : GSR_FormRec;
  715. {
  716.              ┌──────────────────────────────────────────────────┐
  717.              │  Main routine.  This takes and analyzes the      │
  718.              │  argument to build an index file.  It does the   │
  719.              │  following:                                      │
  720.              │  1.  Reset current index files.                  │
  721.              │  2.  Get the total new formula field length.     │
  722.              │  3.  Create an index file.                       │
  723.              │  4.  Build the index by reading all dbase        │
  724.              │      records and updating the index file.        │
  725.              └──────────────────────────────────────────────────┘
  726. }
  727.  
  728. begin
  729.    StatusUpdate(StatusStart,StatusIndexTo,NumRecs);
  730.    ix := IndexMaster;
  731.    if formla <> '' then
  732.    begin
  733.       s := AllCaps(TrimR(filname));
  734.       i := length(s);
  735.       j := i;
  736.       while (i > 0) and not (s[i] in ['\',':']) do dec(i);
  737.       FmRec.FAlias := copy(s,i+1,(j-i));
  738.       Formula(formla,fmrec);         {Get field length/type of the formula}
  739.       if fmrec.FSize = 0 then exit;           {Exit if formula is no good}
  740.       Open;
  741.       ix := nil;
  742.       filname := StripChar(' ',filname);
  743.       excl := GS_Exclusive;
  744.       GS_SetExclusive(On);
  745.       if filname <> '' then
  746.          ix := New(GSP_dBIndex, NewInit(@Self, filname, formla, fmrec.FSize,
  747.                     fmrec.FDcml, fmrec.FType));
  748.       if ix = nil then
  749.          begin
  750.             IndexTo := -1;
  751.             exit;
  752.          end;
  753.       IndexMaster := nil;
  754.       ix^.KeySort(fmrec.FSize,SortUp);              {Ascending Sort}
  755.       SetDBFCache(On);
  756.       delf := UseDelRecord;
  757.       UseDelRecord := true;
  758.       GetRec(Top_Record);             {Read all dBase file records}
  759.       while not File_EOF do
  760.       begin
  761.          fkey := FormXtract(fmrec);
  762.          ix^.ixColl^.InsertKey(RecNumber,fkey);
  763.          StatusUpdate(StatusIndexTo,RecNumber,0);
  764.          GetRec(Next_Record);
  765.       end;
  766.       UseDelRecord := delf;
  767.       SetDBFCache(Off);
  768.       StatusUpdate(StatusStop,0,0);
  769.       StatusUpdate(StatusStart,StatusIndexWr,NumRecs);
  770.       ix^.IndxStore(ix^.ixColl,true);
  771.       GetRec(Top_Record);             {Reset to top record}
  772.       Dispose(ix, Done);
  773.       GS_SetExclusive(excl);
  774.       ix := New(GSP_dBIndex, Init(@Self,filname));
  775.       if ix <> nil then
  776.       begin
  777.          IndexTo := IndexInsert(ix);
  778.          IndexMaster := ix;
  779.       end;
  780.    end
  781.       else IndexTo := -1;
  782.    StatusUpdate(StatusStop,0,0);
  783. end;
  784.  
  785. Procedure GSO_dBHandler.ReIndex;
  786. var
  787.    rxIndexHandle : integer;
  788.    rxIndexMaster : GSP_dBIndex;
  789.    rxIndexStack  : array[1..IndexesAvail] of GSP_dBIndex;
  790.    fm  : string[255];
  791.    nam : string[80];
  792.    i   : integer;
  793.    k   : integer;
  794.    h   : integer;
  795. begin
  796.    rxIndexHandle := IndexHandle;
  797.    rxIndexMaster := IndexMaster;
  798.  
  799.    for i := 1 to IndexesAvail do
  800.    begin
  801.       rxIndexStack[i]  := IndexStack[i];
  802.       IndexStack[i] := nil;
  803.    end;
  804.    IndexMaster := nil;               {Set index active flag to false}
  805.    IndexHandle := -1;
  806.  
  807.    for i := 1 to IndexesAvail do
  808.    begin
  809.       if rxIndexStack[i] <> nil then
  810.       begin
  811.          fm := rxIndexStack[i]^.ixKey_Form;
  812.          nam := rxIndexStack[i]^.dfFileName;
  813.          k := pos('.',nam);
  814.          if k <> 0 then system.delete(nam,k,4);
  815.          Dispose(rxIndexStack[i], Done);
  816.          k := IndexTo(nam,fm);
  817.          if i = rxIndexHandle then h := i;
  818.       end;
  819.    end;
  820.  
  821.    if h > 0 then
  822.    begin
  823.       IndexMaster := IndexStack[h];
  824.       IndexHandle := h;
  825.    end;
  826. end;
  827.  
  828.  
  829. {------------------------------------------------------------------------------
  830.                                Memo Routines
  831. ------------------------------------------------------------------------------}
  832.  
  833. procedure GSO_dBHandler.MemoClear;
  834. begin
  835.    MemoFile^.MemoClear;
  836. end;
  837.  
  838. procedure GSO_dBHandler.MemoGet(st : string);
  839. var
  840.    v : longint;
  841.    s : string;
  842. begin
  843.    FieldPtr := AnalyzeField(st);
  844.    if (FieldPtr <> nil) and (FieldPtr^.FieldType = 'M') then
  845.    begin
  846.       move(FieldPtr^.FieldAddress^,s[1], FieldPtr^.FieldLen);
  847.       s[0] := chr(FieldPtr^.FieldLen);
  848.       v := ValWholeNum(s);
  849.       MemoFile^.MemoGet(v);
  850.    end
  851.    else Error(gsBadFieldType, dbsMemoGetError)
  852. end;
  853.  
  854. procedure GSO_dBHandler.MemoGetN(n : integer);
  855. var
  856.    v : longint;
  857.    s : string;
  858. begin
  859.    FieldPtr := @Fields^[n];
  860.    if (FieldPtr <> nil) and (FieldPtr^.FieldType = 'M') then
  861.    begin
  862.       move(FieldPtr^.FieldAddress^, s[1], FieldPtr^.FieldLen);
  863.       s[0] := chr(FieldPtr^.FieldLen);
  864.       v := ValWholeNum(s);
  865.       MemoFile^.MemoGet(v);
  866.    end
  867.    else Error(gsBadFieldType, dbsMemoGetNError)
  868. end;
  869.  
  870. function GSO_dBHandler.MemoGetLine(linenum : integer) : string;
  871. begin
  872.    MemoGetLine := MemoFile^.MemoGetLine(linenum-1);
  873. end;
  874.  
  875. Procedure GSO_dBHandler.MemoInsLine(linenum : integer; st : string);
  876. begin
  877.    MemoFile^.MemoInsLine(linenum-1,st);
  878. end;
  879.  
  880. function GSO_dBHandler.MemoLines : integer;
  881. begin
  882.    MemoLines := MemoFile^.MemoLines;
  883. end;
  884.  
  885. procedure GSO_dBHandler.MemoPut(st : string);
  886. begin
  887.    FieldPtr := AnalyzeField(st);
  888.    MemoPutN(-713);         {Use MemoPutN to do work.}
  889.                            {-713 tells MemoPutN that FieldPtr is valid}
  890. end;
  891.  
  892. procedure GSO_dBHandler.MemoPutN(n : integer);
  893. var
  894.    v1, v2 : longint;
  895.    rsl    : word;
  896.    i      : integer;
  897.    s      : string;
  898. begin
  899.    if n <> -713 then FieldPtr := @Fields^[n];  {-713 if called from MemoPut}
  900.    if (FieldPtr <> nil) and (FieldPtr^.FieldType = 'M') then
  901.    begin
  902.       move(FieldPtr^.FieldAddress^, s[1], FieldPtr^.FieldLen);
  903.       s[0] := chr(FieldPtr^.FieldLen);
  904.       v1 := ValWholeNum(s);
  905.       i := 0;
  906.       v2 := MemoFile^.MemoPut(v1);
  907.       if v1 <> v2 then
  908.       begin
  909.          s := StrWholeNum(v2,10);
  910.          move(s[1],FieldPtr^.FieldAddress^,FieldPtr^.FieldLen);
  911.       end;
  912.    end
  913.    else Error(gsBadFieldType, dbsMemoPutNError)
  914. end;
  915.  
  916. Procedure GSO_dBHandler.MemoWidth(l : integer);
  917. begin
  918.    MemoFile^.Edit_Lgth := l;
  919. end;
  920.  
  921. {------------------------------------------------------------------------------
  922.                   File Modifying Routine (Sort, Copy, Pack, Zap)
  923. ------------------------------------------------------------------------------}
  924.  
  925. Procedure GSO_dBHandler.CopyFile(filname : string);
  926. var
  927.    ix     : pointer;
  928.    FCopy  : GSP_dBHandler;
  929.    NuFile : GSP_DBFBuild;
  930.    rr     : GSP_IndxEtry;
  931.    keyct  : integer;
  932.    crd  : boolean;
  933.  
  934. BEGIN
  935.    repeat until LokFile;
  936.    StatusUpdate(StatusStart,StatusCopy,RecsInFile);
  937.    ix := IndexMaster;
  938.    IndexMaster := nil;
  939.    crd := CacheRead;
  940.    SetDBFCache(On);
  941.    keyct := 0;
  942.    CopyStructure(filname);
  943.    FCopy := New(GSP_dBHandler, Init(filname));
  944.    FCopy^.Open;
  945.    GetRec(Top_Record);
  946.    while not File_EOF do           {Read .DBF sequentially}
  947.    begin
  948.       move(CurRecord^,FCopy^.CurRecord^,RecLen+1);
  949.       if WithMemo then CopyMemoRecord(FCopy);
  950.       FCopy^.Append;
  951.       StatusUpdate(StatusCopy,RecNumber,0);
  952.       GetRec(Next_Record);
  953.    end;
  954.    Dispose(FCopy, Done);
  955.    StatusUpdate(StatusStop,0,0);
  956.    SetDBFCache(crd);
  957.    IndexMaster := ix;
  958.    LokOff;
  959. END;                        { CopyFile }
  960.  
  961. procedure GSO_dBHandler.CopyMemoRecord(df : GSP_dbHandler);
  962. var
  963.    fp : integer;
  964.    mbuf : array[0..GS_dBase_MaxMemoRec+1] of byte;
  965.    mcnt : word;
  966.    rl   : FloatNum;
  967.    tcnt : longint;
  968.    vcnt : longint;
  969.    i    : integer;
  970.    blk  : longint;
  971. begin
  972.    FillChar(mbuf,GS_dBase_MaxMemoRec,#0);
  973.    for fp := 1 to NumFields do
  974.    begin
  975.       if Fields^[fp].FieldType = 'M' then
  976.       begin
  977.          blk := Trunc(NumberGetN(fp));
  978.          if (blk <> 0) then
  979.          begin
  980.             mcnt := MemoFile^.MemoBlocks(blk);
  981.             i := 0;
  982.             df^.MemoFile^.Read(0, mbuf, 1);
  983.             move(mbuf,tcnt,4);               {Get next block}
  984.             vcnt := tcnt+mcnt;
  985.             move(vcnt,mbuf,4);
  986.             df^.MemoFile^.Write(0,mbuf,1);   {update next block}
  987.             rl := tcnt;
  988.             df^.NumberPutN(fp,rl);
  989.             repeat
  990.                MemoFile^.Read(blk+i,mbuf,1);
  991.                df^.MemoFile^.Write(tcnt+i,mbuf,1);
  992.                inc(i);
  993.             until i = mcnt;
  994.          end;
  995.       end;
  996.    end;
  997. end;
  998.  
  999. procedure GSO_dBHandler.CopyStructure(filname : string);
  1000. var
  1001.    NuFile : GSP_DBFBuild;
  1002.    fp     : integer;
  1003. BEGIN
  1004.    if FileVers = DB4WithMemo then
  1005.       NuFile := New(GSP_DB4Build, Init(filname))
  1006.    else
  1007.       NuFile := New(GSP_DB3Build, Init(filname));
  1008.    for fp := 1 to NumFields do
  1009.       NuFile^.InsertField(FieldName(fp),Fields^[fp].FieldType,
  1010.                           Fields^[fp].FieldLen,Fields^[fp].FieldDec);
  1011.    dispose(NuFile, Done);
  1012. END;
  1013.  
  1014. Procedure GSO_dBHandler.Pack;
  1015. var
  1016.    rxIndexHandle : integer;
  1017.    rxIndexMaster : GSP_dBIndex;
  1018.    fp            : integer;
  1019.    i, j          : longint;
  1020. begin      {Pack}
  1021.    if dfFileShrd then Error(dosAccessDenied, dbsPackError);
  1022.    rxIndexHandle := IndexHandle;
  1023.    rxIndexMaster := IndexMaster;
  1024.    IndexMaster := nil;               {Set index active flag to false}
  1025.    IndexHandle := -1;
  1026.    StatusUpdate(StatusStart,StatusPack,NumRecs);
  1027.    j := 0;
  1028.    for i := 1 to NumRecs do           {Read .DBF sequentially}
  1029.    begin
  1030.       Read(HeadLen+((i-1) * RecLen), CurRecord^, RecLen);
  1031.       RecNumber := i;
  1032.       DelFlag := CurRecord^[0] = GS_dBase_DltChr;
  1033.       if not DelFlag then             {Write to work file if not deleted}
  1034.       begin
  1035.          inc(j);                      {Increment record count for packed file }
  1036.          PutRec(j);
  1037.       end
  1038.       else
  1039.          if WithMemo then
  1040.          begin
  1041.             for fp := 1 to NumFields do
  1042.             begin
  1043.                if Fields^[fp].FieldType = 'M' then
  1044.                begin
  1045.                   MemoFile^.Memo_Loc := Trunc(NumberGetN(fp));
  1046.                   if (MemoFile^.Memo_Loc <> 0) then
  1047.                      MemoFile^.MemoBlockRelease(MemoFile^.Memo_Loc);
  1048.                end;
  1049.             end;
  1050.          end;
  1051.       StatusUpdate(StatusPack,i,0);
  1052.    end;
  1053.    if i > j then                      {If records were deleted then...}
  1054.    begin
  1055.       NumRecs := j;                   {Store new record count in objectname}
  1056.       Write(HeadLen+(j*RecLen), EOFMark, 1);
  1057.                                       {Write End of File byte at file end}
  1058.       Truncate(HeadLen+(j*RecLen)+1);
  1059.                                       {Set new file size for dBase file};
  1060.    end;
  1061.    StatusUpdate(StatusStop,0,0);
  1062.    IndexHandle := rxIndexHandle;
  1063.    IndexMaster := rxIndexMaster;
  1064.    ReIndex;
  1065. END;                        { Pack }
  1066.  
  1067.                      {-------------------------------}
  1068.  
  1069. {-----------------------------------------------------------------------------
  1070.                                File Sorting Routines
  1071. -----------------------------------------------------------------------------}
  1072.  
  1073.  
  1074. Procedure GSO_dBHandler.LoadToIndex(ixColl: GSP_IndxColl; zfld: string);
  1075. var
  1076.    crd  : boolean;
  1077.    ix   : pointer;
  1078.    fkey : GSR_FormRec;
  1079.    ftyp : char;
  1080. begin
  1081.    StatusUpdate(StatusStart,StatusSort,RecsInFile);
  1082.    ix := IndexMaster;
  1083.    IndexMaster := nil;
  1084.    crd := CacheRead;
  1085.    SetDBFCache(On);
  1086.    GetRec(Top_Record);             {Read all dBase file records}
  1087.    while not File_EOF do
  1088.    begin
  1089.       Formula(zfld, fkey);
  1090.       ixColl^.InsertKey(RecNumber, FormXtract(fkey));
  1091.       StatusUpdate(StatusSort,RecNumber,0);
  1092.       GetRec(Next_Record);
  1093.    end;
  1094.    SetDBFCache(crd);
  1095.    IndexMaster := ix;
  1096.    GetRec(Top_Record);             {Reset to top record}
  1097.    StatusUpdate(StatusStop,0,0);
  1098. end;
  1099.  
  1100. procedure GSO_dBHandler.CopyFromIndex(ixColl: GSP_IndxColl; filname: string);
  1101. var
  1102.    FCopy  : GSP_dBHandler;
  1103.    NuFile : GSP_DBFBuild;
  1104.    rr     : GSP_IndxEtry;
  1105.    keyct  : integer;
  1106.    crd  : boolean;
  1107.  
  1108. BEGIN
  1109.    StatusUpdate(StatusStart,StatusCopy,ixColl^.KeyCount);
  1110.    crd := CacheRead;
  1111.    SetDBFCache(Off);
  1112.    keyct := 0;
  1113.    CopyStructure(filname);
  1114.    FCopy := New(GSP_dBHandler, Init(filname));
  1115.    FCopy^.Open;
  1116.    rr := ixColl^.RetrieveKey;
  1117.    while rr <> nil do
  1118.    begin
  1119.       GetRec(rr^.Tag);
  1120.       move(CurRecord^,FCopy^.CurRecord^,RecLen);
  1121.       if WithMemo then CopyMemoRecord(FCopy);
  1122.       FCopy^.Append;
  1123.       inc(keyct);
  1124.       StatusUpdate(StatusCopy,keyct,0);
  1125.       rr := ixColl^.RetrieveKey;
  1126.    end;
  1127.    SetDBFCache(crd);
  1128.    FCopy^.Close;
  1129.    Dispose(FCopy, Done);
  1130.    StatusUpdate(StatusStop,0,0);
  1131. end;
  1132.  
  1133. Procedure GSO_dBHandler.SortFile(filname, zfld: string; isascend : SortStatus);
  1134. var
  1135.    fl    : integer;                      {Local working variable}
  1136.    fkey  : GSR_FormRec;
  1137.    ftyp  : char;
  1138.    ixColl: GSP_IndxColl;
  1139.  
  1140. begin
  1141.  
  1142.    if GS_FileIsOpen(filname+'.DBF') then
  1143.    begin
  1144.       Error(gsFileAlreadyOpen, dbsSortFile);
  1145.       exit;
  1146.    end;
  1147.  
  1148.    if zfld <> '' then
  1149.    begin
  1150.       Formula(zfld, fkey);  {use to get length}
  1151.       fl := fkey.FSize;
  1152.       if fl = 0 then
  1153.       begin
  1154.          Error(gsBadFormula, dbsSortFile);
  1155.          exit;                        {Exit if formula is no good}
  1156.       end;
  1157.       ixColl := New(GSP_IndxColl, Init(fl, isascend));
  1158.       LoadToIndex(ixColl, zfld);
  1159.       CopyFromIndex(ixColl, filname);
  1160.       Dispose(ixColl, Done);
  1161.    end;
  1162. end;
  1163.  
  1164.                      {-------------------------------}
  1165.  
  1166. Procedure GSO_dBHandler.Zap;
  1167. var
  1168.    mbuf : array[0..GS_dBase_MaxMemoRec] of byte;
  1169.    i, j : longint;                    {Local variables   }
  1170. begin              {Zap}
  1171.    if dfFileShrd then Error(dosAccessDenied,dbsZapError);
  1172.    ZapIndexes;
  1173.    if WithMemo then
  1174.    begin
  1175.       MemoFile^.Read(0,mbuf,1);
  1176.       mbuf[0] := 1;
  1177.       MemoFile^.Write(0,mbuf,1);
  1178.       MemoFile^.Truncate(1);
  1179.    end;
  1180.    NumRecs := 0;                   {Store new record count in objectname}
  1181.    RecNumber := 0;
  1182.    Write(HeadLen, EOFMark, 1);
  1183.    Truncate(HeadLen);
  1184.    dStatus := Updated;
  1185.    Close;
  1186.    Open;
  1187. END;                        { Zap }
  1188.  
  1189. Procedure GSO_dBHandler.StatusUpdate(stat1,stat2,stat3 : longint);
  1190. begin
  1191. end;
  1192.  
  1193. Procedure GSO_dBHandler.ZapIndexes;
  1194. var
  1195.    i : integer;
  1196. begin
  1197.    for i := 1 to IndexesAvail do
  1198.       if IndexStack[i] <> nil then IndexStack[i]^.IndxClear;
  1199. end;
  1200.  
  1201. {------------------------------------------------------------------------------
  1202.                                GSO_dBIndex
  1203. ------------------------------------------------------------------------------}
  1204.  
  1205. Constructor GSO_dBIndex.Init(dbfilobj : GSP_dBHandler; IName : string);
  1206. var
  1207.    s : string;
  1208.    i,j : integer;
  1209. begin
  1210.    GSO_IndexFile.Init(IName);
  1211.    DBFObj := dbfilobj;
  1212.    s := AllCaps(TrimR(IName));
  1213.    i := length(s);
  1214.    j := i;
  1215.    while (i > 0) and not (s[i] in ['\',':']) do dec(i);
  1216.    FormRec.FAlias := copy(s,i+1,(j-i));
  1217.    DBFObj^.Formula(IxKey_Form, FormRec);
  1218.    IxKey_Typ := FormRec.FType;
  1219.    PassCount := 0;
  1220. end;
  1221.  
  1222.  
  1223. Constructor GSO_dBIndex.NewInit(dbfilobj : GSP_dBHandler; filname,
  1224.                                 formla: string; lth, dcl: integer; typ: char);
  1225. var
  1226.    s : string;
  1227.    i,j : integer;
  1228. begin
  1229.    GSO_IndexFile.NewInit(filname, formla, lth, dcl, typ);
  1230.    DBFObj := dbfilobj;
  1231.    s := AllCaps(TrimR(filname));
  1232.    i := length(s);
  1233.    j := i;
  1234.    while (i > 0) and not (s[i] in ['\',':']) do dec(i);
  1235.    FormRec.FAlias := copy(s,i+1,(j-i));
  1236.    PassCount := 0;
  1237. end;
  1238.  
  1239. Procedure GSO_dBIndex.IndexUpdate(rnum: longint; fml: GSR_FormRec;
  1240.                                   apnd: boolean);
  1241. begin
  1242.    KeyUpdate(rnum, DBFObj^.FormXtract(fml), apnd);
  1243. end;
  1244.  
  1245. Procedure GSO_dBIndex.WriteStatus(RNum : longint);
  1246. begin
  1247.    if RNum = 1 then inc(PassCount);
  1248.    DBFObj^.StatusUpdate(StatusIndexWr,RNum,PassCount);
  1249. end;
  1250.  
  1251. {-----------------------------------------------------------------------------
  1252.                                GSO_dBTable
  1253. -----------------------------------------------------------------------------}
  1254.  
  1255. Constructor GSO_dBTable.Init(var Fil: GSO_dBHandler; zfld: string;
  1256.                                  sortseq: SortStatus);
  1257. begin
  1258.    zfld := AllCaps(zfld);
  1259.    Fil.Formula(zfld, fmRec);
  1260.    fmType := fmRec.FType;
  1261.    GSO_IndxColl.Init(fmRec.FSize,sortseq);
  1262.    dBas := @Fil;
  1263.    Sel_Item := 1;
  1264.    tbSorted := sortseq <> NoSort;
  1265.    Scn_Key := zfld;
  1266. end;
  1267.  
  1268. procedure GSO_dBTable.Build_dBTabl;
  1269. var
  1270.    t : string;
  1271.    crd : boolean;
  1272.    ia : pointer;
  1273.    i  : integer;
  1274.    z  : GSP_IndxColl;
  1275. begin
  1276.    with dBas^ do
  1277.    begin
  1278.       ia := IndexMaster;
  1279.       IndexMaster := nil;
  1280.       crd := CacheRead;
  1281.       SetDBFCache(On);
  1282.       GetRec(Top_Record);             {Read all dBase file records}
  1283.       while not File_EOF do
  1284.       begin
  1285.          t := FilterKey;
  1286.          InsertKey(RecNumber,t);
  1287.          GetRec(Next_Record);
  1288.       end;
  1289.       SetDBFCache(crd);
  1290.       IndexMaster := ia;
  1291.       GetRec(Top_Record);             {Reset to top record}
  1292.       if tbSorted and (Count > 1) then
  1293.       begin
  1294.          z := new(GSP_IndxColl, InitNode(@Self));
  1295.          i := 1;
  1296.          tbEntry := RetrieveKey;
  1297.          while tbEntry <> nil do
  1298.          begin
  1299.             z^.InsertKey(tbEntry^.Tag,tbEntry^.KeyStr);
  1300.             inc(i);
  1301.             tbEntry := RetrieveKey;
  1302.          end;
  1303.          FreeAll;
  1304.          for i := 0 to z^.Count-1 do Insert(z^.Items^[i]);
  1305.          z^.Count := 0;
  1306.          Dispose(z, Done);
  1307.       end;
  1308.    end;
  1309. end;
  1310.  
  1311. function GSO_dBTable.FilterKey: string;
  1312. begin
  1313.    FilterKey := dbas^.FormXtract(fmRec);
  1314. end;
  1315.  
  1316. function GSO_dBTable.FindKey_dBTabl(pcnd : string) : boolean;
  1317. var
  1318.    Search: Boolean;
  1319.    L, H,
  1320.    I, C  : Integer;
  1321. begin
  1322.    Search := False;
  1323.    L := 1;
  1324.    H := KeyCount;
  1325.    while L <= H do
  1326.    begin
  1327.       I := (L + H) shr 1;
  1328.       tbEntry := PickKey(I);
  1329.       if tbEntry^.KeyStr < pcnd  then L := I + 1 else
  1330.       begin
  1331.          H := I - 1;
  1332.          if pcnd = tbEntry^.KeyStr then Search := True;
  1333.       end;
  1334.    end;
  1335.    tbEntry := PickKey(L);
  1336.    FindKey_dBTabl := Search;
  1337. end;
  1338.  
  1339. function GSO_dBTable.FindRec_dBTabl(pcnd : string) : boolean;
  1340. begin
  1341.    if FindKey_dBTabl(pcnd) then
  1342.    begin
  1343.        FindRec_dBTabl := true;
  1344.        dBas^.GetRec(tbEntry^.Tag);
  1345.    end
  1346.       else FindRec_dBTabl := false;
  1347. end;
  1348.  
  1349. function GSO_dBTable.GetKey_dBTabl(keynum: longint): boolean;
  1350. begin
  1351.    tbEntry := PickKey(keynum);
  1352.    GetKey_dBTabl := tbEntry <> nil;
  1353. end;
  1354.  
  1355. function GSO_dBTable.GetRec_dBTabl(keynum: longint) : boolean;
  1356. begin
  1357.    if GetKey_dBTabl(keynum) then
  1358.    begin
  1359.        GetRec_dBTabl := true;
  1360.        dBas^.GetRec(tbEntry^.Tag);
  1361.    end
  1362.       else GetRec_dBTabl := false;
  1363. end;
  1364.  
  1365.  
  1366.  
  1367. end.
  1368. {-----------------------------------------------------------------------------}
  1369.                                     END
  1370.