path: root/fpcsrc/packages/fcl-db/src/dbase/dbf_idxfile.pas

unit dbf_idxfile;

interface

{$I dbf_common.inc}

uses
{$ifdef WINDOWS}
  Windows,
{$else}
{$ifdef KYLIX}
  Libc,
{$endif}
  Types, dbf_wtil,
{$endif}
  SysUtils,
  Classes,
  db,
  dbf_pgfile,
{$ifdef USE_CACHE}
  dbf_pgcfile,
{$endif}
  dbf_parser,
  dbf_prsdef,
  dbf_cursor,
  dbf_collate,
  dbf_common;

{$ifdef _DEBUG}
{$define TDBF_INDEX_CHECK}
{$endif}
{$ifdef _ASSERTS}
{$define TDBF_INDEX_CHECK}
{$endif}

const
  MaxIndexes = 47;

type
  TIndexPage = class;
  TIndexTag = class;

  TIndexUpdateMode = (umAll, umCurrent);
  TLocaleError = (leNone, leUnknown, leTableIndexMismatch, leNotAvailable);
  TLocaleSolution = (lsNotOpen, lsNoEdit, lsBinary);
  TIndexUniqueType = (iuNormal, iuUnique, iuDistinct);
  TIndexModifyMode = (mmNormal, mmDeleteRecall);

  TDbfLocaleErrorEvent = procedure(var Error: TLocaleError; var Solution: TLocaleSolution) of object;
  TDbfCompareKeysEvent = function(Key1, Key2: PChar): Integer of object;

  PDouble = ^Double;
  PInteger = ^Integer;

//===========================================================================
  TDbfIndexDef = class;
  TDbfIndexDef = class(TCollectionItem)
  protected
    FIndexName: string;
    FExpression: string;
    FOptions: TIndexOptions;
    FTemporary: Boolean;          // added at runtime

    procedure SetIndexName(NewName: string);
    procedure SetExpression(NewField: string);
  public
    constructor Create(ACollection: TCollection); override;
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;
    property Temporary: Boolean read FTemporary write FTemporary;
    property Name: string read FIndexName write SetIndexName;
    property Expression: string read FExpression write SetExpression;
  published
    property IndexFile: string read FIndexName write SetIndexName;
    property SortField: string read FExpression write SetExpression;
    property Options: TIndexOptions read FOptions write FOptions;
  end;

  TDbfIndexParser = class(TDbfParser)
  protected
    FResultLen: Integer; 

    procedure ValidateExpression(AExpression: string); override;
  public
    property ResultLen: Integer read FResultLen;
  end;
//===========================================================================
  TIndexFile = class;
  TIndexPageClass = class of TIndexPage;

  TIndexPage = class(TObject)
  protected
    FIndexFile: TIndexFile;
    FLowerPage: TIndexPage;
    FUpperPage: TIndexPage;
    FPageBuffer: Pointer;
    FEntry: Pointer;
    FEntryNo: Integer;
    FLockCount: Integer;
    FModified: Boolean;
    FPageNo: Integer;
    FWeight: Integer;

    // bracket props
    FLowBracket: Integer;               //  = FLowIndex if FPageNo = FLowPage
    FLowIndex: Integer;
    FLowPage: Integer;
    FLowPageTemp: Integer;
    FHighBracket: Integer;              //  = FHighIndex if FPageNo = FHighPage
    FHighIndex: Integer;
    FHighPage: Integer;
    FHighPageTemp: Integer;

    procedure LocalInsert(RecNo: Integer; Buffer: PChar; LowerPageNo: Integer);
    procedure LocalDelete;
    procedure Delete;

    procedure SyncLowerPage;
    procedure WritePage;
    procedure Split;
    procedure LockPage;
    procedure UnlockPage;

    function RecurPrev: Boolean;
    function RecurNext: Boolean;
    procedure RecurFirst;
    procedure RecurLast;

    procedure SetEntry(RecNo: Integer; AKey: PChar; LowerPageNo: Integer);
    procedure SetEntryNo(value: Integer);
    procedure SetPageNo(NewPageNo: Integer);
    procedure SetLowPage(NewPage: Integer);
    procedure SetHighPage(NewPage: Integer);
    procedure SetUpperPage(NewPage: TIndexPage);
    procedure UpdateBounds(IsInnerNode: Boolean);

  protected
    function GetEntry(AEntryNo: Integer): Pointer; virtual; abstract;
    function GetLowerPageNo: Integer; virtual; abstract;
    function GetKeyData: PChar; virtual; abstract;
    function GetNumEntries: Integer; virtual; abstract;
    function GetKeyDataFromEntry(AEntry: Integer): PChar; virtual; abstract;
    function GetRecNo: Integer; virtual; abstract;
    function GetIsInnerNode: Boolean; virtual; abstract;
    procedure IncNumEntries; virtual; abstract;
    procedure SetNumEntries(NewNum: Integer); virtual; abstract;
    procedure SetRecLowerPageNo(NewRecNo, NewPageNo: Integer); virtual; abstract;
    procedure SetRecLowerPageNoOfEntry(AEntry, NewRecNo, NewPageNo: Integer); virtual; abstract;
{$ifdef TDBF_UPDATE_FIRST_LAST_NODE}
    procedure SetPrevBlock(NewBlock: Integer); virtual;
{$endif}

  public
    constructor Create(Parent: TIndexFile);
    destructor Destroy; override;

    function FindNearest(ARecNo: Integer): Integer;
    function PhysicalRecNo: Integer;
    function MatchKey: Integer;
    procedure GotoInsertEntry;

    procedure Clear;
    procedure GetNewPage;
    procedure Modified;
    procedure RecalcWeight;
    procedure UpdateWeight;
    procedure Flush;
    procedure SaveBracket;
    procedure RestoreBracket;

    property Key: PChar read GetKeyData;
    property Entry: Pointer read FEntry;
    property EntryNo: Integer read FEntryNo write SetEntryNo;
    property IndexFile: TIndexFile read FIndexFile;
    property UpperPage: TIndexPage read FUpperPage write SetUpperPage;
    property LowerPage: TIndexPage read FLowerPage;
//    property LowerPageNo: Integer read GetLowerPageNo;        // never used
    property PageBuffer: Pointer read FPageBuffer;
    property PageNo: Integer read FPageNo write SetPageNo;
    property Weight: Integer read FWeight;

    property NumEntries: Integer read GetNumEntries;
    property HighBracket: Integer read FHighBracket write FHighBracket;
    property HighIndex: Integer read FHighIndex;
    property HighPage: Integer read FHighPage write SetHighPage;
    property LowBracket: Integer read FLowBracket write FLowBracket;
    property LowIndex: Integer read FLowIndex;
    property LowPage: Integer read FLowPage write SetLowPage;
  end;
//===========================================================================
  TIndexTag = class(TObject)
  private
    FTag: Pointer;
  protected
    function  GetHeaderPageNo: Integer; virtual; abstract;
    function  GetTagName: string; virtual; abstract;
    function  GetKeyFormat: Byte; virtual; abstract;
    function  GetForwardTag1: Byte; virtual; abstract;
    function  GetForwardTag2: Byte; virtual; abstract;
    function  GetBackwardTag: Byte; virtual; abstract;
    function  GetReserved: Byte; virtual; abstract;
    function  GetKeyType: Char; virtual; abstract;
    procedure SetHeaderPageNo(NewPageNo: Integer); virtual; abstract;
    procedure SetTagName(NewName: string); virtual; abstract;
    procedure SetKeyFormat(NewFormat: Byte); virtual; abstract;
    procedure SetForwardTag1(NewTag: Byte); virtual; abstract;
    procedure SetForwardTag2(NewTag: Byte); virtual; abstract;
    procedure SetBackwardTag(NewTag: Byte); virtual; abstract;
    procedure SetReserved(NewReserved: Byte); virtual; abstract;
    procedure SetKeyType(NewType: Char); virtual; abstract;
  public
    property HeaderPageNo: Integer read GetHeaderPageNo write SetHeaderPageNo;
    property TagName: string read GetTagName write SetTagName;
    property KeyFormat:   Byte read GetKeyFormat   write SetKeyFormat;
    property ForwardTag1: Byte read GetForwardTag1 write SetForwardTag1;
    property ForwardTag2: Byte read GetForwardTag2 write SetForwardTag2;
    property BackwardTag: Byte read GetBackwardTag write SetBackwardTag;
    property Reserved: Byte read GetReserved write SetReserved;
    property KeyType: Char read GetKeyType write SetKeyType;
    property Tag: Pointer read FTag write FTag;
  end;
//===========================================================================
{$ifdef USE_CACHE}
  TIndexFile = class(TCachedFile)
{$else}
  TIndexFile = class(TPagedFile)
{$endif}
  protected
    FIndexName: string;
    FLastError: string;
    FParsers: array[0..MaxIndexes-1] of TDbfIndexParser;
    FIndexHeaders: array[0..MaxIndexes-1] of Pointer;
    FIndexHeaderModified: array[0..MaxIndexes-1] of Boolean;
    FIndexHeader: Pointer;
    FIndexVersion: TXBaseVersion;
    FRoots: array[0..MaxIndexes-1] of TIndexPage;
    FLeaves: array[0..MaxIndexes-1] of TIndexPage;
    FCurrentParser: TDbfIndexParser;
    FRoot: TIndexPage;
    FLeaf: TIndexPage;
    FMdxTag: TIndexTag;
    FTempMdxTag: TIndexTag;
    FEntryHeaderSize: Integer;
    FPageHeaderSize: Integer;
    FTagSize: Integer;
    FTagOffset: Integer;
    FHeaderPageNo: Integer;
    FSelectedIndex: Integer;
    FRangeIndex: Integer;
    FIsDescending: Boolean;
    FUniqueMode: TIndexUniqueType;
    FModifyMode: TIndexModifyMode;
    FHeaderLocked: Integer;   // used to remember which header page we have locked
    FKeyBuffer: array[0..100] of Char;
    FLowBuffer: array[0..100] of Char;
    FHighBuffer: array[0..100] of Char;
    FEntryBof: Pointer;
    FEntryEof: Pointer;
    FDbfFile: Pointer;
    FCanEdit: Boolean;
    FOpened: Boolean;
    FRangeActive: Boolean;
    FUpdateMode: TIndexUpdateMode;
    FUserKey: PChar;        // find / insert key
    FUserRecNo: Integer;    // find / insert recno
    FUserBCD: array[0..10] of Byte;
    FUserNumeric: Double;
    FForceClose: Boolean;
    FForceReadOnly: Boolean;
    FCodePage: Integer;
    FCollation: PCollationTable;
    FCompareKeys: TDbfCompareKeysEvent;
    FOnLocaleError: TDbfLocaleErrorEvent;

    function  GetNewPageNo: Integer;
    procedure TouchHeader(AHeader: Pointer);
    function  CreateTempFile(BaseName: string): TPagedFile;
    procedure ConstructInsertErrorMsg;
    procedure WriteIndexHeader(AIndex: Integer);
    procedure SelectIndexVars(AIndex: Integer);
    procedure CalcKeyProperties;
    procedure UpdateIndexProperties;
    procedure ClearRoots;
    function  CalcTagOffset(AIndex: Integer): Pointer;

    function  FindKey(AInsert: boolean): Integer;
    function  InsertKey(Buffer: TRecordBuffer): Boolean;
    procedure DeleteKey(Buffer: TRecordBuffer);
    function  InsertCurrent: Boolean;
    procedure DeleteCurrent;
    function  UpdateCurrent(PrevBuffer, NewBuffer: TRecordBuffer): Boolean;
    function  UpdateIndex(Index: Integer; PrevBuffer, NewBuffer: TRecordBuffer): Boolean;
    procedure ReadIndexes;
    procedure Resync(Relative: boolean);
    procedure ResyncRoot;
    procedure ResyncTree;
    procedure ResyncRange(KeepPosition: boolean);
    procedure ResetRange;
    procedure SetBracketLow;
    procedure SetBracketHigh;

    procedure WalkFirst;
    procedure WalkLast;
    function  WalkPrev: boolean;
    function  WalkNext: boolean;
    
    function  CompareKeysNumericNDX(Key1, Key2: PChar): Integer;
    function  CompareKeysNumericMDX(Key1, Key2: PChar): Integer;
    function  CompareKeysString(Key1, Key2: PChar): Integer;

    // property functions
    function  GetName: string;
    function  GetDbfLanguageId: Byte;
    function  GetKeyLen: Integer;
    function  GetKeyType: Char;
//    function  GetIndexCount Integer;
    function  GetExpression: string;
    function  GetPhysicalRecNo: Integer;
    function  GetSequentialRecNo: Integer;
    function  GetSequentialRecordCount: Integer;
    procedure SetSequentialRecNo(RecNo: Integer);
    procedure SetPhysicalRecNo(RecNo: Integer);
    procedure SetUpdateMode(NewMode: TIndexUpdateMode);
    procedure SetIndexName(const AIndexName: string);

  public
    constructor Create(ADbfFile: Pointer);
    destructor Destroy; override;

    procedure Open;
    procedure Close;

    procedure Clear;
    procedure Flush; override;
    procedure ClearIndex;
    procedure AddNewLevel;
    procedure UnlockHeader;
    procedure InsertError;
    function  Insert(RecNo: Integer; Buffer:TRecordBuffer ): Boolean;
    function  Update(RecNo: Integer; PrevBuffer, NewBuffer: TRecordBuffer): Boolean;
    procedure Delete(RecNo: Integer; Buffer: TRecordBuffer);
    function  CheckKeyViolation(Buffer: TRecordBuffer): Boolean;
    procedure RecordDeleted(RecNo: Integer; Buffer: TRecordBuffer);
    function  RecordRecalled(RecNo: Integer; Buffer: TRecordBuffer): Boolean;
    procedure DeleteIndex(const AIndexName: string);
    procedure RepageFile;
    procedure CompactFile;
    procedure PrepareRename(NewFileName: string);

    procedure CreateIndex(FieldDesc, TagName: string; Options: TIndexOptions);
    function  ExtractKeyFromBuffer(Buffer: TRecordBuffer): PChar;
    function  SearchKey(Key: PChar; SearchType: TSearchKeyType): Boolean;
    function  Find(RecNo: Integer; Buffer: PChar): Integer;
    function  IndexOf(const AIndexName: string): Integer;
    procedure DisableRange;
    procedure EnableRange;

    procedure GetIndexNames(const AList: TStrings);
    procedure GetIndexInfo(const AIndexName: string; IndexDef: TDbfIndexDef);
    procedure WriteHeader; override;
    procedure WriteFileHeader;

    procedure First;
    procedure Last;
    function  Next: Boolean;
    function  Prev: Boolean;

    procedure SetRange(LowRange, HighRange: PChar);
    procedure CancelRange;
    function  MatchKey(UserKey: PChar): Integer;
    function  CompareKey(Key: PChar): Integer;
    function  CompareKeys(Key1, Key2: PChar): Integer;
    function  PrepareKey(Buffer: TRecordBuffer; ResultType: TExpressionType): PChar;

    property KeyLen: Integer read GetKeyLen;
    property IndexVersion: TXBaseVersion read FIndexVersion;
    property EntryHeaderSize: Integer read FEntryHeaderSize;
    property KeyType: Char read GetKeyType;

    property SequentialRecordCount: Integer read GetSequentialRecordCount;
    property SequentialRecNo: Integer read GetSequentialRecNo write SetSequentialRecNo;
    property PhysicalRecNo: Integer read GetPhysicalRecNo write SetPhysicalRecNo;
    property HeaderPageNo: Integer read FHeaderPageNo;

    property IndexHeader: Pointer read FIndexHeader;
    property EntryBof: Pointer read FEntryBof;
    property EntryEof: Pointer read FEntryEof;
    property UniqueMode: TIndexUniqueType read FUniqueMode;
    property IsDescending: Boolean read FIsDescending;

    property UpdateMode: TIndexUpdateMode read FUpdateMode write SetUpdateMode;
    property IndexName: string read FIndexName write SetIndexName;
    property Expression: string read GetExpression;
//    property Count: Integer read GetIndexCount;

    property ForceClose: Boolean read FForceClose;
    property ForceReadOnly: Boolean read FForceReadOnly;
    property CodePage: Integer read FCodePage write FCodePage;

    property OnLocaleError: TDbfLocaleErrorEvent read FOnLocaleError write FOnLocaleError;
  end;

//------------------------------------------------------------------------------
implementation

uses
  dbf_dbffile,
  dbf_fields,
  dbf_str,
  dbf_prssupp,
  dbf_prscore,
  dbf_lang;

const
  RecBOF = 0;
  RecEOF = MaxInt;

  lcidBinary = $0A03;

  KeyFormat_Expression = $00;
  KeyFormat_Data       = $10;

  KeyFormat_Descending = $08;
  KeyFormat_String     = $10;
  KeyFormat_Distinct   = $20;
  KeyFormat_Unique     = $40;

  Unique_None          = $00;
  Unique_Unique        = $01;
  Unique_Distinct      = $21;

type

  TLCIDList = class(TList)
  public
    constructor Create;

    procedure Enumerate;
  end;

  PMdxHdr = ^rMdxHdr;
  rMdxHdr = record
    MdxVersion : Byte;     // 0
    Year       : Byte;     // 1
    Month      : Byte;     // 2
    Day        : Byte;     // 3
    FileName   : array[0..15] of Char;   // 4..19
    BlockSize  : Word;     // 20..21
    BlockAdder : Word;     // 22..23
    ProdFlag   : Byte;     // 24
    NumTags    : Byte;     // 25
    TagSize    : Byte;     // 26
    Dummy1     : Byte;     // 27
    TagsUsed   : Word;     // 28..29
    Dummy2     : Byte;     // 30
    Language   : Byte;     // 31
    NumPages   : Integer;  // 32..35
    FreePage   : Integer;  // 36..39
    BlockFree  : Integer;  // 40..43
    UpdYear    : Byte;     // 44
    UpdMonth   : Byte;     // 45
    UpdDay     : Byte;     // 46
    Reserved   : array[0..481] of Byte;  // 47..528
    TagFlag    : Byte;     // 529                   // dunno what this means but it ought to be 1  :-)
  end;

  // Tags -> I don't know what to with them
  // KeyType -> Variable position, db7 different from db4

  PMdx4Tag = ^rMdx4Tag;
  rMdx4Tag = record
    HeaderPageNo   : Integer;      // 0..3
    TagName        : array [0..10] of Char;  // 4..14 of Byte
    KeyFormat      : Byte;         // 15     00h: Calculated
                                   //        10h: Data Field
    ForwardTag1    : Byte;         // 16
    ForwardTag2    : Byte;         // 17
    BackwardTag    : Byte;         // 18
    Reserved       : Byte;         // 19
    KeyType        : Char;         // 20     C : Character
                                   //        N : Numerical
                                   //        D : Date
  end;

  PMdx7Tag = ^rMdx7Tag;
  rMdx7Tag = record
    HeaderPageNo   : Integer;      // 0..3
    TagName        : array [0..32] of Char;  // 4..36 of Byte
    KeyFormat      : Byte;         // 37     00h: Calculated
                                   //        10h: Data Field
    ForwardTag1    : Byte;         // 38
    ForwardTag2    : Byte;         // 39
    BackwardTag    : Byte;         // 40
    Reserved       : Byte;         // 41
    KeyType        : Char;         // 42     C : Character
                                   //        N : Numerical
                                   //        D : Date
  end;

  PIndexHdr = ^rIndexHdr;
  rIndexHdr = record
    RootPage       : Integer;  // 0..3
    NumPages       : Integer;  // 4..7
    KeyFormat      : Byte;     // 8      00h: Right, Left, DTOC
                               //        08h: Descending order
                               //        10h: String
                               //        20h: Distinct
                               //        40h: Unique
    KeyType        : Char;     // 9      C : Character
                               //        N : Numerical
                               //        D : Date
    Dummy          : Word;     // 10..11
    KeyLen         : Word;     // 12..13
    NumKeys        : Word;     // 14..15
    sKeyType       : Word;     // 16..17 00h: DB4: C/N; DB3: C
                               //        01h: DB4: D  ; DB3: N/D
    KeyRecLen      : Word;     // 18..19 Length of key entry in page
    Version        : Word;     // 20..21
    Dummy2         : Byte;     // 22
    Unique         : Byte;     // 23
    KeyDesc        : array [0..219] of Char; // 24..243
    Dummy3         : Byte;     // 244
    ForExist       : Byte;     // 245
    KeyExist       : Byte;     // 246
    FirstNode      : Longint;  // 248..251   first node that contains data
    LastNode       : Longint;  // 252..255   last node that contains data
                               // MDX Header has here a 506 byte block reserved
                               // and then the FILTER expression, which obviously doesn't
                               // fit in a NDX page, so we'll skip it
  end;

  PMdxEntry = ^rMdxEntry;
  rMdxEntry = record
    RecBlockNo: Longint;       // 0..3   either recno or blockno
    KeyData   : Char;          // 4..    first byte of data, context => length
  end;

  PMdxPage = ^rMdxPage;
  rMdxPage = record
    NumEntries : Integer;
    PrevBlock  : Integer;
    FirstEntry : rMdxEntry;
  end;

  PNdxEntry  = ^rNdxEntry;
  rNdxEntry  = record
    LowerPageNo: Integer;      //  0..3 lower page
    RecNo      : Integer;      //  4..7 recno
    KeyData    : Char;
  end;

  PNdxPage  = ^rNdxPage;
  rNdxPage  = record
    NumEntries: Integer;       //  0..3
    FirstEntry: rNdxEntry;
  end;

//---------------------------------------------------------------------------
  TMdxPage = class(TIndexPage)
  protected
    function GetEntry(AEntryNo: Integer): Pointer; override;
    function GetLowerPageNo: Integer; override;
    function GetKeyData: PChar; override;
    function GetNumEntries: Integer; override;
    function GetKeyDataFromEntry(AEntry: Integer): PChar; override;
    function GetRecNo: Integer; override;
    function GetIsInnerNode: Boolean; override;
    procedure IncNumEntries; override;
    procedure SetNumEntries(NewNum: Integer); override;
    procedure SetRecLowerPageNo(NewRecNo, NewPageNo: Integer); override;
    procedure SetRecLowerPageNoOfEntry(AEntry, NewRecNo, NewPageNo: Integer); override;
{$ifdef TDBF_UPDATE_FIRST_LAST_NODE}
    procedure SetPrevBlock(NewBlock: Integer); override;
{$endif}
  end;
//---------------------------------------------------------------------------
  TNdxPage = class(TIndexPage)
  protected
    function GetEntry(AEntryNo: Integer): Pointer; override;
    function GetLowerPageNo: Integer; override;
    function GetKeyData: PChar; override;
    function GetNumEntries: Integer; override;
    function GetKeyDataFromEntry(AEntry: Integer): PChar; override;
    function GetRecNo: Integer; override;
    function GetIsInnerNode: Boolean; override;
    procedure IncNumEntries; override;
    procedure SetNumEntries(NewNum: Integer); override;
    procedure SetRecLowerPageNo(NewRecNo, NewPageNo: Integer); override;
    procedure SetRecLowerPageNoOfEntry(AEntry, NewRecNo, NewPageNo: Integer); override;
  end;
//---------------------------------------------------------------------------
  TMdx4Tag = class(TIndexTag)
  protected
    function  GetHeaderPageNo: Integer; override;
    function  GetTagName: string; override;
    function  GetKeyFormat: Byte; override;
    function  GetForwardTag1: Byte; override;
    function  GetForwardTag2: Byte; override;
    function  GetBackwardTag: Byte; override;
    function  GetReserved: Byte; override;
    function  GetKeyType: Char; override;
    procedure SetHeaderPageNo(NewPageNo: Integer); override;
    procedure SetTagName(NewName: string); override;
    procedure SetKeyFormat(NewFormat: Byte); override;
    procedure SetForwardTag1(NewTag: Byte); override;
    procedure SetForwardTag2(NewTag: Byte); override;
    procedure SetBackwardTag(NewTag: Byte); override;
    procedure SetReserved(NewReserved: Byte); override;
    procedure SetKeyType(NewType: Char); override;
  end;
//---------------------------------------------------------------------------
  TMdx7Tag = class(TIndexTag)
    function  GetHeaderPageNo: Integer; override;
    function  GetTagName: string; override;
    function  GetKeyFormat: Byte; override;
    function  GetForwardTag1: Byte; override;
    function  GetForwardTag2: Byte; override;
    function  GetBackwardTag: Byte; override;
    function  GetReserved: Byte; override;
    function  GetKeyType: Char; override;
    procedure SetHeaderPageNo(NewPageNo: Integer); override;
    procedure SetTagName(NewName: string); override;
    procedure SetKeyFormat(NewFormat: Byte); override;
    procedure SetForwardTag1(NewTag: Byte); override;
    procedure SetForwardTag2(NewTag: Byte); override;
    procedure SetBackwardTag(NewTag: Byte); override;
    procedure SetReserved(NewReserved: Byte); override;
    procedure SetKeyType(NewType: Char); override;
  end;

var
  Entry_Mdx_BOF: rMdxEntry;   //(RecBOF, #0);
  Entry_Mdx_EOF: rMdxEntry;   //(RecBOF, #0);
  Entry_Ndx_BOF: rNdxEntry;   //(0, RecBOF, #0);
  Entry_Ndx_EOF: rNdxEntry;   //(0, RecEOF, #0);

  LCIDList: TLCIDList;

procedure IncWordLE(var AVariable: Word; Amount: Integer);
begin
  AVariable := SwapWordLE(SwapWordLE(AVariable) + Amount);
end;

procedure IncIntLE(var AVariable: Integer; Amount: Integer);
begin
  AVariable := SwapIntLE(DWord(Integer(SwapIntLE(AVariable)) + Amount));
end;

//==========================================================
// Locale support for all versions of Delphi/C++Builder

function LocaleCallBack(LocaleString: PChar): Integer; stdcall;
begin
  LCIDList.Add(Pointer(StrToInt('$'+LocaleString)));
  Result := 1;
end;

constructor TLCIDList.Create;
begin
  inherited;
end;

procedure TLCIDList.Enumerate;
begin
  Clear;
  EnumSystemLocales(@LocaleCallBack, LCID_SUPPORTED);
end;

{ TIndexPage }

constructor TIndexPage.Create(Parent: TIndexFile);
begin
  FIndexFile := Parent;
  GetMem(FPageBuffer, FIndexFile.RecordSize);
  FLowerPage := nil;
  Clear;
end;

destructor TIndexPage.Destroy;
begin
  // no locks anymore?
  assert(FLockCount = 0);
  if (FLowerPage<>nil) then
    LowerPage.Free;
  WritePage;
  FreeMemAndNil(FPageBuffer);
  inherited Destroy;
end;

procedure TIndexPage.Clear;
begin
  FillChar(PChar(FPageBuffer)^, FIndexFile.RecordSize, 0);
  FreeAndNil(FLowerPage);
  FUpperPage := nil;
  FPageNo := -1;
  FEntryNo := -1;
  FWeight := 1;
  FModified := false;
  FEntry := FIndexFile.EntryBof;
  FLowPage := 0;
  FHighPage := 0;
  FLowIndex := 0;
  FHighIndex := -1;
  FLockCount := 0;
end;

procedure TIndexPage.GetNewPage;
begin
  FPageNo := FIndexFile.GetNewPageNo;
end;

procedure TIndexPage.Modified;
begin
  FModified := true;
end;

procedure TIndexPage.LockPage;
begin
  // already locked?
  if FLockCount = 0 then
    FIndexFile.LockPage(FPageNo, true);
  // increase count
  inc(FLockCount);
end;

procedure TIndexPage.UnlockPage;
begin
  // still in domain?
  assert(FLockCount > 0);
  dec(FLockCount);
  // unlock?
  if FLockCount = 0 then
  begin
    if FIndexFile.NeedLocks then
      WritePage;
    FIndexFile.UnlockPage(FPageNo);
  end;
end;

procedure TIndexPage.LocalInsert(RecNo: Integer; Buffer: PChar; LowerPageNo: Integer);
  // *) assumes there is at least one entry free
var
  source, dest: Pointer;
  size, lNumEntries, numKeysAvail: Integer;
begin
  // lock page if needed; wait if not available, anyone else updating?
  LockPage;
  // check assertions
  lNumEntries := GetNumEntries;
  // if this is inner node, we can only store one less than max entries
  numKeysAvail := SwapWordLE(PIndexHdr(FIndexFile.IndexHeader)^.NumKeys) - lNumEntries;
  if FLowerPage <> nil then
    dec(numKeysAvail);
  // check if free space
  assert(numKeysAvail > 0);
  // first free up some space
  source := FEntry;
  dest := GetEntry(FEntryNo + 1);
  size := (lNumEntries - EntryNo) * SwapWordLE(PIndexHdr(FIndexFile.IndexHeader)^.KeyRecLen);
  // if 'rightmost' entry, copy pageno too
  if (FLowerPage <> nil) or (numKeysAvail > 1) then
    size := size + FIndexFile.EntryHeaderSize;
  Move(source^, dest^, size);
  // one entry added
  Inc(FHighIndex);
  IncNumEntries;
  // lNumEntries not valid from here
  SetEntry(RecNo, Buffer, LowerPageNo);
  // done!
  UnlockPage;
end;

procedure TIndexPage.LocalDelete;

  function IsOnlyEntry(Page: TIndexPage): boolean;
  begin
    Result := true;
    repeat
      if Page.HighIndex > 0 then
        Result := false;
      Page := Page.UpperPage;
    until not Result or (Page = nil);
  end;

var
  source, dest: Pointer;
  size, lNumEntries: Integer;
begin
  // get num entries
  lNumEntries := GetNumEntries;
  // is this last entry? if it's not move entries after current one
  if EntryNo < FHighIndex then
  begin
    source := GetEntry(EntryNo + 1);
    dest := FEntry;
    size := (FHighIndex - EntryNo) * SwapWordLE(PIndexHdr(FIndexFile.IndexHeader)^.KeyRecLen);
    Move(source^, dest^, size);
  end else
  // no need to update when we're about to remove the only entry
  if (UpperPage <> nil) and (FHighIndex > FLowIndex) then
  begin
    // we are about to remove the last on this page, so update search
    // key data of parent
    EntryNo := FHighIndex - 1;
    UpperPage.SetEntry(0, GetKeyData, FPageNo);
  end;
  // one entry less now
  dec(lNumEntries);
  dec(FHighIndex);
  SetNumEntries(lNumEntries);
  // zero last one out to not get confused about internal or leaf pages
  // note: need to decrease lNumEntries and HighIndex first, otherwise
  //   check on page key consistency will fail
  SetRecLowerPageNoOfEntry(FHighIndex+1, 0, 0);
  // update bracket indexes
  if FHighPage = FPageNo then
    dec(FHighBracket);
  // check if range violated
  if EntryNo > FHighIndex then
    EntryNo := FHighIndex;
  // check if still entries left, otherwise remove page from parent
  if FHighIndex = -1 then
  begin
    if UpperPage <> nil then
      if not IsOnlyEntry(UpperPage) then
        UpperPage.LocalDelete;
  end;
  // go to valid record in lowerpage
  if FLowerPage <> nil then
    SyncLowerPage;
  // flag modified page
  FModified := true;
  // success!
end;

function TIndexPage.MatchKey: Integer;
  // assumes Buffer <> nil
var
  keyData: PChar;
begin
  // get key data
  keyData := GetKeyData;
  // use locale dependant compare
  Result := FIndexFile.CompareKey(keyData);
end;

function TIndexPage.FindNearest(ARecNo: Integer): Integer;
  // pre:
  //  assumes Key <> nil
  //  assumes FLowIndex <= FHighIndex + 1
  //  ARecNo = -2 -> search first key matching Key
  //  ARecNo = -3 -> search first key greater than Key
  //  ARecNo >  0 -> search key matching Key and its recno = ARecNo
  // post:
  //  Result < 0  -> key,recno smaller than current entry
  //  Result = 0  -> key,recno found, FEntryNo = found key entryno
  //  Result > 0  -> key,recno larger than current entry
var
  low, high, current: Integer;
begin
  // implement binary search, keys are sorted
  low := FLowIndex;
  high := GetNumEntries;
  // always true: Entry(FEntryNo) = FEntry
  // FHighIndex >= 0 because no-entry cases in leaves have been filtered out
  // entry HighIndex may not be bigger than rest (in inner node)
  // ARecNo = -3 -> search last recno matching key
  // need to have: low <= high
  // define low - 1 = neg.inf.
  // define high = pos.inf
  // inv1: (ARecNo<>-3) -> Entry(low-1).Key <  Key <= Entry(high).Key
  // inv2: (ARecNo =-3) -> Entry(low-1).Key <= Key <  Entry(high).Key
  // vf: high + 1 - low
  while low < high do
  begin
    current := (low + high) div 2;
    FEntry := GetEntry(current);
    // calc diff
    Result := MatchKey;
    // test if we need to go lower or higher
    // result < 0 implies key smaller than tested entry
    // result = 0 implies key equal to tested entry
    // result > 0 implies key greater than tested entry
    if (Result < 0) or ((ARecNo<>-3) and (Result=0)) then
      high := current
    else
      low := current+1;
  end;
  // high will contain first greater-or-equal key
  // ARecNo <> -3 -> Entry(high).Key will contain first key that matches    -> go to high
  // ARecNo =  -3 -> Entry(high).Key will contain first key that is greater -> go to high
  FEntryNo := -1;
  EntryNo := high;
  // calc end result: can't inspect high if lowerpage <> nil
  // if this is a leaf, we need to find specific recno
  if (LowerPage = nil) then
  begin
    if high > FHighIndex then
    begin
      Result := 1;
    end else begin
      Result := MatchKey;
      // test if we need to find a specific recno
      // result < 0 -> current key greater -> nothing found -> don't search
      if (ARecNo > 0) then
      begin
        // BLS to RecNo
        high := FHighIndex + 1;
        low := FEntryNo;
        // inv: FLowIndex <= FEntryNo <= high <= FHighIndex + 1 /\
        // (Ai: FLowIndex <= i < FEntryNo: Entry(i).RecNo <> ARecNo)
        while FEntryNo <> high do
        begin
          // FEntryNo < high, get new entry
          if low <> FEntryNo then
          begin
            FEntry := GetEntry(FEntryNo);
            // check if entry key still ok
            Result := MatchKey;
          end;
          // test if out of range or found recno
          if (Result <> 0) or (GetRecNo = ARecNo) then
            high := FEntryNo
          else begin
            // default to EOF
            inc(FEntryNo);
            Result := 1;
          end;
        end;
      end;
    end;
  end else begin
    // FLowerPage <> nil -> high contains entry, can not have empty range
    Result := 0;
  end;
end;

procedure TIndexPage.GotoInsertEntry;
  // assures we really can insert here
begin
  if FEntry = FIndexFile.EntryEof then
    FEntry := GetEntry(FEntryNo);
end;

procedure TIndexPage.SetEntry(RecNo: Integer; AKey: PChar; LowerPageNo: Integer);
var
  keyData: PChar;
{$ifdef TDBF_INDEX_CHECK}
  prevKeyData, curKeyData, nextKeyData: PChar;
{$endif}
begin
  // get num entries
  keyData := GetKeyData;
  // check valid entryno: we should be able to insert entries!
  assert((EntryNo >= 0) and (EntryNo <= FHighIndex));
  if (UpperPage <> nil) and (FEntryNo = FHighIndex) then
    UpperPage.SetEntry(0, AKey, FPageNo);
{  if PIndexHdr(FIndexFile.IndexHeader).KeyType = 'C' then  }
    if AKey <> nil then
      Move(AKey^, keyData^, SwapWordLE(PIndexHdr(FIndexFile.IndexHeader)^.KeyLen))
    else
      PChar(keyData)^ := #0;
{
  else
    if AKey <> nil then
      PDouble(keyData)^ := PDouble(AKey)^
    else
      PDouble(keyData)^ := 0.0;
}
  // set entry info
  SetRecLowerPageNo(RecNo, LowerPageNo);
  // flag we modified the page
  FModified := true;

{$ifdef TDBF_INDEX_CHECK}

    // check sorted entry sequence
    prevKeyData := GetKeyDataFromEntry(FEntryNo-1);
    curKeyData  := GetKeyDataFromEntry(FEntryNo+0);
    nextKeyData := GetKeyDataFromEntry(FEntryNo+1);
    // check if prior entry not greater, 'rightmost' key does not have to match
    if (FEntryNo > 0) and ((FLowerPage = nil) or (FEntryNo < FHighIndex)) then
    begin
      if FIndexFile.CompareKeys(prevKeyData, curKeyData) > 0 then
        assert(false);
    end;
    // check if next entry not smaller
    if ((FLowerPage = nil) and (FEntryNo < FHighIndex)) or
        ((FLowerPage <> nil) and (FEntryNo < (FHighIndex - 1))) then
    begin
      if FIndexFile.CompareKeys(curKeyData, nextKeyData) > 0 then
        assert(false);
    end;

{$endif}

end;

{$ifdef TDBF_UPDATE_FIRST_LAST_NODE}

procedure TIndexPage.SetPrevBlock(NewBlock: Integer);
begin
end;

{$endif}

procedure TIndexPage.Split;
  // *) assumes this page is `nearly' full
var
  NewPage: TIndexPage;
  source, dest: Pointer;
  paKeyData: PChar;
  size, oldEntryNo: Integer;
  splitRight, lNumEntries, numEntriesNew: Integer;
  saveLow, saveHigh: Integer;
  newRoot: Boolean;
begin
  // assure parent exists, if not -> create & lock, else lock it
  newRoot := FUpperPage = nil;
  if newRoot then
    FIndexFile.AddNewLevel
  else
    FUpperPage.LockPage;

  // lock this page for updates
  LockPage;

  // get num entries
  lNumEntries := GetNumEntries;

  // calc split pos: split in half
  splitRight := lNumEntries div 2;
  if (FLowerPage <> nil) and (lNumEntries mod 2 = 1) then
    inc(splitRight);
  numEntriesNew := lNumEntries - splitRight;
  // check if place to insert has least entries
  if (numEntriesNew > splitRight) and (EntryNo > splitRight) then
  begin
    inc(splitRight);
    dec(numEntriesNew);
  end else if (numEntriesNew < splitRight) and (EntryNo < splitRight) then
  begin
    dec(splitRight);
    inc(numEntriesNew);
  end;
  // save current entryno
  oldEntryNo := EntryNo;
  // check if we need to save high / low bound
  if FLowPage = FPageNo then
    saveLow := FLowIndex
  else
    saveLow := -1;
  if FHighPage = FPageNo then
    saveHigh := FHighIndex
  else
    saveHigh := -1;

  // create new page
  NewPage := TIndexPageClass(ClassType).Create(FIndexFile);
  try
    // get page
    NewPage.GetNewPage;
{$ifdef TDBF_UPDATE_FIRSTLAST_NODE}
    NewPage.SetPrevBlock(NewPage.PageNo - FIndexFile.PagesPerRecord);
{$endif}

    // set modified
    FModified := true;
    NewPage.FModified := true;

    // compute source, dest
    dest := NewPage.GetEntry(0);
    source := GetEntry(splitRight);
    size := numEntriesNew * SwapWordLE(PIndexHdr(FIndexFile.IndexHeader)^.KeyRecLen);
    // if inner node, copy rightmost entry too
    if FLowerPage <> nil then
      size := size + FIndexFile.EntryHeaderSize;
    // copy bytes
    Move(source^, dest^, size);
    // if not inner node, clear possible 'rightmost' entry
    if (FLowerPage = nil) then
      SetRecLowerPageNoOfEntry(splitRight, 0, 0);

    // calc new number of entries of this page
    lNumEntries := lNumEntries - numEntriesNew;
    // if lower level, then we need adjust for new 'rightmost' node
    if FLowerPage <> nil then
    begin
      // right split, so we need 'new' rightmost node
      dec(lNumEntries);
    end;
    // store new number of nodes
    // new page is right page, so update parent to point to new right page
    NewPage.SetNumEntries(numEntriesNew);
    SetNumEntries(lNumEntries);
    // update highindex
    FHighIndex := lNumEntries;
    if FLowerPage = nil then
      dec(FHighIndex);

    // get data of last entry on this page
    paKeyData := GetKeyDataFromEntry(splitRight - 1);

    // reinsert ourself into parent
//    FUpperPage.RecurInsert(0, paKeyData, FPageNo);
    // we can do this via a localinsert now: we know there is at least one entry
    // free in this page and higher up
    FUpperPage.LocalInsert(0, paKeyData, FPageNo);

    // new page is right page, so update parent to point to new right page
    // we can't do this earlier: we will get lost in tree!
    FUpperPage.SetRecLowerPageNoOfEntry(FUpperPage.EntryNo+1, 0, NewPage.PageNo);

    // NOTE: UpperPage.LowerPage = Self <= inserted FPageNo, not NewPage.PageNo
  finally
    NewPage.Free;
  end;

  // done updating: unlock page
  UnlockPage;
  // save changes to parent
  FUpperPage.UnlockPage;

  // unlock new root, unlock header too
  FIndexFile.UnlockHeader;

  // go to entry we left on
  if oldEntryNo >= splitRight then
  begin
    // sync upperpage with right page
    FUpperPage.EntryNo := FUpperPage.EntryNo + 1;
    FEntryNo := oldEntryNo - splitRight;
    FEntry := GetEntry(FEntryNo);
  end else begin
    // in left page = this page
    EntryNo := oldEntryNo;
  end;

  // check if we have to save high / low bound
  // seen the fact that FHighPage = FPageNo -> EntryNo <= FHighIndex, it can in
  // theory not happen that page is advanced to right page and high bound remains
  // on left page, but we won't check for that here
  if saveLow >= splitRight then
  begin
    FLowPage := FPageNo;
    FLowIndex := saveLow - splitRight;
  end;
  if saveHigh >= splitRight then
  begin
    FHighPage := FPageNo;
    FHighIndex := saveHigh - splitRight;
  end;
end;

procedure TIndexPage.Delete;
begin
  LocalDelete;
end;

procedure TIndexPage.WritePage;
begin
  // check if we modified current page
  if FModified and (FPageNo > 0) then
  begin
    FIndexFile.WriteRecord(FPageNo, FPageBuffer);
    FModified := false;
  end;
end;

procedure TIndexPage.Flush;
begin
  WritePage;
  if FLowerPage <> nil then
    FLowerPage.Flush;
end;

procedure TIndexPage.RecalcWeight;
begin
  if FLowerPage <> nil then
  begin
    FWeight := FLowerPage.Weight * SwapWordLE(PIndexHdr(FIndexFile.IndexHeader)^.NumKeys);
  end else begin
    FWeight := 1;
  end;
  if FUpperPage <> nil then
    FUpperPage.RecalcWeight;
end;

procedure TIndexPage.UpdateWeight;
begin
  if FLowerPage <> nil then
    FLowerPage.UpdateWeight
  else
    RecalcWeight;
end;

procedure TIndexPage.SetUpperPage(NewPage: TIndexPage);
begin
  if FUpperPage <> NewPage then
  begin
    // root height changed: update weights
    FUpperPage := NewPage;
    UpdateWeight;
  end;
end;

procedure TIndexPage.SetLowPage(NewPage: Integer);
begin
  if FLowPage <> NewPage then
  begin
    FLowPage := NewPage;
    UpdateBounds(FLowerPage <> nil);
  end;
end;

procedure TIndexPage.SetHighPage(NewPage: Integer);
begin
  if FHighPage <> NewPage then
  begin
    FHighPage := NewPage;
    UpdateBounds(FLowerPage <> nil);
  end;
end;

procedure TIndexPage.UpdateBounds(IsInnerNode: Boolean);
begin
  // update low / high index range
  if FPageNo = FLowPage then
    FLowIndex := FLowBracket
  else
    FLowIndex := 0;
  if FPageNo = FHighPage then
    FHighIndex := FHighBracket
  else begin
    FHighIndex := GetNumEntries;
    if not IsInnerNode then
      dec(FHighIndex);
  end;
end;

function TMdxPage.GetIsInnerNode: Boolean;
begin
  Result := SwapIntLE(PMdxPage(FPageBuffer)^.NumEntries) < SwapWordLE(PIndexHdr(FIndexFile.IndexHeader)^.NumKeys);
  // if there is still an entry after the last one, this has to be an inner node
  if Result then
    Result := PMdxEntry(GetEntry(PMdxPage(FPageBuffer)^.NumEntries))^.RecBlockNo <> 0;
end;

function TNdxPage.GetIsInnerNode: Boolean;
begin
  Result := PNdxEntry(GetEntry(0))^.LowerPageNo <> 0;
end;

procedure TIndexPage.SetPageNo(NewPageNo: Integer);
var
  isInnerNode: Boolean;
begin
  if (NewPageNo <> FPageNo) or FIndexFile.NeedLocks then
  begin
    // save changes
    WritePage;
    // no locks
    assert(FLockCount = 0);

    // goto new page
    FPageNo := NewPageNo;
    // remind ourselves we need to load new entry when page loaded
    FEntryNo := -1;
    if (NewPageNo > 0) and (NewPageNo <= FIndexFile.RecordCount) then
    begin
      // read page from disk
      FIndexFile.ReadRecord(NewPageNo, FPageBuffer);

      // fixup descending tree
      isInnerNode := GetIsInnerNode;

      // update low / high index range
      UpdateBounds(isInnerNode);

      // read inner node if any
      if isInnerNode then
      begin
        if FLowerPage = nil then
        begin
          FLowerPage := TIndexPageClass(ClassType).Create(FIndexFile);
          FLowerPage.UpperPage := Self;
        end;
        // read first entry, don't do this sooner, not created lowerpage yet
        // don't recursively resync all lower pages
{$ifdef TDBF_INDEX_CHECK}
      end else if FLowerPage <> nil then
      begin
//        FLowerPage.Free;
//        FLowerPage := nil;
        assert(false);
{$endif}
      end else begin
        // we don't have to check autoresync here because we're already at lowest level
        EntryNo := FLowIndex;
      end;
    end;
  end;
end;

procedure TIndexPage.SyncLowerPage;
  // *) assumes FLowerPage <> nil!
begin
  FLowerPage.PageNo := GetLowerPageNo;
end;

procedure TIndexPage.SetEntryNo(value: Integer);
begin
  // do not bother if no change
  if value <> FEntryNo then
  begin
    // check if out of range
    if (value < FLowIndex) then
    begin
      if FLowerPage = nil then
        FEntryNo := FLowIndex - 1;
      FEntry := FIndexFile.EntryBof;
    end else if value > FHighIndex then begin
      FEntryNo := FHighIndex + 1;
      FEntry := FIndexFile.EntryEof;
    end else begin
      FEntryNo := value;
      FEntry := GetEntry(value);
      // sync lowerpage with entry
      if (FLowerPage <> nil) then
        SyncLowerPage;
    end;
  end;
end;

function TIndexPage.PhysicalRecNo: Integer;
var
  entryRec: Integer;
begin
  // get num entries
  entryRec := GetRecNo;
  // check if in range
  if (FEntryNo >= FLowIndex) and (FEntryNo <= FHighIndex) then
    Result := entryRec
  else
    Result := -1;
end;

function TIndexPage.RecurPrev: Boolean;
begin
  EntryNo := EntryNo - 1;
  Result := Entry <> FIndexFile.EntryBof;
  if Result then
  begin
    if FLowerPage <> nil then
    begin
      FLowerPage.RecurLast;
    end;
  end else begin
    if FUpperPage<>nil then
    begin
      Result := FUpperPage.RecurPrev;
    end;
  end;
end;

function TIndexPage.RecurNext: Boolean;
begin
  EntryNo := EntryNo + 1;
  Result := Entry <> FIndexFile.EntryEof;
  if Result then
  begin
    if FLowerPage <> nil then
    begin
      FLowerPage.RecurFirst;
    end;
  end else begin
    if FUpperPage<>nil then
    begin
      Result := FUpperPage.RecurNext;
    end;
  end;
end;

procedure TIndexPage.RecurFirst;
begin
  EntryNo := FLowIndex;
  if (FLowerPage<>nil) then
    FLowerPage.RecurFirst;
end;

procedure TIndexPage.RecurLast;
begin
  EntryNo := FHighIndex;
  if (FLowerPage<>nil) then
    FLowerPage.RecurLast;
end;

procedure TIndexPage.SaveBracket;
begin
  FLowPageTemp := FLowPage;
  FHighPageTemp := FHighPage;
end;

procedure TIndexPage.RestoreBracket;
begin
  FLowPage := FLowPageTemp;
  FHighPage := FHighPageTemp;
end;

//==============================================================================
//============ Mdx specific access routines
//==============================================================================

function TMdxPage.GetEntry(AEntryNo: Integer): Pointer;
begin
  // get base + offset
  Result := PChar(@PMdxPage(PageBuffer)^.FirstEntry) + (SwapWordLE(PIndexHdr(
    IndexFile.IndexHeader)^.KeyRecLen) * AEntryNo);
end;

function TMdxPage.GetLowerPageNo: Integer;
  // *) assumes LowerPage <> nil
begin
//  if LowerPage = nil then
//    Result := 0
//  else
    Result := SwapIntLE(PMdxEntry(Entry)^.RecBlockNo);
end;

function TMdxPage.GetKeyData: PChar;
begin
  Result := @PMdxEntry(Entry)^.KeyData;
end;

function TMdxPage.GetNumEntries: Integer;
begin
  Result := SwapWordLE(PMdxPage(PageBuffer)^.NumEntries);
end;

function TMdxPage.GetKeyDataFromEntry(AEntry: Integer): PChar;
begin
  Result := @PMdxEntry(GetEntry(AEntry))^.KeyData;
end;

function TMdxPage.GetRecNo: Integer;
begin
  Result := SwapIntLE(PMdxEntry(Entry)^.RecBlockNo);
end;

procedure TMdxPage.SetNumEntries(NewNum: Integer);
begin
  PMdxPage(PageBuffer)^.NumEntries := SwapIntLE(NewNum);
end;

procedure TMdxPage.IncNumEntries;
begin
  IncIntLE(PMdxPage(PageBuffer)^.NumEntries, 1);
end;

procedure TMdxPage.SetRecLowerPageNo(NewRecNo, NewPageNo: Integer);
begin
  if FLowerPage = nil then
    PMdxEntry(Entry)^.RecBlockNo := SwapIntLE(NewRecNo)
  else
    PMdxEntry(Entry)^.RecBlockNo := SwapIntLE(NewPageNo);
end;

procedure TMdxPage.SetRecLowerPageNoOfEntry(AEntry, NewRecNo, NewPageNo: Integer);
begin
  if FLowerPage = nil then
    PMdxEntry(GetEntry(AEntry))^.RecBlockNo := SwapIntLE(NewRecNo)
  else
    PMdxEntry(GetEntry(AEntry))^.RecBlockNo := SwapIntLE(NewPageNo);
end;

{$ifdef TDBF_UPDATE_FIRST_LAST_NODE}

procedure TMdxPage.SetPrevBlock(NewBlock: Integer);
begin
  PMdxPage(PageBuffer)^.PrevBlock := SwapIntLE(NewBlock);
end;

{$endif}

//==============================================================================
//============ Ndx specific access routines
//==============================================================================

function TNdxPage.GetEntry(AEntryNo: Integer): Pointer;
begin
  // get base + offset
  Result := PChar(@PNdxPage(PageBuffer)^.FirstEntry) + 
    (SwapWordLE(PIndexHdr(FIndexFile.IndexHeader)^.KeyRecLen) * AEntryNo);
end;

function TNdxPage.GetLowerPageNo: Integer;
  // *) assumes LowerPage <> nil
begin
//  if LowerPage = nil then
//    Result := 0
//  else
    Result := SwapIntLE(PNdxEntry(Entry)^.LowerPageNo)
end;

function TNdxPage.GetRecNo: Integer;
begin
  Result := SwapIntLE(PNdxEntry(Entry)^.RecNo);
end;

function TNdxPage.GetKeyData: PChar;
begin
  Result := @PNdxEntry(Entry)^.KeyData;
end;

function TNdxPage.GetKeyDataFromEntry(AEntry: Integer): PChar;
begin
  Result := @PNdxEntry(GetEntry(AEntry))^.KeyData;
end;

function TNdxPage.GetNumEntries: Integer;
begin
  Result := SwapIntLE(PNdxPage(PageBuffer)^.NumEntries);
end;

procedure TNdxPage.IncNumEntries;
begin
  IncIntLE(PNdxPage(PageBuffer)^.NumEntries, 1);
end;

procedure TNdxPage.SetNumEntries(NewNum: Integer);
begin
  PNdxPage(PageBuffer)^.NumEntries := SwapIntLE(NewNum);
end;

procedure TNdxPage.SetRecLowerPageNo(NewRecNo, NewPageNo: Integer);
begin
  PNdxEntry(Entry)^.RecNo := SwapIntLE(NewRecNo);
  PNdxEntry(Entry)^.LowerPageNo := SwapIntLE(NewPageNo);
end;

procedure TNdxPage.SetRecLowerPageNoOfEntry(AEntry, NewRecNo, NewPageNo: Integer);
begin
  PNdxEntry(GetEntry(AEntry))^.RecNo := SwapIntLE(NewRecNo);
  PNdxEntry(GetEntry(AEntry))^.LowerPageNo := SwapIntLE(NewPageNo);
end;

//==============================================================================
//============ MDX version 4 header access routines
//==============================================================================

function TMdx4Tag.GetHeaderPageNo: Integer;
begin
  Result := SwapIntLE(Unaligned(PMdx4Tag(Tag)^.HeaderPageNo));
end;

function TMdx4Tag.GetTagName: string;
begin
  Result := PMdx4Tag(Tag)^.TagName;
end;

function TMdx4Tag.GetKeyFormat: Byte;
begin
  Result := PMdx4Tag(Tag)^.KeyFormat;
end;

function TMdx4Tag.GetForwardTag1: Byte;
begin
  Result := PMdx4Tag(Tag)^.ForwardTag1;
end;

function TMdx4Tag.GetForwardTag2: Byte;
begin
  Result := PMdx4Tag(Tag)^.ForwardTag2;
end;

function TMdx4Tag.GetBackwardTag: Byte;
begin
  Result := PMdx4Tag(Tag)^.BackwardTag;
end;

function TMdx4Tag.GetReserved: Byte;
begin
  Result := PMdx4Tag(Tag)^.Reserved;
end;

function TMdx4Tag.GetKeyType: Char;
begin
  Result := PMdx4Tag(Tag)^.KeyType;
end;

procedure TMdx4Tag.SetHeaderPageNo(NewPageNo: Integer);
begin
  Unaligned(PMdx4Tag(Tag)^.HeaderPageNo) := SwapIntLE(NewPageNo);
end;

procedure TMdx4Tag.SetTagName(NewName: string);
begin
  StrPLCopy(PMdx4Tag(Tag)^.TagName, NewName, 10);
  PMdx4Tag(Tag)^.TagName[10] := #0;
end;

procedure TMdx4Tag.SetKeyFormat(NewFormat: Byte);
begin
  PMdx4Tag(Tag)^.KeyFormat := NewFormat;
end;

procedure TMdx4Tag.SetForwardTag1(NewTag: Byte);
begin
  PMdx4Tag(Tag)^.ForwardTag1 := NewTag;
end;

procedure TMdx4Tag.SetForwardTag2(NewTag: Byte);
begin
  PMdx4Tag(Tag)^.ForwardTag2 := NewTag;
end;

procedure TMdx4Tag.SetBackwardTag(NewTag: Byte);
begin
  PMdx4Tag(Tag)^.BackwardTag := NewTag;
end;

procedure TMdx4Tag.SetReserved(NewReserved: Byte);
begin
  PMdx4Tag(Tag)^.Reserved := NewReserved;
end;

procedure TMdx4Tag.SetKeyType(NewType: Char);
begin
  PMdx4Tag(Tag)^.KeyType := NewType;
end;

//==============================================================================
//============ MDX version 7 headertag access routines
//==============================================================================

function TMdx7Tag.GetHeaderPageNo: Integer;
begin
  Result := SwapIntLE(Unaligned(PMdx7Tag(Tag)^.HeaderPageNo));
end;

function TMdx7Tag.GetTagName: string;
begin
  Result := PMdx7Tag(Tag)^.TagName;
end;

function TMdx7Tag.GetKeyFormat: Byte;
begin
  Result := PMdx7Tag(Tag)^.KeyFormat;
end;

function TMdx7Tag.GetForwardTag1: Byte;
begin
  Result := PMdx7Tag(Tag)^.ForwardTag1;
end;

function TMdx7Tag.GetForwardTag2: Byte;
begin
  Result := PMdx7Tag(Tag)^.ForwardTag2;
end;

function TMdx7Tag.GetBackwardTag: Byte;
begin
  Result := PMdx7Tag(Tag)^.BackwardTag;
end;

function TMdx7Tag.GetReserved: Byte;
begin
  Result := PMdx7Tag(Tag)^.Reserved;
end;

function TMdx7Tag.GetKeyType: Char;
begin
  Result := PMdx7Tag(Tag)^.KeyType;
end;

procedure TMdx7Tag.SetHeaderPageNo(NewPageNo: Integer);
begin
  Unaligned(PMdx7Tag(Tag)^.HeaderPageNo) := SwapIntLE(NewPageNo);
end;

procedure TMdx7Tag.SetTagName(NewName: string);
begin
  StrPLCopy(PMdx7Tag(Tag)^.TagName, NewName, 32);
  PMdx7Tag(Tag)^.TagName[32] := #0;
end;

procedure TMdx7Tag.SetKeyFormat(NewFormat: Byte);
begin
  PMdx7Tag(Tag)^.KeyFormat := NewFormat;
end;

procedure TMdx7Tag.SetForwardTag1(NewTag: Byte);
begin
  PMdx7Tag(Tag)^.ForwardTag1 := NewTag;
end;

procedure TMdx7Tag.SetForwardTag2(NewTag: Byte);
begin
  PMdx7Tag(Tag)^.ForwardTag2 := NewTag;
end;

procedure TMdx7Tag.SetBackwardTag(NewTag: Byte);
begin
  PMdx7Tag(Tag)^.BackwardTag := NewTag;
end;

procedure TMdx7Tag.SetReserved(NewReserved: Byte);
begin
  PMdx7Tag(Tag)^.Reserved := NewReserved;
end;

procedure TMdx7Tag.SetKeyType(NewType: Char);
begin
  PMdx7Tag(Tag)^.KeyType := NewType;
end;

{ TDbfIndexParser }

procedure TDbfIndexParser.ValidateExpression(AExpression: string);
const
  AnsiStrFuncs: array[0..13] of TExprFunc = (FuncUppercase, FuncLowercase, FuncStrI_EQ,
    FuncStrIP_EQ, FuncStrI_NEQ, FuncStrI_LT, FuncStrI_GT, FuncStrI_LTE, FuncStrI_GTE,
    FuncStrP_EQ, FuncStr_LT, FuncStr_GT, FuncStr_LTE, FuncStr_GTE);
  AnsiFuncsToMode: array[boolean] of TStringFieldMode = (smRaw, smAnsi);
var
  TempRec: PExpressionRec;
  TempBuffer: TRecordBuffer;
  I: integer;
  hasAnsiFuncs: boolean;
begin
  TempRec := CurrentRec;
  hasAnsiFuncs := false;
  while not hasAnsiFuncs and (TempRec <> nil) do
  begin
    for I := Low(AnsiStrFuncs) to High(AnsiStrFuncs) do
      if @TempRec^.Oper = @AnsiStrFuncs[I] then
      begin
        hasAnsiFuncs := true;
        break;
      end;
    TempRec := TempRec^.Next;
  end;

  StringFieldMode := AnsiFuncsToMode[hasAnsiFuncs];

  FResultLen := inherited ResultLen;

  if FResultLen = -1 then
  begin
    // make empty record
    GetMem(TempBuffer, TDbfFile(DbfFile).RecordSize);
    try
      TDbfFile(DbfFile).InitRecord(TempBuffer);
      FResultLen := StrLen(ExtractFromBuffer(TempBuffer));
    finally
      FreeMem(TempBuffer);
    end;
  end;

  // check if expression not too long
  if FResultLen > 100 then
    raise EDbfError.CreateFmt(STRING_INDEX_EXPRESSION_TOO_LONG, [AExpression, FResultLen]);
end;

//==============================================================================
//============ TIndexFile
//==============================================================================
constructor TIndexFile.Create(ADbfFile: Pointer);
var
  I: Integer;
begin
  inherited Create;

  // clear variables
  FOpened := false;
  FRangeActive := false;
  FUpdateMode := umCurrent;
  FModifyMode := mmNormal;
  FTempMode := TDbfFile(ADbfFile).TempMode;
  FRangeIndex := -1;
  SelectIndexVars(-1);
  for I := 0 to MaxIndexes - 1 do
  begin
    FParsers[I] := nil;
    FRoots[I] := nil;
    FLeaves[I] := nil;
    FIndexHeaderModified[I] := false;
  end;

  // store pointer to `parent' dbf file
  FDbfFile := ADbfFile;
end;

destructor TIndexFile.Destroy;
begin
  // close file
  Close;

  // call ancestor
  inherited Destroy;
end;

procedure TIndexFile.Open;
var
  I: Integer;
  ext: string;
  localeError: TLocaleError;
  localeSolution: TLocaleSolution;
  DbfLangId: Byte;
begin
  if not FOpened then
  begin
    // open physical file
    OpenFile;

    // page offsets are not related to header length
    PageOffsetByHeader := false;
    // we need physical page locks
    VirtualLocks := false;

    // not selected index expression => can't edit yet
    FCanEdit := false;
    FUserKey := nil;
    FUserRecNo := -1;
    FHeaderLocked := -1;
    FHeaderPageNo := 0;
    FForceClose := false;
    FForceReadOnly := false;
    FMdxTag := nil;

    // get index type
    ext := UpperCase(ExtractFileExt(FileName));
    if (ext = '.MDX') then
    begin
      FEntryHeaderSize := 4;
      FPageHeaderSize := 8;
      FEntryBof := @Entry_Mdx_BOF;
      FEntryEof := @Entry_Mdx_EOF;
      HeaderSize := 2048;
      RecordSize := 1024;
      PageSize := 512;
      if FileCreated then
      begin
        FIndexVersion := TDbfFile(FDbfFile).DbfVersion;
        if FIndexVersion = xBaseIII then
          FIndexVersion := xBaseIV;
      end else begin
        case PMdxHdr(Header)^.MdxVersion of
          3: FIndexVersion := xBaseVII;
        else
          FIndexVersion := xBaseIV;
        end;
      end;
      case FIndexVersion of
        xBaseVII:
          begin
            FMdxTag := TMdx7Tag.Create;
            FTempMdxTag := TMdx7Tag.Create;
          end;
      else
        FMdxTag := TMdx4Tag.Create;
        FTempMdxTag := TMdx4Tag.Create;
      end;
      // get mem for all index headers..we're going to cache these
      for I := 0 to MaxIndexes - 1 do
      begin
        GetMem(FIndexHeaders[I], RecordSize);
        FillChar(FIndexHeaders[I]^, RecordSize, 0);
      end;
      // set pointers to first index
      FIndexHeader := FIndexHeaders[0];
    end else begin
      // don't waste memory on another header block: we can just use
      // the pagedfile one, there is only one index in this file
      FIndexVersion := xBaseIII;
      FEntryHeaderSize := 8;
      FPageHeaderSize := 4;
      FEntryBof := @Entry_Ndx_BOF;
      FEntryEof := @Entry_Ndx_EOF;
      HeaderSize := 512;
      RecordSize := 512;
      // have to read header first before we can assign following vars
      FIndexHeaders[0] := Header;
      FIndexHeader := Header;
      // create default root
      FParsers[0] := TDbfIndexParser.Create(FDbfFile);
      FRoots[0] := TNdxPage.Create(Self);
      FCurrentParser := FParsers[0];
      FRoot := FRoots[0];
      FSelectedIndex := 0;
      // parse index expression
      FCurrentParser.ParseExpression(PIndexHdr(FIndexHeader)^.KeyDesc);
      // set index locale
      FCollation := BINARY_COLLATION;
    end;

    // determine how to open file
    if FileCreated then
    begin
      FillChar(Header^, HeaderSize, 0);
      Clear;
    end else begin
      // determine locale type
      localeError := leNone;
      if (FIndexVersion >= xBaseIV) then
      begin
        // get parent language id
        DbfLangId := GetDbfLanguageId;
        // no ID?
        if (DbfLangId = 0) { and (TDbfFile(FDbfFile).DbfVersion = xBaseIII)} then
        begin
          // if dbf is version 3, no language id, if no MDX language, use binary
          if PMdxHdr(Header)^.Language = 0 then
            FCollation := BINARY_COLLATION
          else
            FCollation := GetCollationTable(PMdxHdr(Header)^.Language);
        end else begin
          // check if MDX - DBF language id's match
          if (PMdxHdr(Header)^.Language = 0) or (PMdxHdr(Header)^.Language = DbfLangId) then
            FCollation := GetCollationTable(DbfLangId)
          else
            localeError := leTableIndexMismatch;
        end;
        // don't overwrite previous error
        if (FCollation = UNKNOWN_COLLATION) and (localeError = leNone) then
          localeError := leUnknown;
      end else begin
        // dbase III always binary?
        FCollation := BINARY_COLLATION;
      end;
      // check if selected locale is available, binary is always available...
      if (localeError <> leNone) and (FCollation <> BINARY_COLLATION) then
      begin
        if LCIDList.IndexOf(Pointer(FCollation)) < 0 then
          localeError := leNotAvailable;
      end;
      // check if locale error detected
      if localeError <> leNone then
      begin
        // provide solution, well, solution...
        localeSolution := lsNotOpen;
        // call error handler
        if Assigned(FOnLocaleError) then
          FOnLocaleError(localeError, localeSolution);
        // act to solution
        case localeSolution of
          lsNotOpen: FForceClose := true;
          lsNoEdit: FForceReadOnly := true;
        else
          { lsBinary }
          FCollation := BINARY_COLLATION;
        end;
      end;
      // now read info
      if not ForceClose then
        ReadIndexes;
    end;
    // default to update all
    UpdateMode := umAll;
    // flag open
    FOpened := true;
  end;
end;

procedure TIndexFile.Close;
var
  I: Integer;
begin
  if FOpened then
  begin
    // save headers
    Flush;

    // remove parser reference
    FCurrentParser := nil;

    // free roots
    if FIndexVersion >= xBaseIV then
    begin
      for I := 0 to MaxIndexes - 1 do
      begin
        FreeMemAndNil(FIndexHeaders[I]);
        FreeAndNil(FParsers[I]);
        FreeAndNil(FRoots[I]);
      end;
    end else begin
      FreeAndNil(FRoot);
    end;

    // free mem
    FMdxTag.Free;
    FTempMdxTag.Free;

    // close physical file
    CloseFile;

    // not opened any more
    FOpened := false;
  end;
end;

procedure TIndexFile.ClearRoots;
  //
  // *) assumes FIndexVersion >= xBaseIV
  //
var
  I, prevIndex: Integer;
begin
  prevIndex := FSelectedIndex;
  for I := 0 to MaxIndexes - 1 do
  begin
    SelectIndexVars(I);
    if FRoot <> nil then
    begin
      // clear this entry
      ClearIndex;
      FLeaves[I] := FRoots[I];
    end;
  end;
  // reselect previously selected index
  SelectIndexVars(prevIndex);
  // deselect index
end;

procedure WriteDBFileName(Header: PMdxHdr; HdrFileName: string);
var
  HdrFileExt: string;
  lPos, lenFileName: integer;
begin
  HdrFileName := ExtractFileName(HdrFileName);
  HdrFileExt := ExtractFileExt(HdrFileName);
  if Length(HdrFileExt) > 0 then
  begin
    lPos := System.Pos(HdrFileExt, HdrFileName);
    if lPos > 0 then
      SetLength(HdrFileName, lPos - 1);
  end;
  if Length(HdrFileName) > 15 then
    SetLength(HdrFileName, 15);
  lenFileName := Length(HdrFileName);
  Move(PChar(HdrFileName)^, PMdxHdr(Header)^.FileName[0], lenFileName);
  FillChar(PMdxHdr(Header)^.FileName[lenFileName], 15-lenFileName, 0);
end;

procedure TIndexFile.Clear;
var
  year, month, day: Word;
  pos, prevSelIndex, pageno: Integer;
  DbfLangId: Byte;
begin
  // flush cache to prevent reading corrupted data
  Flush;
  // completely erase index
  if FIndexVersion >= xBaseIV then
  begin
    DecodeDate(Now, year, month, day);
    if FIndexVersion = xBaseVII then
      PMdxHdr(Header)^.MdxVersion := 3
    else  
      PMdxHdr(Header)^.MdxVersion := 2;
    PMdxHdr(Header)^.Year := year - 1900;
    PMdxHdr(Header)^.Month := month;
    PMdxHdr(Header)^.Day := day;
    WriteDBFileName(PMdxHdr(Header), FileName);
    PMdxHdr(Header)^.BlockSize := SwapWordLE(2);
    PMdxHdr(Header)^.BlockAdder := SwapWordLE(1024);
    PMdxHdr(Header)^.ProdFlag := 1;
    PMdxHdr(Header)^.NumTags := 48;
    PMdxHdr(Header)^.TagSize := 32;
    PMdxHdr(Header)^.Dummy2 := 0;
    PMdxHdr(Header)^.Language := GetDbfLanguageID;
    PMdxHdr(Header)^.NumPages := SwapIntLE(HeaderSize div PageSize);  // = 4
    TouchHeader(Header);
    PMdxHdr(Header)^.TagFlag := 1;
    // use locale id of parent
    DbfLangId := GetDbfLanguageId;
    if DbfLangId = 0 then
      FCollation := BINARY_COLLATION
    else
      FCollation := GetCollationTable(DbfLangId);
    // write index headers
    prevSelIndex := FSelectedIndex;
    for pos := 0 to SwapWordLE(PMdxHdr(Header)^.TagsUsed) - 1 do
    begin
      SelectIndexVars(pos);
      pageno := GetNewPageNo;
      FMdxTag.HeaderPageNo := SwapIntLE(pageno);
      WriteRecord(pageno, FIndexHeader);
    end;
    // reselect previously selected index
    SelectIndexVars(prevSelIndex);
    // file header done (tags are included in file header)
    WriteFileHeader;
    // clear roots
    ClearRoots;
    // init vars
    FTagSize := 32;
    FTagOffset := 544;
    // clear entries
    RecordCount := SwapIntLE(PMdxHdr(Header)^.NumPages);
  end else begin
    // clear single index entry
    ClearIndex;
    RecordCount := SwapIntLE(PIndexHdr(FIndexHeader)^.NumPages);
  end;
end;

procedure TIndexFile.ClearIndex;
var
  prevHeaderLocked: Integer;
  needHeaderLock: Boolean;
begin
  // flush cache to prevent reading corrupted data
  Flush;
  // modifying header: lock page
  needHeaderLock := FHeaderLocked <> 0;
  prevHeaderLocked := FHeaderLocked;
  if needHeaderLock then
  begin
    LockPage(0, true);
    FHeaderLocked := 0;
  end;
  // initially, we have 1 page: header
  PIndexHdr(FIndexHeader)^.NumPages := SwapIntLE(HeaderSize div PageSize);
  // clear memory of root
  FRoot.Clear;
  // get new page for root
  FRoot.GetNewPage;
  // store new root page
  PIndexHdr(FIndexHeader)^.RootPage := SwapIntLE(FRoot.PageNo);
{$ifdef TDBF_UPDATE_FIRSTLAST_NODE}
  PIndexHdr(FIndexHeader)^.FirstNode := SwapIntLE(FRoot.PageNo);
{$endif}
  // update leaf pointers
  FLeaves[FSelectedIndex] := FRoot;
  FLeaf := FRoot;
  // write new header
  WriteHeader;
  FRoot.Modified;
  FRoot.WritePage;
  // done updating: unlock header
  if needHeaderLock then
  begin
    UnlockPage(0);
    FHeaderLocked := prevHeaderLocked;
  end;
end;

procedure TIndexFile.CalcKeyProperties;
  // given KeyLen, this func calcs KeyRecLen and NumEntries
begin
  // now adjust keylen to align on DWORD boundaries
  PIndexHdr(FIndexHeader)^.KeyRecLen := SwapWordLE((SwapWordLE(
    PIndexHdr(FIndexHeader)^.KeyLen) + FEntryHeaderSize + 3) and not 3);
  PIndexHdr(FIndexHeader)^.NumKeys := SwapWordLE((RecordSize - FPageHeaderSize) div 
    SwapWordLE(PIndexHdr(FIndexHeader)^.KeyRecLen));
end;

function TIndexFile.GetName: string;
begin
  // get suitable name of index: if tag name defined use that otherwise filename
  if FIndexVersion >= xBaseIV then
    Result := FIndexName
  else
    Result := FileName;
end;

procedure TIndexFile.CreateIndex(FieldDesc, TagName: string; Options: TIndexOptions);
var
  tagNo: Integer;
  fieldType: Char;
  TempParser: TDbfIndexParser;
begin
  // check if we have exclusive access to table
  TDbfFile(FDbfFile).CheckExclusiveAccess;
  // parse index expression; if it cannot be parsed, why bother making index?
  TempParser := TDbfIndexParser.Create(FDbfFile);
  try
    TempParser.ParseExpression(FieldDesc);
    // check if result type is correct
    fieldType := 'C';
    case TempParser.ResultType of
      etString: ; { default set above to suppress delphi warning }
      etInteger, etLargeInt, etFloat: fieldType := 'N';
    else
      raise EDbfError.Create(STRING_INVALID_INDEX_TYPE);
    end;
  finally
    TempParser.Free;
  end;
  // select empty index
  if FIndexVersion >= xBaseIV then
  begin
    // get next entry no
    tagNo := SwapWordLE(PMdxHdr(Header)^.TagsUsed);
    // check if too many indexes
    if tagNo = MaxIndexes then
      raise EDbfError.Create(STRING_TOO_MANY_INDEXES);
    // get memory for root
    if FRoots[tagNo] = nil then
    begin
      FParsers[tagNo] := TDbfIndexParser.Create(FDbfFile);
      FRoots[tagNo] := TMdxPage.Create(Self)
    end else begin
      FreeAndNil(FRoots[tagNo].FLowerPage);
    end;
    // set leaves pointer
    FLeaves[tagNo] := FRoots[tagNo];
    // get pointer to index header
    FIndexHeader := FIndexHeaders[tagNo];
    // load root + leaf
    FCurrentParser := FParsers[tagNo];
    FRoot := FRoots[tagNo];
    FLeaf := FLeaves[tagNo];
    // create new tag
    FTempMdxTag.Tag := CalcTagOffset(tagNo);
    FTempMdxTag.TagName := UpperCase(TagName);
    // if expression then calculate
    FTempMdxTag.KeyFormat := KeyFormat_Data;
    if ixExpression in Options then
      FTempMdxTag.KeyFormat := KeyFormat_Expression;
    // what use have these reference tags?
    FTempMdxTag.ForwardTag1 := 0;
    FTempMdxTag.ForwardTag2 := 0;
    FTempMdxTag.BackwardTag := 0;
    FTempMdxTag.Reserved := 2;
    FTempMdxTag.KeyType := fieldType;
    // save this part of tag, need to save before GetNewPageNo,
    // it will reread header
    WriteFileHeader;
    // store selected index
    FSelectedIndex := tagNo;
    FIndexName := TagName;
    // store new headerno
    FHeaderPageNo := GetNewPageNo;
    FTempMdxTag.HeaderPageNo := FHeaderPageNo;
    // increase number of indexes active
    IncWordLE(PMdxHdr(Header)^.TagsUsed, 1);
    // update updatemode
    UpdateMode := umAll;
    // index header updated
    WriteFileHeader;
  end;
  // clear index
  ClearIndex;

  // parse expression, we know it's parseable, we've checked that
  FCurrentParser.ParseExpression(FieldDesc);

  // looked up index expression: now we can edit
//  FIsExpression := ixExpression in Options;
  FCanEdit := not FForceReadOnly;

  // init key variables
  PIndexHdr(FIndexHeader)^.KeyFormat := 0;
  // descending
  if ixDescending in Options then
    PIndexHdr(FIndexHeader)^.KeyFormat := PIndexHdr(FIndexHeader)^.KeyFormat or KeyFormat_Descending;
  // key type
  if fieldType = 'C' then
    PIndexHdr(FIndexHeader)^.KeyFormat := PIndexHdr(FIndexHeader)^.KeyFormat or KeyFormat_String;
  PIndexHdr(FIndexHeader)^.KeyType := fieldType;
  // uniqueness
  PIndexHdr(FIndexHeader)^.Unique := Unique_None;
  if ixPrimary in Options then
  begin
    PIndexHdr(FIndexHeader)^.KeyFormat := PIndexHdr(FIndexHeader)^.KeyFormat or KeyFormat_Distinct or KeyFormat_Unique;
    PIndexHdr(FIndexHeader)^.Unique := Unique_Distinct;
  end else if ixUnique in Options then
  begin
    PIndexHdr(FIndexHeader)^.KeyFormat := PIndexHdr(FIndexHeader)^.KeyFormat or KeyFormat_Unique;
    PIndexHdr(FIndexHeader)^.Unique := Unique_Unique;
  end;
  // keylen is exact length of field
  if fieldType = 'C' then
    PIndexHdr(FIndexHeader)^.KeyLen := SwapWordLE(FCurrentParser.ResultLen)
  else if FIndexVersion >= xBaseIV then
    PIndexHdr(FIndexHeader)^.KeyLen := SwapWordLE(12)
  else
    PIndexHdr(FIndexHeader)^.KeyLen := SwapWordLE(8);
  CalcKeyProperties;
  // key desc
  StrPLCopy(PIndexHdr(FIndexHeader)^.KeyDesc, FieldDesc, 219);
  PIndexHdr(FIndexHeader)^.KeyDesc[219] := #0;

  // init various
  if FIndexVersion >= xBaseIV then
    PIndexHdr(FIndexHeader)^.Dummy := 0        // MDX -> language driver
  else
    PIndexHdr(FIndexHeader)^.Dummy := SwapWordLE($5800);   // NDX -> same ???
  case fieldType of
    'C':
      PIndexHdr(FIndexHeader)^.sKeyType := 0;
    'D':
      PIndexHdr(FIndexHeader)^.sKeyType := SwapWordLE(1);
    'N', 'F':
      if FIndexVersion >= xBaseIV then
        PIndexHdr(FIndexHeader)^.sKeyType := 0
      else
        PIndexHdr(FIndexHeader)^.sKeyType := SwapWordLE(1);
  else
    PIndexHdr(FIndexHeader)^.sKeyType := 0;
  end;

  PIndexHdr(FIndexHeader)^.Version := SwapWordLE(2);     // this is what DB4 writes into file
  PIndexHdr(FIndexHeader)^.Dummy2 := 0;
  PIndexHdr(FIndexHeader)^.Dummy3 := 0;
  PIndexHdr(FIndexHeader)^.ForExist := 0;    // false
  PIndexHdr(FIndexHeader)^.KeyExist := 1;    // true
{$ifndef TDBF_UPDATE_FIRSTLAST_NODE}
  // if not defined, init to zero
  PIndexHdr(FIndexHeader)^.FirstNode := 0;
  PIndexHdr(FIndexHeader)^.LastNode := 0;
{$endif}
  WriteHeader;

  // update internal properties
  UpdateIndexProperties;

  // for searches / inserts / deletes
  FKeyBuffer[SwapWordLE(PIndexHdr(FIndexHeader)^.KeyLen)] := #0;
end;

procedure TIndexFile.ReadIndexes;
var
  I: Integer;

  procedure CheckHeaderIntegrity;
  begin
    if integer(SwapWordLE(PIndexHdr(FIndexHeader)^.NumKeys) * 
        SwapWordLE(PIndexHdr(FIndexHeader)^.KeyRecLen)) > RecordSize then
    begin
      // adjust index header so that integrity is correct
      // WARNING: we can't be sure this gives a correct result, but at
      // least we won't AV (as easily). user will probably have to regenerate this index
      if SwapWordLE(PIndexHdr(FIndexHeader)^.KeyLen) > 100 then
        PIndexHdr(FIndexHeader)^.KeyLen := SwapWordLE(100);
      CalcKeyProperties;
    end;
  end;

begin
  // force header reread
  inherited ReadHeader;
  // examine all indexes
  if FIndexVersion >= xBaseIV then
  begin
    // clear all roots
    ClearRoots;
    // tags are extended at beginning? tagsize is byte sized
    FTagSize := PMdxHdr(Header)^.TagSize;
    FTagOffset := 544 + FTagSize - 32;
    for I := 0 to SwapWordLE(PMdxHdr(Header)^.TagsUsed) - 1 do
    begin
      // read page header
      FTempMdxTag.Tag := CalcTagOffset(I);
      ReadRecord(FTempMdxTag.HeaderPageNo, FIndexHeaders[I]);
      // select it
      FIndexHeader := FIndexHeaders[I];
      // create root if needed
      if FRoots[I] = nil then
      begin
        FParsers[I] := TDbfIndexParser.Create(FDbfFile);
        FRoots[I] := TMdxPage.Create(Self);
      end;
      // check header integrity
      CheckHeaderIntegrity;
      // read tree
      FRoots[I].PageNo := SwapIntLE(PIndexHdr(FIndexHeader)^.RootPage);
      // go to first record
      FRoots[I].RecurFirst;
      // store leaf
      FLeaves[I] := FRoots[I];
      while FLeaves[I].LowerPage <> nil do
        FLeaves[I] := FLeaves[I].LowerPage;
      // parse expression
      FParsers[I].ParseExpression(PIndexHdr(FIndexHeader)^.KeyDesc);
    end;
  end else begin
    // clear root
    FRoot.Clear;
    // check recordsize constraint
    CheckHeaderIntegrity;
    // just one index: read tree
    FRoot.PageNo := SwapIntLE(PIndexHdr(FIndexHeader)^.RootPage);
    // go to first valid record
    FRoot.RecurFirst;
    // get leaf page
    FLeaf := FRoot;
    while FLeaf.LowerPage <> nil do
      FLeaf := FLeaf.LowerPage;
    // write leaf pointer to first index
    FLeaves[0] := FLeaf;
    // get index properties -> internal props
    UpdateIndexProperties;
  end;
end;

procedure TIndexFile.DeleteIndex(const AIndexName: string);
var
  I, found, numTags, moveItems: Integer;
  tempHeader: Pointer;
  tempRoot, tempLeaf: TIndexPage;
  tempParser: TDbfIndexParser;
begin
  // check if we have exclusive access to table
  TDbfFile(FDbfFile).CheckExclusiveAccess;
  if FIndexVersion = xBaseIII then
  begin
    Close;
    DeleteFile;
  end else if FIndexVersion >= xBaseIV then
  begin
    // find index
    found := IndexOf(AIndexName);
    if found >= 0 then
    begin
      // just remove this tag by copying memory over it
      numTags := SwapWordLE(PMdxHdr(Header)^.TagsUsed);
      moveItems := numTags - found - 1;
      // anything to move?
      if moveItems > 0 then
      begin
        // move entries after found one
        Move((Header + FTagOffset + (found+1) * FTagSize)^,
          (Header + FTagOffset + found * FTagSize)^, moveItems * FTagSize);
        // nullify last entry
        FillChar((Header + FTagOffset + numTags * FTagSize)^, FTagSize, 0);
        // index headers, roots, leaves
        tempHeader := FIndexHeaders[found];
        tempParser := FParsers[found];
        tempRoot := FRoots[found];
        tempLeaf := FLeaves[found];
        for I := 0 to moveItems - 1 do
        begin
          FIndexHeaders[found + I] := FIndexHeaders[found + I + 1];
          FParsers[found + I] := FParsers[found + I + 1];
          FRoots[found + I] := FRoots[found + I + 1];
          FLeaves[found + I] := FLeaves[found + I + 1];
          FIndexHeaderModified[found + I] := true;
        end;
        FIndexHeaders[found + moveItems] := tempHeader;
        FParsers[found + moveItems] := tempParser;
        FRoots[found + moveItems] := tempRoot;
        FLeaves[found + moveItems] := tempLeaf;
        FIndexHeaderModified[found + moveItems] := false;    // non-existant header
      end;
      // one entry less left
      IncWordLE(PMdxHdr(Header)^.TagsUsed, -1);
      // ---*** numTags not valid from here ***---
      // file header changed
      WriteFileHeader;
      // repage index to free space used by deleted index
//      RepageFile;
    end;
  end;
end;

procedure TIndexFile.TouchHeader(AHeader: Pointer);
var
  year, month, day: Word;
begin
  DecodeDate(Now, year, month, day);
  PMdxHdr(AHeader)^.UpdYear := year - 1900;
  PMdxHdr(AHeader)^.UpdMonth := month;
  PMdxHdr(AHeader)^.UpdDay := day;
end;

function TIndexFile.CreateTempFile(BaseName: string): TPagedFile;
var
  lModifier: Integer;
begin
  // create temporary in-memory index file
  lModifier := 0;
  FindNextName(BaseName, BaseName, lModifier);
  Result := TPagedFile.Create;
  Result.FileName := BaseName;
  Result.Mode := pfExclusiveCreate;
  Result.AutoCreate := true;
  Result.OpenFile;
  Result.HeaderSize := HeaderSize;
  Result.RecordSize := RecordSize;
  Result.PageSize := PageSize;
  Result.PageOffsetByHeader := false;
end;

procedure TIndexFile.RepageFile;
var
  TempFile: TPagedFile;
  TempIdxHeader: PIndexHdr;
  I, newPageNo: Integer;
  prevIndex: Integer;

  function  AllocNewPageNo: Integer;
  begin
    Result := newPageNo;
    Inc(newPageNo, PagesPerRecord);
    if FIndexVersion >= xBaseIV then
      IncIntLE(PMdxHdr(TempFile.Header)^.NumPages, PagesPerRecord);
    IncIntLE(TempIdxHeader^.NumPages, PagesPerRecord);
  end;

  function WriteTree(NewPage: TIndexPage): Integer;
  var
    J: Integer;
  begin
    // get us a page so that page no's are more logically ordered
    Result := AllocNewPageNo;
    // use postorder visiting, first do all children
    if NewPage.LowerPage <> nil then
    begin
      for J := 0 to NewPage.HighIndex do
      begin
        NewPage.EntryNo := J;
        WriteTree(NewPage.LowerPage);
      end;
    end;
    // now create new page for ourselves and write
    // update page pointer in parent
    if NewPage.UpperPage <> nil then
    begin
      if FIndexVersion >= xBaseIV then
      begin
        PMdxEntry(NewPage.UpperPage.Entry)^.RecBlockNo := SwapIntLE(Result);
{$ifdef TDBF_UPDATE_FIRSTLAST_NODE}
        // write previous node
        if FRoot = NewPage then
          PMdxPage(NewPage.PageBuffer)^.PrevBlock := 0
        else
          PMdxPage(NewPage.PageBuffer)^.PrevBlock := SwapIntLE(Result - PagesPerRecord);
{$endif}
      end else begin
        PNdxEntry(NewPage.UpperPage.Entry)^.LowerPageNo := SwapIntLE(Result);
      end;
    end;
    // store page
    TempFile.WriteRecord(Result, NewPage.PageBuffer);
  end;

  procedure CopySelectedIndex;
  var
    hdrPageNo: Integer;
  begin
    // copy current index settings
    Move(FIndexHeader^, TempIdxHeader^, RecordSize);
    // clear number of pages
    TempIdxHeader^.NumPages := PagesPerRecord;
    // allocate a page no for header
    hdrPageNo := AllocNewPageNo;
    // use recursive function to write all pages
    TempIdxHeader^.RootPage := SwapIntLE(WriteTree(FRoot));
{$ifdef TDBF_UPDATE_FIRSTLAST_NODE}
    TempIdxHeader^.FirstNode := TempIdxHeader^.RootPage;
{$endif}
    // write index header now we know the root page
    TempFile.WriteRecord(hdrPageNo, TempIdxHeader);
    if FIndexVersion >= xBaseIV then
    begin
      // calculate tag offset in tempfile header
      FTempMdxTag.Tag := PChar(TempFile.Header) + (PChar(CalcTagOffset(I)) - Header);
      FTempMdxTag.HeaderPageNo := hdrPageNo;
    end;
  end;

begin
  CheckExclusiveAccess;

  prevIndex := FSelectedIndex;
  newPageNo := HeaderSize div PageSize;
  TempFile := CreateTempFile(FileName);
  if FIndexVersion >= xBaseIV then
  begin
    // copy header
    Move(Header^, TempFile.Header^, HeaderSize);
    TouchHeader(TempFile.Header);
    // reset header
    PMdxHdr(TempFile.Header)^.NumPages := SwapIntLE(HeaderSize div PageSize);
    TempFile.WriteHeader;
    GetMem(TempIdxHeader, RecordSize);
    // now recreate indexes to that file
    for I := 0 to SwapWordLE(PMdxHdr(Header)^.TagsUsed - 1) do
    begin
      // select this index
      SelectIndexVars(I);
      CopySelectedIndex;
    end;
    FreeMem(TempIdxHeader);
  end else begin
    // indexversion = xBaseIII
    TempIdxHeader := PIndexHdr(TempFile.Header);
    CopySelectedIndex;
  end;
  TempFile.WriteHeader;
  TempFile.CloseFile;
  CloseFile;

  // rename temporary file if all went successfull
  if not TempFile.WriteError then
  begin
    SysUtils.DeleteFile(FileName);
    SysUtils.RenameFile(TempFile.FileName, FileName);
  end;

  TempFile.Free;
  DisableForceCreate;
  OpenFile;
  ReadIndexes;
  SelectIndexVars(prevIndex);
end;

procedure TIndexFile.CompactFile;
var
  TempFile: TPagedFile;
  TempIdxHeader: PIndexHdr;
  I, newPageNo: Integer;
  prevIndex: Integer;

  function  AllocNewPageNo: Integer;
  begin
    Result := newPageNo;
    Inc(newPageNo, PagesPerRecord);
    if FIndexVersion >= xBaseIV then
      IncIntLE(PMdxHdr(TempFile.Header)^.NumPages, PagesPerRecord);
    IncIntLE(TempIdxHeader^.NumPages, PagesPerRecord);
  end;

  function  CreateNewPage: TIndexPage;
  begin
    // create new page + space
    if FIndexVersion >= xBaseIV then
      Result := TMdxPage.Create(Self)
    else
      Result := TNdxPage.Create(Self);
    Result.FPageNo := AllocNewPageNo;

    // set new page properties
    Result.SetNumEntries(0);
  end;

  procedure GetNewEntry(APage: TIndexPage);
    // makes a new entry available and positions current 'pos' on it
    // NOTES: uses TIndexPage *very* carefully
    //  - may not read from self (tindexfile)
    //  - page.FLowerPage is assigned -> SyncLowerPage may *not* be called
    //  - do not set PageNo (= SetPageNo)
    //  - do not set EntryNo
  begin
    if APage.HighIndex >= SwapWordLE(PIndexHdr(FIndexHeader)^.NumKeys)-1 then
    begin
      if APage.UpperPage = nil then
      begin
        // add new upperlevel to page
        APage.FUpperPage := CreateNewPage;
        APage.UpperPage.FLowerPage := APage;
        APage.UpperPage.FEntryNo := 0;
        APage.UpperPage.FEntry := EntryEof;
        APage.UpperPage.GotoInsertEntry;
        APage.UpperPage.LocalInsert(0, APage.Key, APage.PageNo);
        // non-leaf pages need 'rightmost' key; numentries = real# - 1
        APage.UpperPage.SetNumEntries(0);
      end;

      // page done, store
      TempFile.WriteRecord(APage.FPageNo, APage.PageBuffer);

      // allocate new page
      APage.FPageNo := AllocNewPageNo;
      // clear
      APage.SetNumEntries(0);
      APage.FHighIndex := -1;
      APage.FLowIndex := 0;
      // clear 'right-most' blockno
      APage.SetRecLowerPageNoOfEntry(0, 0, 0);

      // get new entry in upper page for current new apage
      GetNewEntry(APage.UpperPage);
      APage.UpperPage.LocalInsert(0, nil, 0);
      // non-leaf pages need 'rightmost' key; numentries = real# - 1
      if APage.UpperPage.EntryNo = 0 then
        APage.UpperPage.SetNumEntries(0);
    end;
    APage.FEntryNo := APage.HighIndex+1;
    APage.FEntry := EntryEof;
    APage.GotoInsertEntry;
  end;

  procedure CopySelectedIndex;
  var
    APage: TIndexPage;
    hdrPageNo: Integer;
  begin
    // copy current index settings
    Move(FIndexHeader^, TempIdxHeader^, RecordSize);
    // clear number of pages
    TempIdxHeader^.NumPages := SwapIntLE(PagesPerRecord);
    // allocate a page no for header
    hdrPageNo := AllocNewPageNo;

    // copy all records
    APage := CreateNewPage;
    FLeaf.RecurFirst;
    while not (FRoot.Entry = FEntryEof) do
    begin
      GetNewEntry(APage);
      APage.LocalInsert(FLeaf.PhysicalRecNo, FLeaf.Key, 0);
      FLeaf.RecurNext;
    end;

    // flush remaining (partially filled) pages
    repeat
      TempFile.WriteRecord(APage.FPageNo, APage.PageBuffer);
      if APage.UpperPage <> nil then
        APage := APage.UpperPage
      else break;
    until false;

    // copy index header + root page
    TempIdxHeader^.RootPage := SwapIntLE(APage.PageNo);
{$ifdef TDBF_UPDATE_FIRSTLAST_NODE}
    TempIdxHeader^.FirstNode := SwapIntLE(APage.PageNo);
{$endif}
    // write index header now we know the root page
    TempFile.WriteRecord(hdrPageNo, TempIdxHeader);
    if FIndexVersion >= xBaseIV then
    begin
      // calculate tag offset in tempfile header
      FTempMdxTag.Tag := PChar(TempFile.Header) + (PChar(CalcTagOffset(I)) - Header);
      FTempMdxTag.HeaderPageNo := hdrPageNo;
    end;
  end;

begin
  CheckExclusiveAccess;

  prevIndex := FSelectedIndex;
  newPageNo := HeaderSize div PageSize;
  TempFile := CreateTempFile(FileName);
  if FIndexVersion >= xBaseIV then
  begin
    // copy header
    Move(Header^, TempFile.Header^, HeaderSize);
    TouchHeader(TempFile.Header);
    // reset header
    PMdxHdr(TempFile.Header)^.NumPages := SwapIntLE(HeaderSize div PageSize);
    TempFile.WriteHeader;
    GetMem(TempIdxHeader, RecordSize);
    // now recreate indexes to that file
    for I := 0 to SwapWordLE(PMdxHdr(Header)^.TagsUsed) - 1 do
    begin
      // select this index
      SelectIndexVars(I);
      CopySelectedIndex;
    end;
    FreeMem(TempIdxHeader);
  end else begin
    // indexversion = xBaseIII
    TempIdxHeader := PIndexHdr(TempFile.Header);
    CopySelectedIndex;
  end;
  TempFile.WriteHeader;
  TempFile.CloseFile;
  CloseFile;

  // rename temporary file if all went successfull
  if not TempFile.WriteError then
  begin
    SysUtils.DeleteFile(FileName);
    SysUtils.RenameFile(TempFile.FileName, FileName);
  end;

  TempFile.Free;
  DisableForceCreate;
  OpenFile;
  ReadIndexes;
  SelectIndexVars(prevIndex);
end;

procedure TIndexFile.PrepareRename(NewFileName: string);
begin
  if FIndexVersion >= xBaseIV then
  begin
    WriteDBFileName(PMdxHdr(Header), NewFileName);
    WriteFileHeader;
  end;
end;

function TIndexFile.GetNewPageNo: Integer;
var
  needLockHeader: Boolean;
begin
  // update header -> lock it if not already locked
  needLockHeader := FHeaderLocked <> 0;
  if needLockHeader then
  begin
    // lock header page
    LockPage(0, true);
    // someone else could be inserting records at the same moment
    if NeedLocks then
      inherited ReadHeader;
  end;
  if FIndexVersion >= xBaseIV then
  begin
    Result := SwapIntLE(PMdxHdr(Header)^.NumPages);
    IncIntLE(PMdxHdr(Header)^.NumPages, PagesPerRecord);
{$ifdef TDBF_UPDATE_FIRSTLAST_NODE}
    // adjust high page
    PIndexHdr(FIndexHeader)^.LastNode := SwapIntLE(Result);
{$endif}
    WriteFileHeader;
  end else begin
    Result := SwapIntLE(PIndexHdr(FIndexHeader)^.NumPages);
  end;
  IncIntLE(PIndexHdr(FIndexHeader)^.NumPages, PagesPerRecord);
  WriteHeader;
  // done updating header -> unlock if locked
  if needLockHeader then
    UnlockPage(0);
end;

function TIndexFile.Insert(RecNo: Integer; Buffer: TRecordBuffer): Boolean; {override;}
var
  I, curSel, count: Integer;
begin
  // check if updating all or only current
  FUserRecNo := RecNo;
  if (FUpdateMode = umAll) or (FSelectedIndex = -1) then
  begin
    // remember currently selected index
    curSel := FSelectedIndex;
    Result := true;
    I := 0;
    count := SwapWordLE(PMdxHdr(Header)^.TagsUsed);
    while I < count do
    begin
      SelectIndexVars(I);
      Result := InsertKey(Buffer);
      if not Result then
      begin
        while I > 0 do
        begin
          Dec(I);
          DeleteKey(Buffer);
        end;
        break;
      end;
      Inc(I);
    end;
    // restore previous selected index
    SelectIndexVars(curSel);
  end else begin
    Result := InsertKey(Buffer);
  end;

  // check range, disabled by insert
  ResyncRange(true);
end;

function TIndexFile.CheckKeyViolation(Buffer: TRecordBuffer): Boolean;
var
  I, curSel: Integer;
begin
  Result := false;
  FUserRecNo := -2;
  if FIndexVersion = xBaseIV then
  begin
    curSel := FSelectedIndex;
    for I := 0 to SwapWordLE(PMdxHdr(Header)^.TagsUsed) - 1 do
    begin
      SelectIndexVars(I);
      if FUniqueMode = iuDistinct then
      begin
        FUserKey := ExtractKeyFromBuffer(Buffer);
        Result := FindKey(false) = 0;
        if Result then
          break;
      end;
    end;
    SelectIndexVars(curSel);
  end else begin
    if FUniqueMode = iuDistinct then
    begin
      FUserKey := ExtractKeyFromBuffer(Buffer);
      Result := FindKey(false) = 0;
    end;
  end;
end;

function TIndexFile.PrepareKey(Buffer: TRecordBuffer; ResultType: TExpressionType): PChar;
var
  FloatRec: TFloatRec;
  I, IntSrc, NumDecimals: Integer;
  ExtValue: Extended;
  BCDdigit: Byte;
{$ifdef SUPPORT_INT64}
  Int64Src: Int64;
{$endif}

begin
  // need to convert numeric?
  Result := PChar(Buffer);
  if PIndexHdr(FIndexHeader)^.KeyType in ['N', 'F'] then
  begin
    if FIndexVersion = xBaseIII then
    begin
      // DB3 -> index always 8 byte float, if original integer, convert to double
      case ResultType of
        etInteger:
          begin
            FUserNumeric := PInteger(Result)^;
            Result := PChar(@FUserNumeric);
          end;
{$ifdef SUPPORT_INT64}
        etLargeInt:
          begin
            FUserNumeric := PLargeInt(Result)^;
            Result := PChar(@FUserNumeric);
          end;
{$endif}
      end;
    end else begin
      // DB4 MDX
      NumDecimals := 0;
      case ResultType of
        etInteger: 
          begin
            IntSrc := PInteger(Result)^;
            // handle zero differently: no decimals
            if IntSrc <> 0 then
              NumDecimals := GetStrFromInt(IntSrc, @FloatRec.Digits[0])
            else
              NumDecimals := 0;
            FloatRec.Negative := IntSrc < 0;
          end;
{$ifdef SUPPORT_INT64}
        etLargeInt:
          begin
            Int64Src := PLargeInt(Result)^;
            if Int64Src <> 0 then
              NumDecimals := GetStrFromInt64(Int64Src, @FloatRec.Digits[0])
            else
              NumDecimals := 0;
            FloatRec.Negative := Int64Src < 0;
          end;
{$endif}
        etFloat:
          begin
            ExtValue := PDouble(Result)^;
            FloatToDecimal(FloatRec, ExtValue, {$ifndef FPC_VERSION}fvExtended,{$endif} 9999, 15);
            if ExtValue <> 0.0 then
              NumDecimals := StrLen(@FloatRec.Digits[0])
            else
              NumDecimals := 0;
            // maximum number of decimals possible to encode in BCD is 16
            if NumDecimals > 16 then
              NumDecimals := 16;
          end;
      end;

      case ResultType of
        etInteger {$ifdef SUPPORT_INT64}, etLargeInt{$endif}:
          begin
            FloatRec.Exponent := NumDecimals;
            // MDX-BCD does not count ending zeroes as `data' space length
            while (NumDecimals > 0) and (FloatRec.Digits[NumDecimals-1] = '0') do
              Dec(NumDecimals);
            // null-terminate string
            FloatRec.Digits[NumDecimals] := #0;
          end;
      end;

      // write 'header', contains number of digits before decimal separator
      FUserBCD[0] := $34 + FloatRec.Exponent;
      // clear rest of BCD
      FillChar(FUserBCD[1], SizeOf(FUserBCD)-1, 0);
      // store number of bytes used (in number of bits + 1)
      FUserBCD[1] := (((NumDecimals+1) div 2) * 8) + 1;
      // where to store decimal dot position? now implicitly in first byte
      // store negative sign
      if FloatRec.Negative then
        FUserBCD[1] := FUserBCD[1] or $80;
      // convert string to BCD
      I := 0;
      while I < NumDecimals do
      begin
        // only one byte left?
        if FloatRec.Digits[I+1] = #0 then
          BCDdigit := 0
        else
          BCDdigit := Byte(FloatRec.Digits[I+1]) - Byte('0');
        // pack two bytes into bcd
        FUserBCD[2+(I div 2)] := ((Byte(FloatRec.Digits[I]) - Byte('0')) shl 4) or BCDdigit;
        // goto next 2 bytes
        Inc(I, 2);
      end;

      // set result pointer to BCD
      Result := PChar(@FUserBCD[0]);
    end;
  end;
end;

function TIndexFile.ExtractKeyFromBuffer(Buffer: TRecordBuffer): PChar;
begin
  // execute expression to get key
  Result := PrepareKey(TRecordBuffer(FCurrentParser.ExtractFromBuffer(Buffer)), FCurrentParser.ResultType);
  if FCurrentParser.StringFieldMode <> smRaw then
    TranslateString(GetACP, FCodePage, Result, Result, KeyLen);
end;

function TIndexFile.InsertKey(Buffer: TRecordBuffer): boolean;
begin
  Result := true;
  // ignore deleted records
  if (FModifyMode = mmNormal) and (FUniqueMode = iuDistinct) and (AnsiChar(Buffer^) = '*') then
    exit;
  // check proper index and modifiability
  if FCanEdit and (PIndexHdr(FIndexHeader)^.KeyLen <> 0) then
  begin
    // get key from buffer
    FUserKey := ExtractKeyFromBuffer(Buffer);
    // patch through
    Result := InsertCurrent;
  end;
end;

function TIndexFile.InsertCurrent: boolean;
  // insert in current index
  // assumes: FUserKey is an OEM key
begin
  // only insert if not recalling or mode = distinct
  // modify = mmDeleteRecall /\ unique <> distinct -> key already present
  Result := true;
  if (FModifyMode <> mmDeleteRecall) or (FUniqueMode = iuDistinct) then
  begin
    // temporarily remove range to find correct location of key
    ResetRange;
    // find this record as closely as possible
    // if result = 0 then key already exists
    // if unique index, then don't insert key if already present
    if (FindKey(true) <> 0) or (FUniqueMode = iuNormal) then
    begin
      // if we found eof, write to pagebuffer
      FLeaf.GotoInsertEntry;
      // insert requested entry, we know there is an entry available
      FLeaf.LocalInsert(FUserRecNo, FUserKey, 0);
    end else begin
      // key already exists -> test possible key violation
      if FUniqueMode = iuDistinct then
      begin
        // raising -> reset modify mode
        FModifyMode := mmNormal;
        ConstructInsertErrorMsg;
        Result := false;
      end;
    end;
  end;
end;

procedure TIndexFile.ConstructInsertErrorMsg;
var
  InfoKey: string;
begin
  if Length(FLastError) > 0 then exit;
  InfoKey := FUserKey;
  SetLength(InfoKey, KeyLen);
  FLastError := Format(STRING_KEY_VIOLATION, [GetName,
    PhysicalRecNo, TrimRight(InfoKey)]);
end;

procedure TIndexFile.InsertError;
var
  errorStr: string;
begin
  errorStr := FLastError;
  FLastError := '';
  raise EDbfError.Create(errorStr);
end;

procedure TIndexFile.Delete(RecNo: Integer; Buffer: TRecordBuffer);
var
  I, curSel: Integer;
begin
  // check if updating all or only current
  FUserRecNo := RecNo;
  if (FUpdateMode = umAll) or (FSelectedIndex = -1) then
  begin
    // remember currently selected index
    curSel := FSelectedIndex;
    for I := 0 to SwapWordLE(PMdxHdr(Header)^.TagsUsed) - 1 do
    begin
      SelectIndexVars(I);
      DeleteKey(Buffer);
    end;
    // restore previous selected index
    SelectIndexVars(curSel);
  end else begin
    DeleteKey(Buffer);
  end;
  // range may be changed
  ResyncRange(true);
end;

procedure TIndexFile.DeleteKey(Buffer: TRecordBuffer);
begin
  if FCanEdit and (PIndexHdr(FIndexHeader)^.KeyLen <> 0) then
  begin
    // get key from record buffer
    FUserKey := ExtractKeyFromBuffer(Buffer);
    // call function
    DeleteCurrent;
  end;
end;

procedure TIndexFile.DeleteCurrent;
  // deletes from current index
begin
  // only delete if not delete record or mode = distinct
  // modify = mmDeleteRecall /\ unique = distinct -> key needs to be deleted from index
  if (FModifyMode <> mmDeleteRecall) or (FUniqueMode = iuDistinct) then
  begin
    // prevent "confined" view of index while deleting
    ResetRange;
    // search correct entry to delete
    if FLeaf.PhysicalRecNo <> FUserRecNo then
    begin
      FindKey(false);
    end;
    // delete selected entry
    FLeaf.Delete;
  end;
end;

function TIndexFile.UpdateIndex(Index: Integer; PrevBuffer, NewBuffer: TRecordBuffer): Boolean;
begin
  SelectIndexVars(Index);
  Result := UpdateCurrent(PrevBuffer, NewBuffer);
end;

function TIndexFile.Update(RecNo: Integer; PrevBuffer, NewBuffer: TRecordBuffer): Boolean;
var
  I, curSel, count: Integer;
begin
  // check if updating all or only current
  FUserRecNo := RecNo;
  if (FUpdateMode = umAll) or (FSelectedIndex = -1) then
  begin
    // remember currently selected index
    curSel := FSelectedIndex;
    Result := true;
    I := 0;
    count := SwapWordLE(PMdxHdr(Header)^.TagsUsed);
    while I < count do
    begin
      Result := UpdateIndex(I, PrevBuffer, NewBuffer);
      if not Result then
      begin
        // rollback updates to previous indexes
        while I > 0 do
        begin
          Dec(I);
          UpdateIndex(I, NewBuffer, PrevBuffer);
        end;
        break;
      end;
      Inc(I);
    end;
    // restore previous selected index
    SelectIndexVars(curSel);
  end else begin
    Result := UpdateCurrent(PrevBuffer, NewBuffer);
  end;
  // check range, disabled by delete/insert
  if (FRoot.LowPage = 0) and (FRoot.HighPage = 0) then
    ResyncRange(true);
end;

function TIndexFile.UpdateCurrent(PrevBuffer, NewBuffer: TRecordBuffer): boolean;
var
  InsertKey, DeleteKey: PChar;
  TempBuffer: array [0..100] of Char;
begin
  Result := true;
  if FCanEdit and (PIndexHdr(FIndexHeader)^.KeyLen <> 0) then
  begin
    DeleteKey := ExtractKeyFromBuffer(PrevBuffer);
    Move(DeleteKey^, TempBuffer, SwapWordLE(PIndexHdr(FIndexHeader)^.KeyLen));
    DeleteKey := @TempBuffer[0];
    InsertKey := ExtractKeyFromBuffer(NewBuffer);

    // compare to see if anything changed
    if CompareKeys(DeleteKey, InsertKey) <> 0 then
    begin
      FUserKey := DeleteKey;
      DeleteCurrent;
      FUserKey := InsertKey;
      Result := InsertCurrent;
      if not Result then
      begin
        FUserKey := DeleteKey;
        InsertCurrent;
        FUserKey := InsertKey;
      end;
    end;
  end;
end;

procedure TIndexFile.AddNewLevel;
var
  lNewPage: TIndexPage;
  pKeyData: PChar;
begin
  // create new page + space
  if FIndexVersion >= xBaseIV then
    lNewPage := TMdxPage.Create(Self)
  else
    lNewPage := TNdxPage.Create(Self);
  lNewPage.GetNewPage;

  // lock this new page; will be unlocked by caller
  lNewPage.LockPage;
  // lock index header; will be unlocked by caller
  LockPage(FHeaderPageNo, true);
  FHeaderLocked := FHeaderPageNo;

  // modify header
  PIndexHdr(FIndexHeader)^.RootPage := SwapIntLE(lNewPage.PageNo);

  // set new page properties
  lNewPage.SetNumEntries(0);
  lNewPage.EntryNo := 0;
  lNewPage.GotoInsertEntry;
{$ifdef TDBF_UPDATE_FIRST_LAST_NODE}
  lNewPage.SetPrevBlock(lNewPage.PageNo - PagesPerRecord);
{$endif}
  pKeyData := FRoot.GetKeyDataFromEntry(0);
  lNewPage.FLowerPage := FRoot;
  lNewPage.FHighIndex := 0;
  lNewPage.SetEntry(0, pKeyData, FRoot.PageNo);

  // update root pointer
  FRoot.UpperPage := lNewPage;
  FRoots[FSelectedIndex] := lNewPage;
  FRoot := lNewPage;

  // write new header
  WriteRecord(FHeaderPageNo, FIndexHeader);
end;

procedure TIndexFile.UnlockHeader;
begin
  if FHeaderLocked <> -1 then
  begin
    UnlockPage(FHeaderLocked);
    FHeaderLocked := -1;
  end;
end;

procedure TIndexFile.ResyncRoot;
begin
  if FIndexVersion >= xBaseIV then
  begin
    // read header page
    inherited ReadRecord(FHeaderPageNo, FIndexHeader);
  end else
    inherited ReadHeader;
  // reread tree
  FRoot.PageNo := SwapIntLE(PIndexHdr(FIndexHeader)^.RootPage);
end;

function TIndexFile.SearchKey(Key: PChar; SearchType: TSearchKeyType): Boolean;
var
  findres, currRecNo: Integer;
begin
  // save current position
  currRecNo := SequentialRecNo;
  // search, these are always from the root: no need for first
  findres := Find(-2, Key);
  // test result
  case SearchType of
    stEqual:
      Result := findres = 0;
    stGreaterEqual:
      Result := findres <= 0;
    stGreater:
      begin
        if findres = 0 then
        begin
          // find next record that is greater
          // NOTE: MatchKey assumes key to search for is already specified
          //   in FUserKey, it is because we have called Find
          repeat
            Result := WalkNext;
          until not Result or (MatchKey(Key) <> 0);
        end else
          Result := findres < 0;
      end;
    else
      Result := false;
  end;
  // search failed -> restore previous position
  if not Result then
    SequentialRecNo := currRecNo;
end;

function TIndexFile.Find(RecNo: Integer; Buffer: PChar): Integer;
begin
  // execute find
  FUserRecNo := RecNo;
  FUserKey := Buffer;
  Result := FindKey(false);
end;

function TIndexFile.FindKey(AInsert: boolean): Integer;
//
// if you set Insert = true, you need to re-enable range after insert!!
//
var
  TempPage, NextPage: TIndexPage;
  numEntries, numKeysAvail, done, searchRecNo: Integer;
begin
  // reread index header (to discover whether root page changed)
  if NeedLocks then
    ResyncRoot;
  // if distinct or unique index -> every entry only occurs once ->
  // does not matter which recno we search -> search recno = -2 ->
  // extra info = recno
  if (FUniqueMode = iuNormal) then
  begin
    // if inserting, search last entry matching key
    if AInsert then
      searchRecNo := -3
    else
      searchRecNo := FUserRecNo
  end else begin
    searchRecNo := -2;
  end;
  // start from root
  TempPage := FRoot;
  repeat
    // find key
    done := 0;
    Result := TempPage.FindNearest(searchRecNo);
    if TempPage.LowerPage = nil then
    begin
      // if key greater than last, try next leaf
      if (Result > 0) and (searchRecNo > 0) then
      begin
        // find first parent in tree so we can advance to next item
        NextPage := TempPage;
        repeat
          NextPage := NextPage.UpperPage;
        until (NextPage = nil) or (NextPage.EntryNo < NextPage.HighIndex);
        // found page?
        if NextPage <> nil then
        begin
          // go to parent
          TempPage := NextPage;
          TempPage.EntryNo := TempPage.EntryNo + 1;
          // resync rest of tree
          TempPage.LowerPage.RecurFirst;
          // go to lower page to continue search
          TempPage := TempPage.LowerPage;
          // check if still more lowerpages
          if TempPage.LowerPage <> nil then
          begin
            // flag we need to traverse down further
            done := 2;
          end else begin
            // this is next child, we don't know if found
            done := 1;
          end;
        end;
      end;
    end else begin
      // need to traverse lower down
      done := 2;
    end;

    // check if we need to split page
    // done = 1 -> not found entry on insert path yet
    if AInsert and (done <> 1) then
    begin
      // now we are on our path to destination where entry is to be inserted
      // check if this page is full, then split it
      numEntries := TempPage.NumEntries;
      // if this is inner node, we can only store one less than max entries
      numKeysAvail := SwapWordLE(PIndexHdr(FIndexHeader)^.NumKeys) - numEntries;
      if TempPage.LowerPage <> nil then
        dec(numKeysAvail);
      // too few available -> split
      if numKeysAvail = 0 then
        TempPage.Split;
    end;

    // do we need to go lower down?
    if done = 2 then
      TempPage := TempPage.LowerPage;
  until done = 0;
end;

function TIndexFile.MatchKey(UserKey: PChar): Integer;
begin
  // BOF and EOF always false
  if FLeaf.Entry = FEntryBof then
    Result := 1
  else
  if FLeaf.Entry = FEntryEof then
    Result := -1
  else begin
    FUserKey := UserKey;
    Result := FLeaf.MatchKey;
  end;
end;

procedure TIndexFile.SetRange(LowRange, HighRange: PChar);
begin
  Move(LowRange^, FLowBuffer[0], KeyLen);
  Move(HighRange^, FHighBuffer[0], KeyLen);
  FRangeActive := true;
  ResyncRange(true);
end;

procedure TIndexFile.RecordDeleted(RecNo: Integer; Buffer: TRecordBuffer);
begin
  // are we distinct -> then delete record from index
  FModifyMode := mmDeleteRecall;
  Delete(RecNo, Buffer);
  FModifyMode := mmNormal;
end;

function TIndexFile.RecordRecalled(RecNo: Integer; Buffer: TRecordBuffer): Boolean;
begin
  // are we distinct -> then reinsert record in index
  FModifyMode := mmDeleteRecall;
  Result := Insert(RecNo, Buffer);
  FModifyMode := mmNormal;
end;

procedure TIndexFile.SetPhysicalRecNo(RecNo: Integer);
begin
  // check if already at specified recno
  if FLeaf.PhysicalRecNo = RecNo then
    exit;

  // check record actually exists
  if TDbfFile(FDbfFile).IsRecordPresent(RecNo) then
  begin
    // read buffer of this RecNo
    TDbfFile(FDbfFile).ReadRecord(RecNo, TDbfFile(FDbfFile).PrevBuffer);
    // extract key
    FUserKey := ExtractKeyFromBuffer(TDbfFile(FDbfFile).PrevBuffer);
    // find this key
    FUserRecNo := RecNo;
    FindKey(false);
  end;
end;

procedure TIndexFile.SetUpdateMode(NewMode: TIndexUpdateMode);
begin
  // if there is only one index, don't waste time and just set single
  if (FIndexVersion = xBaseIII) or (SwapWordLE(PMdxHdr(Header)^.TagsUsed) <= 1) then
    FUpdateMode := umCurrent
  else
    FUpdateMode := NewMode;
end;

procedure TIndexFile.WalkFirst;
begin
  // search first node
  FRoot.RecurFirst;
  // out of index - BOF
  FLeaf.EntryNo := FLeaf.EntryNo - 1;
end;

procedure TIndexFile.WalkLast;
begin
  // search last node
  FRoot.RecurLast;
  // out of index - EOF
  // we need to skip two entries to go out-of-bound
  FLeaf.EntryNo := FLeaf.EntryNo + 2;
end;

procedure TIndexFile.First;
begin
  // resync tree
  Resync(false);
  WalkFirst;
end;

procedure TIndexFile.Last;
begin
  // resync tree
  Resync(false);
  WalkLast;
end;

procedure TIndexFile.ResyncRange(KeepPosition: boolean);
var
  Result: Boolean;
  currRecNo: integer;
begin
  if not FRangeActive then
    exit;

  // disable current range if any
  //  init to 0 to suppress delphi warning
  currRecNo := 0;
  if KeepPosition then
    currRecNo := SequentialRecNo;
  ResetRange;
  // search lower bound
  Result := SearchKey(FLowBuffer, stGreaterEqual);
  if not Result then
  begin
    // not found? -> make empty range
    WalkLast;
  end;
  // set lower bound
  SetBracketLow;
  // search upper bound
  Result := SearchKey(FHighBuffer, stGreater);
  // if result true, then need to get previous item <=>
  //    last of equal/lower than key
  if Result then
  begin
    Result := WalkPrev;
    if not Result then
    begin
      // cannot go prev -> empty range
      WalkFirst;
    end;
  end else begin
    // not found -> EOF found, go EOF, then to last record
    WalkLast;
    WalkPrev;
  end;
  // set upper bound
  SetBracketHigh;
  if KeepPosition then
    SequentialRecNo := currRecNo;
end;

procedure TIndexFile.Resync(Relative: boolean);
begin
  if NeedLocks then
  begin
    if not Relative then
    begin
      ResyncRoot;
      ResyncRange(false);
    end else begin
      // resyncing tree implies resyncing range
      ResyncTree;
    end;
  end;
end;

procedure TIndexFile.ResyncTree;
var
  action, recno: integer;
begin
  // if at BOF or EOF, then we need to resync by first or last
  // remember where the cursor was
  //  init to 0 to suppress delphi warning
  recno := 0;
  if FLeaf.Entry = FEntryBof then
  begin
    action := 0;
  end else if FLeaf.Entry = FEntryEof then begin
    action := 1;
  end else begin
    // read current key into buffer
    Move(FLeaf.Key^, FKeyBuffer, SwapWordLE(PIndexHdr(FIndexHeader)^.KeyLen));
    recno := FLeaf.PhysicalRecNo;
    action := 2;
  end;

  // we now know cursor position, resync possible range
  ResyncRange(false);
  
  // go to cursor position
  case action of
    0: WalkFirst;
    1: WalkLast;
    2:
    begin
      // search current in-mem key on disk
      if (Find(recno, FKeyBuffer) <> 0) then
      begin
        // houston, we've got a problem!
        // our `current' record has gone. we need to find it
        // find it by using physical recno
        PhysicalRecNo := recno;
      end;
    end;
  end;
end;

function TIndexFile.WalkPrev: boolean;
var
  curRecNo: Integer;
begin
  // save current recno, find different next!
  curRecNo := FLeaf.PhysicalRecNo;
  repeat
    // return false if we are at first entry
    Result := FLeaf.RecurPrev;
  until not Result or (curRecNo <> FLeaf.PhysicalRecNo);
end;

function TIndexFile.WalkNext: boolean;
var
  curRecNo: Integer;
begin
  // save current recno, find different prev!
  curRecNo := FLeaf.PhysicalRecNo;
  repeat
    // return false if we are at last entry
    Result := FLeaf.RecurNext;
  until not Result or (curRecNo <> FLeaf.PhysicalRecNo);
end;

function TIndexFile.Prev: Boolean;
begin
  // resync in-mem tree with tree on disk
  Resync(true);
  Result := WalkPrev;
end;

function TIndexFile.Next: Boolean;
begin
  // resync in-mem tree with tree on disk
  Resync(true);
  Result := WalkNext;
end;

function TIndexFile.GetKeyLen: Integer;
begin
  Result := SwapWordLE(PIndexHdr(FIndexHeader)^.KeyLen);
end;

function TIndexFile.GetKeyType: Char;
begin
  Result := PIndexHdr(FIndexHeader)^.KeyType;
end;

function TIndexFile.GetPhysicalRecNo: Integer;
begin
  Result := FLeaf.PhysicalRecNo;
end;

function TIndexFile.GetSequentialRecordCount: Integer;
begin
  Result := FRoot.Weight * (FRoot.HighIndex + 1);
end;

function TIndexFile.GetSequentialRecNo: Integer;
var
  TempPage: TIndexPage;
begin
  // check if at BOF or EOF, special values
  if FLeaf.EntryNo < FLeaf.LowIndex then begin
    Result := RecBOF;
  end else if FLeaf.EntryNo > FLeaf.HighIndex then begin
    Result := RecEOF;
  end else begin
    // first record is record 1
    Result := 1;
    TempPage := FRoot;
    repeat
      inc(Result, TempPage.EntryNo * TempPage.Weight);
      TempPage := TempPage.LowerPage;
    until TempPage = nil;
  end;
end;

procedure TIndexFile.SetSequentialRecNo(RecNo: Integer);
var
  TempPage: TIndexPage;
  gotoEntry: Integer;
begin
  // use our weighting system to quickly go to a seq recno
  // recno starts at 1, entries at zero
  Dec(RecNo);
  TempPage := FRoot;
  repeat
    // don't div by zero
    assert(TempPage.Weight > 0);
    gotoEntry := RecNo div TempPage.Weight;
    RecNo := RecNo mod TempPage.Weight;
    // do we have this much entries?
    if (TempPage.HighIndex < gotoEntry) then
    begin
      // goto next entry in upper page if not
      // if recurnext fails, we have come at the end of the index
      if (TempPage.UpperPage <> nil) and TempPage.UpperPage.RecurNext then
      begin
        // lower recno to get because we skipped an entry
        TempPage.EntryNo := TempPage.LowIndex;
        RecNo := 0;
      end else begin
        // this can only happen if too big RecNo was entered, go to last
        TempPage.RecurLast;
        // terminate immediately
        TempPage := FLeaf;
      end;
    end else begin
      TempPage.EntryNo := gotoEntry;
    end;
    // get lower node
    TempPage := TempPage.LowerPage;
  until TempPage = nil;
end;

procedure TIndexFile.SetBracketLow;
var
  TempPage: TIndexPage;
begin
  // set current record as lower bound
  TempPage := FRoot;
  repeat
    TempPage.LowBracket := TempPage.EntryNo;
    TempPage.LowPage := TempPage.PageNo;
    TempPage := TempPage.LowerPage;
  until TempPage = nil;
end;

procedure TIndexFile.SetBracketHigh;
var
  TempPage: TIndexPage;
begin
  // set current record as lower bound
  TempPage := FRoot;
  repeat
    TempPage.HighBracket := TempPage.EntryNo;
    TempPage.HighPage := TempPage.PageNo;
    TempPage := TempPage.LowerPage;
  until TempPage = nil;
end;

procedure TIndexFile.CancelRange;
begin
  FRangeActive := false;
  ResetRange;
end;

procedure TIndexFile.ResetRange;
var
  TempPage: TIndexPage;
begin
  // disable lower + upper bound
  TempPage := FRoot;
  repeat
    // set a page the index should never reach
    TempPage.LowPage := 0;
    TempPage.HighPage := 0;
    TempPage := TempPage.LowerPage;
  until TempPage = nil;
end;

procedure TIndexFile.DisableRange;
var
  TempPage: TIndexPage;
begin
  TempPage := FRoot;
  repeat
    TempPage.SaveBracket;
    TempPage := TempPage.LowerPage;
  until TempPage = nil;
  CancelRange;
end;

procedure TIndexFile.EnableRange;
var
  TempPage: TIndexPage;
begin
  TempPage := FRoot;
  repeat
    TempPage.RestoreBracket;
    TempPage := TempPage.LowerPage;
  until TempPage = nil;
  FRangeActive := true;
end;

function MemComp(P1, P2: Pointer; const Length: Integer): Integer;
var
  I: Integer;
begin
  for I := 0 to Length - 1 do
  begin
    // still equal?
    if PByte(P1)^ <> PByte(P2)^ then
    begin
      Result := Integer(PByte(P1)^) - Integer(PByte(P2)^);
      exit;
    end;
    // go to next byte
    Inc(PChar(P1));
    Inc(PChar(P2));
  end;

  // memory equal
  Result := 0;
end;

function TIndexFile.CompareKeys(Key1, Key2: PChar): Integer;
begin
  // call compare routine
  Result := FCompareKeys(Key1, Key2);

  // if descending then reverse order
  if FIsDescending then
    Result := -Result;
end;

function TIndexFile.CompareKeysNumericNDX(Key1, Key2: PChar): Integer;
var
  v1,v2: Double;
begin
  v1 := PDouble(Key1)^;
  v2 := PDouble(Key2)^;
  if v1 > v2 then Result := 1
  else if v1 < v2 then Result := -1
  else Result := 0;
end;

function TIndexFile.CompareKeysNumericMDX(Key1, Key2: PChar): Integer;
var
  neg1, neg2: Boolean;
begin
  // first byte - $34 contains dot position
  neg1 := (Byte(Key1[1]) and $80) <> 0;
  neg2 := (Byte(Key2[1]) and $80) <> 0;
  // check if both negative or both positive
  if neg1 = neg2 then
  begin
    // check alignment
    if Key1[0] = Key2[0] then
    begin
      // no alignment needed -> have same alignment
      Result := MemComp(Key1+2, Key2+2, 10-2);
    end else begin
      // greater 10-power implies bigger number except for zero
      if (Byte(Key1[0]) = $01) and (Byte(Key1[1]) = $34) then
        Result := -1
      else
      if (Byte(Key2[0]) = $01) and (Byte(Key2[1]) = $34) then
        Result := 1
      else
        Result := Byte(Key1[0]) - Byte(Key2[0]);
    end;
    // negate result if both negative
    if neg1 and neg2 then
      Result := -Result;
  end else if neg1 {-> not neg2} then
    Result := -1
  else { not neg1 and neg2 }
    Result := 1;
end;

function TIndexFile.CompareKeysString(Key1, Key2: PChar): Integer;
begin
  Result := DbfCompareString(FCollation, Key1, KeyLen, Key2, KeyLen);
  if Result > 0 then
    Dec(Result, 2);
end;

function TIndexFile.CompareKey(Key: PChar): Integer;
begin
  Result := CompareKeys(FUserKey, Key);
end;

function TIndexFile.IndexOf(const AIndexName: string): Integer;
  // *) assumes FIndexVersion >= xBaseIV
var
  I: Integer;
begin
  // get index of this index :-)
  Result := -1;
  for I := 0 to SwapWordLE(PMdxHdr(Header)^.TagsUsed) - 1 do
  begin
    FTempMdxTag.Tag := CalcTagOffset(I);
    if AnsiCompareText(AIndexName, FTempMdxTag.TagName) = 0 then
    begin
      Result := I;
      break;
    end;
  end;
end;

procedure TIndexFile.SetIndexName(const AIndexName: string);
var
  found: Integer;
begin
  // we can only select a different index if we are MDX
  if FIndexVersion >= xBaseIV then
  begin
    // find index
    found := IndexOf(AIndexName);
  end else
    found := 0;
  // if changing index, range is N/A anymore
  if FRangeActive and (found <> FSelectedIndex) then
  begin
    FRangeIndex := FSelectedIndex;
    DisableRange;
  end;
  // we can now select by index
  if found >= 0 then
  begin
    SelectIndexVars(found);
    if found = FRangeIndex then
    begin
      EnableRange;
      FRangeIndex := -1;
    end;
  end;
end;

function TIndexFile.CalcTagOffset(AIndex: Integer): Pointer;
begin
  Result := PChar(Header) + FTagOffset + AIndex * FTagSize;
end;

procedure TIndexFile.SelectIndexVars(AIndex: Integer);
  // *) assumes index is in range
begin
  if AIndex >= 0 then
  begin
    // get pointer to index header
    FIndexHeader := FIndexHeaders[AIndex];
    // load root + leaf
    FCurrentParser := FParsers[AIndex];
    FRoot := FRoots[AIndex];
    FLeaf := FLeaves[AIndex];
    // if xBaseIV then we need to store where pageno of current header
    if FIndexVersion >= xBaseIV then
    begin
      FMdxTag.Tag := CalcTagOffset(AIndex);
      FIndexName := FMdxTag.TagName;
      FHeaderPageNo := FMdxTag.HeaderPageNo;
      // does dBase actually use this flag?
//      FIsExpression := FMdxTag.KeyFormat = KeyFormat_Expression;
    end else begin
      // how does dBase III store whether it is expression?
//      FIsExpression := true;
    end;
    // retrieve properties
    UpdateIndexProperties;
  end else begin
    // not a valid index
    FIndexName := EmptyStr;
  end;
  // store selected index
  FSelectedIndex := AIndex;
  FCanEdit := not FForceReadOnly;
end;

procedure TIndexFile.UpdateIndexProperties;
begin
  // get properties
  FIsDescending := (PIndexHdr(FIndexHeader)^.KeyFormat and KeyFormat_Descending) <> 0;
  FUniqueMode := iuNormal;
  if (PIndexHdr(FIndexHeader)^.KeyFormat and KeyFormat_Unique) <> 0 then
    FUniqueMode := iuUnique;
  if (PIndexHdr(FIndexHeader)^.KeyFormat and KeyFormat_Distinct) <> 0 then
    FUniqueMode := iuDistinct;
  // select key compare routine
  if PIndexHdr(FIndexHeader)^.KeyType = 'C' then
    FCompareKeys := CompareKeysString
  else
  if FIndexVersion >= xBaseIV then
    FCompareKeys := CompareKeysNumericMDX
  else
    FCompareKeys := CompareKeysNumericNDX;
end;

procedure TIndexFile.Flush;
var
  I: Integer;
begin
  // save changes to pages
  if FIndexVersion >= xBaseIV then
  begin
    for I := 0 to MaxIndexes - 1 do
    begin
      if FIndexHeaderModified[I] then
        WriteIndexHeader(I);
      if FRoots[I] <> nil then
        FRoots[I].Flush
    end;
  end else begin
    if FRoot <> nil then
      FRoot.Flush;
  end;

  // save changes to header
  FlushHeader;

  inherited;
end;

(*

function TIndexFile.GetIndexCount: Integer;
begin
  if FIndexVersion = xBaseIII then
    Result := 1
  else
  if FIndexVersion = xBaseIV then
    Result := PMdxHdr(Header).TagsUsed;
  else
    Result := 0;
end;

*)

procedure TIndexFile.GetIndexNames(const AList: TStrings);
var
  I: Integer;
begin
  // only applicable to MDX files
  if FIndexVersion >= xBaseIV then
  begin
    for I := 0 to SwapWordLE(PMdxHdr(Header)^.TagsUsed) - 1 do
    begin
      FTempMdxTag.Tag := CalcTagOffset(I);
      AList.AddObject(FTempMdxTag.TagName, Self);
    end;
  end;
end;

procedure TIndexFile.GetIndexInfo(const AIndexName: string; IndexDef: TDbfIndexDef);
var
  SaveIndexName: string;
begin
  // remember current index
  SaveIndexName := IndexName;
  // select index
  IndexName := AIndexName;
  // copy properties
  IndexDef.IndexFile := AIndexName;
  IndexDef.Expression := PIndexHdr(FIndexHeader)^.KeyDesc;
  IndexDef.Options := [];
  IndexDef.Temporary := true;
  if FIsDescending then
    IndexDef.Options := IndexDef.Options + [ixDescending];
  IndexDef.Options := IndexDef.Options + [ixExpression];
  case FUniqueMode of
    iuUnique: IndexDef.Options := IndexDef.Options + [ixUnique];
    iuDistinct: IndexDef.Options := IndexDef.Options + [ixPrimary];
  end;
  // reselect previous index
  IndexName := SaveIndexName;
end;

function TIndexFile.GetExpression: string;
begin
  if FCurrentParser <> nil then
    Result := FCurrentParser.Expression
  else
    Result := EmptyStr;
end;

function TIndexFile.GetDbfLanguageId: Byte;
begin
  // check if parent DBF version 7, get language id
  if (TDbfFile(FDbfFile).DbfVersion = xBaseVII) then
  begin
    // get language id of parent dbf
    Result := GetLangId_From_LangName(TDbfFile(FDbfFile).LanguageStr);
  end else begin
    // dBase IV has language id in header
    Result := TDbfFile(FDbfFile).LanguageID;
  end;
end;

procedure TIndexFile.WriteHeader; {override;}
begin
  // if NDX, then this means file header
  if FIndexVersion >= xBaseIV then
    if NeedLocks then
      WriteIndexHeader(FSelectedIndex)
    else
      FIndexHeaderModified[FSelectedIndex] := true
  else
    WriteFileHeader;
end;

procedure TIndexFile.WriteFileHeader;
begin
  inherited WriteHeader;
end;

procedure TIndexFile.WriteIndexHeader(AIndex: Integer);
begin
  FTempMdxTag.Tag := CalcTagOffset(AIndex);
  WriteRecord(FTempMdxTag.HeaderPageNo, FIndexHeaders[AIndex]);
  FIndexHeaderModified[AIndex] := false;
end;

//==========================================================
//============ TDbfIndexDef
//==========================================================

constructor TDbfIndexDef.Create(ACollection: TCollection); {override;}
begin
  inherited Create(ACollection);
  FTemporary := false;
end;

destructor TDbfIndexDef.Destroy; {override;}
begin
  inherited Destroy;
end;

procedure TDbfIndexDef.Assign(Source: TPersistent);
begin
  // we can't do anything with it if not a TDbfIndexDef
  if Source is TDbfIndexDef then
  begin
    FIndexName := TDbfIndexDef(Source).IndexFile;
    FExpression := TDbfIndexDef(Source).Expression;
    FOptions := TDbfIndexDef(Source).Options;
  end else
    inherited;
end;

procedure TDbfIndexDef.SetIndexName(NewName: string);
begin
  FIndexName := AnsiUpperCase(Trim(NewName));
end;

procedure TDbfIndexDef.SetExpression(NewField: string);
begin
  FExpression := AnsiUpperCase(Trim(NewField));
end;

initialization

{
  Entry_Mdx_BOF.RecBlockNo := RecBOF;
  Entry_Mdx_BOF.KeyData := #0;

  Entry_Mdx_EOF.RecBlockNo := RecEOF;
  Entry_Mdx_EOF.KeyData := #0;

  Entry_Ndx_BOF.LowerPageNo := 0;
  Entry_Ndx_BOF.RecNo := RecBOF;
  Entry_Ndx_BOF.KeyData := #0;

  Entry_Ndx_EOF.LowerPageNo := 0;
  Entry_Ndx_EOF.RecNo := RecEOF;
  Entry_Ndx_EOF.KeyData := #0;
}

  LCIDList := TLCIDList.Create;
  LCIDList.Enumerate;

finalization

  LCIDList.Free;

end.