home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / Chip_2003-01_cd1.bin / zkuste / delphi / kompon / d56 / VKDBF.ZIP / VKDBFNTX.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-09-30  |  131.6 KB  |  4,594 lines
  1. {
  2.  Copyright:      Vlad Karpov  mailto:KarpovVV@protek.ru
  3.  Author:         Vlad Karpov
  4. }
  5. unit VKDBFNTX;
  6.  
  7. interface
  8.  
  9. uses
  10.   Windows, Messages, SysUtils, Classes, contnrs, db,
  11.   {$IFDEF VER140} Variants, {$ENDIF}
  12.   VKDBFPrx, VKDBFParser, VKDBFIndex, VKDBFUtil, VKDBFMemMgr;
  13.  
  14. const
  15.  
  16.   NTX_MAX_KEY       =       256;    // Maximum of length of key
  17.   NTX_PAGE          =       1024;   // Dimantion of NTX page
  18.   MAX_LEV_BTREE     =       20;     // Maximum depth of BTREE
  19.  
  20.   CL501RUSORDER: array [0..255] of Byte = (
  21. 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17,
  22. 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33,
  23. 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 180, 181,
  24. 182, 183, 184, 185, 186, 187, 188, 189, 49, 50, 51, 52, 53, 54,
  25. 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70,
  26. 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 190, 191, 192, 193,
  27. 194, 195, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95,
  28.  96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 196, 197,
  29.  198, 199, 200, 108, 109, 110, 111, 112, 113, 115, 116, 117, 118,
  30.  119, 120, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131,
  31.  132, 133, 134, 135, 136, 137, 138, 139, 140, 143, 144, 145, 146,
  32.  147, 148, 150, 151, 152, 153, 154, 155, 156, 157, 158, 159, 201,
  33.  202, 203, 204, 205, 206, 207, 208, 209, 210, 211, 212, 213, 214,
  34.  215, 216, 217, 218, 219, 220, 221, 222, 223, 224, 225, 226, 227,
  35.  228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240,
  36.  241, 242, 243, 244, 245, 246, 247, 248, 160, 161, 162, 163, 164,
  37.  165, 166, 167, 168, 169, 170, 171, 172, 173, 174, 175, 114, 149,
  38.  176, 177, 141, 178, 142, 179, 249, 250, 251, 252, 253, 254, 48, 255);
  39.  
  40. type
  41.  
  42.   TDeleteKeyStyle = (dksClipper, dksApolloHalcyon);
  43.  
  44.   //NTX Structute
  45.   NTX_HEADER = packed record
  46.     sign: WORD;                                 //2        0
  47.     version: WORD;                              //2        2
  48.     root: DWORD;                                //4        4
  49.     next_page: DWORD;                           //4        8
  50.     item_size: WORD;                            //2       12
  51.     key_size: WORD;                             //2       14
  52.     key_dec: WORD;                              //2       16
  53.     max_item: WORD;                             //2       18
  54.     half_page: WORD;                            //2       20
  55.     key_expr: array [0..NTX_MAX_KEY-1] of Char; //256     22
  56.     unique: Char;                               //1      278
  57.     reserv1: Char;                              //1      279
  58.     desc: Char;                                 //1      280
  59.     reserv3: Char;                              //1      281
  60.     for_expr: array [0..NTX_MAX_KEY-1] of Char; //256    282
  61.     order: array [0..7] of char;                //8      538
  62.     Rest: array [0..477] of char;               //478    546
  63.   end;
  64.                                                 //1024
  65.  
  66.   //
  67.   // Describer one ITEM
  68.   //
  69.   NTX_ITEM = packed record
  70.     page: DWORD;
  71.     rec_no: DWORD;
  72.     key: array[0..NTX_PAGE-1] of Char;
  73.   end;
  74.   pNTX_ITEM = ^NTX_ITEM;
  75.  
  76.   //
  77.   // Beginign of Index page
  78.   //
  79.   NTX_BUFFER = packed record
  80.     count: WORD;
  81.     ref: array[0..510] of WORD;
  82.   end;
  83.   pNTX_BUFFER = ^NTX_BUFFER;
  84.  
  85.   //
  86.   //  Block item for compact indexing
  87.   //
  88.   BLOCK_ITEM = packed record
  89.     rec_no: DWORD;
  90.     key: array[WORD] of Char;
  91.   end;
  92.   pBLOCK_ITEM = ^BLOCK_ITEM;
  93.  
  94.   //
  95.   //  Block for compact indexing
  96.   //
  97.   BLOCK_BUFFER = packed record
  98.     count: WORD;
  99.     ref: array[WORD] of WORD;
  100.   end;
  101.   pBLOCK_BUFFER = ^BLOCK_BUFFER;
  102.  
  103.   TBTreeLevels = array [0..MAX_LEV_BTREE] of NTX_BUFFER;
  104.   pBTreeLevels = ^TBTreeLevels;
  105.  
  106.   //
  107.   // Abstract class Iterator
  108.   //
  109.   TVKNTXIndexIterator = class(TObject)
  110.   public
  111.     item: NTX_ITEM;
  112.     Eof: boolean;
  113.     procedure Open; virtual; abstract;
  114.     procedure Close; virtual; abstract;
  115.     procedure Next; virtual; abstract;
  116.     constructor Create;
  117.     destructor Destroy; override;
  118.   end;
  119.  
  120.   //
  121.   // Block class Iterator
  122.   //
  123.   TVKNTXBlockIterator = class(TVKNTXIndexIterator)
  124.   protected
  125.     i: Integer;
  126.     FBufSize: Integer;
  127.     Fkey_size: Integer;
  128.     FFileName: String;
  129.     FHndl: Integer;
  130.     p: pBLOCK_BUFFER;
  131.   public
  132.     procedure Open; override;
  133.     procedure Close; override;
  134.     procedure Next; override;
  135.     constructor Create(FileName: String; key_size, BufSize: Integer); overload;
  136.     destructor Destroy; override;
  137.   end;
  138.  
  139.   //
  140.   // NTX class Iterator
  141.   //
  142.   TVKNTXIterator = class(TVKNTXIndexIterator)
  143.   protected
  144.     FFileName: String;
  145.     FHndl: Integer;
  146.     SHead: NTX_HEADER;
  147.     levels: pBTreeLevels;
  148.     indexes: array [0..MAX_LEV_BTREE] of WORD;
  149.     cur_lev: Integer;
  150.   public
  151.     procedure Open; override;
  152.     procedure Close; override;
  153.     procedure Next; override;
  154.     constructor Create(FileName: String); overload;
  155.     destructor Destroy; override;
  156.   end;
  157.  
  158.   //
  159.   // Compact index class for CreateCompact method TVKNTXIndex
  160.   //
  161.   TVKNTXCompactIndex = class(TObject)
  162.   private
  163.     FHndl: Integer;
  164.     SHead: NTX_HEADER;
  165.     levels: TBTreeLevels;
  166.     cur_lev: Integer;
  167.     max_lev: Integer;
  168.     SubOffSet: DWORD;
  169.     CryptPage: NTX_BUFFER;
  170.   public
  171.     FileName: String;
  172.     OwnerTable: TDataSet;
  173.     Crypt: boolean;
  174.     Handler: TProxyStream;
  175.     constructor Create;
  176.     destructor Destroy; override;
  177.     procedure NewPage(lev: Integer);
  178.     procedure CreateEmptyIndex(var FHead: NTX_HEADER);
  179.     procedure AddItem(item: pNTX_ITEM);
  180.     procedure LinkRest;
  181.     procedure NormalizeRest;
  182.     procedure Close;
  183.   end;
  184.  
  185.   //Forword declarations
  186.   TVKNTXIndex = class;
  187.  
  188.   {TVKNTXBuffer}
  189.   TVKNTXBuffer = class
  190.   private
  191.     Fpage_offset: DWORD;
  192.     Fchanged: boolean;
  193.     Fpage: NTX_BUFFER;
  194.   public
  195.     constructor Create;
  196.   end;
  197.  
  198.   {TVKNTXBuffers}
  199.   TVKNTXBuffers = class(TObjectList)
  200.   private
  201.     NXTObject: TVKNTXIndex;
  202.     function FindIndex(page_offset: DWORD; out Ind: Integer): boolean;
  203.   public
  204.     function GetPage(Handle: TProxyStream; page_offset: DWORD; out page: pNTX_BUFFER; fRead: boolean = true): Integer;
  205.     function GetNTXBuffer(Handle: TProxyStream; page_offset: DWORD; out page: pNTX_BUFFER; fRead: boolean = true): Pointer;
  206.     procedure SetPage(Handle: TProxyStream; page_offset: DWORD; page: pNTX_BUFFER);
  207.     procedure SetChanged(i: Integer);
  208.     procedure Flush(Handle: TProxyStream);
  209.   end;
  210.  
  211.   {TVKNTXRange}
  212.   TVKNTXRange = class(TPersistent)
  213.   private
  214.  
  215.     FActive: boolean;
  216.     FLoKey: String;
  217.     FHiKey: String;
  218.     FNTX: TVKNTXIndex;
  219.     function GetActive: boolean;
  220.     procedure SetActive(const Value: boolean);
  221.  
  222.   protected
  223.   public
  224.  
  225.     function InRange(S: String): boolean;
  226.  
  227.     procedure ReOpen;
  228.  
  229.     property NTX: TVKNTXIndex read FNTX write FNTX;
  230.  
  231.   published
  232.  
  233.     property Active: boolean read GetActive write SetActive;
  234.     property HiKey: String read FHiKey write FHiKey;
  235.     property LoKey: String read FLoKey write FLoKey;
  236.  
  237.   end;
  238.  
  239.   {TVKNTXOrder}
  240.   TVKNTXOrder = class(TVKDBFOrder)
  241.   public
  242.  
  243.     FHead: NTX_HEADER;
  244.  
  245.     constructor Create(Collection: TCollection); override;
  246.     destructor Destroy; override;
  247.  
  248.     function CreateOrder: boolean; override;
  249.  
  250.   published
  251.  
  252.     property OnCreateIndex;
  253.     property OnEvaluteKey;
  254.     property OnEvaluteFor;
  255.     property OnCompareKeys;
  256.  
  257.   end;
  258.  
  259.   {TVKNTXBag}
  260.   TVKNTXBag = class(TVKDBFIndexBag)
  261.   private
  262.  
  263.     //FLstOffset: DWORD;
  264.  
  265.   public
  266.  
  267.     constructor Create(Collection: TCollection); override;
  268.     destructor Destroy; override;
  269.  
  270.     function CreateBag: boolean; override;
  271.     function Open: boolean; override;
  272.     function IsOpen: boolean; override;
  273.     procedure Close; override;
  274.  
  275.     procedure FillHandler;
  276.  
  277.     //property FLastOffset: DWORD read FLstOffset write FLstOffset;
  278.     property NTXHandler: TProxyStream read Handler write Handler;
  279.  
  280.   end;
  281.  
  282.   {TVKNTXIndex}
  283.   TVKNTXIndex = class(TIndex)
  284.   private
  285.  
  286.     FNTXBag: TVKNTXBag;
  287.     FNTXOrder: TVKNTXOrder;
  288.  
  289.     FLastOffset: DWORD;
  290.     FReindex: boolean;
  291.     FCreateIndexProc: boolean;
  292.     FNTXBuffers: TVKNTXBuffers;
  293.     FNTXFileName: String;
  294.     //NTXHandler: Integer;
  295.     //FHead: NTX_HEADER;
  296.     FKeyExpresion: String;
  297.     FForExpresion: String;
  298.     FKeyParser: TVKDBFExprParser;
  299.     FForParser: TVKDBFExprParser;
  300.     FForExists: boolean;
  301.     FKeyTranslate: boolean;
  302.     FCl501Rus: boolean;
  303.     FFileLock: boolean;
  304.     FSeekRecord: Integer;
  305.     FSeekKey: String;
  306.     FSeekOk: boolean;
  307.     FTemp: boolean;
  308.     FNTXRange: TVKNTXRange;
  309.     FOnSubNtx: TOnSubNtx;
  310.     FDestructor: boolean;
  311.     FClipperVer: TCLIPPER_VERSION;
  312.     FUpdated: boolean;
  313.     FFLastFUpdated: boolean;
  314.     FDeleteKeyStyle: TDeleteKeyStyle;
  315.  
  316.     FUnique: boolean;
  317.     FDesc: boolean;
  318.     FOrder: String;
  319.  
  320.     procedure SetNTXFileName(const Value: String);
  321.     procedure SetKeyExpresion(Value: String);
  322.     procedure SetForExpresion(Value: String);
  323.     function CompareKeys(S1, S2: PChar; MaxLen: Cardinal): Integer;
  324.     function GetFreePage: DWORD;
  325.     procedure SetUnique(const Value: boolean);
  326.     function GetUnique: boolean;
  327.     procedure SetDesc(const Value: boolean);
  328.     function GetDesc: boolean;
  329.     function SeekFirstInternal(Key: String; SoftSeek: boolean = false): boolean;
  330.     function SeekLastInternal(Key: String; SoftSeek: boolean = false): boolean;
  331.     procedure ChekExpression(var Value: String);
  332.     function GetOwnerTable: TDataSet;
  333.     procedure ClearIfChange;
  334.     function GetCreateNow: Boolean;
  335.     procedure SetCreateNow(const Value: Boolean);
  336.  
  337.   protected
  338.  
  339.     FCurrentKey: String;
  340.     FCurrentRec: DWORD;
  341.     function GetIsRanged: boolean; override;
  342.     procedure AssignIndex(oInd: TVKNTXIndex);
  343.     function InternalFirst: TGetResult; override;
  344.     function InternalNext: TGetResult; override;
  345.     function InternalPrior: TGetResult; override;
  346.     function InternalLast: TGetResult; override;
  347.     function GetCurrentKey: String; override;
  348.     function GetCurrentRec: DWORD; override;
  349.     //function FileRead(Handle: Integer; var Buffer; Count: LongWord): Integer;
  350.     //function FileWrite(Handle: Integer; const Buffer; Count: LongWord): Integer;
  351.     function AddItem(ntxItem: pNTX_ITEM): boolean;
  352.  
  353.     function GetOrder: String; override;
  354.     procedure SetOrder(Value: String); override;
  355.  
  356.     procedure DefineBag; override;
  357.     procedure DefineBagAndOrder; override;
  358.  
  359.   public
  360.  
  361.     constructor Create(Collection: TCollection); override;
  362.     destructor Destroy; override;
  363.     procedure Assign(Source: TPersistent); override;
  364.     function IsEqual(Value: TIndex): Boolean; override;
  365.     function CmpKeys(ItemKey, CurrKey: pChar; KSize: Integer = 0): Integer;
  366.     function CmpKeys1(ItemKey, CurrKey: pChar; KSize: Integer = 0): Integer;
  367.     function CmpKeys2(ItemKey, CurrKey: pChar; KSize: Integer = 0): Integer;
  368.     function CmpKeys3(ItemKey, CurrKey: pChar; KSize: Integer = 0): Integer;
  369.     procedure TransKey(Key: pChar; KSize: Integer = 0; ToOem: Boolean = true); overload;
  370.     function TransKey(Key: String): String; overload;
  371.     function Open: boolean; override;
  372.     procedure Close; override;
  373.     function IsOpen: boolean; override;
  374.     function SetToRecord: boolean; overload; override;
  375.     function SetToRecord(Rec: Longint): boolean; overload; override;
  376.     function SetToRecord(Key: String; Rec: Longint): boolean; overload; override;
  377.  
  378.     //
  379.     function Seek(Key: String; SoftSeek: boolean = false): boolean; override;
  380.     function SeekFirst( Key: String; SoftSeek: boolean = false;
  381.                         PartialKey: boolean = false): boolean; override;
  382.     function SeekFirstRecord( Key: String; SoftSeek: boolean = false;
  383.                               PartialKey: boolean = false): Integer; override;
  384.     function SeekFields(const KeyFields: string; const KeyValues: Variant;
  385.                         SoftSeek: boolean = false;
  386.                         PartialKey: boolean = false): Integer; override;
  387.  
  388.     // It is a new find mashine subject to SetDeleted, Filter and Range
  389.     function FindKey(Key: String; PartialKey: boolean = false; SoftSeek: boolean = false; Rec: DWORD = 0): Integer; override;
  390.     function FindKeyFields( const KeyFields: string; const KeyValues: Variant;
  391.                             PartialKey: boolean = false): Integer; overload; override;
  392.     function FindKeyFields( const KeyFields: string; const KeyValues: array of const;
  393.                             PartialKey: boolean = false): Integer; overload; override;
  394.     function FindKeyFields( PartialKey: boolean = false): Integer; overload; override;
  395.     //
  396.  
  397.     function SubIndex(LoKey, HiKey: String): boolean; override;
  398.     function SubNtx(var SubNtxFile: String; LoKey, HiKey: String): boolean;
  399.     function FillFirstBufRecords(DBFHandler: TProxyStream; FBuffer: pChar; FRecordsPerBuf: Integer; FRecordSize: Integer; FBufInd: pLongint; data_offset: Word): longint; override;
  400.     function FillLastBufRecords(DBFHandler: TProxyStream; FBuffer: pChar; FRecordsPerBuf: Integer; FRecordSize: Integer; FBufInd: pLongint; data_offset: Word): longint; override;
  401.     function EvaluteKeyExpr: String; override;
  402.     function SuiteFieldList(fl: String; out m: Integer): Integer; override;
  403.     function EvaluteForExpr: boolean; override;
  404.     function GetRecordByIndex(GetMode: TGetMode; var cRec: Longint): TGetResult; override;
  405.     function GetFirstByIndex(var cRec: Longint): TGetResult; override;
  406.     function GetLastByIndex(var cRec: Longint): TGetResult; override;
  407.     procedure First; override;
  408.     procedure Next; override;
  409.     procedure Prior; override;
  410.     procedure Last; override;
  411.     function LastKey(out LastKey: String; out LastRec: LongInt): boolean; override;
  412.     function NextBuffer(DBFHandler: TProxyStream; FBuffer: pChar; FRecordsPerBuf: Integer; FRecordSize: Integer; FBufInd: pLongint; data_offset: Word): Longint; override;
  413.     function PriorBuffer(DBFHandler: TProxyStream; FBuffer: pChar; FRecordsPerBuf: Integer; FRecordSize: Integer; FBufInd: pLongint; data_offset: Word): Longint; override;
  414.     procedure SetRangeFields(FieldList: String; FieldValues: array of const); overload; override;
  415.     procedure SetRangeFields(FieldList: String; FieldValues: variant); overload; override;
  416.     function InRange(Key: String): boolean; overload; override;
  417.     function InRange: boolean; overload; override;
  418.  
  419.     function FLock: boolean; override;
  420.     function FUnLock: boolean; override;
  421.  
  422.     procedure StartUpdate(UnLock: boolean = true); override;
  423.     procedure Flush; override;
  424.  
  425.     procedure DeleteKey(sKey: String; nRec: Longint); override;
  426.     procedure AddKey(sKey: String; nRec: Longint); override;
  427.  
  428.     // All index create in memory. Fast, but need much memory
  429.     procedure CreateIndex(Activate: boolean = true); override;
  430.     // Save on disk sorted blocks, then merge blocks into BTrees. Slowly CreateIndex, but no need memory
  431.     procedure CreateCompactIndex(BlockBufferSize: LongWord = 65536; Activate: boolean = true); override;
  432.     procedure Reindex(Activate: boolean = true); override;
  433.  
  434.     procedure Truncate; override;
  435.  
  436.     procedure BeginCreateIndexProcess; override;
  437.     procedure EvaluteAndAddKey(nRec: DWORD); override;
  438.     procedure EndCreateIndexProcess; override;
  439.  
  440.     function IsUniqueIndex: boolean; override;
  441.     function IsForIndex: boolean; override;
  442.  
  443.     property OwnerTable: TDataSet read GetOwnerTable;
  444.  
  445.   published
  446.  
  447.     property NTXFileName: String read FNTXFileName write SetNTXFileName;
  448.     property KeyExpresion: String read FKeyExpresion write SetKeyExpresion stored false;
  449.     property ForExpresion: String read FForExpresion write SetForExpresion stored false;
  450.     property KeyTranslate: boolean read FKeyTranslate write FKeyTranslate default true;
  451.     property Clipper501RusOrder: boolean read FCl501Rus write FCl501Rus;
  452.     property Unique: boolean read GetUnique write SetUnique;
  453.     property Desc: boolean read GetDesc write SetDesc;
  454.     property Order;
  455.     property Temp: boolean read FTemp write FTemp;
  456.     property NTXRange: TVKNTXRange read FNTXRange write FNTXRange;
  457.     property ClipperVer: TCLIPPER_VERSION read FClipperVer write FClipperVer default v500;
  458.     property CreateNow: Boolean read GetCreateNow write SetCreateNow;
  459.     property DeleteKeyStyle: TDeleteKeyStyle read FDeleteKeyStyle write FDeleteKeyStyle;
  460.  
  461.     property OnCreateIndex;
  462.     property OnSubIndex;
  463.     property OnEvaluteKey;
  464.     property OnEvaluteFor;
  465.     property OnCompareKeys;
  466.     property OnSubNtx: TOnSubNtx read FOnSubNtx write FOnSubNtx;
  467.  
  468.   end;
  469.  
  470. implementation
  471.  
  472. uses
  473.    DBCommon, Dialogs, VKDBFDataSet;
  474.  
  475. { TVKNTXIndex }
  476.  
  477. procedure TVKNTXIndex.Assign(Source: TPersistent);
  478. begin
  479.   if Source is TVKNTXIndex then
  480.     AssignIndex(TVKNTXIndex(Source))
  481.   else
  482.     inherited Assign(Source);
  483. end;
  484.  
  485. procedure TVKNTXIndex.AssignIndex(oInd: TVKNTXIndex);
  486. begin
  487.   if oInd <> nil then
  488.   begin
  489.     Name := oInd.Name;
  490.     NTXFileName := oInd.NTXFileName;
  491.   end;
  492. end;
  493.  
  494. procedure TVKNTXIndex.Close;
  495. begin
  496.   if not IsOpen then Exit;
  497.   Flush;
  498.   FNTXBuffers.Clear;
  499.   FNTXBag.Close;
  500.   FForExists := false;
  501.   if FTemp then begin
  502.     DeleteFile(FNTXFileName);
  503.     if not FDestructor then
  504.       Collection.Delete(Index);
  505.   end;
  506. end;
  507.  
  508. constructor TVKNTXIndex.Create(Collection: TCollection);
  509. var
  510.   FieldMap: TFieldMap;
  511. begin
  512.   inherited Create(Collection);
  513.  
  514.   FClipperVer := v500;
  515.  
  516.   FDeleteKeyStyle := dksClipper;
  517.  
  518.   FUnique := False;
  519.   FDesc := False ;
  520.   FOrder := '';
  521.  
  522.   (*
  523.   FNTXOrder.FHead.sign := 6;
  524.   FNTXOrder.FHead.version := 1;
  525.   FNTXOrder.FHead.root := 0;
  526.   FNTXOrder.FHead.next_page := 0;
  527.   FNTXOrder.FHead.item_size := 0;
  528.   FNTXOrder.FHead.key_size := 0;
  529.   FNTXOrder.FHead.key_dec := 0;
  530.   FNTXOrder.FHead.max_item := 0;
  531.   FNTXOrder.FHead.half_page := 0;
  532.   for i := 0 to NTX_MAX_KEY-1 do FNTXOrder.FHead.key_expr[i] := #0;
  533.   FNTXOrder.FHead.unique := #0;
  534.   FNTXOrder.FHead.reserv1 := #0;
  535.   FNTXOrder.FHead.desc := #0;
  536.   FNTXOrder.FHead.reserv3 := #0;
  537.   for i := 0 to NTX_MAX_KEY-1 do FNTXOrder.FHead.for_expr[i] := #0;
  538.   for i := 0 to 7 do FNTXOrder.FHead.order[i] := #0;
  539.   for i := 0 to 477 do FNTXOrder.FHead.Rest[i] := #0;
  540.   *)
  541.  
  542.   FKeyParser := TVKDBFExprParser.Create(TVKDBFNTX(FIndexes.Owner), '', [], [poExtSyntax], '', nil, FieldMap);
  543.   FKeyParser.IndexKeyValue := true;
  544.   FForParser := TVKDBFExprParser.Create(TVKDBFNTX(FIndexes.Owner), '', [], [poExtSyntax], '', nil, FieldMap);
  545.   FForParser.IndexKeyValue := true;
  546.   FKeyTranslate := true;
  547.   FCl501Rus := false;
  548.   FFileLock := false;
  549.   FTemp := false;
  550.   FForExists := false;
  551.  
  552.   FNTXRange := TVKNTXRange.Create;
  553.   FNTXRange.NTX := self;
  554.  
  555.   FNTXBuffers := TVKNTXBuffers.Create;
  556.   FNTXBuffers.NXTObject := self;
  557.   FCreateIndexProc:= false;
  558.   FReindex := false;
  559.  
  560.   FOnSubNtx := nil;
  561.  
  562.   FDestructor := false;
  563.  
  564. end;
  565.  
  566. destructor TVKNTXIndex.Destroy;
  567. begin
  568.   FDestructor := true;
  569.   if IsOpen then Close;
  570.   FKeyParser.Free;
  571.   FForParser.Free;
  572.   FNTXRange.Free;
  573.   FNTXBuffers.Free;
  574.   if TIndexes(Collection).ActiveObject = self then
  575.     TIndexes(Collection).ActiveObject := nil;
  576.   inherited Destroy;
  577. end;
  578.  
  579. function TVKNTXIndex.EvaluteForExpr: boolean;
  580. begin
  581.   if Assigned(FOnEvaluteFor) then
  582.     FOnEvaluteFor(self, Result)
  583.   else
  584.     Result := FForParser.Execute;
  585. end;
  586.  
  587. function TVKNTXIndex.EvaluteKeyExpr: String;
  588. begin
  589.   if Assigned(FOnEvaluteKey) then
  590.     FOnEvaluteKey(self, Result)
  591.   else
  592.     Result := FKeyParser.EvaluteKey;
  593. end;
  594.  
  595. function TVKNTXIndex.InternalFirst: TGetResult;
  596. var
  597.   level: Integer;
  598.   v: WORD;
  599.  
  600.   function Pass(page_off: DWORD): TGetResult;
  601.   var
  602.     page: pNTX_BUFFER;
  603.     item: pNTX_ITEM;
  604.     Srckey: array[0..NTX_PAGE-1] of Char;
  605.     Destkey: array[0..NTX_PAGE-1] of Char;
  606.   begin
  607.     Inc(level);
  608.     try
  609.  
  610.       FNTXBuffers.GetPage(FNTXBag.NTXHandler, page_off, page);
  611.  
  612.       item := pNTX_ITEM(pChar(page) + page.ref[0]);
  613.       if ( item.page <> 0 ) then begin
  614.         Result := Pass(item.page);
  615.         if Result = grOK then Exit;
  616.       end;
  617.       if page.count <> 0 then begin
  618.         //
  619.         if FKeyTranslate then begin
  620.           Move(item.key, Srckey, FNTXOrder.FHead.key_size);
  621.           Srckey[FNTXOrder.FHead.key_size] := #0;
  622.           TVKDBFNTX(FIndexes.Owner).Translate(Srckey, Destkey, false);
  623.           SetString(FCurrentKey, Destkey, FNTXOrder.FHead.key_size);
  624.         end else
  625.           SetString(FCurrentKey, item.key, FNTXOrder.FHead.key_size);
  626.         FCurrentRec := item.rec_no;
  627.         //
  628.         Result := grOK;
  629.       end else
  630.         if level = 1 then
  631.           Result := grEOF
  632.         else
  633.           Result := grError;
  634.       Exit;
  635.     finally
  636.       Dec(level);
  637.     end;
  638.   end;
  639.  
  640. begin
  641.  
  642.   if not FUpdated then begin
  643.     v := FNTXOrder.FHead.version;
  644.     FNTXBag.NTXHandler.Seek(0, 0);
  645.     FNTXBag.NTXHandler.Read(FNTXOrder.FHead, 12);
  646.     if v <> FNTXOrder.FHead.version then FNTXBuffers.Clear;
  647.   end;
  648.  
  649.   level := 0;
  650.   Result := Pass(FNTXOrder.FHead.root);
  651.  
  652. end;
  653.  
  654. procedure TVKNTXIndex.First;
  655. begin
  656.   if InternalFirst = grOk then
  657.     TVKDBFNTX(FIndexes.Owner).RecNo := FCurrentRec;
  658. end;
  659.  
  660. function TVKNTXIndex.IsEqual(Value: TIndex): Boolean;
  661. var
  662.   oNTX: TVKNTXIndex;
  663. begin
  664.   oNTX := Value as TVKNTXIndex;
  665.   Result := ( (FName = oNTX.Name) and (FNTXFileName = oNTX.NTXFileName) );
  666. end;
  667.  
  668. function TVKNTXIndex.IsOpen: boolean;
  669. begin
  670.   Result := ((FNTXBag <> nil) and (FNTXBag.IsOpen));
  671. end;
  672.  
  673. function TVKNTXIndex.InternalLast: TGetResult;
  674. var
  675.   level: Integer;
  676.   v: WORD;
  677.  
  678.   function Pass(page_off: DWORD): TGetResult;
  679.   var
  680.     page: pNTX_BUFFER;
  681.     item: pNTX_ITEM;
  682.     Srckey: array[0..NTX_PAGE-1] of Char;
  683.     Destkey: array[0..NTX_PAGE-1] of Char;
  684.   begin
  685.     Inc(level);
  686.     try
  687.  
  688.       FNTXBuffers.GetPage(FNTXBag.NTXHandler, page_off, page);
  689.  
  690.       item := pNTX_ITEM(pChar(page) + page.ref[page.count]);
  691.       if ( item.page <> 0 ) then begin
  692.         Result := Pass(item.page);
  693.         if Result = grOK then Exit;
  694.       end;
  695.       if page.count <> 0 then begin
  696.         //
  697.         item := pNTX_ITEM(pChar(page) + page.ref[page.count - 1]);
  698.         if FKeyTranslate then begin
  699.           Move(item.key, Srckey, FNTXOrder.FHead.key_size);
  700.           Srckey[FNTXOrder.FHead.key_size] := #0;
  701.           TVKDBFNTX(FIndexes.Owner).Translate(Srckey, Destkey, false);
  702.           SetString(FCurrentKey, Destkey, FNTXOrder.FHead.key_size);
  703.         end else
  704.           SetString(FCurrentKey, item.key, FNTXOrder.FHead.key_size);
  705.         FCurrentRec := item.rec_no;
  706.         //
  707.         Result := grOK;
  708.       end else
  709.         if level = 1 then
  710.           Result := grBOF
  711.         else
  712.           Result := grError;
  713.       Exit;
  714.     finally
  715.       Dec(level);
  716.     end;
  717.   end;
  718.  
  719. begin
  720.  
  721.   if not FUpdated then begin
  722.     v := FNTXOrder.FHead.version;
  723.     FNTXBag.NTXHandler.Seek(0, 0);
  724.     FNTXBag.NTXHandler.Read(FNTXOrder.FHead, 12);
  725.     if v <> FNTXOrder.FHead.version then FNTXBuffers.Clear;
  726.   end;
  727.  
  728.   level := 0;
  729.   Result := Pass(FNTXOrder.FHead.root);
  730.  
  731. end;
  732.  
  733. function TVKNTXIndex.InternalPrior: TGetResult;
  734. var
  735.   Found: boolean;
  736.   gr: TGetResult;
  737.   v: WORD;
  738.  
  739.   procedure Pass(page_off: DWORD);
  740.   var
  741.     i: DWORD;
  742.     page: pNTX_BUFFER;
  743.     item: pNTX_ITEM;
  744.     Srckey: array[0..NTX_PAGE-1] of Char;
  745.     Destkey: array[0..NTX_PAGE-1] of Char;
  746.     c: Integer;
  747.  
  748.     procedure SetCurrentKey;
  749.     begin
  750.       if FKeyTranslate then begin
  751.         Move(item.key, Srckey, FNTXOrder.FHead.key_size);
  752.         Srckey[FNTXOrder.FHead.key_size] := #0;
  753.         TVKDBFNTX(FIndexes.Owner).Translate(Srckey, Destkey, false);
  754.         SetString(FCurrentKey, Destkey, FNTXOrder.FHead.key_size);
  755.       end else
  756.         SetString(FCurrentKey, item.key, FNTXOrder.FHead.key_size);
  757.       FCurrentRec := item.rec_no;
  758.     end;
  759.  
  760.   begin
  761.  
  762.     FNTXBuffers.GetPage(FNTXBag.NTXHandler, page_off, page);
  763.  
  764.     if page.count > 0 then begin
  765.       for i := 0 to page.count - 1 do begin
  766.         item := pNTX_ITEM(pChar(page) + page.ref[i]);
  767.         c := CmpKeys(item.key, pChar(FCurrentKey));
  768.         if c <= 0 then begin
  769.           if ( FCurrentRec = item.rec_no ) and ( c = 0 ) then begin
  770.             Found := true;
  771.  
  772.             if ( item.page = 0 ) then begin
  773.               if ( i <> 0 ) then begin
  774.                 gr := grOK;
  775.                 item := pNTX_ITEM(pChar(page) + page.ref[i - 1]);
  776.                 SetCurrentKey;
  777.               end;
  778.             end else begin
  779.  
  780.               FNTXBuffers.GetPage(FNTXBag.NTXHandler, item.page, page);
  781.  
  782.               if page.count > 0 then begin
  783.                 gr := grOK;
  784.                 item := pNTX_ITEM(pChar(page) + page.ref[page.count - 1]);
  785.                 SetCurrentKey;
  786.               end else
  787.                 gr := grError;
  788.             end;
  789.  
  790.             Exit;
  791.           end;
  792.  
  793.           if ( item.page <> 0 ) then Pass(item.page);
  794.  
  795.           if Found and (gr = grBOF) then begin
  796.             if ( i <> 0 ) then begin
  797.               gr := grOK;
  798.               item := pNTX_ITEM(pChar(page) + page.ref[i - 1]);
  799.               SetCurrentKey;
  800.             end;
  801.             Exit;
  802.           end;
  803.           if gr = grError then Exit;
  804.           if gr = grOK then Exit;
  805.  
  806.         end;
  807.       end;
  808.     end;
  809.     item := pNTX_ITEM(pChar(page) + page.ref[page.count]);
  810.     if ( item.page <> 0 ) then Pass(item.page);
  811.     if Found and (gr = grBOF ) then begin
  812.       if ( page.count <> 0 ) then begin
  813.         gr := grOK;
  814.         item := pNTX_ITEM(pChar(page) + page.ref[page.count - 1]);
  815.         SetCurrentKey;
  816.       end else
  817.         gr := grError;
  818.     end;
  819.   end;
  820.  
  821. begin
  822.  
  823.   if not FUpdated then begin
  824.     v := FNTXOrder.FHead.version;
  825.     FNTXBag.NTXHandler.Seek(0, 0);
  826.     FNTXBag.NTXHandler.Read(FNTXOrder.FHead, 12);
  827.     if v <> FNTXOrder.FHead.version then FNTXBuffers.Clear;
  828.   end;
  829.  
  830.   gr := grBOF;
  831.   Found := false;
  832.   Pass(FNTXOrder.FHead.root);
  833.   Result := gr;
  834.  
  835. end;
  836.  
  837. function TVKNTXIndex.Open: boolean;
  838. var
  839.   oW: TVKDBFNTX;
  840. begin
  841.  
  842.   oW := TVKDBFNTX(FIndexes.Owner);
  843.  
  844.   DefineBagAndOrder;
  845.  
  846.   FNTXBuffers.Clear;
  847.   if not ((FNTXOrder.FHead.sign = 6) or (FNTXOrder.FHead.sign = 7)) then begin
  848.     FNTXBag.Close;
  849.     raise Exception.Create('TVKNTXIndex.Open: File "' + FNTXFileName + '" is not NTX file');
  850.   end;
  851.  
  852.   Result := IsOpen;
  853.  
  854.   if Result then begin
  855.  
  856.     FLastOffset := FNTXBag.NTXHandler.Seek(0, 2);
  857.  
  858.     if  ( ( ( oW.AccessMode.FLast and fmShareExclusive ) = fmShareExclusive ) or
  859.         ( ( oW.AccessMode.FLast and fmShareDenyWrite ) = fmShareDenyWrite ) ) then
  860.         StartUpdate;
  861.     InternalFirst;
  862.     KeyExpresion := FNTXOrder.FHead.key_expr;
  863.     ForExpresion := FNTXOrder.FHead.for_expr;
  864.     if ForExpresion <> '' then
  865.       FForExists := true;
  866.   end;
  867.  
  868. end;
  869.  
  870. function TVKNTXIndex.InternalNext: TGetResult;
  871. var
  872.   Found: Boolean;
  873.   gr: TGetResult;
  874.   v: WORD;
  875.  
  876.   procedure Pass(page_off: DWORD);
  877.   var
  878.     i: DWORD;
  879.     page: pNTX_BUFFER;
  880.     item: pNTX_ITEM;
  881.     Srckey: array[0..NTX_PAGE-1] of Char;
  882.     Destkey: array[0..NTX_PAGE-1] of Char;
  883.     c: Integer;
  884.     level: Integer;
  885.  
  886.     procedure SetCurrentKey;
  887.     begin
  888.       if FKeyTranslate then begin
  889.         Move(item.key, Srckey, FNTXOrder.FHead.key_size);
  890.         Srckey[FNTXOrder.FHead.key_size] := #0;
  891.         TVKDBFNTX(FIndexes.Owner).Translate(Srckey, Destkey, false);
  892.         SetString(FCurrentKey, Destkey, FNTXOrder.FHead.key_size);
  893.       end else
  894.         SetString(FCurrentKey, item.key, FNTXOrder.FHead.key_size);
  895.       FCurrentRec := item.rec_no;
  896.     end;
  897.  
  898.     procedure GetFirstFromSubTree(page_off: DWORD);
  899.     begin
  900.       Inc(level);
  901.       try
  902.  
  903.         FNTXBuffers.GetPage(FNTXBag.NTXHandler, page_off, page);
  904.  
  905.         item := pNTX_ITEM(pChar(page) + page.ref[0]);
  906.         if ( item.page <> 0 ) then begin
  907.           GetFirstFromSubTree(item.page);
  908.           if gr = grOK then Exit;
  909.         end;
  910.         if page.count <> 0 then begin
  911.           SetCurrentKey;
  912.           gr := grOK;
  913.         end else
  914.           if level = 1 then
  915.             gr := grEOF
  916.           else
  917.             gr := grError;
  918.         Exit;
  919.       finally
  920.         Dec(level);
  921.       end;
  922.     end;
  923.  
  924.   begin
  925.  
  926.     FNTXBuffers.GetPage(FNTXBag.NTXHandler, page_off, page);
  927.  
  928.     if page.count > 0 then begin
  929.       for i := 0 to page.count - 1 do begin
  930.         item := pNTX_ITEM(pChar(page) + page.ref[i]);
  931.         c := CmpKeys(item.key, pChar(FCurrentKey));
  932.         if c <= 0 then begin
  933.           if ( FCurrentRec = item.rec_no ) and ( c = 0 ) then begin
  934.             Found := true;
  935.             //
  936.             SetCurrentKey;
  937.             item := pNTX_ITEM(pChar(page) + page.ref[i + 1]);
  938.             if item.page <> 0 then begin
  939.               level := 0;
  940.               GetFirstFromSubTree(item.page);
  941.             end else begin
  942.               if ( ( i + 1 ) = page.count ) then begin
  943.                 gr := grEOF;
  944.               end else begin
  945.                 gr := grOK;
  946.                 SetCurrentKey;
  947.               end;
  948.             end;
  949.             //
  950.             Exit;
  951.           end;
  952.           if ( item.page <> 0 ) then Pass(item.page);
  953.           if (gr = grOK) then Exit;
  954.           if Found and (gr = grEOF) then begin
  955.             gr := grOK;
  956.             SetCurrentKey;
  957.             Exit;
  958.           end;
  959.           if gr = grError then Exit;
  960.         end;
  961.       end;
  962.     end;
  963.     item := pNTX_ITEM(pChar(page) + page.ref[page.count]);
  964.     if ( item.page <> 0 ) then Pass(item.page);
  965.   end;
  966.  
  967. begin
  968.  
  969.   if not FUpdated then begin
  970.     v := FNTXOrder.FHead.version;
  971.     FNTXBag.NTXHandler.Seek(0, 0);
  972.     FNTXBag.NTXHandler.Read(FNTXOrder.FHead, 12);
  973.     if v <> FNTXOrder.FHead.version then FNTXBuffers.Clear;
  974.   end;
  975.  
  976.   Found := false;
  977.   gr := grEOF;
  978.   Pass(FNTXOrder.FHead.root);
  979.   Result := gr;
  980.  
  981. end;
  982.  
  983. function TVKNTXIndex.Seek(Key: String; SoftSeek: boolean = false): boolean;
  984. var
  985.   R: Integer;
  986. begin
  987.   R := FindKey(Key, false, SoftSeek);
  988.   if R <> 0 then begin
  989.     (TVKDBFNTX(FIndexes.Owner)).RecNo := R;
  990.     Result := True;
  991.   end else
  992.     Result := False;
  993. end;
  994.  
  995. function TVKNTXIndex.SeekFirstInternal( Key: String; SoftSeek: boolean = false): boolean;
  996. var
  997.   lResult, SoftSeekSet: boolean;
  998.  
  999.   procedure Pass(page_off: DWORD);
  1000.   var
  1001.     i: DWORD;
  1002.     page: pNTX_BUFFER;
  1003.     item: pNTX_ITEM;
  1004.     c: Integer;
  1005.   begin
  1006.  
  1007.     FNTXBuffers.GetPage(FNTXBag.NTXHandler, page_off, page);
  1008.  
  1009.     if page.count > 0 then begin
  1010.  
  1011.       item := nil;
  1012.  
  1013.       for i := 0 to page.count - 1 do begin
  1014.  
  1015.         item := pNTX_ITEM(pChar(page) + page.ref[i]);
  1016.  
  1017.         c := CmpKeys(item.key, pChar(Key));
  1018.  
  1019.         if c < 0 then begin //Key < item.key
  1020.           if ( item.page <> 0 ) then Pass(item.page);
  1021.           if (SoftSeek) and (not lResult) and (not SoftSeekSet) then begin
  1022.             FSeekRecord := item.rec_no;
  1023.             SetString(FSeekKey, item.key, FNTXOrder.FHead.key_size);
  1024.             SoftSeekSet := true;
  1025.             FSeekOk := true;
  1026.           end;
  1027.           Exit;
  1028.         end;
  1029.  
  1030.         if c = 0 then begin //Key = item.key
  1031.           if ( item.page <> 0 ) then Pass(item.page);
  1032.           if not lResult then begin
  1033.             FSeekRecord := item.rec_no;
  1034.             SetString(FSeekKey, item.key, FNTXOrder.FHead.key_size);
  1035.             FSeekOk := true;
  1036.             lResult := true;
  1037.           end;
  1038.           Exit;
  1039.         end;
  1040.  
  1041.       end;
  1042.  
  1043.       FSeekRecord := item.rec_no;
  1044.       SetString(FSeekKey, item.key, FNTXOrder.FHead.key_size);
  1045.       FSeekOk := true;
  1046.  
  1047.     end;
  1048.  
  1049.     item := pNTX_ITEM(pChar(page) + page.ref[page.count]);
  1050.     if ( item.page <> 0 ) then Pass(item.page);
  1051.  
  1052.   end;
  1053.  
  1054. begin
  1055.  
  1056.   FSeekOk := false;
  1057.  
  1058.   if FLock then
  1059.     try
  1060.  
  1061.       ClearIfChange;
  1062.  
  1063.       SoftSeekSet := false;
  1064.       lResult := false;
  1065.       Pass(FNTXOrder.FHead.root);
  1066.       Result := lResult;
  1067.  
  1068.     finally
  1069.       FUnLock;
  1070.     end
  1071.   else
  1072.     Result := false;
  1073.  
  1074. end;
  1075.  
  1076. function TVKNTXIndex.SeekFirst( Key: String; SoftSeek: boolean = false;
  1077.                                 PartialKey: boolean = false): boolean;
  1078. var
  1079.   R: Integer;
  1080. begin
  1081.   R := FindKey(Key, PartialKey, SoftSeek);
  1082.   if R <> 0 then begin
  1083.     (TVKDBFNTX(FIndexes.Owner)).RecNo := R;
  1084.     Result := True;
  1085.   end else
  1086.     Result := False;
  1087. end;
  1088.  
  1089. procedure TVKNTXIndex.SetKeyExpresion(Value: String);
  1090. begin
  1091.   ChekExpression(Value);
  1092.   FKeyExpresion := Value;
  1093.   FKeyParser.SetExprParams1(FKeyExpresion, [], [poExtSyntax], '');
  1094. end;
  1095.  
  1096. procedure TVKNTXIndex.SetForExpresion(Value: String);
  1097. begin
  1098.   ChekExpression(Value);
  1099.   FForExpresion := Value;
  1100.   FForParser.SetExprParams1(FForExpresion, [], [poExtSyntax], '');
  1101. end;
  1102.  
  1103. procedure TVKNTXIndex.SetNTXFileName(const Value: String);
  1104. var
  1105.   PointPos: Integer;
  1106. begin
  1107.   FNTXFileName := Value;
  1108.   FName := ExtractFileName(FNTXFileName);
  1109.   PointPos := Pos('.', FName);
  1110.   if PointPos <> 0 then
  1111.     FName := Copy(FName, 1, PointPos - 1);
  1112. end;
  1113.  
  1114. function TVKNTXIndex.SubIndex(LoKey, HiKey: String): boolean;
  1115. var
  1116.   l, m: Integer;
  1117.  
  1118.   function Pass(page_off: DWORD): boolean;
  1119.   var
  1120.     i: DWORD;
  1121.     page: pNTX_BUFFER;
  1122.     item: pNTX_ITEM;
  1123.     c: Integer;
  1124.     S: String;
  1125.   begin
  1126.  
  1127.     FNTXBuffers.GetPage(FNTXBag.NTXHandler, page_off, page);
  1128.  
  1129.     if page.count > 0 then begin
  1130.       for i := 0 to page.count - 1 do begin
  1131.  
  1132.         item := pNTX_ITEM(pChar(page) + page.ref[i]);
  1133.  
  1134.         c := CmpKeys(item.key, pChar(LoKey), m);
  1135.  
  1136.         if c <= 0 then begin //LoKey <= item.key
  1137.           if ( item.page <> 0 ) then begin
  1138.             Result := Pass(item.page);
  1139.             if Result then Exit;
  1140.           end;
  1141.           c := CmpKeys(item.key, pChar(HiKey), l);
  1142.           if c < 0 then begin // HiKey < item.key
  1143.             Result := true;
  1144.             Exit;
  1145.           end;
  1146.           if Assigned(OnSubIndex) then begin
  1147.             SetString(S, item.key, FNTXOrder.FHead.key_size);
  1148.             OnSubIndex(self, S, item.rec_no);
  1149.           end;
  1150.         end;
  1151.  
  1152.       end;
  1153.     end;
  1154.  
  1155.     item := pNTX_ITEM(pChar(page) + page.ref[page.count]);
  1156.     if ( item.page <> 0 ) then Pass(item.page);
  1157.  
  1158.     Result := false;
  1159.  
  1160.   end;
  1161.  
  1162. begin
  1163.  
  1164.   if FLock then
  1165.     try
  1166.  
  1167.       ClearIfChange;
  1168.  
  1169.       m := Length(LoKey);
  1170.       if FNTXOrder.FHead.key_size < m then m := FNTXOrder.FHead.key_size;
  1171.       l := Length(HiKey);
  1172.       if FNTXOrder.FHead.key_size < l then l := FNTXOrder.FHead.key_size;
  1173.       Pass(FNTXOrder.FHead.root);
  1174.       Result := true;
  1175.  
  1176.     finally
  1177.       FUnLock;
  1178.     end
  1179.   else
  1180.     Result := false;
  1181.  
  1182. end;
  1183.  
  1184. function TVKNTXIndex.SubNtx(var SubNtxFile: String; LoKey, HiKey: String): boolean;
  1185. var
  1186.   l, m: Integer;
  1187.   Accept: boolean;
  1188.   oSubIndex: TVKNTXCompactIndex;
  1189.  
  1190.   function Pass(page_off: DWORD): boolean;
  1191.   var
  1192.     i: DWORD;
  1193.     page: pNTX_BUFFER;
  1194.     item: pNTX_ITEM;
  1195.     itm: NTX_ITEM;
  1196.     c: Integer;
  1197.     S: String;
  1198.   begin
  1199.  
  1200.     FNTXBuffers.GetPage(FNTXBag.NTXHandler, page_off, page);
  1201.  
  1202.     if page.count > 0 then begin
  1203.       for i := 0 to page.count - 1 do begin
  1204.  
  1205.         item := pNTX_ITEM(pChar(page) + page.ref[i]);
  1206.  
  1207.         c := CmpKeys(item.key, pChar(LoKey), m);
  1208.  
  1209.         if c <= 0 then begin //LoKey <= item.key
  1210.           if ( item.page <> 0 ) then begin
  1211.             Result := Pass(item.page);
  1212.             if Result then Exit;
  1213.           end;
  1214.           c := CmpKeys(item.key, pChar(HiKey), l);
  1215.           if c < 0 then begin // HiKey < item.key
  1216.             Result := true;
  1217.             Exit;
  1218.           end;
  1219.           Accept := true;
  1220.           if Assigned(OnSubNtx) then begin
  1221.             SetString(S, item.key, FNTXOrder.FHead.key_size);
  1222.             OnSubNtx(self, S, item.rec_no, Accept);
  1223.           end;
  1224.           if Accept then begin
  1225.             Move(item^, itm, FNTXOrder.FHead.item_size);
  1226.             oSubIndex.AddItem(@itm);
  1227.           end;
  1228.         end;
  1229.  
  1230.       end;
  1231.     end;
  1232.  
  1233.     item := pNTX_ITEM(pChar(page) + page.ref[page.count]);
  1234.     if ( item.page <> 0 ) then Pass(item.page);
  1235.  
  1236.     Result := false;
  1237.  
  1238.   end;
  1239.  
  1240. begin
  1241.  
  1242.   oSubIndex := TVKNTXCompactIndex.Create;
  1243.   try
  1244.  
  1245.     oSubIndex.FileName := SubNtxFile;
  1246.     oSubIndex.OwnerTable := OwnerTable;
  1247.     oSubIndex.Crypt := TVKDBFNTX(OwnerTable).Crypt.Active;
  1248.     oSubIndex.CreateEmptyIndex(FNTXOrder.FHead);
  1249.  
  1250.     if oSubIndex.FHndl > 0 then
  1251.       try
  1252.  
  1253.         if FLock then
  1254.           try
  1255.  
  1256.             ClearIfChange;
  1257.  
  1258.             m := Length(LoKey);
  1259.             if FNTXOrder.FHead.key_size < m then m := FNTXOrder.FHead.key_size;
  1260.             l := Length(HiKey);
  1261.             if FNTXOrder.FHead.key_size < l then l := FNTXOrder.FHead.key_size;
  1262.  
  1263.             Pass(FNTXOrder.FHead.root);
  1264.  
  1265.             Result := true;
  1266.  
  1267.           finally
  1268.             FUnLock;
  1269.           end
  1270.         else
  1271.           Result := false;
  1272.  
  1273.       finally
  1274.  
  1275.         oSubIndex.Close;
  1276.  
  1277.         with FIndexes.Add as TVKNTXIndex do begin
  1278.           Temp := True;
  1279.           NTXFileName := SubNtxFile;
  1280.           Open;
  1281.           Active := true;
  1282.           TVKDBFNTX(FIndexes.Owner).First;
  1283.         end;
  1284.  
  1285.       end
  1286.  
  1287.     else
  1288.       Result := false;
  1289.  
  1290.   finally
  1291.     oSubIndex.Free;
  1292.   end;
  1293.  
  1294. end;
  1295.  
  1296. procedure TVKNTXIndex.Last;
  1297. begin
  1298.   if InternalLast = grOk then
  1299.     TVKDBFNTX(FIndexes.Owner).RecNo := FCurrentRec;
  1300. end;
  1301.  
  1302. procedure TVKNTXIndex.Next;
  1303. begin
  1304.   if InternalNext = grOk then
  1305.     TVKDBFNTX(FIndexes.Owner).RecNo := FCurrentRec;
  1306. end;
  1307.  
  1308. procedure TVKNTXIndex.Prior;
  1309. begin
  1310.   if InternalPrior = grOk then
  1311.     TVKDBFNTX(FIndexes.Owner).RecNo := FCurrentRec;
  1312. end;
  1313.  
  1314. function TVKNTXIndex.GetRecordByIndex(GetMode: TGetMode;
  1315.   var cRec: Integer): TGetResult;
  1316. begin
  1317.   Result := grOk;
  1318.   case GetMode of
  1319.     gmNext:
  1320.       begin
  1321.         if cRec <> - 1 then
  1322.           Result := InternalNext
  1323.         else
  1324.           Result := InternalFirst;
  1325.       end;
  1326.     gmPrior:
  1327.       begin
  1328.         if cRec <> TVKDBFNTX(FIndexes.Owner).RecordCount then
  1329.           Result := InternalPrior
  1330.         else
  1331.           Result := InternalLast;
  1332.       end;
  1333.   end;
  1334.   if Result = grOk then
  1335.     cRec := FCurrentRec;
  1336.   if Result = grBOF then
  1337.     cRec := -1;
  1338.   if Result = grEOF then
  1339.     cRec := TVKDBFNTX(FIndexes.Owner).RecordCount;
  1340.   if Result = grError then
  1341.     cRec := TVKDBFNTX(FIndexes.Owner).RecordCount;
  1342. end;
  1343.  
  1344. function TVKNTXIndex.GetFirstByIndex(var cRec: Integer): TGetResult;
  1345. begin
  1346.   Result := InternalFirst;
  1347.   cRec := FCurrentRec;
  1348. end;
  1349.  
  1350. function TVKNTXIndex.GetLastByIndex(var cRec: Integer): TGetResult;
  1351. begin
  1352.   Result := InternalLast;
  1353.   cRec := FCurrentRec;
  1354. end;
  1355.  
  1356. function TVKNTXIndex.SetToRecord: boolean;
  1357. var
  1358.   TmpKey: String;
  1359. begin
  1360.   Result := true;
  1361.   FCurrentKey := EvaluteKeyExpr;
  1362.   FCurrentRec := TVKDBFNTX(FIndexes.Owner).RecNo;
  1363.   if Unique or FForExists then begin
  1364.     SeekFirstInternal(FCurrentKey, true);
  1365.     if FSeekOk then begin
  1366.       TmpKey := TransKey(FSeekKey);
  1367.       if (FCurrentKey <> TmpKey) then begin
  1368.         FCurrentKey := TmpKey;
  1369.         FCurrentRec := FSeekRecord;
  1370.       end;
  1371.     end else
  1372.       Result := false;
  1373.   end;
  1374. end;
  1375.  
  1376. function TVKNTXIndex.NextBuffer(DBFHandler: TProxyStream; FBuffer: pChar; FRecordsPerBuf: Integer; FRecordSize: Integer; FBufInd: pLongint; data_offset: Word): Longint;
  1377. var
  1378.   lResult: Longint;
  1379.   Found: boolean;
  1380.   v: WORD;
  1381.  
  1382.   function Pass(page_off: DWORD): boolean;
  1383.   var
  1384.     i: DWORD;
  1385.     page: pNTX_BUFFER;
  1386.     item: pNTX_ITEM;
  1387.     c: Integer;
  1388.     l: Integer;
  1389.  
  1390.   begin
  1391.  
  1392.     FNTXBuffers.GetPage(FNTXBag.NTXHandler, page_off, page);
  1393.  
  1394.     if page.count > 0 then begin
  1395.       for i := 0 to page.count - 1 do begin
  1396.         item := pNTX_ITEM(pChar(page) + page.ref[i]);
  1397.         c := CmpKeys(item.key, pChar(FCurrentKey));
  1398.         if c <= 0 then begin //FCurrentKey <= item.key
  1399.           if ( item.page <> 0 ) then begin
  1400.             Result := Pass(item.page);
  1401.             if Result then Exit;
  1402.           end;
  1403.           //
  1404.           if Found then begin
  1405.             if NTXRange.Active then begin
  1406.               l := Length(NTXRange.HiKey);
  1407.               if l > 0 then begin
  1408.                 c := CmpKeys(item.key, pChar(NTXRange.HiKey), l);
  1409.                 if c < 0 then begin //NTXRange.HiKey < item.key
  1410.                   Result := true;
  1411.                   Exit;
  1412.                 end;
  1413.               end;
  1414.             end;
  1415.             pLongint(pChar(FBufInd) + lResult * SizeOf(Longint))^ := item.rec_no;
  1416.             DBFHandler.Seek(data_offset + (item.rec_no - 1) * DWORD(FRecordSize), soFromBeginning);
  1417.             DBFHandler.Read((FBuffer + lResult * FRecordSize)^, FRecordSize);
  1418.             if TVKDBFNTX(OwnerTable).Crypt.Active then
  1419.               TVKDBFNTX(OwnerTable).Crypt.Decrypt(item.rec_no, Pointer(FBuffer + lResult * FRecordSize), FRecordSize);
  1420.             Inc(lResult);
  1421.           end;
  1422.           //
  1423.           if lResult = FRecordsPerBuf then begin
  1424.             Result := true;
  1425.             Exit;
  1426.           end;
  1427.  
  1428.           if ( FCurrentRec = item.rec_no ) and ( c = 0 ) then Found := true;
  1429.  
  1430.         end;
  1431.  
  1432.       end;
  1433.     end;
  1434.  
  1435.     item := pNTX_ITEM(pChar(page) + page.ref[page.count]);
  1436.     if ( item.page <> 0 ) then begin
  1437.       Result := Pass(item.page);
  1438.       if Result then Exit;
  1439.     end;
  1440.  
  1441.     Result := false;
  1442.  
  1443.   end;
  1444.  
  1445. begin
  1446.  
  1447.   if not FUpdated then begin
  1448.     v := FNTXOrder.FHead.version;
  1449.     FNTXBag.NTXHandler.Seek(0, 0);
  1450.     FNTXBag.NTXHandler.Read(FNTXOrder.FHead, 12);
  1451.     if v <> FNTXOrder.FHead.version then FNTXBuffers.Clear;
  1452.   end;
  1453.  
  1454.   lResult := 0;
  1455.   Found := false;
  1456.   Pass(FNTXOrder.FHead.root);
  1457. //  if not Found then
  1458. //    beep;
  1459.   Result := lResult;
  1460.  
  1461. end;
  1462.  
  1463. function TVKNTXIndex.PriorBuffer(DBFHandler: TProxyStream; FBuffer: pChar; FRecordsPerBuf: Integer; FRecordSize: Integer; FBufInd: pLongint; data_offset: Word): Longint;
  1464. var
  1465.   lResult: Longint;
  1466.   bResult: boolean;
  1467.   Found: boolean;
  1468.   v: WORD;
  1469.  
  1470.   procedure Pass(page_off: DWORD);
  1471.   var
  1472.     k, i: Integer;
  1473.     page: pNTX_BUFFER;
  1474.     item: pNTX_ITEM;
  1475.     c: Integer;
  1476.   label
  1477.     a1;
  1478.  
  1479.   begin
  1480.  
  1481.     FNTXBuffers.GetPage(FNTXBag.NTXHandler, page_off, page);
  1482.  
  1483.     k := page.count;
  1484.     if not Found then begin
  1485.       if page.count > 0 then begin
  1486.         for i := 0 to page.count - 1 do begin
  1487.           k := i - 1;
  1488.           item := pNTX_ITEM(pChar(page) + page.ref[i]);
  1489.           c := CmpKeys(item.key, pChar(FCurrentKey));
  1490.           if c <= 0 then begin //FCurrentKey <= item.key
  1491.             if ( FCurrentRec = item.rec_no ) and ( c = 0 ) then Found := true;
  1492.             if ( item.page <> 0 ) then begin
  1493.               Pass(item.page);
  1494.               if bResult then Exit;
  1495.             end;
  1496.             if Found then goto a1;
  1497.           end;
  1498.         end;
  1499.       end;
  1500.       item := pNTX_ITEM(pChar(page) + page.ref[page.count]);
  1501.       if ( item.page <> 0 ) then begin
  1502.         Pass(item.page);
  1503.         if bResult then Exit;
  1504.         k := page.count - 1;
  1505.         if Found then goto a1;
  1506.       end;
  1507.     end;
  1508.     //
  1509.     a1:
  1510.     if Found then begin
  1511.       while k >= 0 do begin
  1512.         item := pNTX_ITEM(pChar(page) + page.ref[k]);
  1513.         if k < page.count then begin
  1514.           if NTXRange.Active then begin
  1515.             c := CmpKeys(item.key, pChar(NTXRange.LoKey));
  1516.             if c > 0 then begin //NTXRange.LoKey > item.key
  1517.               bResult := true;
  1518.               Exit;
  1519.             end;
  1520.           end;
  1521.           pLongint(pChar(FBufInd) + (FRecordsPerBuf - lResult - 1) * SizeOf(Longint))^ := item.rec_no;
  1522.           DBFHandler.Seek(data_offset + (item.rec_no - 1) * DWORD(FRecordSize), soFromBeginning);
  1523.           DBFHandler.Read((FBuffer + (FRecordsPerBuf - lResult - 1) * FRecordSize)^, FRecordSize);
  1524.           if TVKDBFNTX(OwnerTable).Crypt.Active then
  1525.             TVKDBFNTX(OwnerTable).Crypt.Decrypt(item.rec_no, Pointer(FBuffer + (FRecordsPerBuf - lResult - 1) * FRecordSize), FRecordSize);
  1526.           Inc(lResult);
  1527.           if lResult = FRecordsPerBuf then begin
  1528.             bResult := true;
  1529.             Exit;
  1530.           end;
  1531.         end;
  1532.         if ( item.page <> 0 ) then begin
  1533.           Pass(item.page);
  1534.           if bResult then Exit;
  1535.         end;
  1536.         Dec(k);
  1537.       end;
  1538.     end;
  1539.     //
  1540.   end;
  1541.  
  1542. begin
  1543.  
  1544.   if not FUpdated then begin
  1545.     v := FNTXOrder.FHead.version;
  1546.     FNTXBag.NTXHandler.Seek(0, 0);
  1547.     FNTXBag.NTXHandler.Read(FNTXOrder.FHead, 12);
  1548.     if v <> FNTXOrder.FHead.version then FNTXBuffers.Clear;
  1549.   end;
  1550.  
  1551.   lResult := 0;
  1552.   bResult := false;
  1553.   Found := false;
  1554.   Pass(FNTXOrder.FHead.root);
  1555. //  if not Found then
  1556. //    beep;
  1557.   Result := lResult;
  1558.  
  1559. end;
  1560.  
  1561. function TVKNTXIndex.SetToRecord(Key: String; Rec: Integer): boolean;
  1562. var
  1563.   TmpKey: String;
  1564. begin
  1565.   Result := true;
  1566.   FCurrentKey := Key;
  1567.   FCurrentRec := Rec;
  1568.   if Unique or FForExists then begin
  1569.     SeekFirstInternal(FCurrentKey, true);
  1570.     if FSeekOk then begin
  1571.       TmpKey := TransKey(FSeekKey);
  1572.       if (FCurrentKey <> TmpKey) then begin
  1573.         FCurrentKey := TmpKey;
  1574.         FCurrentRec := FSeekRecord;
  1575.       end;
  1576.     end else
  1577.       Result := false;
  1578.   end;
  1579. end;
  1580.  
  1581. function TVKNTXIndex.GetCurrentKey: String;
  1582. begin
  1583.   Result := FCurrentKey;
  1584. end;
  1585.  
  1586. function TVKNTXIndex.GetCurrentRec: DWORD;
  1587. begin
  1588.   Result := FCurrentRec;
  1589. end;
  1590.  
  1591. function TVKNTXIndex.FillFirstBufRecords(DBFHandler: TProxyStream; FBuffer: pChar;
  1592.   FRecordsPerBuf, FRecordSize: Integer;
  1593.   FBufInd: pLongInt; data_offset: Word): longint;
  1594. var
  1595.   lResult: longint;
  1596.   c, l: Integer;
  1597.   v: WORD;
  1598.  
  1599.   function Pass(page_off: DWORD): boolean;
  1600.   var
  1601.     i: DWORD;
  1602.     page: pNTX_BUFFER;
  1603.     item: pNTX_ITEM;
  1604.   begin
  1605.  
  1606.     FNTXBuffers.GetPage(FNTXBag.NTXHandler, page_off, page);
  1607.  
  1608.     if page.count > 0 then begin
  1609.       for i := 0 to page.count - 1 do begin
  1610.  
  1611.         item := pNTX_ITEM(pChar(page) + page.ref[i]);
  1612.  
  1613.         if ( item.page <> 0 ) then begin
  1614.           Result := Pass(item.page);
  1615.           if Result then Exit;
  1616.         end;
  1617.         //
  1618.         pLongint(pChar(FBufInd) + lResult * SizeOf(Longint))^ := item.rec_no;
  1619.         DBFHandler.Seek(data_offset + (item.rec_no - 1) * DWORD(FRecordSize), soFromBeginning);
  1620.         DBFHandler.Read((FBuffer + lResult * FRecordSize)^, FRecordSize);
  1621.         if TVKDBFNTX(OwnerTable).Crypt.Active then
  1622.           TVKDBFNTX(OwnerTable).Crypt.Decrypt(item.rec_no, Pointer(FBuffer + lResult * FRecordSize), FRecordSize);
  1623.         Inc(lResult);
  1624.         //
  1625.         if lResult = FRecordsPerBuf then begin
  1626.           Result := true;
  1627.           Exit;
  1628.         end;
  1629.  
  1630.       end;
  1631.     end;
  1632.  
  1633.     item := pNTX_ITEM(pChar(page) + page.ref[page.count]);
  1634.     if ( item.page <> 0 ) then
  1635.       Result := Pass(item.page)
  1636.     else
  1637.       Result := false;
  1638.  
  1639.   end;
  1640.  
  1641. begin
  1642.  
  1643.   if not NTXRange.Active then begin
  1644.  
  1645.     if not FUpdated then begin
  1646.       v := FNTXOrder.FHead.version;
  1647.       FNTXBag.NTXHandler.Seek(0, 0);
  1648.       FNTXBag.NTXHandler.Read(FNTXOrder.FHead, 12);
  1649.       if v <> FNTXOrder.FHead.version then FNTXBuffers.Clear;
  1650.     end;
  1651.  
  1652.     lResult := 0;
  1653.     Pass(FNTXOrder.FHead.root);
  1654.     Result := lResult;
  1655.  
  1656.   end else begin
  1657.     SeekFirstInternal(NTXRange.LoKey, true);
  1658.     if FSeekOk then begin
  1659.       l := Length(NTXRange.LoKey);
  1660.       c := CmpKeys2(pChar(NTXRange.LoKey), pChar(FSeekKey), l);
  1661.       if c >= 0 then begin
  1662.         l := Length(NTXRange.HiKey);
  1663.         c := CmpKeys2(pChar(NTXRange.HiKey), pChar(FSeekKey), l);
  1664.         if (l > 0) and (c <= 0) then begin
  1665.           FCurrentKey := TransKey(FSeekKey);
  1666.           FCurrentRec := FSeekRecord;
  1667.           pLongint(FBufInd)^ := FSeekRecord;
  1668.           DBFHandler.Seek(data_offset + (DWORD(FSeekRecord) - 1) * DWORD(FRecordSize), soFromBeginning);
  1669.           DBFHandler.Read(FBuffer^, FRecordSize);
  1670.           if TVKDBFNTX(OwnerTable).Crypt.Active then
  1671.             TVKDBFNTX(OwnerTable).Crypt.Decrypt(FSeekRecord, Pointer(FBuffer), FRecordSize);
  1672.           Result := 1 + NextBuffer(DBFHandler, FBuffer + FRecordSize, FRecordsPerBuf - 1, FRecordSize, pLongint(pChar(FBufInd) + SizeOf(Longint)), data_offset);
  1673.         end else
  1674.           Result := 0;
  1675.       end else
  1676.         Result := 0;
  1677.     end else
  1678.       Result := 0;
  1679.   end;
  1680.  
  1681. end;
  1682.  
  1683. function TVKNTXIndex.FillLastBufRecords(DBFHandler: TProxyStream; FBuffer: pChar;
  1684.   FRecordsPerBuf, FRecordSize: Integer; FBufInd: pLongint;
  1685.   data_offset: Word): longint;
  1686. var
  1687.   lResult: longint;
  1688.   c, l: Integer;
  1689.   v: WORD;
  1690.  
  1691.   function Pass(page_off: DWORD): boolean;
  1692.   var
  1693.     i: DWORD;
  1694.     page: pNTX_BUFFER;
  1695.     item: pNTX_ITEM;
  1696.   begin
  1697.  
  1698.     FNTXBuffers.GetPage(FNTXBag.NTXHandler, page_off, page);
  1699.  
  1700.     item := pNTX_ITEM(pChar(page) + page.ref[page.count]);
  1701.     if ( item.page <> 0 ) then begin
  1702.       Result := Pass(item.page);
  1703.       if Result then Exit;
  1704.     end;
  1705.  
  1706.     if page.count > 0 then begin
  1707.       for i := page.count - 1 downto 0 do begin
  1708.  
  1709.         item := pNTX_ITEM(pChar(page) + page.ref[i]);
  1710.  
  1711.         //
  1712.         pLongint(pChar(FBufInd) + (FRecordsPerBuf - lResult - 1) * SizeOf(Longint))^ := item.rec_no;
  1713.         DBFHandler.Seek(data_offset + (item.rec_no - 1) * DWORD(FRecordSize), soFromBeginning);
  1714.         DBFHandler.Read((FBuffer + (FRecordsPerBuf - lResult - 1) * FRecordSize)^, FRecordSize);
  1715.         if TVKDBFNTX(OwnerTable).Crypt.Active then
  1716.           TVKDBFNTX(OwnerTable).Crypt.Decrypt(item.rec_no, Pointer(FBuffer + (FRecordsPerBuf - lResult - 1) * FRecordSize), FRecordSize);
  1717.         Inc(lResult);
  1718.         //
  1719.  
  1720.         if lResult = FRecordsPerBuf then begin
  1721.           Result := true;
  1722.           Exit;
  1723.         end;
  1724.  
  1725.         if ( item.page <> 0 ) then begin
  1726.           Result := Pass(item.page);
  1727.           if Result then Exit;
  1728.         end;
  1729.  
  1730.       end;
  1731.     end;
  1732.  
  1733.     Result := false;
  1734.  
  1735.   end;
  1736.  
  1737. begin
  1738.  
  1739.   if (not NTXRange.Active) or (NTXRange.LoKey  = '') then begin
  1740.  
  1741.     if not FUpdated then begin
  1742.       v := FNTXOrder.FHead.version;
  1743.       FNTXBag.NTXHandler.Seek(0, 0);
  1744.       FNTXBag.NTXHandler.Read(FNTXOrder.FHead, 12);
  1745.       if v <> FNTXOrder.FHead.version then FNTXBuffers.Clear;
  1746.     end;
  1747.  
  1748.     lResult := 0;
  1749.     Pass(FNTXOrder.FHead.root);
  1750.     Result := lResult;
  1751.  
  1752.   end else begin
  1753.     SeekLastInternal(NTXRange.HiKey, true);
  1754.     if FSeekOk then begin
  1755.       l := Length(NTXRange.LoKey);
  1756.       c := CmpKeys2(pChar(NTXRange.LoKey), pChar(FSeekKey), l);
  1757.       if c >= 0 then begin
  1758.         l := Length(NTXRange.HiKey);
  1759.         c := CmpKeys2(pChar(NTXRange.HiKey), pChar(FSeekKey), l);
  1760.         if (l > 0) and (c <= 0) then begin
  1761.           FCurrentKey := TransKey(FSeekKey);
  1762.           FCurrentRec := FSeekRecord;
  1763.           pLongint(pChar(FBufInd) + (FRecordsPerBuf - 1) * SizeOf(Longint))^ := FCurrentRec;
  1764.           DBFHandler.Seek(data_offset + (FCurrentRec - 1) * DWORD(FRecordSize), soFromBeginning);
  1765.           DBFHandler.Read((FBuffer + (FRecordsPerBuf - 1) * FRecordSize)^, FRecordSize);
  1766.           if TVKDBFNTX(OwnerTable).Crypt.Active then
  1767.             TVKDBFNTX(OwnerTable).Crypt.Decrypt(FCurrentRec, Pointer(FBuffer + (FRecordsPerBuf - 1) * FRecordSize), FRecordSize);
  1768.           Result := 1 + PriorBuffer(DBFHandler, FBuffer, FRecordsPerBuf - 1, FRecordSize, FBufInd, data_offset);
  1769.         end else
  1770.           Result := 0;
  1771.       end else
  1772.         Result := 0;
  1773.     end else
  1774.       Result := 0;
  1775.   end;
  1776.  
  1777. end;
  1778.  
  1779. function TVKNTXIndex.SetToRecord(Rec: Integer): boolean;
  1780. var
  1781.   TmpKey: String;
  1782. begin
  1783.   Result := true;
  1784.   FCurrentKey := EvaluteKeyExpr;
  1785.   FCurrentRec := Rec;
  1786.   if Unique or FForExists then begin
  1787.     SeekFirstInternal(FCurrentKey, true);
  1788.     if FSeekOk then begin
  1789.       TmpKey := TransKey(FSeekKey);
  1790.       if (FCurrentKey <> FSeekKey) then begin
  1791.         FCurrentKey := TmpKey;
  1792.         FCurrentRec := FSeekRecord;
  1793.       end;
  1794.     end else
  1795.       Result := false;
  1796.   end;
  1797. end;
  1798.  
  1799. (*
  1800. function TVKNTXIndex.FileWrite(Handle: Integer; const Buffer;
  1801.   Count: LongWord): Integer;
  1802. var
  1803.   i: Integer;
  1804.   l: boolean;
  1805.   Ok: boolean;
  1806.   oW: TVKDBFNTX;
  1807. begin
  1808.   i := 0;
  1809.   oW := TVKDBFNTX(FIndexes.Owner);
  1810.   l := (( (oW.AccessMode.FLast and fmShareExclusive) = fmShareExclusive ) or ( (oW.AccessMode.FLast and fmShareDenyWrite) = fmShareDenyWrite ));
  1811.   repeat
  1812.     Result := SysUtils.FileWrite(Handle, Buffer, Count);
  1813.     Ok := (Result <> -1);
  1814.     if not Ok then begin
  1815.       if l then
  1816.         Ok := true
  1817.       else begin
  1818.         Wait(0.001, false);
  1819.         Inc(i);
  1820.         if i = oW.WaitBusyRes then Ok := true;
  1821.       end;
  1822.     end;
  1823.   until Ok;
  1824. end;
  1825. *)
  1826.  
  1827. (*
  1828. function TVKNTXIndex.FileRead(Handle: Integer; var Buffer;
  1829.   Count: LongWord): Integer;
  1830. var
  1831.   i: Integer;
  1832.   l: boolean;
  1833.   Ok: boolean;
  1834.   oW: TVKDBFNTX;
  1835. begin
  1836.   i := 0;
  1837.   oW := TVKDBFNTX(FIndexes.Owner);
  1838.   l := (( (oW.AccessMode.FLast and fmShareExclusive) = fmShareExclusive ) or ( (oW.AccessMode.FLast and fmShareDenyWrite) = fmShareDenyWrite ));
  1839.   repeat
  1840.     Result := SysUtils.FileRead(Handle, Buffer, Count);
  1841.     Ok := (Result <> -1);
  1842.     if not Ok then begin
  1843.       if l then
  1844.         Ok := true
  1845.       else begin
  1846.         Wait(0.001, false);
  1847.         Inc(i);
  1848.         if i = oW.WaitBusyRes then Ok := true;
  1849.       end;
  1850.     end;
  1851.   until Ok;
  1852. end;
  1853. *)
  1854.  
  1855. function TVKNTXIndex.CompareKeys(S1, S2: PChar; MaxLen: Cardinal): Integer;
  1856. var
  1857.   i: Integer;
  1858.   T1: array [0..NTX_PAGE] of Char;
  1859.   T2: array [0..NTX_PAGE] of Char;
  1860. begin
  1861.   //S1 - CurrentKey
  1862.   //S2 - Item Key
  1863.   if Assigned(OnCompareKeys) then begin
  1864.     OnCompareKeys(self, S1, S2, MaxLen, Result);
  1865.   end else begin
  1866.     if FCl501Rus then begin
  1867.       Result := 0;
  1868.       CharToOem(pChar(S1), T1);
  1869.       CharToOem(pChar(S2), T2);
  1870.       for i := 0 to MaxLen - 1 do begin
  1871.         Result := CL501RUSORDER[Ord(T1[i])] - CL501RUSORDER[Ord(T2[i])];
  1872.         if Result <> 0 then Exit;
  1873.       end;
  1874.     end else begin
  1875.       //Result := AnsiStrLComp(S1, S2, MaxLen);  - in Win95-98 not currect
  1876.       Result := StrLComp(S1, S2, MaxLen);
  1877.     end;
  1878.   end;
  1879. end;
  1880.  
  1881. function TVKNTXIndex.GetFreePage: DWORD;
  1882. var
  1883.   page: pNTX_BUFFER;
  1884.   i: Integer;
  1885.   Ind: TVKNTXBuffer;
  1886.   item_off: WORD;
  1887. begin
  1888.   if FNTXOrder.FHead.next_page <> 0 then begin
  1889.  
  1890.     Ind := FNTXBuffers.GetNTXBuffer(FNTXBag.NTXHandler, FNTXOrder.FHead.next_page, page);
  1891.  
  1892.     page.count := 0;
  1893.     Result := FNTXOrder.FHead.next_page;
  1894.     FNTXOrder.FHead.next_page := pNTX_ITEM(pChar(page) + page.ref[page.count]).page;
  1895.     pNTX_ITEM(pChar(page) + page.ref[page.count]).page := 0;
  1896.  
  1897.     Ind.Fchanged := true;
  1898.  
  1899.   end else begin
  1900.  
  1901.     Result := FLastOffset;
  1902.  
  1903.     Ind := FNTXBuffers.GetNTXBuffer(FNTXBag.NTXHandler, Result, page, false);
  1904.  
  1905.     page.count := 0;
  1906.     item_off := ( FNTXOrder.FHead.max_item * 2 ) + 4;
  1907.     for i := 0 to FNTXOrder.FHead.max_item do begin
  1908.       page.ref[i] := item_off;
  1909.       item_off := item_off + FNTXOrder.FHead.item_size;
  1910.     end;
  1911.     pNTX_ITEM(pChar(page) + page.ref[0]).page := 0;
  1912.  
  1913.     Inc(FLastOffset, SizeOf(NTX_BUFFER));
  1914.  
  1915.     Ind.Fchanged := true;
  1916.  
  1917.   end;
  1918. end;
  1919.  
  1920. function TVKNTXIndex.AddItem(ntxItem: pNTX_ITEM): boolean;
  1921. var
  1922.   NewPage: pNTX_BUFFER;
  1923.   _NewPageOff, NewPageOff: DWORD;
  1924.   ItemHasBeenAdded: boolean;
  1925.   rf: WORD;
  1926.   Ind: TVKNTXBuffer;
  1927.  
  1928.   procedure AddItemInternal(page_off: DWORD);
  1929.   var
  1930.     i, j, beg, Mid: Integer;
  1931.     page: pNTX_BUFFER;
  1932.     item: pNTX_ITEM;
  1933.     c: Integer;
  1934.     Ind, Ind1: TVKNTXBuffer;
  1935.  
  1936.     procedure InsItem(page: pNTX_BUFFER);
  1937.     begin
  1938.       j := page.count;
  1939.       while j >= i do begin
  1940.         rf := page.ref[j + 1];
  1941.         page.ref[j + 1] := page.ref[j];
  1942.         page.ref[j] := rf;
  1943.         Dec(j);
  1944.       end;
  1945.       page.count := page.count + 1;
  1946.       Move(ntxItem.key, pNTX_ITEM(pChar(page) + page.ref[i]).key, FNTXOrder.FHead.key_size);
  1947.       pNTX_ITEM(pChar(page) + page.ref[i]).rec_no := ntxItem.rec_no;
  1948.       pNTX_ITEM(pChar(page) + page.ref[i]).page := ntxItem.page;
  1949.       if ( ntxItem.page <> 0 ) then begin
  1950.         pNTX_ITEM(pChar(page) + page.ref[i + 1]).page := NewPageOff;
  1951.         NewPageOff := 0;
  1952.       end;
  1953.     end;
  1954.  
  1955.     procedure CmpRec;
  1956.     begin
  1957.       if c = 0 then begin
  1958.         if item.rec_no < ntxItem.rec_no then
  1959.           c := 1
  1960.         else
  1961.           c := -1;
  1962.       end;
  1963.     end;
  1964.  
  1965.   begin
  1966.  
  1967.     Ind := FNTXBuffers.GetNTXBuffer(FNTXBag.NTXHandler, page_off, page);
  1968.  
  1969.     i := page.count;
  1970.     if ( i > 0 ) then begin
  1971.       beg := 0;
  1972.       item := pNTX_ITEM(pChar(page) + page.ref[beg]);
  1973.       c := CmpKeys1(item.key, pChar(@ntxItem^.key[0]));
  1974.  
  1975.       CmpRec;
  1976.  
  1977.       if ( c > 0 ) then begin
  1978.         repeat
  1979.           Mid := (i+beg) div 2;
  1980.           item := pNTX_ITEM(pChar(page) + page.ref[Mid]);
  1981.           c := CmpKeys1(item.key, pChar(@ntxItem^.key[0]));
  1982.  
  1983.           CmpRec;
  1984.  
  1985.           if ( c > 0 ) then
  1986.              beg := Mid
  1987.           else
  1988.              i := Mid;
  1989.         until ( ((i-beg) div 2) = 0 );
  1990.       end else
  1991.         i := beg;
  1992.     end;
  1993.     item := pNTX_ITEM(pChar(page) + page.ref[i]);
  1994.     if ( item.page <> 0 ) then AddItemInternal(item.page);
  1995.     if not ItemHasBeenAdded then begin
  1996.       if (page.count = FNTXOrder.FHead.max_item) then begin
  1997.         _NewPageOff := GetFreePage;
  1998.  
  1999.         Ind1 := FNTXBuffers.GetNTXBuffer(FNTXBag.NTXHandler, _NewPageOff, NewPage);
  2000.  
  2001.         Move(page^, NewPage^, SizeOf(NTX_BUFFER));
  2002.         page.count := FNTXOrder.FHead.half_page;
  2003.         for j := FNTXOrder.FHead.half_page to NewPage.count do begin
  2004.           rf := NewPage.ref[j - FNTXOrder.FHead.half_page];
  2005.           NewPage.ref[j - FNTXOrder.FHead.half_page] := NewPage.ref[j];
  2006.           NewPage.ref[j] := rf;
  2007.         end;
  2008.         NewPage.count := NewPage.count - FNTXOrder.FHead.half_page;
  2009.         if i < FNTXOrder.FHead.half_page then begin
  2010.           InsItem(page);
  2011.         end else begin
  2012.           i := i - FNTXOrder.FHead.half_page;
  2013.           InsItem(NewPage);
  2014.         end;
  2015.         NewPageOff := _NewPageOff;
  2016.         if page.count >= NewPage.count then begin
  2017.           page.count := page.count - 1;
  2018.           Move(pNTX_ITEM(pChar(page) + page.ref[page.count]).key, ntxItem.key, FNTXOrder.FHead.key_size);
  2019.           ntxItem.rec_no := pNTX_ITEM(pChar(page) + page.ref[page.count]).rec_no;
  2020.         end else begin
  2021.           Move(pNTX_ITEM(pChar(NewPage) + NewPage.ref[0]).key, ntxItem.key, FNTXOrder.FHead.key_size);
  2022.           ntxItem.rec_no := pNTX_ITEM(pChar(NewPage) + NewPage.ref[0]).rec_no;
  2023.           for j := 0 to NewPage.count do begin
  2024.             rf := NewPage.ref[j];
  2025.             NewPage.ref[j] := NewPage.ref[j + 1];
  2026.             NewPage.ref[j + 1] := rf;
  2027.           end;
  2028.           NewPage.count := NewPage.count - 1;
  2029.         end;
  2030.         ntxItem.page := page_off;
  2031.  
  2032.         Ind.Fchanged := true;
  2033.  
  2034.         Ind1.Fchanged := true;
  2035.  
  2036.         ItemHasBeenAdded := false;
  2037.       end else begin
  2038.         InsItem(page);
  2039.  
  2040.         Ind.Fchanged := true;
  2041.  
  2042.         ItemHasBeenAdded := true;
  2043.       end;
  2044.     end;
  2045.   end;
  2046.  
  2047. begin
  2048.  
  2049.   NewPageOff := 0;
  2050.   ItemHasBeenAdded := false;
  2051.  
  2052.   AddItemInternal(FNTXOrder.FHead.root);
  2053.  
  2054.   if not ItemHasBeenAdded then begin
  2055.     _NewPageOff := GetFreePage;
  2056.     Ind := FNTXBuffers.GetNTXBuffer(FNTXBag.NTXHandler, _NewPageOff, NewPage);
  2057.     NewPage.count := 1;
  2058.     Move(ntxItem.key, pNTX_ITEM(pChar(NewPage) + NewPage.ref[0]).key, FNTXOrder.FHead.key_size);
  2059.     pNTX_ITEM(pChar(NewPage) + NewPage.ref[0]).rec_no := ntxItem.rec_no;
  2060.     pNTX_ITEM(pChar(NewPage) + NewPage.ref[0]).page := ntxItem.page;
  2061.     pNTX_ITEM(pChar(NewPage) + NewPage.ref[1]).page := NewPageOff;
  2062.     FNTXOrder.FHead.root := _NewPageOff;
  2063.  
  2064.     Ind.Fchanged := true;
  2065.  
  2066.     ItemHasBeenAdded := true;
  2067.  
  2068.   end;
  2069.   Result := ItemHasBeenAdded;
  2070.  
  2071. end;
  2072.  
  2073. procedure TVKNTXIndex.AddKey(sKey: String; nRec: Integer);
  2074. var
  2075.   item: NTX_ITEM;
  2076.   AddOk: boolean;
  2077. begin
  2078.   AddOk := true;
  2079.   if Unique then
  2080.     AddOk := AddOk and (not SeekFirstInternal(sKey));
  2081.   if FForExists then
  2082.     AddOk := AddOk and (FForParser.Execute);
  2083.   if AddOk then begin
  2084.     item.page := 0;
  2085.     item.rec_no := nRec;
  2086.     Move(pChar(sKey)^, item.key, FNTXOrder.FHead.key_size);
  2087.     TransKey(item.key);
  2088.     AddItem(@item);
  2089.   end;
  2090. end;
  2091.  
  2092. procedure TVKNTXIndex.DeleteKey(sKey: String; nRec: Integer);
  2093. var
  2094.   TempItem: NTX_ITEM;
  2095.   LastItem: NTX_ITEM;
  2096.   FLastKey: String;
  2097.   FLastRec: DWORD;
  2098.   rf: WORD;
  2099.  
  2100.   procedure AddInEndItem(page_off: DWORD; itemKey: pChar; itemRec: DWORD);
  2101.   var
  2102.     page: pNTX_BUFFER;
  2103.     NewPage: pNTX_BUFFER;
  2104.     item: pNTX_ITEM;
  2105.     NewPageOff: DWORD;
  2106.     i: DWORD;
  2107.     Ind, Ind1: TVKNTXBuffer;
  2108.   begin
  2109.  
  2110.     Ind := FNTXBuffers.GetNTXBuffer(FNTXBag.NTXHandler, page_off, page);
  2111.  
  2112.     item := pNTX_ITEM(pChar(page) + page.ref[page.count]);
  2113.     if ( item.page <> 0 ) then
  2114.       AddInEndItem(item.page, itemKey, itemRec)
  2115.     else begin
  2116.       if page.count < FNTXOrder.FHead.max_item then begin
  2117.         Move(itemKey^, pNTX_ITEM(pChar(page) + page.ref[page.count]).key, FNTXOrder.FHead.key_size);
  2118.         pNTX_ITEM(pChar(page) + page.ref[page.count]).rec_no := itemRec;
  2119.         pNTX_ITEM(pChar(page) + page.ref[page.count]).page := 0;
  2120.         page.count := page.count + 1;
  2121.         pNTX_ITEM(pChar(page) + page.ref[page.count]).page := 0;
  2122.  
  2123.         Ind.Fchanged := true;
  2124.  
  2125.       end else begin
  2126.         NewPageOff := GetFreePage;
  2127.  
  2128.         Ind1 := FNTXBuffers.GetNTXBuffer(FNTXBag.NTXHandler, NewPageOff, NewPage);
  2129.  
  2130.         Move(page^, NewPage^, SizeOf(NTX_BUFFER));
  2131.         page.count := FNTXOrder.FHead.half_page;
  2132.         pNTX_ITEM(pChar(page) + page.ref[FNTXOrder.FHead.half_page]).page := NewPageOff;
  2133.  
  2134.         Ind.Fchanged := true;
  2135.  
  2136.         for i := FNTXOrder.FHead.half_page to NewPage.count do begin
  2137.           rf := NewPage.ref[i - FNTXOrder.FHead.half_page];
  2138.           NewPage.ref[i - FNTXOrder.FHead.half_page] := NewPage.ref[i];
  2139.           NewPage.ref[i] := rf;
  2140.         end;
  2141.         NewPage.count := NewPage.count - FNTXOrder.FHead.half_page;
  2142.         Move(itemKey^, pNTX_ITEM(pChar(NewPage) + NewPage.ref[NewPage.count]).key, FNTXOrder.FHead.key_size);
  2143.         pNTX_ITEM(pChar(NewPage) + NewPage.ref[NewPage.count]).rec_no := itemRec;
  2144.         pNTX_ITEM(pChar(NewPage) + NewPage.ref[NewPage.count]).page := 0;
  2145.         NewPage.count := NewPage.count + 1;
  2146.  
  2147.         Ind1.Fchanged := true;
  2148.  
  2149.       end;
  2150.     end;
  2151.   end;
  2152.  
  2153.   procedure DeletePage(page_off: DWORD);
  2154.   var
  2155.     page: pNTX_BUFFER;
  2156.     Ind: TVKNTXBuffer;
  2157.   begin
  2158.  
  2159.     Ind := FNTXBuffers.GetNTXBuffer(FNTXBag.NTXHandler, page_off, page);
  2160.  
  2161.     page.count := 0;
  2162.     pNTX_ITEM(pChar(page) + page.ref[0]).page := FNTXOrder.FHead.next_page;
  2163.  
  2164.     Ind.Fchanged := true;
  2165.  
  2166.     FNTXOrder.FHead.next_page := page_off;
  2167.  
  2168.   end;
  2169.  
  2170.   procedure GetLastItemOld(page_off: DWORD; PrePage: pNTX_BUFFER; PrePageOffset: DWORD; PreItemRef: WORD);
  2171.   var
  2172.     page: pNTX_BUFFER;
  2173.     item: pNTX_ITEM;
  2174.     Srckey: array[0..NTX_PAGE-1] of Char;
  2175.     Destkey: array[0..NTX_PAGE-1] of Char;
  2176.     Ind: TVKNTXBuffer;
  2177.   begin
  2178.  
  2179.     Ind := FNTXBuffers.GetNTXBuffer(FNTXBag.NTXHandler, page_off, page);
  2180.  
  2181.     item := pNTX_ITEM(pChar(page) + page.ref[page.count]);
  2182.     if ( item.page <> 0 ) then
  2183.       GetLastItemOld(item.page, page, page_off, page.count)
  2184.     else begin
  2185.       //
  2186.       item := pNTX_ITEM(pChar(page) + page.ref[page.count - 1]);
  2187.       if FKeyTranslate then begin
  2188.         Move(item.key, Srckey, FNTXOrder.FHead.key_size);
  2189.         Srckey[FNTXOrder.FHead.key_size] := #0;
  2190.         TVKDBFNTX(FIndexes.Owner).Translate(Srckey, Destkey, false);
  2191.         SetString(FLastKey, Destkey, FNTXOrder.FHead.key_size);
  2192.       end else
  2193.         SetString(FLastKey, item.key, FNTXOrder.FHead.key_size);
  2194.       FLastRec := item.rec_no;
  2195.       //
  2196.       page.count := page.count - 1;
  2197.  
  2198.       Ind.Fchanged := true;
  2199.  
  2200.     end;
  2201.     item := pNTX_ITEM(pChar(page) + page.ref[page.count]);
  2202.     if ( page.count = 0 ) and ( item.page = 0 ) then begin
  2203.       DeletePage(page_off);
  2204.       pNTX_ITEM(pChar(PrePage) + NTX_BUFFER(PrePage^).ref[PreItemRef])^.page := 0;
  2205.  
  2206.       FNTXBuffers.SetPage(FNTXBag.NTXHandler, PrePageOffset, PrePage);
  2207.  
  2208.     end;
  2209.   end;
  2210.  
  2211.   function Pass(page_off: DWORD; LastItemRef: WORD; LastPage: pNTX_BUFFER; LastPageOffset: DWORD): boolean;
  2212.   var
  2213.     i, j: DWORD;
  2214.     page: pNTX_BUFFER;
  2215.     item: pNTX_ITEM;
  2216.     item1: pNTX_ITEM;
  2217.     c: Integer;
  2218.     Ind: TVKNTXBuffer;
  2219.  
  2220.     function DelPage: boolean;
  2221.     begin
  2222.       Result := false;
  2223.       if page.count = 0 then begin
  2224.         item1 := pNTX_ITEM(pChar(page) + page.ref[0]);
  2225.         if ( item1.page = 0 ) then begin
  2226.           if LastPage <> nil then begin
  2227.             pNTX_ITEM(pChar(LastPage) + NTX_BUFFER(LastPage^).ref[LastItemRef])^.page := 0;
  2228.             DeletePage(page_off);
  2229.  
  2230.             FNTXBuffers.SetPage(FNTXBag.NTXHandler, LastPageOffset, LastPage);
  2231.  
  2232.             Result := true;
  2233.           end;
  2234.         end;
  2235.       end;
  2236.     end;
  2237.  
  2238.   begin
  2239.  
  2240.     Ind := FNTXBuffers.GetNTXBuffer(FNTXBag.NTXHandler, page_off, page);
  2241.  
  2242.     if page.count > 0 then begin
  2243.       for i := 0 to page.count - 1 do begin
  2244.         item := pNTX_ITEM(pChar(page) + page.ref[i]);
  2245.         c := CmpKeys(item.key, pChar(sKey));
  2246.         if c <= 0 then begin //sKey <= item.key
  2247.  
  2248.           if ( item.page <> 0 ) then begin
  2249.             Result := Pass(item.page, i, page, page_off);
  2250.             DelPage;
  2251.             if Result then Exit;
  2252.           end;
  2253.  
  2254.           if ( DWORD(nRec) = item.rec_no ) and ( c = 0 ) then begin
  2255.             if ( item.page = 0 ) then begin
  2256.               j := i;
  2257.               while j < page.count do begin
  2258.                 rf := page.ref[j];
  2259.                 page.ref[j] := page.ref[j + 1];
  2260.                 page.ref[j + 1] := rf;
  2261.                 Inc(j);
  2262.               end;
  2263.               if page.count > 0 then begin
  2264.                 page.count := page.count - 1;
  2265.  
  2266.                 Ind.Fchanged := true;
  2267.  
  2268.               end;
  2269.               DelPage;
  2270.               Result := true;
  2271.             end else begin
  2272.               GetLastItemOld(item.page, page, page_off, i);
  2273.               Move(pChar(FLastKey)^, pNTX_ITEM(pChar(page) + page.ref[i]).key, FNTXOrder.FHead.key_size);
  2274.               pNTX_ITEM(pChar(page) + page.ref[i]).rec_no := FLastRec;
  2275.  
  2276.               Ind.Fchanged := true;
  2277.  
  2278.               Result := true;
  2279.             end;
  2280.             Exit;
  2281.           end;
  2282.  
  2283.         end;
  2284.       end;
  2285.     end;
  2286.  
  2287.     item := pNTX_ITEM(pChar(page) + page.ref[page.count]);
  2288.     if ( item.page <> 0 ) then begin
  2289.       Result := Pass(item.page, page.count, page, page_off);
  2290.       DelPage;
  2291.       if Result then Exit;
  2292.     end;
  2293.  
  2294.     Result := false;
  2295.  
  2296.   end;
  2297.  
  2298.   procedure GetLastItem(page_off: DWORD);
  2299.   var
  2300.     page: pNTX_BUFFER;
  2301.     item: pNTX_ITEM;
  2302.   begin
  2303.     FNTXBuffers.GetNTXBuffer(FNTXBag.NTXHandler, page_off, page);
  2304.     item := pNTX_ITEM(pChar(page) + page.ref[page.count]);
  2305.     if ( item.page <> 0 ) then
  2306.       GetLastItem(item.page)
  2307.     else begin
  2308.       item := pNTX_ITEM(pChar(page) + page.ref[page.count - 1]);
  2309.       Move(item^, LastItem, FNTXOrder.FHead.item_size);
  2310.     end;
  2311.   end;
  2312.  
  2313.   function PassForDel(page_off: DWORD; ItemForDelete: pNTX_ITEM; Parent: TVKNTXBuffer; ParentItemRef: WORD): boolean;
  2314.   var
  2315.     i, j: DWORD;
  2316.     item: pNTX_ITEM;
  2317.     page: pNTX_BUFFER;
  2318.     Ind: TVKNTXBuffer;
  2319.     c: Integer;
  2320.  
  2321.     procedure DelItemi;
  2322.     var
  2323.       rf: WORD;
  2324.     begin
  2325.       j := i;
  2326.       while j < page.count do begin
  2327.         rf := page.ref[j];
  2328.         page.ref[j] := page.ref[j + 1];
  2329.         page.ref[j + 1] := rf;
  2330.         Inc(j);
  2331.       end;
  2332.       page.count := page.count - 1;
  2333.     end;
  2334.  
  2335.     procedure NormalizePage(CurrPage, Parent: TVKNTXBuffer; ParentItemRef: WORD);
  2336.     var
  2337.       LeftSibling, RightSibling: TVKNTXBuffer;
  2338.       LeftPage, RightPage: pNTX_BUFFER;
  2339.       TryRight: boolean;
  2340.       SLItem, LItem, CItem, RItem, Item, SRItem: pNTX_ITEM;
  2341.       Shift, j: Integer;
  2342.       rf: WORD;
  2343.       LstPage: DWORD;
  2344.     begin
  2345.       if Parent <> nil then begin
  2346.         if CurrPage.Fpage.count < FNTXOrder.FHead.half_page then begin
  2347.  
  2348.           TryRight := false;
  2349.           if ParentItemRef > 0 then begin
  2350.             LItem := pNTX_ITEM( pChar(@Parent.Fpage) + Parent.Fpage.ref[ParentItemRef - 1]);
  2351.             if LItem.page <> 0 then begin
  2352.               LeftSibling := FNTXBuffers.GetNTXBuffer(FNTXBag.NTXHandler, LItem.page, LeftPage);
  2353.               if LeftPage.count > FNTXOrder.FHead.half_page then begin
  2354.  
  2355.                 SLItem := pNTX_ITEM( pChar(LeftPage) + LeftPage.ref[LeftPage.count]);
  2356.  
  2357.                 rf := LeftPage.count - FNTXOrder.FHead.half_page;
  2358.                 Shift := (rf div 2) + (rf mod 2);
  2359.  
  2360.                 LeftPage.count := LeftPage.count - Shift;
  2361.  
  2362.                 j := CurrPage.Fpage.count;
  2363.                 while j >= 0 do begin
  2364.                   rf := CurrPage.Fpage.ref[j + Shift];
  2365.                   CurrPage.Fpage.ref[j + Shift] := CurrPage.Fpage.ref[j];
  2366.                   CurrPage.Fpage.ref[j] := rf;
  2367.                   Dec(j);
  2368.                 end;
  2369.                 Inc(CurrPage.Fpage.count, Shift);
  2370.  
  2371.                 CItem := pNTX_ITEM( pChar(@CurrPage.Fpage) + CurrPage.Fpage.ref[Shift - 1]);
  2372.                 Move(LItem.key, CItem.key, FNTXOrder.FHead.key_size);
  2373.                 CItem.rec_no := LItem.rec_no;
  2374.                 CItem.page := SLItem.page;
  2375.  
  2376.                 Dec(Shift);
  2377.  
  2378.                 while Shift > 0 do begin
  2379.  
  2380.                   SLItem := pNTX_ITEM( pChar(LeftPage) + LeftPage.ref[LeftPage.count + Shift]);
  2381.  
  2382.                   CItem := pNTX_ITEM( pChar(@CurrPage.Fpage) + CurrPage.Fpage.ref[Shift - 1]);
  2383.                   Move(SLItem.key, CItem.key, FNTXOrder.FHead.key_size);
  2384.                   CItem.rec_no := SLItem.rec_no;
  2385.                   CItem.page := SLItem.page;
  2386.  
  2387.                   Dec(Shift);
  2388.                 end;
  2389.  
  2390.                 SLItem := pNTX_ITEM( pChar(LeftPage) + LeftPage.ref[LeftPage.count]);
  2391.                 Move(SLItem.key, LItem.key, FNTXOrder.FHead.key_size);
  2392.                 LItem.rec_no := SLItem.rec_no;
  2393.  
  2394.               end else begin
  2395.  
  2396.                   CItem := pNTX_ITEM( pChar(@Parent.Fpage) + Parent.Fpage.ref[ParentItemRef]);
  2397.                   Item := pNTX_ITEM( pChar(LeftPage) + LeftPage.ref[LeftPage.count]);
  2398.                   Move(LItem.key, Item.key, FNTXOrder.FHead.key_size);
  2399.                   Item.rec_no := LItem.rec_no;
  2400.  
  2401.                   Inc(LeftPage.count);
  2402.  
  2403.                   CItem.page := LItem.page;
  2404.  
  2405.                   for j := ParentItemRef - 1 to Parent.Fpage.count - 1 do begin
  2406.                     rf := Parent.Fpage.ref[j];
  2407.                     Parent.Fpage.ref[j] := Parent.Fpage.ref[j + 1];
  2408.                     Parent.Fpage.ref[j + 1] := rf;
  2409.                   end;
  2410.  
  2411.                   Dec(Parent.Fpage.count);
  2412.  
  2413.                   for j := 0 to CurrPage.Fpage.count do begin
  2414.                     CItem := pNTX_ITEM( pChar(@CurrPage.Fpage) + CurrPage.Fpage.ref[j]);
  2415.                     Item := pNTX_ITEM( pChar(LeftPage) + LeftPage.ref[LeftPage.count]);
  2416.                     Move(CItem^, Item^, FNTXOrder.FHead.item_size);
  2417.                     Inc(LeftPage.count);
  2418.                   end;
  2419.  
  2420.                   Dec(LeftPage.count);
  2421.  
  2422.                   //Delete page
  2423.                   CurrPage.Fpage.count := 0;
  2424.                   CItem := pNTX_ITEM( pChar(@CurrPage.Fpage) + CurrPage.Fpage.ref[0]);
  2425.                   CItem.page := FNTXOrder.FHead.next_page;
  2426.                   FNTXOrder.FHead.next_page := CurrPage.Fpage_offset;
  2427.  
  2428.                   if Parent.Fpage.count = 0 then begin
  2429.                     //Delete Parent
  2430.                     CItem := pNTX_ITEM( pChar(@Parent.Fpage) + Parent.Fpage.ref[0]);
  2431.                     FNTXOrder.FHead.root := CItem.page;
  2432.                     CItem.page := FNTXOrder.FHead.next_page;
  2433.                     FNTXOrder.FHead.next_page := Parent.Fpage_offset;
  2434.                   end;
  2435.  
  2436.               end;
  2437.  
  2438.               LeftSibling.Fchanged := true;
  2439.               CurrPage.Fchanged := true;
  2440.               Parent.Fchanged := true;
  2441.  
  2442.             end else
  2443.               TryRight := true;
  2444.           end else
  2445.             TryRight := true;
  2446.  
  2447.           if TryRight then begin
  2448.             if ParentItemRef < Parent.Fpage.count then begin
  2449.               RItem := pNTX_ITEM( pChar(@Parent.Fpage) + Parent.Fpage.ref[ParentItemRef + 1]);
  2450.               if RItem.page <> 0 then begin
  2451.                 RightSibling := FNTXBuffers.GetNTXBuffer(FNTXBag.NTXHandler, RItem.page, RightPage);
  2452.                 if RightPage.count > FNTXOrder.FHead.half_page then begin
  2453.  
  2454.                   rf := RightPage.count - FNTXOrder.FHead.half_page;
  2455.                   Shift := (rf div 2) + (rf mod 2);
  2456.  
  2457.                   CItem := pNTX_ITEM( pChar(@Parent.Fpage) + Parent.Fpage.ref[ParentItemRef]);
  2458.                   Item := pNTX_ITEM( pChar(@CurrPage.Fpage) + CurrPage.Fpage.ref[CurrPage.Fpage.count]);
  2459.                   Move(CItem.key, Item.key, FNTXOrder.FHead.key_size);
  2460.                   Item.rec_no := CItem.rec_no;
  2461.  
  2462.                   Inc(CurrPage.Fpage.count);
  2463.  
  2464.                   Item := pNTX_ITEM( pChar(@RightSibling.Fpage) + RightSibling.Fpage.ref[Shift - 1]);
  2465.                   Move(Item.key, CItem.key, FNTXOrder.FHead.key_size);
  2466.                   CItem.rec_no := Item.rec_no;
  2467.                   LstPage := Item.page;
  2468.  
  2469.                   for j := 0 to Shift - 2 do begin
  2470.                     SRItem := pNTX_ITEM( pChar(@RightSibling.Fpage) + RightSibling.Fpage.ref[j]);
  2471.                     Item := pNTX_ITEM( pChar(@CurrPage.Fpage) + CurrPage.Fpage.ref[CurrPage.Fpage.count]);
  2472.                     Move(SRItem^, Item^, FNTXOrder.FHead.item_size);
  2473.                     Inc(CurrPage.Fpage.count);
  2474.                   end;
  2475.                   Item := pNTX_ITEM( pChar(@CurrPage.Fpage) + CurrPage.Fpage.ref[CurrPage.Fpage.count]);
  2476.                   Item.page := LstPage;
  2477.  
  2478.                   Dec(RightSibling.Fpage.count, Shift);
  2479.                   for j := 0 to RightSibling.Fpage.count do begin
  2480.                     rf := RightSibling.Fpage.ref[j];
  2481.                     RightSibling.Fpage.ref[j] := RightSibling.Fpage.ref[j + Shift];
  2482.                     RightSibling.Fpage.ref[j + Shift] := rf;
  2483.                   end;
  2484.  
  2485.                 end else begin
  2486.  
  2487.                   CItem := pNTX_ITEM( pChar(@Parent.Fpage) + Parent.Fpage.ref[ParentItemRef]);
  2488.                   Item := pNTX_ITEM( pChar(@CurrPage.Fpage) + CurrPage.Fpage.ref[CurrPage.Fpage.count]);
  2489.                   Move(CItem.key, Item.key, FNTXOrder.FHead.key_size);
  2490.                   Item.rec_no := CItem.rec_no;
  2491.  
  2492.                   Inc(CurrPage.Fpage.count);
  2493.  
  2494.                   RItem.page := CItem.page;
  2495.  
  2496.                   for j := ParentItemRef to Parent.Fpage.count - 1 do begin
  2497.                     rf := Parent.Fpage.ref[j];
  2498.                     Parent.Fpage.ref[j] := Parent.Fpage.ref[j + 1];
  2499.                     Parent.Fpage.ref[j + 1] := rf;
  2500.                   end;
  2501.  
  2502.                   Dec(Parent.Fpage.count);
  2503.  
  2504.                   for j := 0 to RightSibling.Fpage.count do begin
  2505.                     SRItem := pNTX_ITEM( pChar(@RightSibling.Fpage) + RightSibling.Fpage.ref[j]);
  2506.                     Item := pNTX_ITEM( pChar(@CurrPage.Fpage) + CurrPage.Fpage.ref[CurrPage.Fpage.count]);
  2507.                     Move(SRItem^, Item^, FNTXOrder.FHead.item_size);
  2508.                     Inc(CurrPage.Fpage.count);
  2509.                   end;
  2510.  
  2511.                   Dec(CurrPage.Fpage.count);
  2512.  
  2513.                   //Delete page
  2514.                   RightSibling.Fpage.count := 0;
  2515.                   CItem := pNTX_ITEM( pChar(@RightSibling.Fpage) + RightSibling.Fpage.ref[0]);
  2516.                   CItem.page := FNTXOrder.FHead.next_page;
  2517.                   FNTXOrder.FHead.next_page := RightSibling.Fpage_offset;
  2518.  
  2519.                   if Parent.Fpage.count = 0 then begin
  2520.                     //Delete Parent
  2521.                     CItem := pNTX_ITEM( pChar(@Parent.Fpage) + Parent.Fpage.ref[0]);
  2522.                     FNTXOrder.FHead.root := CItem.page;
  2523.                     CItem.page := FNTXOrder.FHead.next_page;
  2524.                     FNTXOrder.FHead.next_page := Parent.Fpage_offset;
  2525.                   end;
  2526.  
  2527.                 end;
  2528.                 RightSibling.Fchanged := true;
  2529.                 CurrPage.Fchanged := true;
  2530.                 Parent.Fchanged := true;
  2531.               end;
  2532.             end;
  2533.           end;
  2534.  
  2535.         end;
  2536.       end;
  2537.     end;
  2538.  
  2539.   begin
  2540.     Ind := FNTXBuffers.GetNTXBuffer(FNTXBag.NTXHandler, page_off, page);
  2541.     for i := 0 to page.count - 1 do begin
  2542.       item := pNTX_ITEM(pChar(page) + page.ref[i]);
  2543.       c := CmpKeys1(item.key, ItemForDelete.key);
  2544.       if c <= 0 then begin //ItemForDelete.key <= item.key
  2545.         if ( item.page <> 0 ) then begin
  2546.           Result := PassForDel(item.page, ItemForDelete, Ind, i);
  2547.           NormalizePage(Ind, Parent, ParentItemRef);
  2548.           if Result then Exit;
  2549.         end;
  2550.         if ( ItemForDelete.rec_no = item.rec_no ) and ( c = 0 ) then begin
  2551.           if ( item.page = 0 ) then begin
  2552.             DelItemi;
  2553.             Ind.Fchanged := true;
  2554.           end else begin
  2555.             GetLastItem(item.page);
  2556.             Move(LastItem.key, item.key, FNTXOrder.FHead.key_size);
  2557.             item.rec_no := LastItem.rec_no;
  2558.             Ind.Fchanged := true;
  2559.             PassForDel(item.page, @LastItem, Ind, i);
  2560.           end;
  2561.           NormalizePage(Ind, Parent, ParentItemRef);
  2562.           Result := true;
  2563.           Exit;
  2564.         end;
  2565.       end;
  2566.     end;
  2567.     item := pNTX_ITEM(pChar(page) + page.ref[page.count]);
  2568.     if ( item.page <> 0 ) then begin
  2569.       Result := PassForDel(item.page, ItemForDelete, Ind, page.count);
  2570.       NormalizePage(Ind, Parent, ParentItemRef);
  2571.       if Result then Exit;
  2572.     end;
  2573.     Result := false;
  2574.   end;
  2575.  
  2576. begin
  2577.  
  2578.   if FDeleteKeyStyle = dksClipper then begin
  2579.  
  2580.     TempItem.page := 0;
  2581.     TempItem.rec_no := nRec;
  2582.     Move(pChar(sKey)^, TempItem.key, FNTXOrder.FHead.key_size);
  2583.     TransKey(TempItem.key);
  2584.  
  2585.     PassForDel(FNTXOrder.FHead.root, @TempItem, nil, 0);
  2586.  
  2587.   end else
  2588.  
  2589.     Pass(FNTXOrder.FHead.root, 0, nil, 0);
  2590.  
  2591. end;
  2592.  
  2593. function TVKNTXIndex.LastKey(out LastKey: String; out LastRec: Integer): boolean;
  2594. var
  2595.   level: Integer;
  2596.  
  2597.   function Pass(page_off: DWORD): TGetResult;
  2598.   var
  2599.     page: pNTX_BUFFER;
  2600.     item: pNTX_ITEM;
  2601.     Srckey: array[0..NTX_PAGE-1] of Char;
  2602.     Destkey: array[0..NTX_PAGE-1] of Char;
  2603.   begin
  2604.     Inc(level);
  2605.     try
  2606.  
  2607.       FNTXBuffers.GetPage(FNTXBag.NTXHandler, page_off, page);
  2608.  
  2609.       item := pNTX_ITEM(pChar(page) + page.ref[page.count]);
  2610.       if ( item.page <> 0 ) then begin
  2611.         Result := Pass(item.page);
  2612.         if Result = grOK then Exit;
  2613.       end;
  2614.       if page.count <> 0 then begin
  2615.         //
  2616.         item := pNTX_ITEM(pChar(page) + page.ref[page.count - 1]);
  2617.         if FKeyTranslate then begin
  2618.           Move(item.key, Srckey, FNTXOrder.FHead.key_size);
  2619.           Srckey[FNTXOrder.FHead.key_size] := #0;
  2620.           TVKDBFNTX(FIndexes.Owner).Translate(Srckey, Destkey, false);
  2621.           SetString(LastKey, Destkey, FNTXOrder.FHead.key_size);
  2622.         end else
  2623.           SetString(LastKey, item.key, FNTXOrder.FHead.key_size);
  2624.         LastRec := item.rec_no;
  2625.         //
  2626.         Result := grOK;
  2627.       end else
  2628.         if level = 1 then
  2629.           Result := grBOF
  2630.         else
  2631.           Result := grError;
  2632.       Exit;
  2633.     finally
  2634.       Dec(level);
  2635.     end;
  2636.   end;
  2637.  
  2638. begin
  2639.  
  2640.   if FLock then
  2641.     try
  2642.  
  2643.       ClearIfChange;
  2644.  
  2645.       level := 0;
  2646.       Result := (Pass(FNTXOrder.FHead.root) = grOK);
  2647.     finally
  2648.       FUnLock;
  2649.     end
  2650.   else
  2651.     Result := false;
  2652.  
  2653. end;
  2654.  
  2655. function TVKNTXIndex.FLock: boolean;
  2656. var
  2657.   i: Integer;
  2658.   l: boolean;
  2659.   oW: TVKDBFNTX;
  2660. begin
  2661.   if not FFileLock then begin
  2662.     i := 0;
  2663.     oW := TVKDBFNTX(FIndexes.Owner);
  2664.     l := ( ( (oW.AccessMode.FLast and fmShareExclusive) = fmShareExclusive ) or ( (oW.AccessMode.FLast and fmShareDenyWrite) = fmShareDenyWrite ) or FFileLock );
  2665.     repeat
  2666.       if not l then begin
  2667.         Result := FNTXBag.NTXHandler.Lock(1000000000, 1);
  2668.         if not Result then begin
  2669.           Wait(0.001, false);
  2670.           Inc(i);
  2671.           if i = oW.WaitBusyRes then Exit;
  2672.         end;
  2673.       end else
  2674.         Result := true;
  2675.     until Result;
  2676.     FFileLock := Result;
  2677.   end else
  2678.     Result := true;
  2679. end;
  2680.  
  2681. function TVKNTXIndex.FUnLock: boolean;
  2682. var
  2683.   l: boolean;
  2684.   oW: TVKDBFNTX;
  2685. begin
  2686.   oW := TVKDBFNTX(FIndexes.Owner);
  2687.   l := ( ( (oW.AccessMode.FLast and fmShareExclusive) = fmShareExclusive ) or ( (oW.AccessMode.FLast and fmShareDenyWrite) = fmShareDenyWrite ) );
  2688.   if not l then
  2689.     Result := FNTXBag.NTXHandler.UnLock(1000000000, 1)
  2690.   else
  2691.     Result := true;
  2692.   FFileLock := not Result;
  2693. end;
  2694.  
  2695. procedure TVKNTXIndex.SetUnique(const Value: boolean);
  2696. begin
  2697.   if IsOpen then begin
  2698.     if Value then
  2699.       FNTXOrder.FHead.unique := #1
  2700.     else
  2701.       FNTXOrder.FHead.unique := #0;
  2702.   end else
  2703.     FUnique := Value;
  2704. end;
  2705.  
  2706. function TVKNTXIndex.GetUnique: boolean;
  2707. begin
  2708.   if IsOpen then
  2709.     Result := (FNTXOrder.FHead.unique <> #0)
  2710.   else
  2711.     Result := FUnique;
  2712. end;
  2713.  
  2714. procedure TVKNTXIndex.SetDesc(const Value: boolean);
  2715. begin
  2716.   if IsOpen then begin
  2717.     if Value then
  2718.       FNTXOrder.FHead.Desc := #1
  2719.     else
  2720.       FNTXOrder.FHead.Desc := #0;
  2721.   end else
  2722.     FDesc := Value;
  2723. end;
  2724.  
  2725. function TVKNTXIndex.GetDesc: boolean;
  2726. begin
  2727.   if IsOpen then
  2728.     Result := (FNTXOrder.FHead.Desc <> #0)
  2729.   else
  2730.     Result := FDesc;
  2731. end;
  2732.  
  2733. function TVKNTXIndex.GetOrder: String;
  2734. var
  2735.   i: Integer;
  2736.   p: pChar;
  2737. begin
  2738.   if IsOpen then begin
  2739.     for i := 0 to 7 do
  2740.       if FNTXOrder.FHead.order[i] = #0 then break;
  2741.     p := pChar(@FNTXOrder.FHead.order[0]);
  2742.     SetString(Result, p, i);
  2743.     ChekExpression(Result);
  2744.     if Result = '' then Result := Name;
  2745.   end else
  2746.     Result := FOrder;
  2747. end;
  2748.  
  2749. procedure TVKNTXIndex.SetOrder(Value: String);
  2750. var
  2751.   i, j: Integer;
  2752. begin
  2753.   if IsOpen then begin
  2754.     ChekExpression(Value);
  2755.     j := Length(Value);
  2756.     if j > 8 then j := 8;
  2757.     for i := 0 to j - 1 do
  2758.       FNTXOrder.FHead.order[i] := Value[i + 1];
  2759.     FNTXOrder.FHead.order[j] := #0;
  2760.     Name := FNTXOrder.FHead.order;
  2761.   end else
  2762.     FOrder := Value;
  2763. end;
  2764.  
  2765. procedure TVKNTXIndex.ChekExpression(var Value: String);
  2766. var
  2767.   i, j: Integer;
  2768. begin
  2769.   j := Length(Value);
  2770.   for i := 1 to j do
  2771.     if Value[i] < #32 then begin
  2772.       Value := '';
  2773.       Exit;
  2774.     end;
  2775. end;
  2776.  
  2777. function TVKNTXIndex.CmpKeys1(ItemKey, CurrKey: pChar; KSize: Integer): Integer;
  2778. var
  2779.   Srckey: array[0..NTX_PAGE-1] of Char;
  2780.   Destkey1, Destkey2: array[0..NTX_PAGE-1] of Char;
  2781. begin
  2782.   if KSize = 0 then KSize := FNTXOrder.FHead.key_size;
  2783.   if FKeyTranslate then begin
  2784.     Move(ItemKey^, Srckey, KSize);
  2785.     Srckey[KSize] := #0;
  2786.     TVKDBFNTX(FIndexes.Owner).Translate(Srckey, Destkey1, false);
  2787.     Move(CurrKey^, Srckey, KSize);
  2788.     Srckey[KSize] := #0;
  2789.     TVKDBFNTX(FIndexes.Owner).Translate(Srckey, Destkey2, false);
  2790.     Result := CompareKeys(Destkey2, Destkey1, KSize);
  2791.   end else
  2792.     Result := CompareKeys(CurrKey, ItemKey, KSize);
  2793.   if Desc then Result := - Result;
  2794. end;
  2795.  
  2796. function TVKNTXIndex.CmpKeys2(ItemKey, CurrKey: pChar; KSize: Integer): Integer;
  2797. var
  2798.   Srckey: array[0..NTX_PAGE-1] of Char;
  2799.   Destkey1, Destkey2: array[0..NTX_PAGE-1] of Char;
  2800. begin
  2801.   if KSize = 0 then KSize := FNTXOrder.FHead.key_size;
  2802.   if FKeyTranslate then begin
  2803.     Move(ItemKey^, Destkey1, KSize);
  2804.     //Move(ItemKey^, Srckey, KSize);
  2805.     //Srckey[KSize] := #0;
  2806.     //TVKDBFNTX(FIndexes.Owner).Translate(Srckey, Destkey1, false);
  2807.     Move(CurrKey^, Srckey, KSize);
  2808.     Srckey[KSize] := #0;
  2809.     TVKDBFNTX(FIndexes.Owner).Translate(Srckey, Destkey2, false);
  2810.     Result := CompareKeys(Destkey2, Destkey1, KSize);
  2811.   end else
  2812.     Result := CompareKeys(CurrKey, ItemKey, KSize);
  2813.   if Desc then Result := - Result;
  2814. end;
  2815.  
  2816. function TVKNTXIndex.CmpKeys(ItemKey, CurrKey: pChar; KSize: Integer = 0): Integer;
  2817. var
  2818.   Srckey: array[0..NTX_PAGE-1] of Char;
  2819.   Destkey: array[0..NTX_PAGE-1] of Char;
  2820. begin
  2821.   if KSize = 0 then KSize := FNTXOrder.FHead.key_size;
  2822.   if FKeyTranslate then begin
  2823.     Move(ItemKey^, Srckey, KSize);
  2824.     Srckey[KSize] := #0;
  2825.     TVKDBFNTX(FIndexes.Owner).Translate(Srckey, Destkey, false);
  2826.     Result := CompareKeys(CurrKey, Destkey, KSize);
  2827.   end else
  2828.     Result := CompareKeys(CurrKey, ItemKey, KSize);
  2829.   if Desc then Result := - Result;
  2830. end;
  2831.  
  2832. function TVKNTXIndex.CmpKeys3(ItemKey, CurrKey: pChar; KSize: Integer): Integer;
  2833. begin
  2834.   if KSize = 0 then KSize := FNTXOrder.FHead.key_size;
  2835.   Result := CompareKeys(CurrKey, ItemKey, KSize);
  2836.   if Desc then Result := - Result;
  2837. end;
  2838.  
  2839. procedure TVKNTXIndex.TransKey(Key: pChar; KSize: Integer = 0; ToOem: Boolean = true);
  2840. var
  2841.   Srckey: array[0..NTX_PAGE-1] of Char;
  2842. begin
  2843.   if KSize = 0 then KSize := FNTXOrder.FHead.key_size;
  2844.   if FKeyTranslate then begin
  2845.     Move(Key^, Srckey, KSize);
  2846.     Srckey[KSize] := #0;
  2847.     TVKDBFNTX(FIndexes.Owner).Translate(Srckey, Key, ToOem);
  2848.   end;
  2849. end;
  2850.  
  2851. procedure TVKNTXIndex.CreateIndex(Activate: boolean = true);
  2852. var
  2853.   oB: TVKDBFNTX;
  2854.   DBFBuffer: pChar;
  2855.   RecPareBuf: Integer;
  2856.   ReadSize, RealRead, BufCnt: Integer;
  2857.   i: Integer;
  2858.   Key: String;
  2859.   Rec: DWORD;
  2860.   LastFUpdated: boolean;
  2861.  
  2862.   procedure CreateEmptyIndex;
  2863.   var
  2864.     IndAttr: TIndexAttributes;
  2865.   begin
  2866.     if not FReindex then begin
  2867.       DefineBag;
  2868.       FNTXBag.NTXHandler.CreateProxyStream;
  2869.       if not FNTXBag.NTXHandler.IsOpen then begin
  2870.         raise Exception.Create('TVKNTXIndex.CreateIndex: Create error "' + Name + '"');
  2871.       end else begin
  2872.         FNTXBuffers.Clear;
  2873.         if FClipperVer in [v500, v501] then
  2874.           FNTXOrder.FHead.sign := 6
  2875.         else
  2876.           FNTXOrder.FHead.sign := 7;
  2877.         FNTXOrder.FHead.version := 1;
  2878.         FNTXOrder.FHead.root := NTX_PAGE;
  2879.         FNTXOrder.FHead.next_page := 0;
  2880.  
  2881.         if Assigned(OnCreateIndex) then begin
  2882.           OnCreateIndex(self, IndAttr);
  2883.           FNTXOrder.FHead.key_size := IndAttr.key_size;
  2884.           FNTXOrder.FHead.key_dec := IndAttr.key_dec;
  2885.           System.Move(pChar(IndAttr.key_expr)^, FNTXOrder.FHead.key_expr, Length(IndAttr.key_expr));
  2886.           FNTXOrder.FHead.key_expr[Length(IndAttr.key_expr)] := #0;
  2887.           System.Move(pChar(IndAttr.for_expr)^, FNTXOrder.FHead.for_expr, Length(IndAttr.for_expr));
  2888.           FNTXOrder.FHead.for_expr[Length(IndAttr.for_expr)] := #0;
  2889.         end else begin
  2890.           FNTXOrder.FHead.key_size := Length(FKeyParser.Key);
  2891.           FNTXOrder.FHead.key_dec := FKeyParser.Prec;
  2892.           System.Move(pChar(FKeyExpresion)^, FNTXOrder.FHead.key_expr, Length(FKeyExpresion));
  2893.           FNTXOrder.FHead.key_expr[Length(FKeyExpresion)] := #0;
  2894.           System.Move(pChar(FForExpresion)^, FNTXOrder.FHead.for_expr, Length(FForExpresion));
  2895.           FNTXOrder.FHead.for_expr[Length(FForExpresion)] := #0;
  2896.         end;
  2897.  
  2898.         FNTXOrder.FHead.item_size := FNTXOrder.FHead.key_size + 8;
  2899.         FNTXOrder.FHead.max_item := (NTX_PAGE - FNTXOrder.FHead.item_size - 4) div (FNTXOrder.FHead.item_size + 2);
  2900.         FNTXOrder.FHead.half_page := FNTXOrder.FHead.max_item div 2;
  2901.         FNTXOrder.FHead.max_item := FNTXOrder.FHead.half_page * 2;
  2902.  
  2903.         FNTXOrder.FHead.reserv1 := #0;
  2904.         FNTXOrder.FHead.reserv3 := #0;
  2905.  
  2906.         Order := FOrder;
  2907.         Desc := FDesc;
  2908.         Unique := FUnique;
  2909.  
  2910.         FNTXBag.NTXHandler.Seek(0, 0);
  2911.         FNTXBag.NTXHandler.Write(FNTXOrder.FHead, SizeOf(NTX_HEADER));
  2912.         FLastOffset := SizeOf(NTX_HEADER);
  2913.         GetFreePage;
  2914.       end;
  2915.     end else begin
  2916.       //Truncate ntx file
  2917.       FNTXBag.NTXHandler.Seek(0, 0);
  2918.       FNTXBag.NTXHandler.SetEndOfFile;
  2919.       FNTXBuffers.Clear;
  2920.       if FClipperVer in [v500, v501] then
  2921.         FNTXOrder.FHead.sign := 6
  2922.       else
  2923.         FNTXOrder.FHead.sign := 7;
  2924.       FNTXOrder.FHead.version := 1;
  2925.       FNTXOrder.FHead.root := NTX_PAGE;
  2926.       FNTXOrder.FHead.next_page := 0;
  2927.       FNTXOrder.FHead.reserv1 := #0;
  2928.       FNTXOrder.FHead.reserv3 := #0;
  2929.       FNTXBag.NTXHandler.Seek(0, 0);
  2930.       FNTXBag.NTXHandler.Write(FNTXOrder.FHead, SizeOf(NTX_HEADER));
  2931.       FLastOffset := SizeOf(NTX_HEADER);
  2932.       GetFreePage;
  2933.     end;
  2934.   end;
  2935.  
  2936. begin
  2937.   oB := TVKDBFNTX(FIndexes.Owner);
  2938.   if oB.Active then begin
  2939.     oB.IndState := true;
  2940.     FCreateIndexProc:= true;
  2941.     DBFBuffer := VKDBFMemMgr.oMem.GetMem(self, oB.BufferSize);
  2942.     LastFUpdated := FUpdated;
  2943.     FUpdated := true;
  2944.     try
  2945.  
  2946.       FillChar(DBFBuffer^, oB.BufferSize, ' ');
  2947.       oB.IndRecBuf := DBFBuffer;
  2948.       if FForExpresion <> '' then
  2949.         FForExists := true;
  2950.       EvaluteKeyExpr;
  2951.       CreateEmptyIndex;
  2952.  
  2953.       RecPareBuf := oB.BufferSize div oB.Header.rec_size;
  2954.       if RecPareBuf >= 1 then begin
  2955.         ReadSize := RecPareBuf * oB.Header.rec_size;
  2956.         oB.Handle.Seek(oB.Header.data_offset, 0);
  2957.         Rec := 0;
  2958.         repeat
  2959.           RealRead := oB.Handle.Read(DBFBuffer^, ReadSize);
  2960.           BufCnt := RealRead div oB.Header.rec_size;
  2961.           for i := 0 to BufCnt - 1 do begin
  2962.             oB.IndRecBuf := DBFBuffer + oB.Header.rec_size * i;
  2963.             if oB.Crypt.Active then
  2964.               oB.Crypt.Decrypt(Rec + 1, Pointer(oB.IndRecBuf), oB.Header.rec_size);
  2965.             Inc(Rec);
  2966.             Key := EvaluteKeyExpr;
  2967.             AddKey(Key, Rec);
  2968.           end;
  2969.         until ( BufCnt <= 0 );
  2970.       end else Exception.Create('TVKNTXIndex.CreateIndex: Record size too lage');
  2971.     finally
  2972.       Flush;
  2973.       FUpdated := LastFUpdated;
  2974.       FNTXBag.NTXHandler.Seek(0, 0);
  2975.       FNTXBag.NTXHandler.Write(FNTXOrder.FHead, SizeOf(NTX_HEADER));
  2976.       FNTXBuffers.Clear;
  2977.       FCreateIndexProc:= false;
  2978.       oB.IndState := false;
  2979.       oB.IndRecBuf := nil;
  2980.       VKDBFMemMgr.oMem.FreeMem(DBFBuffer);
  2981.     end;
  2982.     if IsOpen then begin
  2983.       InternalFirst;
  2984.       KeyExpresion := FNTXOrder.FHead.key_expr;
  2985.       ForExpresion := FNTXOrder.FHead.for_expr;
  2986.       if ForExpresion <> '' then
  2987.         FForExists := true;
  2988.       if Activate then Active := true;
  2989.     end;
  2990.   end else raise Exception.Create('TVKNTXIndex.CreateIndex: Create index only on active DataSet');
  2991. end;
  2992.  
  2993. procedure TVKNTXIndex.CreateCompactIndex(BlockBufferSize: LongWord = 65536;  Activate: boolean = true);
  2994. var
  2995.   oB: TVKDBFNTX;
  2996.   DBFBuffer: pChar;
  2997.   RecPareBuf: Integer;
  2998.   ReadSize, RealRead, BufCnt: Integer;
  2999.   i: Integer;
  3000.   Key: String;
  3001.   Rec: DWORD;
  3002.   BlockBuffer: pChar;
  3003.   FNtxHead: NTX_HEADER;
  3004.   max_item: WORD;
  3005.   Objects: TObjectList;
  3006.   Iter1, Iter2: TVKNTXIndexIterator;
  3007.   cIndex: TVKNTXCompactIndex;
  3008.  
  3009.   procedure LoadBlock(BlockFile: String; pBlock: pChar);
  3010.   var
  3011.     h: Integer;
  3012.   begin
  3013.     h := FileOpen(BlockFile, fmOpenRead or fmShareExclusive);
  3014.     if h > 0 then begin
  3015.       SysUtils.FileRead(h, pBlock^, BlockBufferSize);
  3016.       SysUtils.FileClose(h);
  3017.     end;
  3018.   end;
  3019.  
  3020.   procedure SaveBlock;
  3021.   var
  3022.     TmpFileName: String;
  3023.     h: Integer;
  3024.   begin
  3025.     if pBLOCK_BUFFER(BlockBuffer).count > 0 then begin
  3026.       TmpFileName := GetTmpFileName;
  3027.       h := FileOpen(TmpFileName, fmOpenWrite or fmShareExclusive);
  3028.       if h > 0 then begin
  3029.         SysUtils.FileWrite(h, BlockBuffer^, BlockBufferSize);
  3030.         SysUtils.FileClose(h);
  3031.         Objects.Add(TVKNTXBlockIterator.Create(TmpFileName, FNtxHead.key_size, BlockBufferSize));
  3032.       end;
  3033.     end;
  3034.   end;
  3035.  
  3036.   procedure FillNtxHeader;
  3037.   var
  3038.     i: Integer;
  3039.     IndAttr: TIndexAttributes;
  3040.   begin
  3041.     DefineBag;
  3042.     if FClipperVer in [v500, v501] then
  3043.       FNtxHead.sign := 6
  3044.     else
  3045.       FNtxHead.sign := 7;
  3046.     FNtxHead.version := 0;
  3047.     FNtxHead.root := NTX_PAGE;
  3048.     FNtxHead.next_page := 0;
  3049.  
  3050.     if Assigned(OnCreateIndex) then begin
  3051.       OnCreateIndex(self, IndAttr);
  3052.       FNtxHead.key_size := IndAttr.key_size;
  3053.       FNtxHead.key_dec := IndAttr.key_dec;
  3054.       System.Move(pChar(IndAttr.key_expr)^, FNtxHead.key_expr, Length(IndAttr.key_expr));
  3055.       FNtxHead.key_expr[Length(IndAttr.key_expr)] := #0;
  3056.       System.Move(pChar(IndAttr.for_expr)^, FNtxHead.for_expr, Length(IndAttr.for_expr));
  3057.       FNtxHead.for_expr[Length(IndAttr.for_expr)] := #0;
  3058.     end else begin
  3059.       FNtxHead.key_size := Length(FKeyParser.Key);
  3060.       FNtxHead.key_dec := FKeyParser.Prec;
  3061.       System.Move(pChar(FKeyExpresion)^, FNtxHead.key_expr, Length(FKeyExpresion));
  3062.       FNtxHead.key_expr[Length(FKeyExpresion)] := #0;
  3063.       System.Move(pChar(FForExpresion)^, FNtxHead.for_expr, Length(FForExpresion));
  3064.       FNtxHead.for_expr[Length(FForExpresion)] := #0;
  3065.     end;
  3066.  
  3067.     FNtxHead.item_size := FNtxHead.key_size + 8;
  3068.     FNtxHead.max_item := (NTX_PAGE - FNtxHead.item_size - 4) div (FNtxHead.item_size + 2);
  3069.     FNtxHead.half_page := FNtxHead.max_item div 2;
  3070.     FNtxHead.max_item := FNtxHead.half_page * 2;
  3071.     if Unique then
  3072.       FNtxHead.unique := #1
  3073.     else
  3074.       FNtxHead.unique := #0;
  3075.     FNtxHead.reserv1 := #0;
  3076.     if Desc then
  3077.       FNtxHead.desc := #1
  3078.     else
  3079.       FNtxHead.desc := #0;
  3080.     FNtxHead.reserv3 := #0;
  3081.     for i := 0 to 7 do FNtxHead.order[i] := FNTXOrder.FHead.Order[i];
  3082.     //
  3083.     FNTXOrder.FHead := FNtxHead;
  3084.     //
  3085.   end;
  3086.  
  3087.   procedure InitBlock(Block: pChar);
  3088.   var
  3089.     page: pBLOCK_BUFFER;
  3090.     half_page, item_size, item_off: WORD;
  3091.     i: Integer;
  3092.     q: LongWord;
  3093.   begin
  3094.  
  3095.     item_size := FNtxHead.key_size + 4;
  3096.     q := (BlockBufferSize - item_size - 4) div (item_size + 2);
  3097.     if q > MAXWORD then raise Exception.Create('TVKNTXIndex.CreateCompactIndex: BlockBufferSize too large!');
  3098.     max_item := WORD(q);
  3099.     half_page := max_item div 2;
  3100.     max_item := half_page * 2;
  3101.  
  3102.     page := pBLOCK_BUFFER(Block);
  3103.     page.count := 0;
  3104.     item_off := ( max_item * 2 ) + 4;
  3105.     for i := 0 to max_item do begin
  3106.       page.ref[i] := item_off;
  3107.       item_off := item_off + item_size;
  3108.     end;
  3109.   end;
  3110.  
  3111.   procedure AddKeyInBlock(Key: String; Rec: DWORD);
  3112.   var
  3113.     AddOk: boolean;
  3114.     i, j, beg, Mid: Integer;
  3115.     page: pBLOCK_BUFFER;
  3116.     item: pBLOCK_ITEM;
  3117.     c: Integer;
  3118.     rf: WORD;
  3119.  
  3120.     procedure InsItem;
  3121.     begin
  3122.       j := page.count;
  3123.       while j >= i do begin
  3124.         rf := page.ref[j + 1];
  3125.         page.ref[j + 1] := page.ref[j];
  3126.         page.ref[j] := rf;
  3127.         Dec(j);
  3128.       end;
  3129.       page.count := page.count + 1;
  3130.       Move(pChar(Key)^, pBLOCK_ITEM(pChar(page) + page.ref[i]).key, FNTXOrder.FHead.key_size);
  3131.       pBLOCK_ITEM(pChar(page) + page.ref[i]).rec_no := Rec;
  3132.     end;
  3133.  
  3134.     procedure CmpRec;
  3135.     begin
  3136.       if c = 0 then begin
  3137.         if item.rec_no < Rec then
  3138.           c := 1
  3139.         else
  3140.           c := -1;
  3141.       end;
  3142.     end;
  3143.  
  3144.   begin
  3145.     AddOk := true;
  3146.     if FForExists then
  3147.       AddOk := AddOk and (FForParser.Execute);
  3148.     if AddOk then begin
  3149.       page := pBLOCK_BUFFER(BlockBuffer);
  3150.       if page.count = max_item then begin
  3151.         //Save block on disc
  3152.         SaveBlock;
  3153.         //Truncate block
  3154.         page.count := 0;
  3155.       end;
  3156.       TransKey(pChar(Key));
  3157.       i := page.count;
  3158.       if ( i > 0 ) then begin
  3159.         beg := 0;
  3160.         item := pBLOCK_ITEM(pChar(page) + page.ref[beg]);
  3161.         c := CmpKeys1(item.key, pChar(Key));
  3162.         if ( c = 0 ) and Unique then Exit;
  3163.  
  3164.         CmpRec;
  3165.  
  3166.         if ( c > 0 ) then begin
  3167.           repeat
  3168.             Mid := (i+beg) div 2;
  3169.             item := pBLOCK_ITEM(pChar(page) + page.ref[Mid]);
  3170.             c := CmpKeys1(item.key, pChar(Key));
  3171.             if ( c = 0 ) and Unique then Exit;
  3172.  
  3173.             CmpRec;
  3174.  
  3175.             if ( c > 0 ) then
  3176.                beg := Mid
  3177.             else
  3178.                i := Mid;
  3179.           until ( ((i-beg) div 2) = 0 );
  3180.         end else
  3181.           i := beg;
  3182.       end;
  3183.       if AddOk then InsItem;
  3184.     end;
  3185.   end;
  3186.  
  3187.   procedure MergeList(Iter1, Iter2: TVKNTXIndexIterator; cIndex: TVKNTXCompactIndex);
  3188.   var
  3189.     c: Integer;
  3190.  
  3191.     procedure CmpRec;
  3192.     begin
  3193.       if c = 0 then begin
  3194.         if Iter1.item.rec_no < Iter2.item.rec_no then
  3195.           c := 1
  3196.         else
  3197.           c := -1;
  3198.       end;
  3199.     end;
  3200.  
  3201.   begin
  3202.     if Iter2 = nil then begin
  3203.       Iter1.Open;
  3204.       try
  3205.         while not Iter1.Eof do begin
  3206.           cIndex.AddItem(@Iter1.item);
  3207.           Iter1.Next;
  3208.         end;
  3209.       finally
  3210.         Iter1.Close;
  3211.       end;
  3212.     end else begin
  3213.       Iter1.Open;
  3214.       Iter2.Open;
  3215.       try
  3216.         repeat
  3217.           if not ( Iter1.Eof or Iter2.Eof ) then begin
  3218.             c := CmpKeys1(Iter1.Item.key, Iter2.Item.key);
  3219.             if ( c = 0 ) and Unique then begin
  3220.               cIndex.AddItem(@Iter1.Item);
  3221.               Iter1.Next;
  3222.               Iter2.Next;
  3223.               Continue;
  3224.             end;
  3225.             CmpRec;
  3226.             if c > 0 then begin
  3227.               if not Iter1.Eof then begin
  3228.                 cIndex.AddItem(@Iter1.Item);
  3229.                 Iter1.Next;
  3230.               end;
  3231.             end else
  3232.               if not Iter2.Eof then begin
  3233.                 cIndex.AddItem(@Iter2.Item);
  3234.                 Iter2.Next;
  3235.               end;
  3236.           end else begin
  3237.             if not Iter1.Eof then begin
  3238.               cIndex.AddItem(@Iter1.Item);
  3239.               Iter1.Next;
  3240.             end;
  3241.             if not Iter2.Eof then begin
  3242.               cIndex.AddItem(@Iter2.Item);
  3243.               Iter2.Next;
  3244.             end;
  3245.           end;
  3246.         until ( Iter1.Eof and Iter2.Eof );
  3247.       finally
  3248.         Iter1.Close;
  3249.         Iter2.Close;
  3250.       end;
  3251.     end;
  3252.   end;
  3253.  
  3254. begin
  3255.   oB := TVKDBFNTX(FIndexes.Owner);
  3256.   if oB.Active then begin
  3257.     oB.IndState := true;
  3258.     Objects := TObjectList.Create;
  3259.     cIndex := TVKNTXCompactIndex.Create;
  3260.     DBFBuffer := VKDBFMemMgr.oMem.GetMem(self, oB.BufferSize);
  3261.     BlockBuffer := VKDBFMemMgr.oMem.GetMem(self, BlockBufferSize);
  3262.     try
  3263.  
  3264.       FillChar(DBFBuffer^, oB.BufferSize, ' ');
  3265.       oB.IndRecBuf := DBFBuffer;
  3266.       if FForExpresion <> '' then
  3267.         FForExists := true;
  3268.       EvaluteKeyExpr;
  3269.       FillNtxHeader;
  3270.  
  3271.       InitBlock(BlockBuffer);
  3272.  
  3273.       RecPareBuf := oB.BufferSize div oB.Header.rec_size;
  3274.       if RecPareBuf >= 1 then begin
  3275.         ReadSize := RecPareBuf * oB.Header.rec_size;
  3276.         oB.Handle.Seek(oB.Header.data_offset, 0);
  3277.         Rec := 0;
  3278.         repeat
  3279.           RealRead := oB.Handle.Read(DBFBuffer^, ReadSize);
  3280.           BufCnt := RealRead div oB.Header.rec_size;
  3281.           for i := 0 to BufCnt - 1 do begin
  3282.             oB.IndRecBuf := DBFBuffer + oB.Header.rec_size * i;
  3283.             if oB.Crypt.Active then
  3284.               oB.Crypt.Decrypt(Rec + 1, Pointer(oB.IndRecBuf), oB.Header.rec_size);
  3285.             Inc(Rec);
  3286.             Key := EvaluteKeyExpr;
  3287.             //
  3288.             AddKeyInBlock(Key, Rec);
  3289.             //
  3290.           end;
  3291.         until ( BufCnt <= 0 );
  3292.         //Save the rest block
  3293.         SaveBlock;
  3294.         if Objects.Count > 0 then begin
  3295.           // Merge lists
  3296.           i := 0;
  3297.           while  i < Objects.Count do begin
  3298.             Iter1 := TVKNTXIndexIterator(Objects[i]);
  3299.             if ( i + 1 ) < Objects.Count then
  3300.               Iter2 := TVKNTXIndexIterator(Objects[i + 1])
  3301.             else
  3302.               Iter2 := nil;
  3303.             if ( Objects.Count - i ) > 2 then
  3304.               cIndex.FileName := ''
  3305.             else begin
  3306.               cIndex.FileName := FNTXFileName;
  3307.               cIndex.Crypt := oB.Crypt.Active;
  3308.               cIndex.OwnerTable := oB;
  3309.               if FNTXBag.NTXHandler.ProxyStreamType <> pstFile then
  3310.                 cIndex.Handler := FNTXBag.NTXHandler;
  3311.             end;
  3312.             cIndex.CreateEmptyIndex(FNtxHead);
  3313.             try
  3314.               MergeList(Iter1, Iter2, cIndex);
  3315.             finally
  3316.               cIndex.Close;
  3317.               if ( Objects.Count - i ) > 2 then
  3318.                 Objects.Add(TVKNTXIterator.Create(cIndex.FileName));
  3319.             end;
  3320.             Inc(i, 2);
  3321.           end;
  3322.         end else begin
  3323.           cIndex.FileName := FNTXFileName;
  3324.           cIndex.Crypt := oB.Crypt.Active;
  3325.           cIndex.OwnerTable := oB;
  3326.           if FNTXBag.NTXHandler.ProxyStreamType <> pstFile then
  3327.             cIndex.Handler := FNTXBag.NTXHandler;
  3328.           cIndex.CreateEmptyIndex(FNtxHead);
  3329.           cIndex.Close;
  3330.         end;
  3331.         //
  3332.       end else Exception.Create('TVKNTXIndex.CreateCompactIndex: Record size too lage');
  3333.     finally
  3334.       oB.IndState := false;
  3335.       oB.IndRecBuf := nil;
  3336.       VKDBFMemMgr.oMem.FreeMem(DBFBuffer);
  3337.       VKDBFMemMgr.oMem.FreeMem(BlockBuffer);
  3338.       Objects.Free;
  3339.       cIndex.Free;
  3340.     end;
  3341.     Open;
  3342.     if IsOpen and Activate then Active := true;
  3343.   end else raise Exception.Create('TVKNTXIndex.CreateCompactIndex: Create index only on active DataSet');
  3344. end;
  3345.  
  3346. function TVKNTXIndex.SuiteFieldList(fl: String; out m: Integer): Integer;
  3347. begin
  3348.   if Temp then begin
  3349.     m := 0;
  3350.     Result := 0
  3351.   end else
  3352.     Result := FKeyParser.SuiteFieldList(fl, m);
  3353. end;
  3354.  
  3355. function TVKNTXIndex.SeekFields(const KeyFields: string;
  3356.   const KeyValues: Variant; SoftSeek: boolean = false;
  3357.   PartialKey: boolean = false): Integer;
  3358. var
  3359.   m, n: Integer;
  3360.   Key: String;
  3361. begin
  3362.   Result := 0;
  3363.   m := FKeyParser.SuiteFieldList(KeyFields, n);
  3364.   if m > 0 then begin
  3365.     Key := FKeyParser.EvaluteKey(KeyFields, KeyValues);
  3366.     if PartialKey then Key := TrimRight(Key);
  3367.     Result := SeekFirstRecord(Key, SoftSeek, PartialKey);
  3368.   end;
  3369. end;
  3370.  
  3371. function TVKNTXIndex.GetOwnerTable: TDataSet;
  3372. begin
  3373.   Result := TDataSet(FIndexes.Owner);
  3374. end;
  3375.  
  3376. function TVKNTXIndex.SeekLastInternal(Key: String;
  3377.   SoftSeek: boolean): boolean;
  3378. var
  3379.   lResult, SoftSeekSet: boolean;
  3380.  
  3381.   procedure Pass(page_off: DWORD);
  3382.   var
  3383.     i: DWORD;
  3384.     page: pNTX_BUFFER;
  3385.     item: pNTX_ITEM;
  3386.     c: Integer;
  3387.   begin
  3388.  
  3389.     FNTXBuffers.GetPage(FNTXBag.NTXHandler, page_off, page);
  3390.  
  3391.     if page.count > 0 then begin
  3392.       for i := 0 to page.count - 1 do begin
  3393.  
  3394.         item := pNTX_ITEM(pChar(page) + page.ref[i]);
  3395.  
  3396.         c := CmpKeys(item.key, pChar(Key), Length(Key));
  3397.  
  3398.         if c < 0 then begin //Key < item.key
  3399.           if ( item.page <> 0 ) then Pass(item.page);
  3400.           if (SoftSeek) and (not lResult) and ( not SoftSeekSet ) then begin
  3401.             FSeekRecord := item.rec_no;
  3402.             SoftSeekSet := true;
  3403.             SetString(FSeekKey, item.key, FNTXOrder.FHead.key_size);
  3404.             FSeekOk := true;
  3405.           end;
  3406.           Exit;
  3407.         end;
  3408.  
  3409.         if c = 0 then begin //Key = item.key
  3410.           FSeekRecord := item.rec_no;
  3411.           SetString(FSeekKey, item.key, FNTXOrder.FHead.key_size);
  3412.           FSeekOk := true;
  3413.           lResult := true;
  3414.         end;
  3415.  
  3416.       end;
  3417.  
  3418.     end;
  3419.  
  3420.     item := pNTX_ITEM(pChar(page) + page.ref[page.count]);
  3421.     if ( item.page <> 0 ) then Pass(item.page);
  3422.  
  3423.   end;
  3424.  
  3425. begin
  3426.  
  3427.   FSeekOk := false;
  3428.  
  3429.   SoftSeekSet := false;
  3430.  
  3431.   if FLock then
  3432.     try
  3433.  
  3434.       ClearIfChange;
  3435.  
  3436.       lResult := false;
  3437.       Pass(FNTXOrder.FHead.root);
  3438.       Result := lResult;
  3439.  
  3440.     finally
  3441.       FUnLock;
  3442.     end
  3443.   else
  3444.     Result := false;
  3445.  
  3446. end;
  3447.  
  3448. procedure TVKNTXIndex.SetRangeFields(FieldList: String;
  3449.   FieldValues: array of const);
  3450. var
  3451.   FieldVal: Variant;
  3452. begin
  3453.   ArrayOfConstant2Variant(FieldValues, FieldVal);
  3454.   SetRangeFields(FieldList, FieldVal);
  3455. end;
  3456.  
  3457. procedure TVKNTXIndex.SetRangeFields(FieldList: String;
  3458.   FieldValues: Variant);
  3459. var
  3460.   Key: String;
  3461. begin
  3462.   Key := TrimRight(FKeyParser.EvaluteKey(FieldList, FieldValues));
  3463.   NTXRange.HiKey := Key;
  3464.   NTXRange.LoKey := Key;
  3465.   NTXRange.ReOpen;
  3466. end;
  3467.  
  3468. function TVKNTXIndex.GetIsRanged: boolean;
  3469. begin
  3470.   Result := NTXRange.Active;
  3471. end;
  3472.  
  3473. function TVKNTXIndex.InRange(Key: String): boolean;
  3474. begin
  3475.   Result := NTXRange.InRange(Key);
  3476. end;
  3477.  
  3478. procedure TVKNTXIndex.ClearIfChange;
  3479. var
  3480.   v: WORD;
  3481. begin
  3482.   if not FCreateIndexProc then begin
  3483.     if not FUpdated then begin
  3484.       v := FNTXOrder.FHead.version;
  3485.       FNTXBag.NTXHandler.Seek(0, 0);
  3486.       FNTXBag.NTXHandler.Read(FNTXOrder.FHead, 12);
  3487.       if v <> FNTXOrder.FHead.version then FNTXBuffers.Clear;
  3488.     end;
  3489.   end;
  3490. end;
  3491.  
  3492. procedure TVKNTXIndex.StartUpdate(UnLock: boolean = true);
  3493. begin
  3494.   if not FUpdated then
  3495.     if FLock then
  3496.       try
  3497.         FLastOffset := FNTXBag.NTXHandler.Seek(0, 2);
  3498.         ClearIfChange;
  3499.         FUpdated := true;
  3500.       finally
  3501.         if UnLock then FUnLock;
  3502.       end;
  3503. end;
  3504.  
  3505. procedure TVKNTXIndex.Flush;
  3506. begin
  3507.   if FUpdated then begin
  3508.     FNTXBuffers.Flush(FNTXBag.NTXHandler);
  3509.     if not FCreateIndexProc then begin
  3510.       if FNTXOrder.FHead.version > 65530 then
  3511.         FNTXOrder.FHead.version := 0
  3512.       else
  3513.         FNTXOrder.FHead.version := FNTXOrder.FHead.version + 1;
  3514.       FNTXBag.NTXHandler.Seek(0, 0);
  3515.       FNTXBag.NTXHandler.Write(FNTXOrder.FHead, 12);
  3516.     end;
  3517.     FUpdated := false;
  3518.   end;
  3519. end;
  3520.  
  3521. procedure TVKNTXIndex.Reindex(Activate: boolean = true);
  3522. begin
  3523.   FReindex := true;
  3524.   try
  3525.     CreateIndex(Activate);
  3526.   finally
  3527.     FReindex := false;
  3528.   end;
  3529. end;
  3530.  
  3531. function TVKNTXIndex.GetCreateNow: Boolean;
  3532. begin
  3533.   Result := false;
  3534. end;
  3535.  
  3536. procedure TVKNTXIndex.SetCreateNow(const Value: Boolean);
  3537. begin
  3538.   if Value then begin
  3539.     CreateIndex;
  3540.     if csDesigning in OwnerTable.ComponentState then ShowMessage(Format('Index %s create successfully!', [NTXFileName]));
  3541.   end;
  3542. end;
  3543.  
  3544. function TVKNTXIndex.SeekFirstRecord(Key: String;
  3545.   SoftSeek: boolean = false; PartialKey: boolean = false): Integer;
  3546. begin
  3547.   Result := FindKey(Key, PartialKey, SoftSeek);
  3548. end;
  3549.  
  3550. procedure TVKNTXIndex.Truncate;
  3551. begin
  3552.   //Truncate ntx file
  3553.   FNTXBag.NTXHandler.Seek(0, 0);
  3554.   FNTXBag.NTXHandler.SetEndOfFile;
  3555.   //Create new header
  3556.   FNTXBuffers.Clear;
  3557.   FNTXOrder.FHead.version := 1;
  3558.   FNTXOrder.FHead.root := NTX_PAGE;
  3559.   FNTXOrder.FHead.next_page := 0;
  3560.   FNTXOrder.FHead.reserv1 := #0;
  3561.   FNTXOrder.FHead.reserv3 := #0;
  3562.   FNTXBag.NTXHandler.Seek(0, 0);
  3563.   FNTXBag.NTXHandler.Write(FNTXOrder.FHead, SizeOf(NTX_HEADER));
  3564.   FLastOffset := SizeOf(NTX_HEADER);
  3565.   GetFreePage;
  3566. end;
  3567.  
  3568. procedure TVKNTXIndex.BeginCreateIndexProcess;
  3569. begin
  3570.   Truncate;
  3571.   FCreateIndexProc:= true;
  3572.   FFLastFUpdated := FUpdated;
  3573.   FUpdated := true;
  3574. end;
  3575.  
  3576. procedure TVKNTXIndex.EndCreateIndexProcess;
  3577. begin
  3578.   Flush;
  3579.   FUpdated := FFLastFUpdated;
  3580.   FNTXBag.NTXHandler.Seek(0, 0);
  3581.   FNTXBag.NTXHandler.Write(FNTXOrder.FHead, SizeOf(NTX_HEADER));
  3582.   FNTXBuffers.Clear;
  3583.   FCreateIndexProc:= false;
  3584. end;
  3585.  
  3586. procedure TVKNTXIndex.EvaluteAndAddKey(nRec: DWORD);
  3587. var
  3588.   Key: String;
  3589. begin
  3590.   Key := EvaluteKeyExpr;
  3591.   AddKey(Key, nRec);
  3592. end;
  3593.  
  3594. function TVKNTXIndex.InRange: boolean;
  3595. var
  3596.   Key: String;
  3597. begin
  3598.   Key := EvaluteKeyExpr;
  3599.   Result := NTXRange.InRange(Key);
  3600. end;
  3601.  
  3602. function TVKNTXIndex.FindKey( Key: String; PartialKey: boolean = false;
  3603.                               SoftSeek: boolean = false; Rec: DWORD = 0): Integer;
  3604. var
  3605.   oB: TVKDBFNTX;
  3606.   m: Integer;
  3607.   iResult: Integer;
  3608.  
  3609.   function Pass(page_off: DWORD): boolean;
  3610.   var
  3611.     i: DWORD;
  3612.     page: pNTX_BUFFER;
  3613.     item: pNTX_ITEM;
  3614.     c: Integer;
  3615.   begin
  3616.  
  3617.     FNTXBuffers.GetPage(FNTXBag.NTXHandler, page_off, page);
  3618.  
  3619.     if page.count > 0 then begin
  3620.       for i := 0 to page.count - 1 do begin
  3621.  
  3622.         item := pNTX_ITEM(pChar(page) + page.ref[i]);
  3623.  
  3624.         c := CmpKeys(item.key, pChar(Key), m);
  3625.  
  3626.         if Rec > 0 then
  3627.           if c = 0 then begin
  3628.             if item.rec_no < Rec then
  3629.               c := 1
  3630.             else if item.rec_no = Rec then
  3631.               c := 0
  3632.             else
  3633.               c := -1;
  3634.           end;
  3635.  
  3636.         if c <= 0 then begin //LoKey <= item.key
  3637.           if ( item.page <> 0 ) then begin
  3638.             Result := Pass(item.page);
  3639.             if Result then Exit;
  3640.           end;
  3641.           if not SoftSeek then begin
  3642.             c := CmpKeys(item.key, pChar(Key), m);
  3643.             if c < 0 then begin // HiKey < item.key
  3644.               Result := true;
  3645.               Exit;
  3646.             end;
  3647.           end;
  3648.           if oB.AcceptTmpRecord(item.rec_no) then begin
  3649.             iResult := item.rec_no;
  3650.             Result := true;
  3651.             Exit;
  3652.           end;
  3653.         end;
  3654.  
  3655.       end;
  3656.     end;
  3657.  
  3658.     item := pNTX_ITEM(pChar(page) + page.ref[page.count]);
  3659.     if ( item.page <> 0 ) then Pass(item.page);
  3660.  
  3661.     Result := false;
  3662.  
  3663.   end;
  3664.  
  3665. begin
  3666.  
  3667.   Result := 0;
  3668.   oB := TVKDBFNTX(FIndexes.Owner);
  3669.   if oB.Active then
  3670.     if FLock then
  3671.       try
  3672.  
  3673.         ClearIfChange;
  3674.  
  3675.         m := Length(Key);
  3676.         if m > FNTXOrder.FHead.key_size then m := FNTXOrder.FHead.key_size;
  3677.         if ( not ( PartialKey or SoftSeek ) ) and (m < FNTXOrder.FHead.key_size) then Exit;
  3678.         iResult := 0;
  3679.         Pass(FNTXOrder.FHead.root);
  3680.         Result := iResult;
  3681.  
  3682.       finally
  3683.         FUnLock;
  3684.       end;
  3685.  
  3686. end;
  3687.  
  3688. function TVKNTXIndex.FindKeyFields(const KeyFields: string;
  3689.   const KeyValues: Variant; PartialKey: boolean = false): Integer;
  3690. var
  3691.   m, l: Integer;
  3692.   Key: String;
  3693.   KeyFields_: string;
  3694.   PartialKeyInternal: boolean;
  3695. begin
  3696.   Result := 0;
  3697.   KeyFields_ := KeyFields;
  3698.   if KeyFields_ = '' then KeyFields_ := FKeyParser.GetFieldList;
  3699.   m := FKeyParser.SuiteFieldList(KeyFields_, l);
  3700.   if m > 0 then begin
  3701.     Key := FKeyParser.EvaluteKey(KeyFields_, KeyValues);
  3702.     PartialKeyInternal := PartialKey;
  3703.     if not PartialKeyInternal then begin
  3704.       if m > VarArrayHighBound(KeyValues, 1) then PartialKeyInternal := True;
  3705.     end;
  3706.     if PartialKeyInternal then Key := TrimRight(Key);
  3707.     Result:= FindKey(Key, PartialKeyInternal);
  3708.   end;
  3709. end;
  3710.  
  3711. function TVKNTXIndex.FindKeyFields(const KeyFields: string;
  3712.   const KeyValues: array of const; PartialKey: boolean = false): Integer;
  3713. var
  3714.   FieldVal: Variant;
  3715. begin
  3716.   ArrayOfConstant2Variant(KeyValues, FieldVal);
  3717.   Result := FindKeyFields(KeyFields, FieldVal, PartialKey);
  3718. end;
  3719.  
  3720. function TVKNTXIndex.FindKeyFields(PartialKey: boolean = false): Integer;
  3721. var
  3722.   Key: String;
  3723. begin
  3724.   Key := FKeyParser.EvaluteKey;
  3725.   if PartialKey then Key := TrimRight(Key);
  3726.   Result := FindKey(Key, PartialKey);
  3727. end;
  3728.  
  3729. function TVKNTXIndex.TransKey(Key: String): String;
  3730. begin
  3731.   Result := Key;
  3732.   TransKey(pChar(Result), Length(Result), false);
  3733. end;
  3734.  
  3735. function TVKNTXIndex.IsForIndex: boolean;
  3736. begin
  3737.   Result := FForExists;
  3738. end;
  3739.  
  3740. function TVKNTXIndex.IsUniqueIndex: boolean;
  3741. begin
  3742.   Result := Unique;
  3743. end;
  3744.  
  3745. procedure TVKNTXIndex.DefineBagAndOrder;
  3746. var
  3747.   oO: TVKNTXOrder;
  3748.   i: Integer;
  3749.   IndexName: String;
  3750. begin
  3751.   IndexName := ChangeFileExt(ExtractFileName(NTXFileName), '');
  3752.   if IndexName = '' then IndexName := Order;
  3753.   if IndexName = '' then IndexName := Name;
  3754.   DefineBag;
  3755.   if not FNTXBag.IsOpen then FNTXBag.Open;
  3756.   for i := 0 to FNTXBag.Orders.Count - 1 do begin
  3757.     oO := TVKNTXOrder(FNTXBag.Orders.Items[i]);
  3758.     if AnsiUpperCase(oO.Name) = AnsiUpperCase(IndexName) then FNTXOrder := oO;
  3759.   end;
  3760.   if FNTXOrder = nil then
  3761.     raise Exception.Create('TVKNTXIndex.DefineBagAndOrder: FNTXOrder not defined!');
  3762. end;
  3763.  
  3764. procedure TVKNTXIndex.DefineBag;
  3765. var
  3766.   oW: TVKDBFNTX;
  3767.   oB: TVKNTXBag;
  3768.   oO: TVKNTXOrder;
  3769.   i: Integer;
  3770.   BgNm, IndexName: String;
  3771. begin
  3772.   oW := TVKDBFNTX(FIndexes.Owner);
  3773.   IndexName := ChangeFileExt(ExtractFileName(NTXFileName), '');
  3774.   if IndexName = '' then IndexName := Order;
  3775.   if IndexName = '' then IndexName := Name;
  3776.   FNTXOrder := nil;
  3777.   FNTXBag := nil;
  3778.   for i := 0 to oW.DBFIndexDefs.Count - 1 do begin
  3779.     oB := TVKNTXBag(oW.DBFIndexDefs.Items[i]);
  3780.     BgNm := oB.Name;
  3781.     if BgNm = '' then BgNm := ChangeFileExt(ExtractFileName(oB.IndexFileName), '');
  3782.     if BagName <> '' then begin
  3783.       if AnsiUpperCase(BgNm) = AnsiUpperCase(BagName) then begin
  3784.         FNTXBag := oB;
  3785.         break;
  3786.       end;
  3787.     end else begin
  3788.       if AnsiUpperCase(BgNm) = AnsiUpperCase(IndexName) then begin
  3789.         FNTXBag := oB;
  3790.         break;
  3791.       end;
  3792.     end;
  3793.   end;
  3794.   if FNTXBag = nil then begin
  3795.     oB := TVKNTXBag(oW.DBFIndexDefs.Add);
  3796.     oB.Name := ChangeFileExt(ExtractFileName(NTXFileName), '');
  3797.     oB.IndexFileName := NTXFileName;
  3798.     oB.StorageType := oW.StorageType;
  3799.     FNTXBag := oB;
  3800.   end;
  3801.   FNTXBag.FillHandler;
  3802.   if FNTXBag.Orders.Count = 0 then FNTXBag.Orders.Add;
  3803.   oO := TVKNTXOrder(FNTXBag.Orders.Items[0]);
  3804.   FillChar(oO.FHead, SizeOf(NTX_HEADER), #0);
  3805.   oO.Name := ChangeFileExt(ExtractFileName(FNTXBag.IndexFileName), '');
  3806.   if oO.Name = '' then oO.Name := FNTXBag.Name;
  3807.   FNTXOrder := oO;
  3808. end;
  3809.  
  3810. { TVKNTXRange }
  3811.  
  3812. function TVKNTXRange.GetActive: boolean;
  3813. begin
  3814.   Result := FActive;
  3815. end;
  3816.  
  3817. function TVKNTXRange.InRange(S: String): boolean;
  3818. var
  3819.   l, c: Integer;
  3820. begin
  3821.   c := NTX.CompareKeys(pChar(HiKey), pChar(S), NTX.FNTXOrder.FHead.key_size);
  3822.   Result := (c >= 0); //HiKey >= S
  3823.   if Result then begin
  3824.     l := Length(LoKey);
  3825.     if l > 0 then begin
  3826.       c := NTX.CompareKeys(pChar(LoKey), pChar(S), l);
  3827.       Result := (c <= 0); //LoKey <= S
  3828.     end;
  3829.   end;
  3830. end;
  3831.  
  3832. procedure TVKNTXRange.ReOpen;
  3833. var
  3834.   oDB: TVKDBFNTX;
  3835. begin
  3836.   if not Active then begin
  3837.     Active := true;
  3838.   end else begin
  3839.     NTX.Active := true;
  3840.     oDB := TVKDBFNTX(NTX.OwnerTable);
  3841.     if oDB.Active then oDB.First;
  3842.   end;
  3843. end;
  3844.  
  3845. procedure TVKNTXRange.SetActive(const Value: boolean);
  3846. var
  3847.   oDB: TVKDBFNTX;
  3848.   l: boolean;
  3849. begin
  3850.   l := FActive;
  3851.   FActive := Value;
  3852.   oDB := TVKDBFNTX(NTX.OwnerTable);
  3853.   NTX.Active := true;
  3854.   if (l <> Value) and oDB.Active then begin
  3855.     oDB.First;
  3856.   end;
  3857. end;
  3858.  
  3859. { TVKNTXBuffer }
  3860.  
  3861. constructor TVKNTXBuffer.Create;
  3862. begin
  3863.   inherited Create;
  3864.   Fchanged := false;
  3865. end;
  3866.  
  3867. { TVKNTXBuffers }
  3868.  
  3869. function TVKNTXBuffers.FindIndex(page_offset: DWORD;
  3870.   out Ind: Integer): boolean;
  3871. var
  3872.   B: TVKNTXBuffer;
  3873.   beg, Mid: Integer;
  3874. begin
  3875.   Ind := Count;
  3876.   if ( Ind > 0 ) then begin
  3877.     beg := 0;
  3878.     B := TVKNTXBuffer(Items[beg]);
  3879.     if ( page_offset > B.Fpage_offset ) then begin
  3880.       repeat
  3881.         Mid := (Ind + beg) div 2;
  3882.         B := TVKNTXBuffer(Items[Mid]);
  3883.         if ( page_offset > B.Fpage_offset ) then
  3884.            beg := Mid
  3885.         else
  3886.            Ind := Mid;
  3887.       until ( ((Ind - beg) div 2) = 0 );
  3888.     end else
  3889.       Ind := beg;
  3890.     if Ind < Count then begin
  3891.       B := TVKNTXBuffer(Items[Ind]);
  3892.       Result := (page_offset = B.Fpage_offset);
  3893.     end else
  3894.       Result := false;
  3895.   end else
  3896.     Result := false;
  3897. end;
  3898.  
  3899. procedure TVKNTXBuffers.Flush(Handle: TProxyStream);
  3900. var
  3901.   i: Integer;
  3902.   CryptPage: NTX_BUFFER;
  3903. begin
  3904.   for i := 0 to Count - 1 do begin
  3905.     with TVKNTXBuffer(Items[i]) do begin
  3906.       if Fchanged then begin
  3907.         Handle.Seek(Fpage_offset, 0);
  3908.         if TVKDBFNTX(NXTObject.OwnerTable).Crypt.Active then begin
  3909.           CryptPage := Fpage;
  3910.           TVKDBFNTX(NXTObject.OwnerTable).Crypt.Encrypt(Fpage_offset, @CryptPage, SizeOf(NTX_BUFFER));
  3911.           Handle.Write(CryptPage, SizeOf(NTX_BUFFER));
  3912.         end else
  3913.           Handle.Write(Fpage, SizeOf(NTX_BUFFER));
  3914.         Fchanged := false;
  3915.       end;
  3916.     end;
  3917.   end;
  3918. end;
  3919.  
  3920. function TVKNTXBuffers.GetPage(Handle: TProxyStream; page_offset: DWORD;
  3921.   out page: pNTX_BUFFER; fRead: boolean = true): Integer;
  3922. var
  3923.   i: Integer;
  3924.   b: TVKNTXBuffer;
  3925. begin
  3926.   if FindIndex(page_offset, i) then begin
  3927.     b := TVKNTXBuffer(Items[i]);
  3928.     page := @b.Fpage;
  3929.     Result := i;
  3930.   end else begin
  3931.     Insert(i, TVKNTXBuffer.Create);
  3932.     Result := i;
  3933.     if fRead then begin
  3934.       Handle.Seek(page_offset, 0);
  3935.       with TVKNTXBuffer(Items[i]) do begin
  3936.         Handle.Read(Fpage, SizeOf(NTX_BUFFER));
  3937.         if TVKDBFNTX(NXTObject.OwnerTable).Crypt.Active then
  3938.           TVKDBFNTX(NXTObject.OwnerTable).Crypt.Decrypt(page_offset, Pointer(@FPage), SizeOf(NTX_BUFFER));
  3939.         Fpage_offset := page_offset;
  3940.         page := @Fpage;
  3941.       end;
  3942.     end else
  3943.       with TVKNTXBuffer(Items[i]) do begin
  3944.         Fpage_offset := page_offset;
  3945.         page := @Fpage;
  3946.       end;
  3947.   end;
  3948. end;
  3949.  
  3950. function TVKNTXBuffers.GetNTXBuffer(Handle: TProxyStream; page_offset: DWORD;
  3951.   out page: pNTX_BUFFER; fRead: boolean): Pointer;
  3952. var
  3953.   i: Integer;
  3954. begin
  3955.   if FindIndex(page_offset, i) then begin
  3956.     Result := Items[i];
  3957.     page := @TVKNTXBuffer(Result).Fpage;
  3958.   end else begin
  3959.     Insert(i, TVKNTXBuffer.Create);
  3960.     Result := Items[i];
  3961.     if fRead then begin
  3962.       Handle.Seek(page_offset, 0);
  3963.       with TVKNTXBuffer(Items[i]) do begin
  3964.         Handle.Read(Fpage, SizeOf(NTX_BUFFER));
  3965.         if TVKDBFNTX(NXTObject.OwnerTable).Crypt.Active then
  3966.           TVKDBFNTX(NXTObject.OwnerTable).Crypt.Decrypt(page_offset, Pointer(@FPage), SizeOf(NTX_BUFFER));
  3967.         Fpage_offset := page_offset;
  3968.         page := @Fpage;
  3969.       end;
  3970.     end else
  3971.       with TVKNTXBuffer(Items[i]) do begin
  3972.         Fpage_offset := page_offset;
  3973.         page := @Fpage;
  3974.       end;
  3975.   end;
  3976. end;
  3977.  
  3978. procedure TVKNTXBuffers.SetChanged(i: Integer);
  3979. begin
  3980.   TVKNTXBuffer(Items[i]).Fchanged := true;
  3981. end;
  3982.  
  3983. procedure TVKNTXBuffers.SetPage(Handle: TProxyStream; page_offset: DWORD; page: pNTX_BUFFER);
  3984. var
  3985.   i: Integer;
  3986. begin
  3987.   if FindIndex(page_offset, i) then
  3988.     with TVKNTXBuffer(Items[i]) do
  3989.       Fchanged := true;
  3990. end;
  3991.  
  3992. { TVKNTXCompactIndex }
  3993.  
  3994. procedure TVKNTXCompactIndex.Close;
  3995. begin
  3996.   SubOffSet := 0;
  3997.   LinkRest;
  3998.   SHead.root := SubOffSet;
  3999.   SHead.next_page := 0;
  4000.   if Handler = nil then begin
  4001.     SysUtils.FileSeek(FHndl, 0, 0);
  4002.     SysUtils.FileWrite(FHndl, SHead, SizeOf(NTX_HEADER));
  4003.   end else begin
  4004.     Handler.Seek(0, 0);
  4005.     Handler.Write(SHead, SizeOf(NTX_HEADER));
  4006.   end;
  4007.   NormalizeRest;
  4008.   if Handler = nil then
  4009.     FileClose(FHndl)
  4010.   else
  4011.     Handler.Close;
  4012. end;
  4013.  
  4014. procedure TVKNTXCompactIndex.CreateEmptyIndex(var FHead: NTX_HEADER);
  4015. begin
  4016.   if Handler = nil then begin
  4017.     if FileName = '' then
  4018.       FileName := GetTmpFileName;
  4019.     FHndl := FileCreate(FileName);
  4020.     if FHndl <= 0 then
  4021.       raise Exception.Create('TVKNTXCompactIndex.CreateEmptyIndex: Index create error');
  4022.   end else
  4023.     Handler.CreateProxyStream;
  4024.   SHead := FHead;
  4025.   SHead.version := 0;
  4026.   SHead.root := NTX_PAGE;
  4027.   SHead.next_page := 0;
  4028.   if Handler = nil then begin
  4029.     SysUtils.FileSeek(FHndl, 0, 0);
  4030.     SysUtils.FileWrite(FHndl, SHead, SizeOf(NTX_HEADER));
  4031.   end else begin
  4032.     Handler.Seek(0, 0);
  4033.     Handler.Write(SHead, SizeOf(NTX_HEADER));
  4034.   end;
  4035.   NewPage(0);
  4036.   cur_lev := -1;
  4037.   SubOffSet := NTX_PAGE;
  4038. end;
  4039.  
  4040. procedure TVKNTXCompactIndex.NewPage(lev: Integer);
  4041. var
  4042.   item_off: WORD;
  4043.   i: Integer;
  4044. begin
  4045.   levels[lev].count := 0;
  4046.   item_off := ( SHead.max_item * 2 ) + 4;
  4047.   for i := 0 to SHead.max_item do begin
  4048.     levels[lev].ref[i] := item_off;
  4049.     item_off := item_off + SHead.item_size;
  4050.   end;
  4051.   pNTX_ITEM(pChar(@levels[lev]) + levels[lev].ref[0]).page := 0;
  4052.   max_lev := lev;
  4053. end;
  4054.  
  4055. procedure TVKNTXCompactIndex.NormalizeRest;
  4056. var
  4057.   LeftPage: TVKNTXBuffer;
  4058.  
  4059.   procedure SavePage(page: TVKNTXBuffer);
  4060.   begin
  4061.     if Handler = nil then
  4062.       FileSeek(FHndl, page.Fpage_offset, 0)
  4063.     else
  4064.       Handler.Seek(page.Fpage_offset, 0);
  4065.     if Crypt then begin
  4066.       CryptPage := page.Fpage;
  4067.       TVKDBFNTX(OwnerTable).Crypt.Encrypt(SubOffSet, @CryptPage, SizeOf(NTX_BUFFER));
  4068.       if Handler = nil then
  4069.         SysUtils.FileWrite(FHndl, CryptPage, SizeOf(NTX_BUFFER))
  4070.       else
  4071.         Handler.Write(CryptPage, SizeOf(NTX_BUFFER));
  4072.     end else begin
  4073.       if Handler = nil then
  4074.         SysUtils.FileWrite(FHndl, page.Fpage, SizeOf(NTX_BUFFER))
  4075.       else
  4076.         Handler.Write(page.Fpage, SizeOf(NTX_BUFFER));
  4077.     end;
  4078.   end;
  4079.  
  4080.   procedure GetPage(root: DWORD; page: TVKNTXBuffer);
  4081.   begin
  4082.     if Handler = nil then begin
  4083.       SysUtils.FileSeek(FHndl, root, 0);
  4084.       SysUtils.FileRead(FHndl, page.Fpage, SizeOf(NTX_BUFFER));
  4085.     end else begin
  4086.       Handler.Seek(root, 0);
  4087.       Handler.Read(page.Fpage, SizeOf(NTX_BUFFER));
  4088.     end;
  4089.     if Crypt then
  4090.       TVKDBFNTX(OwnerTable).Crypt.Decrypt(root, @page.Fpage, SizeOf(NTX_BUFFER));
  4091.     page.Fpage_offset := root;
  4092.   end;
  4093.  
  4094.   procedure Normalize(root: DWORD; Parent: TVKNTXBuffer);
  4095.   var
  4096.     item, LItem, SLItem, CItem: pNTX_ITEM;
  4097.     rf: DWORD;
  4098.     Shift, j: Integer;
  4099.     CurrentPage: TVKNTXBuffer;
  4100.   begin
  4101.     CurrentPage := TVKNTXBuffer.Create;
  4102.     GetPage(root, CurrentPage);
  4103.     if Parent <> nil then begin
  4104.       if CurrentPage.Fpage.count < SHead.half_page then begin
  4105.         LItem := pNTX_ITEM( pChar(@Parent.Fpage) + Parent.Fpage.ref[Parent.Fpage.count - 1]);
  4106.         GetPage(LItem.page, LeftPage);
  4107.  
  4108.         SLItem := pNTX_ITEM( pChar(@LeftPage.FPage) + LeftPage.FPage.ref[LeftPage.FPage.count]);
  4109.  
  4110.         Shift := SHead.half_page;
  4111.  
  4112.         LeftPage.FPage.count := LeftPage.FPage.count - Shift;
  4113.  
  4114.         j := CurrentPage.Fpage.count;
  4115.         while j >= 0 do begin
  4116.           rf := CurrentPage.Fpage.ref[j + Shift];
  4117.           CurrentPage.Fpage.ref[j + Shift] := CurrentPage.Fpage.ref[j];
  4118.           CurrentPage.Fpage.ref[j] := rf;
  4119.           Dec(j);
  4120.         end;
  4121.         Inc(CurrentPage.Fpage.count, Shift);
  4122.  
  4123.         CItem := pNTX_ITEM( pChar(@CurrentPage.Fpage) + CurrentPage.Fpage.ref[Shift - 1]);
  4124.         Move(LItem.key, CItem.key, SHead.key_size);
  4125.         CItem.rec_no := LItem.rec_no;
  4126.         CItem.page := SLItem.page;
  4127.  
  4128.         Dec(Shift);
  4129.  
  4130.         while Shift > 0 do begin
  4131.  
  4132.           SLItem := pNTX_ITEM( pChar(@LeftPage.FPage) + LeftPage.FPage.ref[LeftPage.FPage.count + Shift]);
  4133.  
  4134.           CItem := pNTX_ITEM( pChar(@CurrentPage.Fpage) + CurrentPage.Fpage.ref[Shift - 1]);
  4135.           Move(SLItem.key, CItem.key, SHead.key_size);
  4136.           CItem.rec_no := SLItem.rec_no;
  4137.           CItem.page := SLItem.page;
  4138.  
  4139.           Dec(Shift);
  4140.         end;
  4141.  
  4142.         SLItem := pNTX_ITEM( pChar(@LeftPage.FPage) + LeftPage.FPage.ref[LeftPage.FPage.count]);
  4143.         Move(SLItem.key, LItem.key, SHead.key_size);
  4144.         LItem.rec_no := SLItem.rec_no;
  4145.  
  4146.         SavePage(Parent);
  4147.         SavePage(CurrentPage);
  4148.         SavePage(LeftPage);
  4149.  
  4150.       end;
  4151.     end;
  4152.     Item := pNTX_ITEM( pChar(@CurrentPage.Fpage) + CurrentPage.Fpage.ref[CurrentPage.Fpage.count]);
  4153.     if Item.page <> 0 then
  4154.       Normalize(Item.page, CurrentPage);
  4155.     CurrentPage.Free;
  4156.   end;
  4157.  
  4158. begin
  4159.   LeftPage := TVKNTXBuffer.Create;
  4160.   try
  4161.     Normalize(SHead.root, nil);
  4162.   finally
  4163.     LeftPage.Free;
  4164.   end;
  4165. end;
  4166.  
  4167. procedure TVKNTXCompactIndex.LinkRest;
  4168. var
  4169.   page: pNTX_BUFFER;
  4170.   i: pNTX_ITEM;
  4171. begin
  4172.   Inc(cur_lev);
  4173.   if (cur_lev <= max_lev) then begin
  4174.     page := pNTX_BUFFER(@levels[cur_lev]);
  4175.     i := pNTX_ITEM(pChar(page) + page.ref[page.count]);
  4176.     i.page := SubOffSet;
  4177.     if Handler = nil then
  4178.       SubOffSet := FileSeek(FHndl, 0, 2)
  4179.     else
  4180.       SubOffSet := Handler.Seek(0, 2);
  4181.     if Crypt then begin
  4182.       CryptPage := page^;
  4183.       TVKDBFNTX(OwnerTable).Crypt.Encrypt(SubOffSet, @CryptPage, SizeOf(NTX_BUFFER));
  4184.       if Handler = nil then
  4185.         SysUtils.FileWrite(FHndl, CryptPage, SizeOf(NTX_BUFFER))
  4186.       else
  4187.         Handler.Write(CryptPage, SizeOf(NTX_BUFFER));
  4188.     end else begin
  4189.       if Handler = nil then
  4190.         SysUtils.FileWrite(FHndl, page^, SizeOf(NTX_BUFFER))
  4191.       else
  4192.         Handler.Write(page^, SizeOf(NTX_BUFFER));
  4193.     end;
  4194.     LinkRest;
  4195.   end;
  4196.   Dec(cur_lev);
  4197. end;
  4198.  
  4199. procedure TVKNTXCompactIndex.AddItem(item: pNTX_ITEM);
  4200. var
  4201.   page: pNTX_BUFFER;
  4202.   i: pNTX_ITEM;
  4203. begin
  4204.   Inc(cur_lev);
  4205.   if (cur_lev > max_lev) then NewPage(cur_lev);
  4206.   page := pNTX_BUFFER(@levels[cur_lev]);
  4207.   if page.count = SHead.max_item then begin
  4208.     i := pNTX_ITEM(pChar(page) + page.ref[page.count]);
  4209.     if cur_lev <> 0  then
  4210.       i.page := item.page
  4211.     else
  4212.       i.page := 0;
  4213.     if Crypt then begin
  4214.       CryptPage := page^;
  4215.       TVKDBFNTX(OwnerTable).Crypt.Encrypt(SubOffSet, @CryptPage, SizeOf(NTX_BUFFER));
  4216.       if Handler = nil then
  4217.         SysUtils.FileWrite(FHndl, CryptPage, SizeOf(NTX_BUFFER))
  4218.       else
  4219.         Handler.Write(CryptPage, SizeOf(NTX_BUFFER));
  4220.     end else begin
  4221.       if Handler = nil then
  4222.         SysUtils.FileWrite(FHndl, page^, SizeOf(NTX_BUFFER))
  4223.       else
  4224.         Handler.Write(page^, SizeOf(NTX_BUFFER));
  4225.     end;
  4226.     item.page := SubOffSet;
  4227.     Inc(SubOffSet, NTX_PAGE);
  4228.     AddItem(item);
  4229.     page.count := 0;
  4230.   end else begin
  4231.     if ( cur_lev = 0 ) then item.page := 0;
  4232.     Move(item^, (pChar(page) + page.ref[page.count])^, SHead.item_size);
  4233.     page.count := page.count + 1;
  4234.   end;
  4235.   Dec(cur_lev);
  4236. end;
  4237.  
  4238. constructor TVKNTXCompactIndex.Create;
  4239. begin
  4240.   Handler := nil;
  4241.   FHndl := -1;
  4242.   cur_lev := -1;
  4243.   max_lev := -1;
  4244.   SubOffSet := 0;
  4245.   FileName := '';
  4246.   OwnerTable := nil;
  4247.   Crypt := false;
  4248. end;
  4249.  
  4250. destructor TVKNTXCompactIndex.Destroy;
  4251. begin
  4252.   inherited Destroy;
  4253. end;
  4254.  
  4255. { TVKNTXIndexIterator }
  4256.  
  4257. constructor TVKNTXIndexIterator.Create;
  4258. begin
  4259.   Eof := false;
  4260. end;
  4261.  
  4262. destructor TVKNTXIndexIterator.Destroy;
  4263. begin
  4264.   inherited Destroy;
  4265. end;
  4266.  
  4267. { TVKNTXBlockIterator }
  4268.  
  4269. procedure TVKNTXBlockIterator.Close;
  4270. begin
  4271.   VKDBFMemMgr.oMem.FreeMem(p);
  4272.   DeleteFile(FFileName);
  4273. end;
  4274.  
  4275. constructor TVKNTXBlockIterator.Create(FileName: String; key_size, BufSize: Integer);
  4276. begin
  4277.   inherited Create;
  4278.   FFileName := FileName;
  4279.   Fkey_size := key_size;
  4280.   FBufSize := BufSize;
  4281. end;
  4282.  
  4283. destructor TVKNTXBlockIterator.Destroy;
  4284. begin
  4285.   DeleteFile(FFileName);
  4286.   inherited Destroy;
  4287. end;
  4288.  
  4289. procedure TVKNTXBlockIterator.Next;
  4290. var
  4291.   BlockItem: pBLOCK_ITEM;
  4292. begin
  4293.   Inc(i);
  4294.   if i >= p.count then Eof := true else begin
  4295.     item.page := 0;
  4296.     BlockItem := pBLOCK_ITEM(pChar(p) + p.ref[i]);
  4297.     item.rec_no := BlockItem.rec_no;
  4298.     Move(BlockItem.key, item.key, Fkey_size);
  4299.   end;
  4300. end;
  4301.  
  4302. procedure TVKNTXBlockIterator.Open;
  4303. var
  4304.   BlockItem: pBLOCK_ITEM;
  4305. begin
  4306.   p := VKDBFMemMgr.oMem.GetMem(self, FBufSize);
  4307.   FHndl := FileOpen(FFileName, fmOpenRead or fmShareExclusive);
  4308.   if FHndl > 0 then begin
  4309.     SysUtils.FileRead(FHndl, p^, FBufSize);
  4310.     SysUtils.FileClose(FHndl);
  4311.     i := 0;
  4312.     if p.count = 0 then Eof := true;
  4313.     item.page := 0;
  4314.     BlockItem := pBLOCK_ITEM(pChar(p) + p.ref[i]);
  4315.     item.rec_no := BlockItem.rec_no;
  4316.     Move(BlockItem.key, item.key, Fkey_size);
  4317.   end else
  4318.     raise Exception.Create('TVKNTXBlockIterator.Open: Open Error "' + FFileName + '"');
  4319. end;
  4320.  
  4321. { TVKNTXIterator }
  4322.  
  4323. procedure TVKNTXIterator.Close;
  4324. begin
  4325.   FileClose(FHndl);
  4326.   VKDBFMemMgr.oMem.FreeMem(levels);
  4327.   DeleteFile(FFileName);
  4328. end;
  4329.  
  4330. constructor TVKNTXIterator.Create(FileName: String);
  4331. begin
  4332.   inherited Create;
  4333.   FFileName := FileName;
  4334. end;
  4335.  
  4336. destructor TVKNTXIterator.Destroy;
  4337. begin
  4338.   DeleteFile(FFileName);
  4339.   inherited Destroy;
  4340. end;
  4341.  
  4342. procedure TVKNTXIterator.Next;
  4343. var
  4344.   page: pNTX_BUFFER;
  4345.   i: pNTX_ITEM;
  4346. begin
  4347.   Inc(indexes[cur_lev]);
  4348.   repeat
  4349.     page := pNTX_BUFFER(@levels^[cur_lev]);
  4350.     i := pNTX_ITEM(pChar(page) + page.ref[indexes[cur_lev]]);
  4351.     if i.page <> 0 then begin
  4352.       Inc(cur_lev);
  4353.       indexes[cur_lev] := 0;
  4354.       SysUtils.FileSeek(FHndl, i.page, 0);
  4355.       SysUtils.FileRead(FHndl, levels^[cur_lev], SizeOf(NTX_BUFFER));
  4356.     end;
  4357.   until i.page = 0;
  4358.   repeat
  4359.     if indexes[cur_lev] = page.count then begin
  4360.       Dec(cur_lev);
  4361.       if cur_lev = -1 then begin
  4362.         Eof := true;
  4363.         Break;
  4364.       end else begin
  4365.         page := pNTX_BUFFER(@levels^[cur_lev]);
  4366.         i := pNTX_ITEM(pChar(page) + page.ref[indexes[cur_lev]]);
  4367.         item.page := 0;
  4368.         item.rec_no := i.rec_no;
  4369.         Move(i.key, item.key, SHead.key_size);
  4370.       end;
  4371.     end else begin
  4372.       item.page := 0;
  4373.       item.rec_no := i.rec_no;
  4374.       Move(i.key, item.key, SHead.key_size);
  4375.     end;
  4376.   until indexes[cur_lev] < page.count;
  4377. end;
  4378.  
  4379. procedure TVKNTXIterator.Open;
  4380. var
  4381.   page: pNTX_BUFFER;
  4382.   i: pNTX_ITEM;
  4383. begin
  4384.   levels := VKDBFMemMgr.oMem.GetMem(self, MAX_LEV_BTREE * SizeOf(NTX_BUFFER));
  4385.   FHndl := FileOpen(FFileName, fmOpenRead or fmShareExclusive);
  4386.   if FHndl > 0 then begin
  4387.     SysUtils.FileRead(FHndl, SHead, SizeOf(NTX_HEADER));
  4388.     cur_lev := 0;
  4389.     SysUtils.FileSeek(FHndl, SHead.root, 0);
  4390.     SysUtils.FileRead(FHndl, levels^[cur_lev], SizeOf(NTX_BUFFER));
  4391.     Eof := false;
  4392.     indexes[cur_lev] := 0;
  4393.     if levels^[cur_lev].count = 0 then Eof := true;
  4394.     if not Eof then begin
  4395.       repeat
  4396.         page := pNTX_BUFFER(@levels^[cur_lev]);
  4397.         i := pNTX_ITEM(pChar(page) + page.ref[indexes[cur_lev]]);
  4398.         if i.page <> 0 then begin
  4399.           Inc(cur_lev);
  4400.           indexes[cur_lev] := 0;
  4401.           SysUtils.FileSeek(FHndl, i.page, 0);
  4402.           SysUtils.FileRead(FHndl, levels^[cur_lev], SizeOf(NTX_BUFFER));
  4403.         end;
  4404.       until i.page = 0;
  4405.       item.page := 0;
  4406.       item.rec_no := i.rec_no;
  4407.       Move(i.key, item.key, SHead.key_size);
  4408.     end;
  4409.   end else
  4410.     raise Exception.Create('TVKNTXIterator.Open: Open Error "' + FFileName + '"');
  4411. end;
  4412.  
  4413. { TVKNTXBag }
  4414.  
  4415. procedure TVKNTXBag.Close;
  4416. begin
  4417.   Handler.Close;
  4418. end;
  4419.  
  4420. constructor TVKNTXBag.Create(Collection: TCollection);
  4421. begin
  4422.   inherited Create(Collection);
  4423. end;
  4424.  
  4425. function TVKNTXBag.CreateBag: boolean;
  4426. begin
  4427.   if ( StorageType = pstOuterStream ) and ( OuterStream = nil ) then
  4428.     raise Exception.Create('TVKNTXBag.CreateBag: StorageType = pstOuterStream but OuterStream = nil!');
  4429.   Handler.FileName := IndexFileName;
  4430.   Handler.AccessMode.AccessMode := TVKDBFNTX(OwnerTable).AccessMode.AccessMode;
  4431.   Handler.ProxyStreamType := StorageType;
  4432.   Handler.OuterStream := OuterStream;
  4433.   Handler.OnLockEvent := TVKDBFNTX(OwnerTable).OnOuterStreamLock;
  4434.   Handler.OnUnlockEvent := TVKDBFNTX(OwnerTable).OnOuterStreamUnlock;
  4435.   Handler.CreateProxyStream;
  4436.   Result := Handler.IsOpen;
  4437. end;
  4438.  
  4439. destructor TVKNTXBag.Destroy;
  4440. begin
  4441.   inherited Destroy;
  4442. end;
  4443.  
  4444. procedure TVKNTXBag.FillHandler;
  4445. begin
  4446.   Handler.FileName := IndexFileName;
  4447.   Handler.AccessMode.AccessMode := TVKDBFNTX(OwnerTable).AccessMode.AccessMode;
  4448.   Handler.ProxyStreamType := StorageType;
  4449.   Handler.OuterStream := OuterStream;
  4450.   Handler.OnLockEvent := TVKDBFNTX(OwnerTable).OnOuterStreamLock;
  4451.   Handler.OnUnlockEvent := TVKDBFNTX(OwnerTable).OnOuterStreamUnlock;
  4452. end;
  4453.  
  4454. function TVKNTXBag.IsOpen: boolean;
  4455. begin
  4456.   Result := Handler.IsOpen;
  4457. end;
  4458.  
  4459. function TVKNTXBag.Open: boolean;
  4460. begin
  4461.   if ( StorageType = pstOuterStream ) and ( OuterStream = nil ) then
  4462.     raise Exception.Create('TVKNTXBag.Open: StorageType = pstOuterStream but OuterStream = nil!');
  4463.   Handler.FileName := IndexFileName;
  4464.   Handler.AccessMode.AccessMode := TVKDBFNTX(OwnerTable).AccessMode.AccessMode;
  4465.   Handler.ProxyStreamType := StorageType;
  4466.   Handler.OuterStream := OuterStream;
  4467.   Handler.OnLockEvent := TVKDBFNTX(OwnerTable).OnOuterStreamLock;
  4468.   Handler.OnUnlockEvent := TVKDBFNTX(OwnerTable).OnOuterStreamUnlock;
  4469.   Handler.Open;
  4470.   if not Handler.IsOpen then
  4471.     raise Exception.Create('TVKNTXBag.Open: Open error "' + IndexFileName + '"')
  4472.   else begin
  4473.     if Orders.Count = 0 then Orders.Add;
  4474.     with Orders.Items[0] as TVKNTXOrder do begin
  4475.       Handler.Seek(0, 0);
  4476.       Handler.Read(FHead, SizeOf(NTX_HEADER));
  4477.       //FLastOffset := Handler.Seek(0, 2);
  4478.  
  4479.       if FHead.order <> '' then
  4480.         TVKNTXOrder(Orders.Items[0]).Name := FHead.Order
  4481.       else
  4482.         TVKNTXOrder(Orders.Items[0]).Name := ChangeFileExt(ExtractFileName(IndexFileName), '');
  4483.  
  4484.       KeyExpresion := FHead.key_expr;
  4485.       ForExpresion := FHead.for_expr;
  4486.       Unique := (FHead.unique <> #0);
  4487.       Desc := (FHead.Desc <> #0);
  4488.  
  4489.     end;
  4490.   end;
  4491.   Result := Handler.IsOpen;
  4492. end;
  4493.  
  4494. { TVKNTXOrder }
  4495.  
  4496. constructor TVKNTXOrder.Create(Collection: TCollection);
  4497. begin
  4498.   inherited Create(Collection);
  4499.   if Index > 0 then
  4500.     raise Exception.Create('TVKNTXOrder.Create: NTX bag can not content more then one order!');
  4501. end;
  4502.  
  4503. function TVKNTXOrder.CreateOrder: boolean;
  4504. var
  4505.   oBag: TVKNTXBag;
  4506.   FKeyParser: TVKDBFExprParser;
  4507.   FieldMap: TFieldMap;
  4508.   IndAttr: TIndexAttributes;
  4509.   page: NTX_BUFFER;
  4510.   item_off: WORD;
  4511.   i: Integer;
  4512.  
  4513.   function EvaluteKeyExpr: String;
  4514.   begin
  4515.     if Assigned(OnEvaluteKey) then
  4516.       OnEvaluteKey(self, Result)
  4517.     else
  4518.       Result := FKeyParser.EvaluteKey;
  4519.   end;
  4520.  
  4521. begin
  4522.  
  4523.   oBag := TVKNTXBag(TVKDBFOrders(Collection).Owner);
  4524.  
  4525.   FKeyParser := TVKDBFExprParser.Create(TVKDBFNTX(oBag.OwnerTable), '', [], [poExtSyntax], '', nil, FieldMap);
  4526.   FKeyParser.IndexKeyValue := true;
  4527.  
  4528.   if ClipperVer in [v500, v501] then
  4529.     FHead.sign := 6
  4530.   else
  4531.     FHead.sign := 7;
  4532.   FHead.version := 1;
  4533.   FHead.root := NTX_PAGE;
  4534.   FHead.next_page := 0;
  4535.  
  4536.   if Assigned(OnCreateIndex) then begin
  4537.     OnCreateIndex(self, IndAttr);
  4538.     FHead.key_size := IndAttr.key_size;
  4539.     FHead.key_dec := IndAttr.key_dec;
  4540.     System.Move(pChar(IndAttr.key_expr)^, FHead.key_expr, Length(IndAttr.key_expr));
  4541.     FHead.key_expr[Length(IndAttr.key_expr)] := #0;
  4542.     System.Move(pChar(IndAttr.for_expr)^, FHead.for_expr, Length(IndAttr.for_expr));
  4543.     FHead.for_expr[Length(IndAttr.for_expr)] := #0;
  4544.   end else begin
  4545.     FKeyParser.SetExprParams1(KeyExpresion, [], [poExtSyntax], '');
  4546.     EvaluteKeyExpr;
  4547.     FHead.key_size := Length(FKeyParser.Key);
  4548.     FHead.key_dec := FKeyParser.Prec;
  4549.     System.Move(pChar(KeyExpresion)^, FHead.key_expr, Length(KeyExpresion));
  4550.     FHead.key_expr[Length(KeyExpresion)] := #0;
  4551.     System.Move(pChar(ForExpresion)^, FHead.for_expr, Length(ForExpresion));
  4552.     FHead.for_expr[Length(ForExpresion)] := #0;
  4553.   end;
  4554.  
  4555.   FHead.item_size := FHead.key_size + 8;
  4556.   FHead.max_item := (NTX_PAGE - FHead.item_size - 4) div (FHead.item_size + 2);
  4557.   FHead.half_page := FHead.max_item div 2;
  4558.   FHead.max_item := FHead.half_page * 2;
  4559.  
  4560.   FHead.reserv1 := #0;
  4561.   FHead.reserv3 := #0;
  4562.  
  4563.   System.Move(pChar(Name)^, FHead.order, Length(Name));
  4564.   if Desc then FHead.Desc := #1;
  4565.   if Unique then FHead.Unique := #1;
  4566.  
  4567.   oBag.NTXHandler.Seek(0, 0);
  4568.   oBag.NTXHandler.Write(FHead, SizeOf(NTX_HEADER));
  4569.  
  4570.   page.count := 0;
  4571.   item_off := ( FHead.max_item * 2 ) + 4;
  4572.   for i := 0 to FHead.max_item do begin
  4573.     page.ref[i] := item_off;
  4574.     item_off := item_off + FHead.item_size;
  4575.   end;
  4576.   pNTX_ITEM(pChar(@page) + page.ref[0]).page := 0;
  4577.  
  4578.   oBag.NTXHandler.Write(page, SizeOf(NTX_BUFFER));
  4579.  
  4580.   oBag.NTXHandler.SetEndOfFile;
  4581.  
  4582.   FKeyParser.Free;
  4583.  
  4584.   Result := True;
  4585.  
  4586. end;
  4587.  
  4588. destructor TVKNTXOrder.Destroy;
  4589. begin
  4590.   inherited Destroy;
  4591. end;
  4592.  
  4593. end.
  4594.