Updated to version 6.3.4

fcl/db/dbase/Dbf.pas

@@ -0,0 +1,2828 @@
+unit Dbf;
+
+{ design info in dbf_reg.pas }
+
+interface
+
+{$I Dbf_Common.inc}
+
+uses
+  Classes,
+  Db,
+  Dbf_Common,
+  Dbf_DbfFile,
+  Dbf_Parser,
+  Dbf_Cursor,
+  Dbf_Fields,
+  Dbf_IdxFile;
+// If you got a compilation error here or asking for dsgnintf.pas, then just add
+// this file in your project:
+// dsgnintf.pas in 'C: \Program Files\Borland\Delphi5\Source\Toolsapi\dsgnintf.pas'
+
+type
+
+//====================================================================
+  pDbfRecord = ^rDbfRecordHeader;
+  rDbfRecordHeader = record
+    BookmarkData: rBookmarkData;
+    BookmarkFlag: TBookmarkFlag;
+    DeletedFlag: Char;
+  end;
+//====================================================================
+  TDbf = class;
+//====================================================================
+  TDbfStorage = (stoMemory,stoFile);
+  TDbfOpenMode = (omNormal,omAutoCreate,omTemporary);
+  TDbfLanguageAction = (laReadOnly, laForceOEM, laForceANSI, laDefault);
+  TDbfTranslationMode = (tmNoneAvailable, tmNoneNeeded, tmSimple, tmAdvanced);
+  TDbfFileName = (dfDbf, dfMemo, dfIndex);
+//====================================================================
+  TDbfFileNames = set of TDbfFileName;
+//====================================================================
+  TCompareRecordEvent = procedure(Dbf: TDbf; var Accept: Boolean) of object;
+  TTranslateEvent = function(Dbf: TDbf; Src, Dest: PChar; ToOem: Boolean): Integer of object;
+  TLanguageWarningEvent = procedure(Dbf: TDbf; var Action: TDbfLanguageAction) of object;
+  TConvertFieldEvent = procedure(Dbf: TDbf; DstField, SrcField: TField) of object;
+  TBeforeAutoCreateEvent = procedure(Dbf: TDbf; var DoCreate: Boolean) of object;
+//====================================================================
+  // TDbfBlobStream keeps a reference count to number of references to
+  // this instance. Only if FRefCount reaches zero, then the object will be
+  // destructed. AddReference `clones' a reference.
+  // This allows the VCL to use Free on the object to `free' that
+  // particular reference.
+
+  TDbfBlobStream = class(TMemoryStream)
+  private
+    FBlobField: TBlobField;
+    FMode: TBlobStreamMode;
+    FDoWrite: Boolean;
+    FMemoRecNo: Integer;
+    FReadSize: Integer;
+    FRefCount: Integer;
+
+    function  GetTransliterate: Boolean;
+    procedure Translate(ToOem: Boolean);
+    procedure SetMode(NewMode: TBlobStreamMode);
+  public
+    constructor Create(FieldVal: TField);
+    destructor Destroy; override;
+
+    function  AddReference: TDbfBlobStream;
+    procedure FreeInstance; override;
+
+    procedure Cancel;
+    procedure Commit;
+
+    property Transliterate: Boolean read GetTransliterate;
+    property MemoRecNo: Integer read FMemoRecNo write FMemoRecNo;
+    property ReadSize: Integer read FReadSize write FReadSize;
+    property Mode: TBlobStreamMode write SetMode;
+    property Modified: Boolean read FDoWrite;
+    property BlobField: TBlobField read FBlobField;
+  end;
+//====================================================================
+  TDbfIndexDefs = class(TCollection)
+  public
+    FOwner: TDbf;
+   private
+    function GetItem(N: Integer): TDbfIndexDef;
+    procedure SetItem(N: Integer; Value: TDbfIndexDef);
+   protected
+    function GetOwner: TPersistent; override;
+   public
+    constructor Create(AOwner: TDbf);
+
+    function  Add: TDbfIndexDef;
+    function  GetIndexByName(const Name: string): TDbfIndexDef;
+    function  GetIndexByField(const Name: string): TDbfIndexDef;
+    procedure Update; {$ifdef SUPPORT_REINTRODUCE} reintroduce; {$endif}
+
+    property Items[N: Integer]: TDbfIndexDef read GetItem write SetItem; default;
+  end;
+//====================================================================
+  TDbfMasterLink = class(TDataLink)
+  private
+    FDetailDataSet: TDbf;
+    FParser: TDbfParser;
+    FFieldNames: string;
+    FValidExpression: Boolean;
+    FOnMasterChange: TNotifyEvent;
+    FOnMasterDisable: TNotifyEvent;
+
+    function GetFieldsVal: PChar;
+
+    procedure SetFieldNames(const Value: string);
+  protected
+    procedure ActiveChanged; override;
+    procedure CheckBrowseMode; override;
+    procedure LayoutChanged; override;
+    procedure RecordChanged(Field: TField); override;
+
+  public
+    constructor Create(ADataSet: TDbf);
+    destructor Destroy; override;
+
+    property FieldNames: string read FFieldNames write SetFieldNames;
+    property ValidExpression: Boolean read FValidExpression write FValidExpression;
+    property FieldsVal: PChar read GetFieldsVal;
+    property Parser: TDbfParser read FParser;
+
+    property OnMasterChange: TNotifyEvent read FOnMasterChange write FOnMasterChange;
+    property OnMasterDisable: TNotifyEvent read FOnMasterDisable write FOnMasterDisable;
+  end;
+//====================================================================
+  PDbfBlobList = ^TDbfBlobList;
+  TDbfBlobList = array[0..MaxListSize-1] of TDbfBlobStream;
+//====================================================================
+  TDbf = class(TDataSet)
+  private
+    FDbfFile: TDbfFile;
+    FCursor: TVirtualCursor;
+    FOpenMode: TDbfOpenMode;
+    FStorage: TDbfStorage;
+    FMasterLink: TDbfMasterLink;
+    FParser: TDbfParser;
+    FBlobStreams: PDbfBlobList;
+    FTableName: string;    // table path and file name
+    FRelativePath: string;
+    FAbsolutePath: string;
+    FIndexName: string;
+    FReadOnly: Boolean;
+    FFilterBuffer: PChar;
+    FTempBuffer: PChar;
+    FEditingRecNo: Integer;
+    FTableLevel: Integer;
+    FExclusive: Boolean;
+    FShowDeleted: Boolean;
+    FUseFloatFields: Boolean;
+    FPosting: Boolean;
+    FDisableResyncOnPost: Boolean;
+    FTempExclusive: Boolean;
+    FInCopyFrom: Boolean;
+    FStoreDefs: Boolean;
+    FCopyDateTimeAsString: Boolean;
+    FFindRecordFilter: Boolean;
+    FIndexFile: TIndexFile;
+    FDateTimeHandling: TDateTimeHandling;
+    FTranslationMode: TDbfTranslationMode;
+    FIndexDefs: TDbfIndexDefs;
+    FBeforeAutoCreate: TBeforeAutoCreateEvent;
+    FOnTranslate: TTranslateEvent;
+    FOnLanguageWarning: TLanguageWarningEvent;
+    FOnLocaleError: TDbfLocaleErrorEvent;
+    FOnIndexMissing: TDbfIndexMissingEvent;
+    FOnCompareRecord: TNotifyEvent;
+    FOnCopyDateTimeAsString: TConvertFieldEvent;
+
+    function GetIndexName: string;
+    function GetVersion: string;
+    function GetPhysicalRecNo: Integer;
+    function GetLanguageID: Integer;
+    function GetLanguageStr: string;
+    function GetCodePage: Cardinal;
+    function GetExactRecordCount: Integer;
+    function GetPhysicalRecordCount: Integer;
+    function GetKeySize: Integer;
+    function GetMasterFields: string;
+    function FieldDefsStored: Boolean;
+
+    procedure SetIndexName(AIndexName: string);
+    procedure SetDbfIndexDefs(const Value: TDbfIndexDefs);
+    procedure SetFilePath(const Value: string);
+    procedure SetTableName(const S: string);
+    procedure SetVersion(const S: string);
+    procedure SetDataSource(Value: TDataSource);
+    procedure SetMasterFields(const Value: string);
+    procedure SetTableLevel(const NewLevel: Integer);
+    procedure SetPhysicalRecNo(const NewRecNo: Integer);
+
+    procedure MasterChanged(Sender: TObject);
+    procedure MasterDisabled(Sender: TObject);
+    procedure DetermineTranslationMode;
+    procedure CheckMasterRange;
+    procedure UpdateRange;
+    procedure SetShowDeleted(Value: Boolean);
+    procedure GetFieldDefsFromDbfFieldDefs;
+    function  ParseIndexName(const AIndexName: string): string;
+    function  GetDbfFieldDefs: TDbfFieldDefs;
+    function  SearchKeyBuffer(Buffer: PChar; SearchType: TSearchKeyType): Boolean;
+    procedure SetRangeBuffer(LowRange: PChar; HighRange: PChar);
+
+  protected
+    { abstract methods }
+    function  AllocRecordBuffer: PChar; override; {virtual abstract}
+    procedure ClearCalcFields(Buffer: PChar); override;
+    procedure FreeRecordBuffer(var Buffer: PChar); override; {virtual abstract}
+    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override; {virtual abstract}
+    function  GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override; {virtual abstract}
+    function  GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override; {virtual abstract}
+    function  GetRecordSize: Word; override; {virtual abstract}
+    procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override; {virtual abstract}
+    procedure InternalClose; override; {virtual abstract}
+    procedure InternalDelete; override; {virtual abstract}
+    procedure InternalFirst; override; {virtual abstract}
+    procedure InternalGotoBookmark(Bookmark: Pointer); override; {virtual abstract}
+    procedure InternalHandleException; override; {virtual abstract}
+    procedure InternalInitFieldDefs; override; {virtual abstract}
+    procedure InternalInitRecord(Buffer: PChar); override; {virtual abstract}
+    procedure InternalLast; override; {virtual abstract}
+    procedure InternalOpen; override; {virtual abstract}
+    procedure InternalEdit; override; {virtual}
+    procedure InternalCancel; override; {virtual}
+    procedure InternalPost; override; {virtual abstract}
+    procedure InternalSetToRecord(Buffer: PChar); override; {virtual abstract}
+    procedure InitFieldDefs; override;
+    function  IsCursorOpen: Boolean; override; {virtual abstract}
+    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override; {virtual abstract}
+    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override; {virtual abstract}
+    procedure SetFieldData(Field: TField; Buffer: Pointer); override; {virtual abstract}
+
+    { virtual methods (mostly optionnal) }
+    function  GetDataSource: TDataSource; {$ifndef VER1_0}override;{$endif}
+    function  GetRecordCount: Integer; override; {virtual}
+    function  GetRecNo: Integer; override; {virtual}
+    function  GetCanModify: Boolean; override; {virtual}
+    procedure SetRecNo(Value: Integer); override; {virual}
+    procedure SetFiltered(Value: Boolean); override; {virtual;}
+    procedure SetFilterText(const Value: String); override; {virtual;}
+{$ifdef SUPPORT_DEFCHANGED}
+    procedure DefChanged(Sender: TObject); override;
+{$endif}
+    function  FindRecord(Restart, GoForward: Boolean): Boolean; override;
+
+    function  GetIndexFieldNames: string; {virtual;}
+    procedure SetIndexFieldNames(const Value: string); {virtual;}
+
+{$ifdef SUPPORT_VARIANTS}
+    function  LocateRecord(const KeyFields: String; const KeyValues: Variant; Options: TLocateOptions): Boolean;
+{$endif}
+
+    procedure DoFilterRecord(var Acceptable: Boolean);
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+
+    { abstract methods }
+    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override; {virtual abstract}
+    { virtual methods (mostly optionnal) }
+    procedure Resync(Mode: TResyncMode); override;
+    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override; {virtual}
+{$ifdef SUPPORT_NEW_TRANSLATE}
+    function Translate(Src, Dest: PChar; ToOem: Boolean): Integer; override; {virtual}
+{$else}
+    procedure Translate(Src, Dest: PChar; ToOem: Boolean); override; {virtual}
+{$endif}
+
+{$ifdef SUPPORT_BACKWARD_FIELDDATA}
+    function  GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload; override;
+    procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); overload; override;
+{$endif}
+
+    function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
+    procedure CheckDbfFieldDefs(DbfFieldDefs: TDbfFieldDefs);
+
+{$ifdef VER1_0}
+    procedure DataEvent(Event: TDataEvent; Info: Longint); override;
+{$endif}
+
+    // my own methods and properties
+    // most look like ttable functions but they are not tdataset related
+    // I (try to) use the same syntax to facilitate the conversion between bde and TDbf
+
+    // index support (use same syntax as ttable but is not related)
+{$ifdef SUPPORT_DEFAULT_PARAMS}
+    procedure AddIndex(const AIndexName, Fields: String; Options: TIndexOptions; const DescFields: String='');
+{$else}
+    procedure AddIndex(const AIndexName, Fields: String; Options: TIndexOptions);
+{$endif}
+    procedure RegenerateIndexes;
+
+    procedure CancelRange;
+{$ifdef SUPPORT_VARIANTS}
+    function  SearchKey(Key: Variant; SearchType: TSearchKeyType): Boolean;
+    procedure SetRange(LowRange: Variant; HighRange: Variant);
+{$endif}
+    function  SearchKeyPChar(Key: PChar; SearchType: TSearchKeyType): Boolean;
+    procedure SetRangePChar(LowRange: PChar; HighRange: PChar);
+    function  GetCurrentBuffer: PChar;
+    procedure ExtractKey(KeyBuffer: PChar);
+    procedure UpdateIndexDefs; override;
+    procedure GetFileNames(Strings: TStrings; Files: TDbfFileNames); {$ifdef SUPPORT_DEFAULT_PARAMS} overload; {$endif}
+{$ifdef SUPPORT_DEFAULT_PARAMS}
+    function  GetFileNames(Files: TDbfFileNames  = [dfDbf]  ): string; overload;
+{$else}
+    function  GetFileNamesString(Files: TDbfFileNames (* = [dfDbf] *) ): string;
+{$endif}
+    procedure GetIndexNames(Strings: TStrings);
+    procedure GetAllIndexFiles(Strings: TStrings);
+
+    procedure TryExclusive;
+    procedure EndExclusive;
+    function  LockTable(const Wait: Boolean): Boolean;
+    procedure UnlockTable;
+    procedure OpenIndexFile(IndexFile: string);
+    procedure DeleteIndex(const AIndexName: string);
+    procedure CloseIndexFile(const AIndexName: string);
+    procedure RepageIndexFile(const AIndexFile: string);
+    procedure CompactIndexFile(const AIndexFile: string);
+
+{$ifdef SUPPORT_VARIANTS}
+{$ifdef USE_BUGGY_LOOKUP}
+    function  Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; override;
+{$endif}
+    function  Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; {$ifndef FPC_VERSION}override;{$endif}
+{$endif}
+
+    function  IsDeleted: Boolean;
+    procedure Undelete;
+
+    procedure CreateTable;
+    procedure CreateTableEx(DbfFieldDefs: TDbfFieldDefs);
+    procedure CopyFrom(DataSet: TDataSet; FileName: string; DateTimeAsString: Boolean; Level: Integer);
+    procedure RestructureTable(DbfFieldDefs: TDbfFieldDefs; Pack: Boolean);
+    procedure PackTable;
+    procedure EmptyTable;
+    procedure Zap;
+
+{$ifndef SUPPORT_INITDEFSFROMFIELDS}
+    procedure InitFieldDefsFromFields;
+{$endif}
+
+    property AbsolutePath: string read FAbsolutePath;
+    property DbfFieldDefs: TDbfFieldDefs read GetDbfFieldDefs;
+    property PhysicalRecNo: Integer read GetPhysicalRecNo write SetPhysicalRecNo;
+    property LanguageID: Integer read GetLanguageID;
+    property LanguageStr: String read GetLanguageStr;
+    property CodePage: Cardinal read GetCodePage;
+    property ExactRecordCount: Integer read GetExactRecordCount;
+    property PhysicalRecordCount: Integer read GetPhysicalRecordCount;
+    property KeySize: Integer read GetKeySize;
+    property DbfFile: TDbfFile read FDbfFile;
+    property DisableResyncOnPost: Boolean read FDisableResyncOnPost write FDisableResyncOnPost;
+  published
+    property DateTimeHandling: TDateTimeHandling
+             read FDateTimeHandling write FDateTimeHandling default dtBDETimeStamp;
+    property Exclusive: Boolean read FExclusive write FExclusive default false;
+    property FilePath: string     read FRelativePath write SetFilePath;
+    property FilePathFull: string read FAbsolutePath write SetFilePath stored false;
+    property Indexes: TDbfIndexDefs read FIndexDefs write SetDbfIndexDefs stored false;
+    property IndexDefs: TDbfIndexDefs read FIndexDefs write SetDbfIndexDefs;
+    property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
+    property IndexName: string read GetIndexName write SetIndexName;
+    property MasterFields: string read GetMasterFields write SetMasterFields;
+    property MasterSource: TDataSource read GetDataSource write SetDataSource;
+    property OpenMode: TDbfOpenMode read FOpenMode write FOpenMode default omNormal;
+    property ReadOnly: Boolean read FReadOnly write FReadonly default false;
+    property ShowDeleted: Boolean read FShowDeleted write SetShowDeleted default false;
+    property Storage: TDbfStorage read FStorage write FStorage default stoFile;
+    property StoreDefs: Boolean read FStoreDefs write FStoreDefs default False;
+    property TableName: string read FTableName write SetTableName;
+    property TableLevel: Integer read FTableLevel write SetTableLevel;
+    property UseFloatFields: Boolean read FUseFloatFields write FUseFloatFields default true;
+    property Version: string read GetVersion write SetVersion stored false;
+    property BeforeAutoCreate: TBeforeAutoCreateEvent read FBeforeAutoCreate write FBeforeAutoCreate;
+    property OnCompareRecord: TNotifyEvent read FOnCompareRecord write FOnCompareRecord;
+    property OnLanguageWarning: TLanguageWarningEvent read FOnLanguageWarning write FOnLanguageWarning;
+    property OnLocaleError: TDbfLocaleErrorEvent read FOnLocaleError write FOnLocaleError;
+    property OnIndexMissing: TDbfIndexMissingEvent read FOnIndexMissing write FOnIndexMissing;
+    property OnCopyDateTimeAsString: TConvertFieldEvent read FOnCopyDateTimeAsString write FOnCopyDateTimeAsString;
+    property OnTranslate: TTranslateEvent read FOnTranslate write FOnTranslate;
+
+    // redeclared data set properties
+    property Active;
+    property FieldDefs stored FieldDefsStored;
+    property Filter;
+    property Filtered;
+    property FilterOptions;
+    property BeforeOpen;
+    property AfterOpen;
+    property BeforeClose;
+    property AfterClose;
+    property BeforeInsert;
+    property AfterInsert;
+    property BeforeEdit;
+    property AfterEdit;
+    property BeforePost;
+    property AfterPost;
+    property BeforeCancel;
+    property AfterCancel;
+    property BeforeDelete;
+    property AfterDelete;
+    property BeforeScroll;
+    property AfterScroll;
+    property OnCalcFields;
+    property OnDeleteError;
+    property OnEditError;
+    property OnFilterRecord;
+    property OnNewRecord;
+    property OnPostError;
+  end;
+
+  TDbf_GetBasePathFunction = function: string;
+
+var
+  DbfBasePath: TDbf_GetBasePathFunction;
+
+implementation
+
+uses
+  SysUtils,
+{$ifndef FPC}
+  DBConsts,
+{$endif}
+{$ifdef WIN32}
+  Windows,
+{$else}
+{$ifdef KYLIX}
+  Libc,
+{$endif}  
+  Types,
+  Dbf_Wtil,
+{$endif}
+{$ifdef DELPHI_6}
+  Variants,
+{$endif}
+  Dbf_PgFile,
+  Dbf_IdxCur,
+  Dbf_Memo,
+  Dbf_Str;
+
+
+//==========================================================
+//============ TDbfBlobStream
+//==========================================================
+constructor TDbfBlobStream.Create(FieldVal: TField);
+begin
+  FBlobField := FieldVal as TBlobField;
+  FReadSize := 0;
+  FMemoRecNo := 0;
+  FRefCount := 1;
+  FDoWrite := false;
+end;
+
+destructor TDbfBlobStream.Destroy;
+begin
+  // only continue destroy if all references released
+  Dec(FRefCount);
+  if FRefCount = 0 then
+  begin
+    inherited
+  end else begin
+    if FMode = bmWrite then
+    begin
+      // a second referer to instance has changed the data, remember modified
+//      TDbf(FBlobField.DataSet).SetModified(true);
+      // is following better? seems to provide notification for user (from VCL)
+      if not (FBlobField.DataSet.State in [dsCalcFields, dsFilter, dsNewValue]) then
+        TDbf(FBlobField.DataSet).DataEvent(deFieldChange, Longint(FBlobField));
+    end;
+  end;
+end;
+
+procedure TDbfBlobStream.FreeInstance;
+begin
+  // only continue freeing if all references released
+  if FRefCount = 0 then
+    inherited;
+end;
+
+procedure TDbfBlobStream.SetMode(NewMode: TBlobStreamMode);
+begin
+  FMode := NewMode;
+  FDoWrite := FDoWrite or (NewMode = bmWrite);
+end;
+
+procedure TDbfBlobStream.Cancel;
+begin
+  FDoWrite := false;
+  FMemoRecNo := 0;
+end;
+
+procedure TDbfBlobStream.Commit;
+var
+  Dbf: TDbf;
+begin
+  if FDoWrite then
+  begin
+    Size := Position; // Strange but it leave tailing trash bytes if I do not write that.
+    Dbf := TDbf(FBlobField.DataSet);
+    Translate(true);
+    Dbf.FDbfFile.MemoFile.WriteMemo(FMemoRecNo, FReadSize, Self);
+    Dbf.FDbfFile.SetFieldData(FBlobField.FieldNo-1, ftInteger, @FMemoRecNo,
+      @pDbfRecord(TDbf(FBlobField.DataSet).ActiveBuffer).DeletedFlag);
+    FDoWrite := false;
+  end;
+end;
+
+function TDbfBlobStream.AddReference: TDbfBlobStream;
+begin
+  Inc(FRefCount);
+  Result := Self;
+end;
+
+function TDbfBlobStream.GetTransliterate: Boolean;
+begin
+  Result := FBlobField.Transliterate;
+end;
+
+procedure TDbfBlobStream.Translate(ToOem: Boolean);
+var
+  bytesToDo, numBytes: Integer;
+  bufPos: PChar;
+  saveChar: Char;
+begin
+  if (Transliterate) and (Size > 0) then
+  begin
+    // get number of bytes to be translated
+    bytesToDo := Size;
+    // make space for final null-terminator
+    Size := Size + 1;
+    bufPos := Memory;
+    repeat
+      // process blocks of 512 bytes
+      numBytes := bytesToDo;
+      if numBytes > 512 then
+        numBytes := 512;
+      // null-terminate memory
+      saveChar := bufPos[numBytes];
+      bufPos[numBytes] := #0;
+      // translate memory
+      TDbf(FBlobField.DataSet).Translate(bufPos, bufPos, ToOem);
+      // restore char
+      bufPos[numBytes] := saveChar;
+      // numBytes bytes translated
+      Dec(bytesToDo, numBytes);
+      Inc(bufPos, numBytes);
+    until bytesToDo = 0;
+    // cut ending null-terminator
+    Size := Size - 1;
+  end;
+end;
+
+//====================================================================
+// TDbf = TDataset Descendant.
+//====================================================================
+constructor TDbf.Create(AOwner: TComponent); {override;}
+begin
+  inherited;
+
+  if DbfGlobals = nil then
+    DbfGlobals := TDbfGlobals.Create;
+
+  BookmarkSize := sizeof(rBookmarkData);
+  FIndexDefs := TDbfIndexDefs.Create(Self);
+  FMasterLink := TDbfMasterLink.Create(Self);
+  FMasterLink.OnMasterChange := MasterChanged;
+  FMasterLink.OnMasterDisable := MasterDisabled;
+  FDateTimeHandling := dtBDETimeStamp;
+  FStorage := stoFile;
+  FOpenMode := omNormal;
+  FParser := nil;
+  FPosting := false;
+  FReadOnly := false;
+  FExclusive := false;
+  FUseFloatFields := true;
+  FDisableResyncOnPost := false;
+  FTempExclusive := false;
+  FCopyDateTimeAsString := false;
+  FInCopyFrom := false;
+  FFindRecordFilter := false;
+  FEditingRecNo := -1;
+  FTableLevel := 4;
+  FIndexName := EmptyStr;
+  FilePath := EmptyStr;
+  FTempBuffer := nil;
+  FFilterBuffer := nil;
+  FIndexFile := nil;
+  FOnTranslate := nil;
+  FOnCopyDateTimeAsString := nil;
+end;
+
+destructor TDbf.Destroy; {override;}
+var
+  I: Integer;
+begin
+  inherited Destroy;
+
+  if FIndexDefs <> nil then
+  begin
+    for I := FIndexDefs.Count - 1 downto 0 do
+      TDbfIndexDef(FIndexDefs.Items[I]).Free;
+    FIndexDefs.Free;
+  end;
+  FMasterLink.Free;
+end;
+
+function TDbf.AllocRecordBuffer: PChar; {override virtual abstract from TDataset}
+begin
+  GetMem(Result, SizeOf(rDbfRecordHeader)+FDbfFile.RecordSize+CalcFieldsSize+1);
+end;
+
+procedure TDbf.FreeRecordBuffer(var Buffer: PChar); {override virtual abstract from TDataset}
+begin
+  FreeMem(Buffer);
+end;
+
+procedure TDbf.GetBookmarkData(Buffer: PChar; Data: Pointer); {override virtual abstract from TDataset}
+var
+  pRecord: pDbfRecord;
+begin
+  pRecord := pDbfRecord(Buffer);
+  pBookMarkData(Data)^ := pRecord.BookMarkData;
+end;
+
+function TDbf.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; {override virtual abstract from TDataset}
+var
+  pRecord: pDbfRecord;
+begin
+  pRecord := pDbfRecord(Buffer);
+  Result := pRecord.BookMarkFlag;
+end;
+
+function TDbf.GetCurrentBuffer: PChar;
+begin
+  case State of
+    dsFilter:     Result := FFilterBuffer;
+    dsCalcFields: Result := @(pDbfRecord(CalcBuffer).DeletedFlag);
+//    dsSetKey:     Result := FKeyBuffer;     // TO BE Implemented
+  else
+    if IsEmpty then
+    begin
+      Result := nil;
+    end else begin
+      Result := @(pDbfRecord(ActiveBuffer).DeletedFlag);
+    end;
+  end;
+end;
+
+function TDbf.GetFieldData(Field: TField; Buffer: Pointer): Boolean; {override virtual abstract from TDataset}
+var
+  Src: PChar;
+begin
+  Src := GetCurrentBuffer;
+  if Src = nil then
+  begin
+    Result := false;
+    exit;
+  end;
+
+  if Field.FieldNo>0 then
+  begin
+    Result := FDbfFile.GetFieldData(Field.FieldNo-1, Field.DataType, Src, Buffer);
+  end else begin { calculated fields.... }
+    Inc(PChar(Src), Field.Offset + GetRecordSize);
+//    Result := Boolean(PChar(Buffer)[0]);
+    Result := true;
+    if {Result and  (Src <> nil) and } (Buffer <> nil) then
+    begin
+      // A ftBoolean was 1 byte in Delphi 3
+      // it is now 2 byte in Delphi 5
+      // not sure about delphi 4.
+{$ifdef DELPHI_5}
+        Move(Src^, Buffer^, Field.DataSize);
+{$else}
+      if Field.DataType = ftBoolean then
+        Move(Src^, Buffer^, 1)
+      else
+        Move(Src^, Buffer^, Field.DataSize);
+{$endif}
+    end;
+  end;
+end;
+
+{$ifdef SUPPORT_BACKWARD_FIELDDATA}
+
+// we don't want converted data formats, we want native :-)
+// it makes coding easier in TDbfFile.GetFieldData
+//  ftCurrency:
+//    Delphi 3,4: BCD array
+//  ftBCD:
+// ftDateTime is more difficult though
+
+function TDbf.GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; {overload; override;}
+begin
+  // pretend nativeformat is true
+  Result := inherited GetFieldData(Field, Buffer, True);
+end;
+
+procedure TDbf.SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); {overload; override;}
+begin
+  // pretend nativeformat is true
+  inherited SetFieldData(Field, Buffer, True);
+end;
+
+{$endif}
+
+procedure TDbf.DoFilterRecord(var Acceptable: Boolean);
+begin
+  // check filtertext
+  if Length(Filter) > 0 then
+  begin
+{$ifndef VER1_0}
+    Acceptable := Boolean((FParser.ExtractFromBuffer(GetCurrentBuffer))^);
+{$else}
+    // strange problem
+    // dbf.pas(716,19) Error: Incompatible types: got "CHAR" expected "BOOLEAN"
+    Acceptable := not ((FParser.ExtractFromBuffer(GetCurrentBuffer))^ = #0);
+{$endif}
+  end;
+
+  // check user filter
+  if Acceptable and Assigned(OnFilterRecord) then
+    OnFilterRecord(Self, Acceptable);
+end;
+
+function TDbf.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; {override virtual abstract from TDataset}
+var
+  pRecord: pDBFRecord;
+  acceptable: Boolean;
+  SaveState: TDataSetState;
+  lPhysicalRecNo: Integer;
+//  s: string;
+begin
+  if (FDbfFile.RecordCount<1) or (FCursor=nil) then
+  begin
+    Result := grEOF;
+    exit;
+  end;
+  pRecord := pDBFRecord(Buffer);
+  acceptable := false;
+  repeat
+    Result := grOK;
+    case GetMode of
+      gmCurrent :
+        begin
+          //if pRecord.BookmarkData.RecNo=FPhysicalRecNo then begin
+          //  exit;    // try to fasten a bit...
+          //end;
+        end;
+      gmNext :
+        begin
+          Acceptable := FCursor.Next;
+          if Acceptable then begin
+            Result := grOK;
+          end else begin
+            //FCursor.Last;
+            Result := grEOF
+          end;
+        end;
+      gmPrior :
+        begin
+          Acceptable := FCursor.Prev;
+          if Acceptable then begin
+            Result := grOK;
+          end else begin
+            //FCursor.First;
+            Result := grBOF
+          end;
+        end;
+    end;
+
+    if (Result = grOK) then
+    begin
+      lPhysicalRecNo := FCursor.PhysicalRecNo;
+      if (lPhysicalRecNo > FDbfFile.RecordCount) or (lPhysicalRecNo <= 0) then
+      begin
+        Result := grError;
+      end else begin
+        FDbfFile.ReadRecord(lPhysicalRecNo, @pRecord.DeletedFlag);
+        acceptable := (FShowDeleted or (pRecord.DeletedFlag <> '*'))
+      end;
+    end;
+
+    if (Result = grOK) and acceptable then
+    begin
+      if Filtered or FFindRecordFilter then
+      begin
+        FFilterBuffer := @pRecord.DeletedFlag;
+        SaveState := SetTempState(dsFilter);
+        DoFilterRecord(acceptable);
+        RestoreState(SaveState);
+      end;
+    end;
+
+    if (GetMode = gmCurrent) and not acceptable then
+      Result := grError;
+  until (Result <> grOK) or acceptable;
+
+  if (Result = grOK) and not FFindRecordFilter then
+  begin
+    ClearCalcFields(Buffer); //run automatically
+    try
+      GetCalcFields(Buffer);
+    finally
+       pRecord.BookmarkData := FCursor.GetBookMark;
+       pRecord.BookmarkFlag := bfCurrent;
+    end;
+    if (pRecord.BookMarkData <= 0) then
+       pRecord.BookmarkData := FCursor.GetBookMark;
+  end else begin
+    pRecord.BookmarkData := -1;
+  end;
+end;
+
+function TDbf.GetRecordSize: Word; {override virtual abstract from TDataset}
+begin
+  Result := FDbfFile.RecordSize;
+end;
+
+procedure TDbf.InternalAddRecord(Buffer: Pointer; Append: Boolean); {override virtual abstract from TDataset}
+  // this function is called from TDataSet.InsertRecord and TDataSet.AppendRecord
+  // goal: add record with Edit...Set Fields...Post all in one step
+var
+  pRecord: pDbfRecord;
+begin
+  // if InternalAddRecord is called, we know we are active
+  pRecord := Buffer;
+
+  // we can not insert records in DBF files, only append
+  // ignore Append parameter
+  FDbfFile.Insert(@pRecord.DeletedFlag);
+
+  // set flag that TDataSet is about to post...so we can disable resync
+  FPosting := true;
+end;
+
+procedure TDbf.InternalClose; {override virtual abstract from TDataset}
+var
+  lIndex: TDbfIndexDef;
+  I: Integer;
+begin
+  // clear automatically added MDX index entries
+  I := 0;
+  while I < FIndexDefs.Count do
+  begin
+    // is this an MDX index?
+    lIndex := FIndexDefs.Items[I];
+    if (Length(ExtractFileExt(lIndex.IndexFile)) = 0) and
+      TDbfIndexDef(FIndexDefs.Items[I]).Temporary then
+    begin
+{$ifdef SUPPORT_DEF_DELETE}
+      // delete this entry
+      FIndexDefs.Delete(I);
+{$else}
+      // does this work? I hope so :-)
+      FIndexDefs.Items[I].Free;
+{$endif}
+    end else begin
+      // NDX entry -> goto next
+      Inc(I);
+    end;
+  end;
+
+  // free blobs
+  if FBlobStreams <> nil then
+  begin
+    for I := 0 to Pred(FieldCount) do
+      if FBlobStreams[I] <> nil then
+        FBlobStreams[I].Free;
+    FreeMemAndNil(Pointer(FBlobStreams));
+  end;
+  FreeRecordBuffer(FTempBuffer);
+  // disconnect field objects
+  BindFields(false);
+  // Destroy field object (if not persistent)
+  if DefaultFields then
+    DestroyFields;
+
+  if FParser <> nil then
+    FreeAndNil(FParser);
+  if (FDbfFile <> nil) and not FReadOnly then
+    FDbfFile.WriteHeader;
+  FreeAndNil(FCursor);
+  if FDbfFile <> nil then
+    FreeAndNil(FDbfFile);
+end;
+
+procedure TDbf.InternalCancel;
+var
+  I: Integer;
+begin
+  // cancel blobs
+  for I := 0 to Pred(FieldCount) do
+    if Assigned(FBlobStreams[I]) then
+      FBlobStreams[I].Cancel;
+  // if we have locked a record, unlock it
+  if FEditingRecNo >= 0 then
+  begin
+    FDbfFile.UnlockPage(FEditingRecNo);
+    FEditingRecNo := -1;
+  end;
+end;
+
+procedure TDbf.InternalDelete; {override virtual abstract from TDataset}
+var
+  lRecord: pDbfRecord;
+begin
+  // start editing
+  Edit;
+  // get record pointer
+  lRecord := pDbfRecord(ActiveBuffer);
+  // flag we deleted this record
+  lRecord.DeletedFlag := '*';
+  // notify indexes this record is deleted
+  FDbfFile.RecordDeleted(FEditingRecNo, @lRecord.DeletedFlag);
+  // done!
+  Post;
+end;
+
+procedure TDbf.InternalFirst; {override virtual abstract from TDataset}
+begin
+  FCursor.First;
+end;
+
+procedure TDbf.InternalGotoBookmark(Bookmark: Pointer); {override virtual abstract from TDataset}
+var
+  RecInfo: rBookmarkData;
+begin
+  RecInfo := rBookmarkData(Bookmark^);
+  FCursor.GotoBookmark(RecInfo);
+end;
+
+procedure TDbf.InternalHandleException; {override virtual abstract from TDataset}
+begin
+  SysUtils.ShowException(ExceptObject, ExceptAddr);
+end;
+
+procedure TDbf.GetFieldDefsFromDbfFieldDefs;
+var
+  I, N: Integer;
+  TempFieldDef: TDbfFieldDef;
+  TempMdxFile: TIndexFile;
+  BaseName, lIndexName: string;
+begin
+  FieldDefs.Clear;
+
+  // get all fields
+  for I := 0 to FDbfFile.FieldDefs.Count - 1 do
+  begin
+    TempFieldDef := FDbfFile.FieldDefs.Items[I];
+    // handle duplicate field names
+    N := 1;
+    BaseName := TempFieldDef.FieldName;
+    while FieldDefs.IndexOf(TempFieldDef.FieldName)>=0 do
+    begin
+      Inc(N);
+      TempFieldDef.FieldName:=BaseName+IntToStr(N);
+    end;
+    // add field
+    if TempFieldDef.FieldType in [ftString, ftBCD, ftBytes] then
+      FieldDefs.Add(TempFieldDef.FieldName, TempFieldDef.FieldType, TempFieldDef.Size, false)
+    else
+      FieldDefs.Add(TempFieldDef.FieldName, TempFieldDef.FieldType, 0, false);
+
+{$ifdef SUPPORT_FIELDDEF_ATTRIBUTES}
+    // AutoInc fields are readonly
+    if TempFieldDef.FieldType = ftAutoInc then
+      FieldDefs[I].Attributes := [Db.faReadOnly];
+
+    // if table has dbase lock field, then hide it
+    if TempFieldDef.IsLockField then
+      FieldDefs[I].Attributes := [Db.faHiddenCol];
+{$endif}
+  end;
+
+  // get all (new) MDX index defs
+  TempMdxFile := FDbfFile.MdxFile;
+  for I := 0 to FDbfFile.IndexNames.Count - 1 do
+  begin
+    // is this an MDX index?
+    lIndexName := FDbfFile.IndexNames.Strings[I];
+    if FDbfFile.IndexNames.Objects[I] = TempMdxFile then
+      if FIndexDefs.GetIndexByName(lIndexName) = nil then
+        TempMdxFile.GetIndexInfo(lIndexName, FIndexDefs.Add);
+  end;
+end;
+
+procedure TDbf.InitFieldDefs;
+begin
+  InternalInitFieldDefs;
+end;
+
+procedure TDbf.InternalInitFieldDefs; {override virtual abstract from TDataset}
+var
+  MustReleaseDbfFile: Boolean;
+begin
+  MustReleaseDbfFile := false;
+  with FieldDefs do
+  begin
+    if FDbfFile = nil then
+    begin
+      // do not AutoCreate file
+      FDbfFile := TDbfFile.Create(FAbsolutePath + FTableName);
+      FDbfFile.Mode := pfReadOnly;
+      FDbfFile.AutoCreate := false;
+      FDbfFile.DateTimeHandling := FDateTimeHandling;
+      FDbfFile.OnLocaleError := FOnLocaleError;
+      FDbfFile.OnIndexMissing := FOnIndexMissing;
+      FDbfFile.UseFloatFields := FUseFloatFields;
+      FDbfFile.Open;
+      MustReleaseDbfFile := true;
+    end;
+    GetFieldDefsFromDbfFieldDefs;
+    if MustReleaseDbfFile then
+      FreeAndNil(FDbfFile);
+  end;
+end;
+
+procedure TDbf.InternalInitRecord(Buffer: PChar); {override virtual abstract from TDataset}
+var
+  pRecord: pDbfRecord;
+begin
+  pRecord := pDbfRecord(Buffer);
+  pRecord.BookmarkData{.IndexBookmark} := 0;
+  pRecord.BookmarkFlag := bfCurrent;
+// Init Record with zero and set autoinc field with next value
+  FDbfFile.InitRecord(@pRecord.DeletedFlag);
+end;
+
+procedure TDbf.InternalLast; {override virtual abstract from TDataset}
+begin
+  FCursor.Last;
+end;
+
+procedure TDbf.DetermineTranslationMode;
+var
+  codePage: Cardinal;
+begin
+  codePage := FDbfFile.UseCodePage;
+  if codePage = GetACP then
+    FTranslationMode := tmNoneNeeded
+  else
+  if codePage = GetOEMCP then
+    FTranslationMode := tmSimple
+  // check if this code page, although non default, is installed
+  else
+  if DbfGlobals.CodePageInstalled(codePage) then
+    FTranslationMode := tmAdvanced
+  else
+    FTranslationMode := tmNoneAvailable;
+end;
+
+procedure TDbf.InternalOpen; {override virtual abstract from TDataset}
+const
+  DbfOpenMode: array[Boolean, Boolean] of TPagedFileMode =
+     ((pfReadWriteOpen, pfExclusiveOpen), (pfReadOnly, pfReadOnly));
+var
+  lIndex: TDbfIndexDef;
+  lIndexName: string;
+  LanguageAction: TDbfLanguageAction;
+  doCreate: Boolean;
+  I: Integer;
+begin
+  // close current file
+  FreeAndNil(FDbfFile);
+
+  // does file not exist? -> create
+  if not FileExists(FAbsolutePath + FTableName) and (FOpenMode in [omAutoCreate, omTemporary]) then
+  begin
+    doCreate := true;
+    if Assigned(FBeforeAutoCreate) then
+      FBeforeAutoCreate(Self, doCreate);
+    if doCreate then
+      CreateTable
+    else
+      exit;
+  end;
+
+  // now we know for sure the file exists
+  FDbfFile := TDbfFile.Create(FAbsolutePath + FTableName);
+  FDbfFile.Mode := DbfOpenMode[FReadOnly{ or (csDesigning in ComponentState)}, FExclusive];
+  FDbfFile.AutoCreate := false;
+  FDbfFile.UseFloatFields := FUseFloatFields;
+  FDbfFile.DateTimeHandling := FDateTimeHandling;
+  FDbfFile.OnLocaleError := FOnLocaleError;
+  FDbfFile.OnIndexMissing := FOnIndexMissing;
+  FDbfFile.Open;
+
+  // fail open?
+{$ifndef FPC}  
+  if FDbfFile.ForceClose then
+    Abort;
+{$endif}    
+
+  // determine dbf version
+  case FDbfFile.DbfVersion of
+    xBaseIII: FTableLevel := 3;
+    xBaseIV:  FTableLevel := 4;
+    xBaseVII: FTableLevel := 7;
+    xFoxPro:  FTableLevel := TDBF_TABLELEVEL_FOXPRO;
+  end;
+
+  // build VCL fielddef list from native DBF FieldDefs
+(*
+  if (FDbfFile.HeaderSize = 0) or (FDbfFile.FieldDefs.Count = 0) then
+  begin
+    if FieldDefs.Count > 0 then
+    begin
+      CreateTableFromFieldDefs;
+    end else begin
+      CreateTableFromFields;
+    end;
+  end else begin
+*)
+//    GetFieldDefsFromDbfFieldDefs;
+//  end;
+
+{$ifdef SUPPORT_FIELDDEFS_UPDATED}
+  FieldDefs.Updated := False;
+  FieldDefs.Update;
+{$else}
+  InternalInitFieldDefs;
+{$endif}
+
+  // create the fields dynamically
+  if DefaultFields then
+    CreateFields; // Create fields from fielddefs.
+
+  BindFields(true);
+
+  // create array of blobstreams to store memo's in. each field is a possible blob
+  GetMem(FBlobStreams, FieldCount * SizeOf(TDbfBlobStream));
+  for I := 0 to Pred(FieldCount) do
+    FBlobStreams[I] := nil;
+
+  // check codepage settings
+  DetermineTranslationMode;
+  if FTranslationMode = tmNoneAvailable then
+  begin
+    // no codepage available? ask user
+    LanguageAction := laReadOnly;
+    if Assigned(FOnLanguageWarning) then
+      FOnLanguageWarning(Self, LanguageAction);
+    case LanguageAction of
+      laReadOnly: FTranslationMode := tmNoneAvailable;
+      laForceOEM:
+        begin
+          FDbfFile.UseCodePage := GetOEMCP;
+          FTranslationMode := tmSimple;
+        end;
+      laForceANSI:
+        begin
+          FDbfFile.UseCodePage := GetACP;
+          FTranslationMode := tmNoneNeeded;
+        end;
+      laDefault:
+        begin
+          FDbfFile.UseCodePage := DbfGlobals.DefaultOpenCodePage;
+          DetermineTranslationMode;
+        end;
+    end;
+  end;
+
+  // allocate a record buffer for temporary data
+  FTempBuffer := AllocRecordBuffer;
+
+  // open indexes
+  for I := 0 to FIndexDefs.Count - 1 do
+  begin
+    lIndex := FIndexDefs.Items[I];
+    lIndexName := ParseIndexName(lIndex.IndexFile);
+    // if index does not exist -> create, if it does exist -> open only
+    FDbfFile.OpenIndex(lIndexName, lIndex.SortField, false, lIndex.Options);
+  end;
+
+  // parse filter
+  if Length(Filter) > 0 then
+  begin
+    // create parser
+    FParser := TDbfParser.Create(FDbfFile);
+    // parse expression
+    try
+      FParser.ParseExpression(Filter);
+    except
+      // oops, a problem with parsing, clear filter for now
+      on E: EDbfError do Filter := EmptyStr;
+    end;
+  end;
+
+  SetIndexName(FIndexName);
+
+// SetIndexName will have made the cursor for us if no index selected :-)
+//  if FCursor = nil then FCursor := TDbfCursor.Create(FDbfFile);
+
+  InternalFirst;
+
+//  FDbfFile.SetIndex(FIndexName);
+//  FDbfFile.FIsCursorOpen := true;
+end;
+
+function TDbf.GetCodePage: Cardinal;
+begin
+  if FDbfFile <> nil then
+    Result := FDbfFile.UseCodePage
+  else
+    Result := 0;
+end;
+
+function TDbf.GetLanguageID: Integer;
+begin
+  if FDbfFile <> nil then
+    Result := FDbfFile.LanguageID
+  else
+    Result := 0;
+end;
+
+function TDbf.GetLanguageStr: String;
+begin
+  if FDbfFile <> nil then
+    Result := FDbfFile.LanguageStr;
+end;
+
+function TDbf.LockTable(const Wait: Boolean): Boolean;
+begin
+  Result := FDbfFile.LockAllPages(Wait);
+end;
+
+procedure TDbf.UnlockTable;
+begin
+  FDbfFile.UnlockAllPages;
+end;
+
+procedure TDbf.InternalEdit;
+var
+  I: Integer;
+begin
+  // store recno we are editing
+  FEditingRecNo := FCursor.PhysicalRecNo;
+  // reread blobs, execute cancel -> clears remembered memo pageno,
+  // causing it to reread the memo contents
+  for I := 0 to Pred(FieldCount) do
+    if Assigned(FBlobStreams[I]) then
+      if not FBlobStreams[I].Modified then
+        FBlobStreams[I].Cancel;
+  // try to lock this record
+  FDbfFile.LockRecord(FEditingRecNo, @pDbfRecord(ActiveBuffer).DeletedFlag);
+  // succeeded!
+end;
+
+procedure TDbf.InternalPost; {override virtual abstract from TDataset}
+var
+  pRecord: pDbfRecord;
+  I: Integer;
+begin
+  // if internalpost is called, we know we are active
+  pRecord := pDbfRecord(ActiveBuffer);
+  // commit blobs
+  for I := 0 to Pred(FieldCount) do
+    if Assigned(FBlobStreams[I]) then
+      FBlobStreams[I].Commit;
+  if State = dsEdit then
+  begin
+    // write changes
+    FDbfFile.UnlockRecord(FEditingRecNo, @pRecord.DeletedFlag);
+    // not editing anymore
+    FEditingRecNo := -1;
+  end else begin
+    // insert
+    FDbfFile.Insert(@pRecord.DeletedFlag);
+  end;
+  // set flag that TDataSet is about to post...so we can disable resync
+  FPosting := true;
+end;
+
+procedure TDbf.Resync(Mode: TResyncMode);
+begin
+  // try to increase speed
+  if not FDisableResyncOnPost or not FPosting then
+    inherited;
+  // clear post flag
+  FPosting := false;
+end;
+
+
+{$ifndef SUPPORT_INITDEFSFROMFIELDS}
+
+procedure TDbf.InitFieldDefsFromFields;
+var
+  I: Integer;
+  F: TField;
+begin
+  { create fielddefs from persistent fields if needed }
+  for I := 0 to FieldCount - 1 do
+  begin
+    F := Fields[I];
+    with F do
+    if FieldKind = fkData then begin
+      FieldDefs.Add(FieldName,DataType,Size,Required);
+    end;
+  end;
+end;
+
+{$endif}
+
+procedure TDbf.CreateTable;
+begin
+  CreateTableEx(nil);
+end;
+
+procedure TDbf.CheckDbfFieldDefs(DbfFieldDefs: TDbfFieldDefs);
+var
+  I: Integer;
+  TempDef: TDbfFieldDef;
+
+    function FieldTypeStr(const FieldType: char): string;
+    begin
+      if FieldType = #0 then
+        Result := 'NULL'
+      else if FieldType > #127 then
+        Result := 'ASCII '+IntToStr(Byte(FieldType))
+      else
+        Result := ' "'+fieldType+'" ';
+      Result := ' ' + Result + '(#'+IntToHex(Byte(FieldType),SizeOf(FieldType))+') '
+    end;
+
+begin
+  if DbfFieldDefs = nil then exit;
+
+  for I := 0 to DbfFieldDefs.Count - 1 do
+  begin
+    // check dbffielddefs for errors
+    TempDef := DbfFieldDefs.Items[I];
+    if FTableLevel < 7 then
+      if not (TempDef.NativeFieldType in ['C', 'F', 'N', 'D', 'L', 'M']) then
+        raise EDbfError.CreateFmt(STRING_INVALID_FIELD_TYPE,
+          [FieldTypeStr(TempDef.NativeFieldType), TempDef.FieldName]);
+  end;
+end;
+
+procedure TDbf.CreateTableEx(DbfFieldDefs: TDbfFieldDefs);
+var
+  I: Integer;
+  lIndex: TDbfIndexDef;
+  IndexName: string;
+  tempFieldDefs: Boolean;
+begin
+  CheckInactive;
+  tempFieldDefs := DbfFieldDefs = nil;
+  try
+    try
+      if tempFieldDefs then
+      begin
+        DbfFieldDefs := TDbfFieldDefs.Create(Self);
+
+        // get fields -> fielddefs if no fielddefs
+{$ifndef FPC_VERSION}
+        if FieldDefs.Count = 0 then
+          InitFieldDefsFromFields;
+{$endif}
+
+        // fielddefs -> dbffielddefs
+        for I := 0 to FieldDefs.Count - 1 do
+        begin
+          with DbfFieldDefs.AddFieldDef do
+          begin
+            FieldName := FieldDefs.Items[I].Name;
+            FieldType := FieldDefs.Items[I].DataType;
+            if FieldDefs.Items[I].Size > 0 then
+            begin
+              Size := FieldDefs.Items[I].Size;
+              Precision := FieldDefs.Items[I].Precision;
+            end else begin
+              SetDefaultSize;
+            end;
+          end;
+        end;
+      end;
+
+      FDbfFile := TDbfFile.Create(FAbsolutePath + FTableName);
+      FDbfFile.Mode := pfExclusiveCreate;
+      FDbfFile.AutoCreate := true;
+      FDbfFile.CopyDateTimeAsString := FInCopyFrom and FCopyDateTimeAsString;
+      FDbfFile.OnLocaleError := FOnLocaleError;
+      FDbfFile.OnIndexMissing := FOnIndexMissing;
+      FDbfFile.UseFloatFields := FUseFloatFields;
+      case FTableLevel of
+        3:                      FDbfFile.DbfVersion := xBaseIII;
+        7:                      FDbfFile.DbfVersion := xBaseVII;
+        TDBF_TABLELEVEL_FOXPRO: FDbfFile.DbfVersion := xFoxPro;
+      else
+        {4:} FDbfFile.DbfVersion := xBaseIV;
+      end;
+      FDbfFile.Open;
+      FDbfFile.FinishCreate(DbfFieldDefs, 512);
+
+      // create all indexes
+      for I := 0 to FIndexDefs.Count-1 do
+      begin
+        lIndex := FIndexDefs.Items[I];
+        IndexName := ParseIndexName(lIndex.IndexFile);
+        FDbfFile.OpenIndex(IndexName, lIndex.SortField, true, lIndex.Options);
+      end;
+    except
+      // dbf file created?
+      if FDbfFile <> nil then
+      begin
+        FreeAndNil(FDbfFile);
+        SysUtils.DeleteFile(FAbsolutePath+FTableName);
+      end;
+      raise;
+    end;
+  finally
+    // free temporary fielddefs
+    if tempFieldDefs and Assigned(DbfFieldDefs) then
+      DbfFieldDefs.Free;
+    FreeAndNil(FDbfFile);
+  end;
+end;
+
+procedure TDbf.EmptyTable;
+begin
+  Zap;
+end;
+
+procedure TDbf.Zap;
+begin
+  // are we active?
+  CheckActive;
+  FDbfFile.Zap;
+end;
+
+procedure TDbf.RestructureTable(DbfFieldDefs: TDbfFieldDefs; Pack: Boolean);
+begin
+  CheckInactive;
+
+  // check field defs for errors
+  CheckDbfFieldDefs(DbfFieldDefs);
+
+  // open dbf file
+  FDbfFile := TDbfFile.Create(FAbsolutePath + FTableName);
+  FDbfFile.Mode := pfExclusiveOpen;
+  FDbfFile.AutoCreate := false;
+  FDbfFile.UseFloatFields := FUseFloatFields;
+  FDbfFile.OnLocaleError := FOnLocaleError;
+  FDbfFile.OnIndexMissing := FOnIndexMissing;
+  FDbfFile.Open;
+
+  // do restructure
+  try
+    FDbfFile.RestructureTable(DbfFieldDefs, Pack);
+  finally
+    // close file
+    FreeAndNil(FDbfFile);
+  end;
+end;
+
+procedure TDbf.PackTable;
+var
+  oldIndexName: string;
+begin
+  CheckBrowseMode;
+  // deselect any index while packing
+  oldIndexName := IndexName;
+  IndexName := EmptyStr;
+  // pack
+  FDbfFile.RestructureTable(nil, true);
+  // reselect index
+  IndexName := oldIndexName;
+end;
+
+procedure TDbf.CopyFrom(DataSet: TDataSet; FileName: string; DateTimeAsString: Boolean; Level: Integer);
+var
+  I: integer;
+begin
+  FInCopyFrom := true;
+  try
+    if Active then
+      Close;
+    FilePath := ExtractFilePath(FileName);
+    TableName := ExtractFileName(FileName);
+    FCopyDateTimeAsString := DateTimeAsString;
+    TableLevel := Level;
+    if not DataSet.Active then
+      DataSet.Open;
+    DataSet.FieldDefs.Update;
+    FieldDefs.Assign(DataSet.FieldDefs);
+    IndexDefs.Clear;
+    CreateTable;
+    Open;
+    DataSet.First;
+    while not DataSet.EOF do
+    begin
+      Append;
+      for I := 0 to Pred(FieldCount) do
+      begin
+        if not DataSet.Fields[I].IsNull then
+        begin
+          if DataSet.Fields[I].DataType = ftDateTime then
+          begin
+            if FCopyDateTimeAsString then
+            begin
+              Fields[I].AsString := DataSet.Fields[I].AsString;
+              if Assigned(FOnCopyDateTimeAsString) then
+                FOnCopyDateTimeAsString(Self, Fields[I], DataSet.Fields[I])
+            end else
+              Fields[I].AsDateTime := DataSet.Fields[I].AsDateTime;
+          end else
+            Fields[I].Assign(DataSet.Fields[I]);
+        end;
+      end;
+      Post;
+      DataSet.Next;
+    end;
+    Close;
+  finally
+    FInCopyFrom := false;
+  end;
+end;
+
+function TDbf.FindRecord(Restart, GoForward: Boolean): Boolean;
+var
+  oldRecNo: Integer;
+begin
+  CheckBrowseMode;
+  DoBeforeScroll;
+  Result := false;
+  oldRecNo := RecNo;
+  try
+    FFindRecordFilter := true;
+    if GoForward then
+    begin
+      if Restart then FCursor.First;
+      Result := GetRecord(FTempBuffer, gmNext, false) = grOK;
+    end else begin
+      if Restart then FCursor.Last;
+      Result := GetRecord(FTempBuffer, gmPrior, false) = grOK;
+    end;
+  finally
+    FFindRecordFilter := false;
+    if not Result then
+      RecNo := oldRecNo;
+    Resync([]);
+  end;
+end;
+
+{$ifdef SUPPORT_VARIANTS}
+{$ifdef USE_BUGGY_LOOKUP}
+
+function TDbf.Lookup(const KeyFields: string; const KeyValues: Variant;
+  const ResultFields: string): Variant;
+var
+//  OldState:  TDataSetState;
+  retBookmark: TBookmarkStr;
+begin
+  Result := Null;
+  if VarIsNull(KeyValues) then exit;
+
+  retBookmark := Bookmark;
+  DisableControls;
+  try
+    if LocateRecord(KeyFields, KeyValues, []) then
+    begin
+{
+      OldState := SetTempState(dsCalcFields);
+//      OldState := SetTempState(dsInternalCalc);
+        // disable Calculated fields - otherwise were heavy AVs
+        // and buffer troubles below
+      try
+//        CalculateFields(PChar(@FDbfCalcBuffer));
+        CalculateFields(TempBuffer);
+//        CalculateFields(GetCurrentBuffer);
+        if KeyValues = FieldValues[KeyFields] then // there was bug in TDbf.SearchKey
+}
+           Result := FieldValues[ResultFields]; // also there may be buffer troubles from above
+{
+      finally
+          (* else *) RestoreState(OldState);
+      end;
+}
+    end;
+  finally
+    Bookmark := retBookmark;
+    EnableControls;
+  end;
+end;
+
+{$endif}
+
+function TDbf.Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean;
+var
+  retBookmark: TBookmarkStr;
+begin
+  DoBeforeScroll;
+  try
+    DisableControls;
+    retBookmark := Bookmark;
+    Result := LocateRecord(KeyFields, KeyValues, Options);
+    if Result then
+      DoAfterScroll
+    else
+      Bookmark := retBookmark;
+  finally
+    EnableControls;
+  end;
+end;
+
+function TDbf.LocateRecord(const KeyFields: String; const KeyValues: Variant;
+    Options: TLocateOptions): Boolean;
+var
+  lstKeys              : TList;
+  iIndex               : Integer;
+  Field                : TField;
+  bMatchedData         : Boolean;
+  bVarIsArray          : Boolean;
+  varCompare           : Variant;
+  doLinSearch          : Boolean;
+  pIndexValue          : PChar;
+
+  function CompareValues: Boolean;
+  var
+    sCompare: String;
+  begin
+    if (Field.DataType = ftString) then
+    begin
+      sCompare := VarToStr(varCompare);
+      if loCaseInsensitive in Options then
+      begin
+        Result := AnsiCompareText(Field.AsString,sCompare) = 0;
+        if not Result and (iIndex = lstKeys.Count - 1) and (loPartialKey in Options) and
+          (Length(sCompare) < Length(Field.AsString)) then
+        begin
+          if Length(sCompare) = 0 then
+            Result := true
+          else
+            Result := AnsiCompareText (Copy (Field.AsString,1,Length (sCompare)),sCompare) = 0;
+        end;
+      end else begin
+        Result := Field.AsString = sCompare;
+        if not Result and (iIndex = lstKeys.Count - 1) and (loPartialKey in Options) and
+          (Length (sCompare) < Length (Field.AsString)) then
+        begin
+          if Length (sCompare) = 0 then
+            Result := true
+          else
+            Result := Copy(Field.AsString, 1, Length(sCompare)) = sCompare;
+        end;
+      end;
+    end
+    else
+      Result := Field.Value = varCompare;
+  end;
+
+var
+  searchFlag: TSearchKeyType;
+  searchString: string;
+  strLength: Integer;
+
+begin
+  Result := false;
+  CheckBrowseMode;
+
+  doLinSearch := true;
+  // index active?
+  if FCursor is TIndexCursor then
+  begin
+    // matches field to search on?
+    if TIndexCursor(FCursor).IndexFile.Expression = KeyFields then
+    begin
+      // can do index search
+      doLinSearch := false;
+      if loPartialKey in Options then
+        searchFlag := stGreaterEqual
+      else
+        searchFlag := stEqual;
+      Result := SearchKey(KeyValues, searchFlag);
+      if Result and (loPartialKey in Options) then
+      begin
+        searchString := VarToStr(KeyValues);
+        strLength := Length(searchString);
+        pIndexValue := TIndexCursor(FCursor).IndexFile.ExtractKeyFromBuffer(GetCurrentBuffer);
+        if loCaseInsensitive in Options then
+        begin
+          Result := AnsiStrLIComp(pIndexValue, PChar(searchString), strLength) = 0;
+        end else begin
+          Result := StrLComp(pIndexValue, PChar(searchString), strLength) = 0;
+        end;
+      end;
+    end;
+  end;
+
+  if doLinSearch then
+  begin
+    bVarIsArray := false;
+    CursorPosChanged;
+    lstKeys := TList.Create;
+    try
+      GetFieldList(lstKeys, KeyFields);
+      if VarArrayDimCount(KeyValues) = 0 then
+        bMatchedData := lstKeys.Count = 1
+      else if VarArrayDimCount (KeyValues) = 1 then
+      begin
+        bMatchedData := VarArrayHighBound (KeyValues,1) + 1 = lstKeys.Count;
+        bVarIsArray := true;
+      end else
+        bMatchedData := false;
+      if bMatchedData then
+      begin
+        First;
+        while not Eof and not Result Do
+        begin
+          Result := true;
+          iIndex := 0;
+          while Result and (iIndex < lstKeys.Count) Do
+          begin
+            Field := TField (lstKeys [iIndex]);
+            if bVarIsArray then
+              varCompare := KeyValues [iIndex]
+            else
+              varCompare := KeyValues;
+            Result := CompareValues;
+            iIndex := iIndex + 1;
+          end;
+          if not Result then
+            Next;
+        end;
+      end;
+    finally
+      lstKeys.Free;
+    end;
+  end;
+end;
+
+{$endif}
+
+procedure TDbf.TryExclusive;
+begin
+  // are we active?
+  if Active then
+  begin
+    // already in exclusive mode?
+    FDbfFile.TryExclusive;
+    // update file mode
+    FExclusive := FDbfFile.Mode in [pfMemory..pfExclusiveOpen];
+    FReadOnly := FDbfFile.Mode = pfReadOnly;
+  end else begin
+    // just set exclusive to true
+    FExclusive := true;
+    FReadOnly := false;
+  end;
+end;
+
+procedure TDbf.EndExclusive;
+begin
+  if Active then
+  begin
+    // call file handler
+    FDbfFile.EndExclusive;
+    // update file mode
+    FExclusive := FDbfFile.Mode in [pfMemory..pfExclusiveOpen];
+    FReadOnly := FDbfFile.Mode = pfReadOnly;
+  end else begin
+    // just set exclusive to false
+    FExclusive := false;
+  end;
+end;
+
+function TDbf.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; {override virtual}
+var
+  MemoPageNo: Integer;
+  MemoFieldNo: Integer;
+  lBlob: TDbfBlobStream;
+begin
+  // already created a `placeholder' blob for this field?
+  MemoFieldNo := Field.FieldNo - 1;
+  if FBlobStreams[MemoFieldNo] = nil then
+    FBlobStreams[MemoFieldNo] := TDbfBlobStream.Create(Field);
+  lBlob := FBlobStreams[MemoFieldNo].AddReference;
+  lBlob.Mode := Mode;
+  // update pageno of blob <-> location where to read/write in memofile
+  if FDbfFile.GetFieldData(Field.FieldNo-1, ftInteger, GetCurrentBuffer, @MemoPageNo) then
+  begin
+    // read blob? different blob?
+    if (Mode = bmRead) or (Mode = bmReadWrite) then
+    begin
+      if MemoPageNo <> lBlob.MemoRecNo then
+      begin
+        FDbfFile.MemoFile.ReadMemo(MemoPageNo, lBlob);
+        lBlob.ReadSize := lBlob.Size;
+        lBlob.Translate(false);
+      end;
+    end else begin
+      lBlob.Size := 0;
+      lBlob.ReadSize := 0;
+    end;
+  end else begin
+    MemoPageNo := 0;
+    lBlob.Size := 0;
+    lBlob.ReadSize := 0;
+  end;
+  lBlob.MemoRecNo := MemoPageNo;
+  Result := lBlob;
+  Result.Position := 0;
+end;
+
+{$ifdef SUPPORT_NEW_TRANSLATE}
+
+function TDbf.Translate(Src, Dest: PChar; ToOem: Boolean): Integer; {override virtual}
+var
+  FromCP, ToCP: Cardinal;
+begin
+  if (Src <> nil) and (Dest <> nil) then
+  begin
+    if Assigned(FOnTranslate) then
+    begin
+      Result := FOnTranslate(Self, Src, Dest, ToOem);
+      if Result = -1 then
+        Result := StrLen(Dest);
+    end else begin
+      if FTranslationMode <> tmNoneNeeded then
+      begin
+        if ToOem then
+        begin
+          FromCP := GetACP;
+          ToCP := FDbfFile.UseCodePage;
+        end else begin
+          FromCP := FDbfFile.UseCodePage;
+          ToCP := GetACP;
+        end;
+      end else begin
+        FromCP := GetACP;
+        ToCP := FromCP;
+      end;
+      Result := TranslateString(FromCP, ToCP, Src, Dest, -1);
+    end;
+  end else
+    Result := 0;
+end;
+
+{$else}
+
+procedure TDbf.Translate(Src, Dest: PChar; ToOem: Boolean); {override virtual}
+var
+  FromCP, ToCP: Cardinal;
+begin
+  if (Src <> nil) and (Dest <> nil) then
+  begin
+    if Assigned(FOnTranslate) then
+    begin
+      FOnTranslate(Self, Src, Dest, ToOem);
+    end else begin
+      if FTranslationMode <> tmNoneNeeded then
+      begin
+        if ToOem then
+        begin
+          FromCP := GetACP;
+          ToCP := FDbfFile.UseCodePage;
+        end else begin
+          FromCP := FDbfFile.UseCodePage;
+          ToCP := GetACP;
+        end;
+        TranslateString(FromCP, ToCP, Src, Dest, -1);
+      end;
+    end;
+  end;
+end;
+
+{$endif}
+
+procedure TDbf.ClearCalcFields(Buffer: PChar);
+var
+  RealBuffer, CalcBuffer: PChar;
+begin
+  RealBuffer := @pDbfRecord(Buffer).DeletedFlag;
+  CalcBuffer := RealBuffer + FDbfFile.RecordSize;
+  FillChar(CalcBuffer^, CalcFieldsSize, 0);
+end;
+
+procedure TDbf.InternalSetToRecord(Buffer: PChar); {override virtual abstract from TDataset}
+var
+  pRecord: pDbfRecord;
+begin
+  if Buffer <> nil then
+  begin
+    pRecord := pDbfRecord(Buffer);
+    if pRecord.BookMarkFlag = bfInserted then
+    begin
+      // do what ???
+    end else begin
+      FCursor.GotoBookmark(pRecord.BookmarkData);
+    end;
+  end;
+end;
+
+function TDbf.IsCursorOpen: Boolean; {override virtual abstract from TDataset}
+begin
+  Result := FCursor <> nil;
+end;
+
+function TDbf.FieldDefsStored: Boolean;
+begin
+  Result := StoreDefs and (FieldDefs.Count > 0);
+end;
+
+procedure TDbf.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); {override virtual abstract from TDataset}
+var
+  pRecord: pDbfRecord;
+begin
+  pRecord := pDbfRecord(Buffer);
+  pRecord.BookMarkFlag := Value;
+end;
+
+procedure TDbf.SetBookmarkData(Buffer: PChar; Data: Pointer); {override virtual abstract from TDataset}
+var
+  pRecord: pDbfRecord;
+begin
+  pRecord := pDbfRecord(Buffer);
+  pRecord.BookMarkData := pBookMarkData(Data)^;
+end;
+
+procedure TDbf.SetFieldData(Field: TField; Buffer: Pointer); {override virtual abstract from TDataset}
+var
+  pRecord: pDbfRecord;
+  Dst: Pointer;
+begin
+  if (Field.FieldNo >= 0) then
+  begin
+    pRecord := pDbfRecord(ActiveBuffer);
+    dst := @pRecord.DeletedFlag;
+    FDbfFile.SetFieldData(Field.FieldNo - 1,Field.DataType,Buffer,Dst);
+  end else begin    { ***** fkCalculated, fkLookup ***** }
+    pRecord := pDbfRecord(CalcBuffer);
+    Dst := @pRecord.DeletedFlag;
+    Inc(PChar(Dst), RecordSize + Field.Offset);
+//    Boolean(dst^) := LongBool(Buffer);
+//    if Boolean(dst^) then begin
+//      Inc(Integer(dst), 1);
+    if Buffer <> nil then
+      Move(Buffer^, Dst^, Field.DataSize)
+    else
+      FillChar(Dst^, Field.DataSize, #0);
+//    end;
+  end;     { end of ***** fkCalculated, fkLookup ***** }
+  if not (State in [dsCalcFields, dsFilter, dsNewValue]) then begin
+    DataEvent(deFieldChange, Longint(Field));
+  end;
+end;
+
+// this function counts real number of records: skip deleted records, filter, etc.
+// warning: is very slow, compared to GetRecordCount
+function TDbf.GetExactRecordCount: Integer;
+var
+  prevRecNo: Integer;
+  getRes: TGetResult;
+begin
+  // init vars
+  Result := 0;
+  // store current position
+  prevRecNo := FCursor.SequentialRecNo;
+  FCursor.First;
+  repeat
+    // repeatedly retrieve next record until eof encountered
+    getRes := GetRecord(FTempBuffer, gmNext, true);
+    if getRes = grOk then
+      inc(Result);
+  until getRes <> grOk;
+  // restore current position
+  FCursor.SequentialRecNo := prevRecNo;
+end;
+
+// this functions returns the physical number of records present in file
+function TDbf.GetPhysicalRecordCount: Integer;
+begin
+  if FDbfFile <> nil then
+    Result := FDbfFile.RecordCount
+  else
+    Result := 0
+end;
+
+// this function is just for the grid scrollbars
+// it doesn't have to be perfectly accurate, but fast.
+function TDbf.GetRecordCount: Integer; {override virtual}
+begin
+  if FCursor <> nil then
+    Result := FCursor.SequentialRecordCount
+  else
+    Result := 0
+end;
+
+// this function is just for the grid scrollbars
+// it doesn't have to be perfectly accurate, but fast.
+function TDbf.GetRecNo: Integer; {override virtual}
+begin
+  UpdateCursorPos;
+  Result := FCursor.SequentialRecNo;
+end;
+
+procedure TDbf.SetRecNo(Value: Integer); {override virual}
+begin
+  FCursor.SequentialRecNo := Value;
+  Resync([]);
+end;
+
+function TDbf.GetCanModify: Boolean; {override;}
+begin
+  if FReadOnly or (csDesigning in ComponentState) then
+    Result := false
+  else
+    Result := FTranslationMode > tmNoneAvailable;
+end;
+
+{$ifdef SUPPORT_DEFCHANGED}
+
+procedure TDbf.DefChanged(Sender: TObject);
+begin
+  StoreDefs := true;
+end;
+
+{$endif}
+
+procedure TDbf.SetFilterText(const Value: String);
+begin
+  // parser created?
+  if Length(Value) > 0 then
+  begin
+    if (FParser = nil) and (FDbfFile <> nil) then
+    begin
+      FParser := TDbfParser.Create(FDbfFile);
+      // we need translated (to ANSI) strings
+      FParser.RawStringFields := false;
+    end;
+    // have a parser now?
+    if FParser <> nil then
+    begin
+      // set options
+      FParser.CaseInsensitive := foCaseInsensitive in FilterOptions;
+      // parse expression
+      FParser.ParseExpression(Value);
+    end;
+  end;
+
+  // call dataset method
+  inherited;
+
+  // refilter dataset if filtered
+  if (FDbfFile <> nil) and Filtered then Resync([]);
+end;
+
+procedure TDbf.SetFiltered(Value: Boolean); {override;}
+begin
+  // pass on to ancestor
+  inherited;
+
+  // only refresh if active
+  if FCursor <> nil then
+    Resync([]);
+end;
+
+procedure TDbf.SetFilePath(const Value: string);
+begin
+  CheckInactive;
+
+  FRelativePath := Value;
+  if Length(FRelativePath) > 0 then
+       FRelativePath := IncludeTrailingPathDelimiter(FRelativePath);
+
+  if IsFullFilePath(Value) then
+  begin
+    FAbsolutePath := IncludeTrailingPathDelimiter(Value);
+  end else begin
+    FAbsolutePath := GetCompletePath(DbfBasePath, FRelativePath);
+  end;
+end;
+
+procedure TDbf.SetTableName(const s: string);
+var
+  lPath: string;
+begin
+  FTableName := ExtractFileName(s);
+  lPath := ExtractFilePath(s);
+  if (Length(lPath) > 0) then
+    FilePath := lPath;
+  // force IDE to reread fielddefs when a different file is opened
+{$ifdef SUPPORT_FIELDDEFS_UPDATED}
+  FieldDefs.Updated := false;
+{$else}
+  // TODO ... ??
+{$endif}
+end;
+
+procedure TDbf.SetDbfIndexDefs(const Value: TDbfIndexDefs);
+begin
+  FIndexDefs.Assign(Value);
+end;
+
+procedure TDbf.SetTableLevel(const NewLevel: Integer);
+begin
+  if NewLevel <> FTableLevel then
+  begin
+    // check validity
+    if not ((NewLevel = 3) or (NewLevel = 4) or (NewLevel = 7) or (NewLevel = 25)) then
+      exit;
+
+    // can only assign tablelevel if table is closed
+    CheckInactive;
+    FTableLevel := NewLevel;
+  end;
+end;
+
+function TDbf.GetIndexName: string;
+begin
+  Result := FIndexName;
+end;
+
+function TDbf.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
+const
+  RetCodes: array[Boolean, Boolean] of ShortInt = ((2,-1),(1,0));
+var
+  b1,b2: Integer;
+begin
+  // Check for uninitialized bookmarks
+  Result := RetCodes[Bookmark1 = nil, Bookmark2 = nil];
+  if (Result = 2) then
+  begin
+    b1 := PInteger(Bookmark1)^;
+    b2 := PInteger(Bookmark2)^;
+    if b1 < b2 then Result := -1
+    else if b1 > b2 then Result := 1
+    else Result := 0;
+  end;
+end;
+
+function TDbf.GetVersion: string;
+begin
+  Result := Format('%d.%02d', [TDBF_MAJOR_VERSION, TDBF_MINOR_VERSION]);
+end;
+
+procedure TDbf.SetVersion(const S: string);
+begin
+  // What an idea...
+end;
+
+function TDbf.ParseIndexName(const AIndexName: string): string;
+begin
+  // if no ext, then it is a MDX tag, get complete only if it is a filename
+  // MDX: get first 10 characters only
+  if Length(ExtractFileExt(AIndexName)) > 0 then
+    Result := GetCompleteFileName(FAbsolutePath, AIndexName)
+  else
+    Result := AIndexName;
+end;
+
+procedure TDbf.RegenerateIndexes;
+begin
+  CheckBrowseMode;
+  FDbfFile.RegenerateIndexes;
+end;
+
+{$ifdef SUPPORT_DEFAULT_PARAMS}
+procedure TDbf.AddIndex(const AIndexName, Fields: String; Options: TIndexOptions; const DescFields: String='');
+{$else}
+procedure TDbf.AddIndex(const AIndexName, Fields: String; Options: TIndexOptions);
+{$endif}
+var
+  lIndexFileName: string;
+begin
+  CheckActive;
+  lIndexFileName := ParseIndexName(AIndexName);
+  FDbfFile.OpenIndex(lIndexFileName, Fields, true, Options);
+
+  // refresh our indexdefs
+  InternalInitFieldDefs;
+end;
+
+procedure TDbf.SetIndexName(AIndexName: string);
+var
+  RecNo: Integer;
+begin
+  FIndexName := AIndexName;
+  if FDbfFile = nil then
+    exit;
+
+  // get accompanying index file
+  AIndexName := ParseIndexName(Trim(AIndexName));
+  FIndexFile := FDbfFile.GetIndexByName(AIndexName);
+  // store current recno
+  if FCursor = nil then
+  begin
+    RecNo := 1;
+  end else begin
+    UpdateCursorPos;
+    RecNo := FCursor.PhysicalRecNo;
+  end;
+  // select new cursor
+  FreeAndNil(FCursor);
+  if FIndexFile <> nil then
+  begin
+    FCursor := TIndexCursor.Create(FIndexFile);
+    // select index
+    FIndexFile.IndexName := AIndexName;
+    // check if can activate master link
+    CheckMasterRange;
+  end else begin
+    FCursor := TDbfCursor.Create(FDbfFile);
+    FIndexName := EmptyStr;
+  end;
+  // reset previous recno
+  FCursor.PhysicalRecNo := RecNo;
+  // refresh records
+  if State = dsBrowse then
+    Resync([]);
+  // warn user if selecting non-existing index
+  if (FCursor = nil) and (AIndexName <> EmptyStr) then
+    raise EDbfError.CreateFmt(STRING_INDEX_NOT_EXIST, [AIndexName]);
+end;
+
+function TDbf.GetIndexFieldNames: string;
+var
+  lIndexDef: TDbfIndexDef;
+begin
+  lIndexDef := FIndexDefs.GetIndexByName(IndexName);
+  if lIndexDef = nil then
+    Result := EmptyStr
+  else
+    Result := lIndexDef.SortField;
+end;
+
+procedure tdbf.SetIndexFieldNames(const Value: string);
+var
+  lIndexDef: TDbfIndexDef;
+begin
+  // Exception if index not found?
+  lIndexDef := FIndexDefs.GetIndexByField(Value);
+  if lIndexDef = nil then
+    IndexName := EmptyStr
+  else
+    IndexName := lIndexDef.IndexFile;
+end;
+
+procedure TDbf.DeleteIndex(const AIndexName: string);
+var
+  lIndexFileName: string;
+begin
+  // extract absolute path if NDX file
+  lIndexFileName := ParseIndexName(AIndexName);
+  // try to delete index
+  FDbfFile.DeleteIndex(lIndexFileName);
+//    raise EDbfError.CreateFmt(STRING_INDEX_NOT_EXIST, [AIndexName]);
+
+  // refresh index defs
+  InternalInitFieldDefs;
+end;
+
+procedure TDbf.OpenIndexFile(IndexFile: string);
+var
+  lIndexFileName: string;
+begin
+  CheckActive;
+  // make absolute path
+  lIndexFileName := GetCompleteFileName(FAbsolutePath, IndexFile);
+  // open index
+  FDbfFile.OpenIndex(lIndexFileName, '', false, []);
+end;
+
+procedure TDbf.CloseIndexFile(const AIndexName: string);
+var
+  lIndexFileName: string;
+begin
+  CheckActive;
+  // make absolute path
+  lIndexFileName := GetCompleteFileName(FAbsolutePath, AIndexName);
+  // close this index
+  FDbfFile.CloseIndex(lIndexFileName);
+end;
+
+procedure TDbf.RepageIndexFile(const AIndexFile: string);
+begin
+  if FDbfFile <> nil then
+    FDbfFile.RepageIndex(ParseIndexName(AIndexFile));
+end;
+
+procedure TDbf.CompactIndexFile(const AIndexFile: string);
+begin
+  if FDbfFile <> nil then
+    FDbfFile.CompactIndex(ParseIndexName(AIndexFile));
+end;
+
+procedure TDbf.GetFileNames(Strings: TStrings; Files: TDbfFileNames);
+var
+  I: Integer;
+begin
+  Strings.Clear;
+  if FDbfFile = nil then
+  begin
+    if dfDbf in Files then
+      Strings.Add(FDbfFile.FileName);
+    if (dfMemo in Files) and (FDbfFile.MemoFile <> nil) then
+      Strings.Add(FDbfFile.MemoFile.FileName);
+    if dfIndex in Files then
+      for I := 0 to Pred(FDbfFile.IndexFiles.Count) do
+        Strings.Add(TPagedFile(FDbfFile.IndexFiles.Items[I]).FileName);
+  end;
+end;
+
+{$ifdef SUPPORT_DEFAULT_PARAMS}
+function TDbf.GetFileNames(Files: TDbfFileNames (* = [dfDbf] *) ): string;
+{$else}
+function TDbf.GetFileNamesString(Files: TDbfFileNames ): string;
+{$endif}
+var
+  sl: TStrings;
+begin
+  if Files = [dfDbf] then
+  begin
+    //even if closed!
+    // do it myself, since it is rather faster than the code below
+    Result := IncludeTrailingPathDelimiter(FilePathFull) + TableName;
+  end else begin
+    CheckActive;
+    sl := TStringList.Create;
+    try
+      GetFileNames(sl, Files);
+      Result := sl.Text;
+    finally
+      sl.Free
+    end;
+  end;
+end;
+
+
+
+procedure TDbf.GetIndexNames(Strings: TStrings);
+begin
+  CheckActive;
+  Strings.Assign(DbfFile.IndexNames)
+end;
+
+procedure TDbf.GetAllIndexFiles(Strings: TStrings);
+var
+  SR: TSearchRec;
+begin
+  CheckActive;
+  Strings.Clear;
+  if SysUtils.FindFirst(IncludeTrailingPathDelimiter(ExtractFilePath(FDbfFile.FileName))
+        + '*.NDX', faAnyFile, SR) = 0 then
+  begin
+    repeat
+      Strings.Add(SR.Name);
+    until SysUtils.FindNext(SR)<>0;
+    SysUtils.FindClose(SR);
+  end;
+end;
+
+function TDbf.GetPhysicalRecNo: Integer;
+begin
+  // check if active, test state: if inserting, then -1
+  if (FCursor <> nil) and (State <> dsInsert) then
+  begin
+    UpdateCursorPos;
+    Result := FCursor.PhysicalRecNo;
+  end else
+    Result := -1;
+end;
+
+procedure TDbf.SetPhysicalRecNo(const NewRecNo: Integer);
+begin
+  // active?
+  if FCursor <> nil then
+  begin
+    // editing?
+    CheckBrowseMode;
+    // set recno
+    FCursor.PhysicalRecNo := NewRecNo;
+    // refresh data controls
+    Resync([]);
+  end;
+end;
+
+function TDbf.GetDbfFieldDefs: TDbfFieldDefs;
+begin
+  if FDbfFile <> nil then
+    Result := FDbfFile.FieldDefs
+  else
+    Result := nil;
+end;
+
+procedure TDbf.SetShowDeleted(Value: Boolean);
+begin
+  // test if changed
+  if Value <> FShowDeleted then
+  begin
+    // store new value
+    FShowDeleted := Value;
+    // refresh view only if active
+    if FCursor <> nil then
+      Resync([]);
+  end;
+end;
+
+function TDbf.IsDeleted: Boolean;
+var
+  src: PChar;
+begin
+  src := GetCurrentBuffer;
+  IsDeleted := (src=nil) or (src^ = '*')
+end;
+
+procedure TDbf.Undelete;
+var
+  src: PChar;
+begin
+  if State <> dsEdit then
+    inherited Edit;
+  // get active buffer
+  src := GetCurrentBuffer;
+  if (src <> nil) and (src^ = '*') then
+  begin
+    // notify indexes record is about to be recalled
+    FDbfFile.RecordRecalled(FCursor.PhysicalRecNo, src);
+    // recall record
+    src^ := ' ';
+    FDbfFile.WriteRecord(FCursor.PhysicalRecNo, src);
+  end;
+end;
+
+procedure TDbf.CancelRange;
+begin
+  if FIndexFile = nil then
+    exit;
+
+  // disable current range if any
+  TIndexCursor(FCursor).CancelRange;
+  // refresh
+  Refresh;
+end;
+
+procedure TDbf.SetRangeBuffer(LowRange: PChar; HighRange: PChar);
+var
+  Result: Boolean;
+begin
+  if FIndexFile = nil then
+    exit;
+
+  // disable current range if any
+  TIndexCursor(FCursor).CancelRange;
+  // search lower bound
+  Result := TIndexCursor(FCursor).SearchKey(LowRange, stGreaterEqual);
+  if not Result then
+  begin
+    // not found? -> make empty range
+    FCursor.Last;
+  end;
+  // set lower bound
+  TIndexCursor(FCursor).SetBracketLow;
+  // search upper bound
+  Result := TIndexCursor(FCursor).SearchKey(HighRange, stGreater);
+  // if result true, then need to get previous item <=>
+  //    last of equal/lower than key
+  if Result then
+  begin
+    Result := FCursor.Prev;
+    if not Result then
+    begin
+      // cannot go prev -> empty range
+      FCursor.First;
+    end;
+  end else begin
+    // not found -> EOF found, go EOF, then to last record
+    FCursor.Last;
+    FCursor.Prev;
+  end;
+  // set upper bound
+  TIndexCursor(FCursor).SetBracketHigh;
+  // go to first in this range
+  if Active then
+    inherited First;
+end;
+
+{$ifdef SUPPORT_VARIANTS}
+
+procedure TDbf.SetRange(LowRange: Variant; HighRange: Variant);
+var
+  LowBuf, HighBuf: array[0..100] of Char;
+begin
+  if (FIndexFile = nil) or VarIsNull(LowRange) or VarIsNull(HighRange) then
+    exit;
+
+  // convert variants to index key type
+  TIndexCursor(FCursor).VariantToBuffer(LowRange,  @LowBuf[0]);
+  TIndexCursor(FCursor).VariantToBuffer(HighRange, @HighBuf[0]);
+  SetRangeBuffer(@LowBuf[0], @HighBuf[0]);
+end;
+
+{$endif}
+
+procedure TDbf.SetRangePChar(LowRange: PChar; HighRange: PChar);
+var
+  LowBuf, HighBuf: array [0..100] of Char;
+  LowPtr, HighPtr: PChar;
+begin
+  if FIndexFile = nil then
+    exit;
+
+  // convert to pchars
+  LowPtr  := TIndexCursor(FCursor).CheckUserKey(LowRange,  @LowBuf[0]);
+  HighPtr := TIndexCursor(FCursor).CheckUserKey(HighRange, @HighBuf[0]);
+  SetRangeBuffer(LowPtr, HighPtr);
+end;
+
+procedure TDbf.ExtractKey(KeyBuffer: PChar);
+begin
+  if FCursor is TIndexCursor then
+    StrCopy(TIndexCursor(FCursor).IndexFile.ExtractKeyFromBuffer(GetCurrentBuffer), KeyBuffer)
+  else
+    KeyBuffer[0] := #0;
+end;
+
+function TDbf.GetKeySize: Integer;
+begin
+  if FCursor is TIndexCursor then
+    Result := TIndexCursor(FCursor).IndexFile.KeyLen
+  else
+    Result := 0;
+end;
+
+{$ifdef SUPPORT_VARIANTS}
+
+function TDbf.SearchKey(Key: Variant; SearchType: TSearchKeyType): Boolean;
+var
+  TempBuffer: array [0..100] of Char;
+begin
+  if (FIndexFile = nil) or VarIsNull(Key) then
+  begin
+    Result := false;
+    exit;
+  end;
+
+  // FIndexFile <> nil -> FCursor as TIndexCursor <> nil
+  TIndexCursor(FCursor).VariantToBuffer(Key, @TempBuffer[0]);
+  Result := SearchKeyBuffer(@TempBuffer[0], SearchType);
+end;
+
+{$endif}
+
+function TDbf.SearchKeyPChar(Key: PChar; SearchType: TSearchKeyType): Boolean;
+var
+  StringBuf: array [0..100] of Char;
+begin
+  if FIndexFile = nil then
+  begin
+    Result := false;
+    exit;
+  end;
+
+  Result := SearchKeyBuffer(TIndexCursor(FCursor).CheckUserKey(Key, @StringBuf[0]), SearchType);
+end;
+
+function TDbf.SearchKeyBuffer(Buffer: PChar; SearchType: TSearchKeyType): Boolean;
+var
+  matchRes: Integer;
+begin
+  if FIndexFile = nil then
+  begin
+    Result := false;
+    exit;
+  end;
+
+  CheckBrowseMode;
+  Result := TIndexCursor(FCursor).SearchKey(Buffer, SearchType);
+  { if found, then retrieve new current record }
+  if Result then
+  begin
+    Resync([]);
+    UpdateCursorPos;
+    { recno could have been changed due to deleted record, check if still matches }
+    matchRes := TIndexCursor(FCursor).IndexFile.MatchKey;
+    case SearchType of
+      stEqual:        Result := matchRes =  0;
+      stGreater:      Result := (not Eof) and (matchRes <  0);
+      stGreaterEqual: Result := (not Eof) and (matchRes <= 0);
+    end;
+  end;
+end;
+
+procedure TDbf.UpdateIndexDefs;
+begin
+  FieldDefs.Update;
+end;
+
+// A hack to upgrade method visibility, only necessary for FPC 1.0.x
+
+{$ifdef VER1_0}
+
+procedure TDbf.DataEvent(Event: TDataEvent; Info: Longint);
+begin
+  inherited;
+end;
+
+{$endif}
+
+{ Master / Detail }
+
+procedure TDbf.CheckMasterRange;
+begin
+  if FMasterLink.Active and FMasterLink.ValidExpression and (FIndexFile <> nil) then
+    UpdateRange;
+end;
+
+procedure TDbf.UpdateRange;
+var
+  fieldsVal: PChar;
+begin
+  fieldsVal := FMasterLink.FieldsVal;
+  fieldsVal := TIndexCursor(FCursor).IndexFile.PrepareKey(fieldsVal, FMasterLink.Parser.ResultType);
+  SetRangeBuffer(fieldsVal, fieldsVal);
+end;
+
+procedure TDbf.MasterChanged(Sender: TObject);
+begin
+  CheckBrowseMode;
+  CheckMasterRange;
+end;
+
+procedure TDbf.MasterDisabled(Sender: TObject);
+begin
+  CancelRange;
+end;
+
+function TDbf.GetDataSource: TDataSource;
+begin
+  Result := FMasterLink.DataSource;
+end;
+
+procedure TDbf.SetDataSource(Value: TDataSource);
+begin
+{$ifndef FPC_VERSION}
+  if IsLinkedTo(Value) then
+  begin
+{$ifdef DELPHI_4}
+    DatabaseError(SCircularDataLink, Self);
+{$else}
+    DatabaseError(SCircularDataLink);
+{$endif}
+  end;
+{$endif}
+  FMasterLink.DataSource := Value;
+end;
+
+function TDbf.GetMasterFields: string;
+begin
+  Result := FMasterLink.FieldNames;
+end;
+
+procedure TDbf.SetMasterFields(const Value: string);
+begin
+  FMasterLink.FieldNames := Value;
+end;
+
+//==========================================================
+//============ TDbfIndexDefs
+//==========================================================
+constructor TDbfIndexDefs.Create(AOwner: TDbf);
+begin
+  inherited Create(TDbfIndexDef);
+  FOwner := AOwner;
+end;
+
+function TDbfIndexDefs.Add: TDbfIndexDef;
+begin
+  Result := TDbfIndexDef(inherited Add);
+end;
+
+procedure TDbfIndexDefs.SetItem(N: Integer; Value: TDbfIndexDef);
+begin
+  inherited SetItem(N, Value);
+end;
+
+function TDbfIndexDefs.GetItem(N: Integer): TDbfIndexDef;
+begin
+  Result := TDbfIndexDef(inherited GetItem(N));
+end;
+
+function TDbfIndexDefs.GetOwner: tpersistent;
+begin
+  Result := FOwner;
+end;
+
+function TDbfIndexDefs.GetIndexByName(const Name: string): TDbfIndexDef;
+var
+  I: Integer;
+  lIndex: TDbfIndexDef;
+begin
+  for I := 0 to Count-1 do
+  begin
+    lIndex := Items[I];
+    if lIndex.IndexFile = Name then
+    begin
+      Result := lIndex;
+      exit;
+    end
+  end;
+  Result := nil;
+end;
+
+function TDbfIndexDefs.GetIndexByField(const Name: string): TDbfIndexDef;
+var
+  lIndex: TDbfIndexDef;
+  searchStr: string;
+  i: integer;
+begin
+  searchStr := AnsiUpperCase(Trim(Name));
+  Result := nil;
+  if searchStr = EmptyStr then
+    exit;
+
+  for I := 0 to Count-1 do
+  begin
+    lIndex := Items[I];
+    if AnsiUpperCase(Trim(lIndex.SortField)) = searchStr then
+    begin
+      Result := lIndex;
+      exit;
+    end
+  end;
+end;
+
+procedure TDbfIndexDefs.Update;
+begin
+  if Assigned(FOwner) then
+    FOwner.UpdateIndexDefs;
+end;
+
+//==========================================================
+//============ TDbfMasterLink
+//==========================================================
+
+constructor TDbfMasterLink.Create(ADataSet: TDbf);
+begin
+  inherited Create;
+
+  FDetailDataSet := ADataSet;
+  FParser := TDbfParser.Create(nil);
+  FValidExpression := false;
+end;
+
+destructor TDbfMasterLink.Destroy;
+begin
+  FParser.Free;
+
+  inherited;
+end;
+
+procedure TDbfMasterLink.ActiveChanged;
+begin
+  if Active and (FFieldNames <> EmptyStr) then
+  begin
+    FValidExpression := false;
+    FParser.DbfFile := TDbf(DataSet).DbfFile;
+    FParser.ParseExpression(FFieldNames);
+    FValidExpression := true;
+  end else begin
+    FParser.ClearExpressions;
+    FValidExpression := false;
+  end;
+
+  if FDetailDataSet.Active and not (csDestroying in FDetailDataSet.ComponentState) then
+    if Active then
+    begin
+      if Assigned(FOnMasterChange) then FOnMasterChange(Self);
+    end else
+      if Assigned(FOnMasterDisable) then FOnMasterDisable(Self);
+end;
+
+procedure TDbfMasterLink.CheckBrowseMode;
+begin
+  if FDetailDataSet.Active then
+    FDetailDataSet.CheckBrowseMode;
+end;
+
+procedure TDbfMasterLink.LayoutChanged;
+begin
+  ActiveChanged;
+end;
+
+procedure TDbfMasterLink.RecordChanged(Field: TField);
+begin
+  if (DataSource.State <> dsSetKey) and FDetailDataSet.Active and Assigned(FOnMasterChange) then
+    FOnMasterChange(Self);
+end;
+
+procedure TDbfMasterLink.SetFieldNames(const Value: string);
+begin
+  if FFieldNames <> Value then
+  begin
+    FFieldNames := Value;
+    ActiveChanged;
+  end;
+end;
+
+function TDbfMasterLink.GetFieldsVal: PChar;
+begin
+  Result := FParser.ExtractFromBuffer(@pDbfRecord(TDbf(DataSet).ActiveBuffer).DeletedFlag);
+end;
+
+////////////////////////////////////////////////////////////////////////////
+
+function ApplicationPath: string;
+begin
+  Result := ExtractFilePath(ParamStr(0));
+end;
+
+
+////////////////////////////////////////////////////////////////////////////
+
+initialization
+
+  DbfBasePath := ApplicationPath;
+
+end.
+

fcl/db/dbase/Dbf_Avl.pas

@@ -0,0 +1,425 @@
+unit Dbf_Avl;
+
+{fix CR/LF}
+
+interface
+
+type
+  TBal = -1..1;
+
+  TAvlTree = class;
+
+  TKeyType = Cardinal;
+  TExtraData = Pointer;
+
+  PData = ^TData;
+  TData = record
+    ID: TKeyType;
+    ExtraData: TExtraData;
+  end;
+
+  PNode = ^TNode;
+  TNode = record
+    Data: TData;
+    Left: PNode;
+    Right: PNode;
+    Bal: TBal;    // balance factor: h(Right) - h(Left)
+  end;
+
+  TAvlTreeEvent = procedure(Sender: TAvlTree; Data: PData) of object;
+
+  TAvlTree = class(TObject)
+  private
+    FRoot: PNode;
+    FCount: Cardinal;
+    FOnDelete: TAvlTreeEvent;
+    FHeightChange: Boolean;
+
+    procedure InternalInsert(X: PNode; var P: PNode);
+    procedure InternalDelete(X: TKeyType; var P: PNode);
+
+    procedure DeleteNode(X: PNode);
+    procedure TreeDispose(X: PNode);
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    procedure Clear;
+    function  Find(Key: TKeyType): TExtraData;
+    procedure Insert(Key: TKeyType; Extra: TExtraData);
+    procedure Delete(Key: TKeyType);
+
+    function  Lowest: PData;
+
+    property Count: Cardinal read FCount;
+    property OnDelete: TAvlTreeEvent read FOnDelete write FOnDelete;
+  end;
+
+
+implementation
+
+uses
+    Math;
+
+procedure RotL(var P: PNode);
+var
+  P1: PNode;
+begin
+  P1 := P^.Right;
+  P^.Right := P1^.Left;
+  P1^.Left := P;
+  P := P1;
+end;
+
+procedure RotR(var P: PNode);
+var
+  P1: PNode;
+begin
+  P1 := P^.Left;
+  P^.Left := P1^.Right;
+  P1^.Right := P;
+  P := P1;
+end;
+
+function  Height(X: PNode): Integer;
+begin
+  if X = nil then
+    Result := 0
+  else
+    Result := 1+Max(Height(X^.Left), Height(X^.Right));
+end;
+
+function  CheckTree_T(X: PNode; var H: Integer): Boolean;
+var
+  HR: Integer;
+begin
+  if X = nil then
+  begin
+    Result := true;
+    H := 0;
+  end else begin
+    Result := CheckTree_T(X^.Left, H) and CheckTree_T(X^.Right, HR) and
+        ((X^.Left = nil) or (X^.Left^.Data.ID < X^.Data.ID)) and
+        ((X^.Right = nil) or (X^.Right^.Data.ID > X^.Data.ID)) and
+//      ((Height(X^.Right) - Height(X^.Left)) = X^.Bal);
+        (HR - H = X^.Bal);
+    H := 1 + Max(H, HR);
+  end;
+end;
+
+function  CheckTree(X: PNode): Boolean;
+var
+  H: Integer;
+begin
+  Result := CheckTree_T(X, H);
+end;
+
+procedure BalanceLeft(var P: PNode; var HeightChange: Boolean);
+var
+  B1, B2: TBal;
+{HeightChange = true, left branch has become less high}
+begin
+  case P^.Bal of
+   -1: begin P^.Bal := 0 end;
+    0: begin P^.Bal := 1; HeightChange := false end;
+    1: begin {Rebalance}
+         B1 := P^.Right^.Bal;
+         if B1 >= 0
+         then {single L rotation}
+           begin
+             RotL(P);
+             //adjust balance factors:
+             if B1 = 0
+             then
+               begin P^.Bal :=-1; P^.Left^.Bal := 1; HeightChange := false end
+             else
+               begin P^.Bal := 0; P^.Left^.Bal := 0 end;
+           end
+         else {double RL rotation}
+           begin
+             B2 := P^.Right^.Left^.Bal;
+             RotR(P^.Right);
+             RotL(P);
+             //adjust balance factors:
+             if B2=+1 then P^.Left^.Bal := -1 else P^.Left^.Bal := 0;
+             if B2=-1 then P^.Right^.Bal := 1 else P^.Right^.Bal := 0;
+             P^.Bal := 0;
+           end;
+       end;{1}
+  end{case}
+end;{BalanceLeft}
+
+procedure BalanceRight(var P: PNode; var HeightChange: Boolean);
+var
+  B1, B2: TBal;
+{HeightChange = true, right branch has become less high}
+begin
+  case P^.Bal of
+    1: begin P^.Bal := 0 end;
+    0: begin P^.Bal := -1; HeightChange := false end;
+   -1: begin {Rebalance}
+         B1 := P^.Left^.Bal;
+         if B1 <= 0
+         then {single R rotation}
+           begin
+             RotR(P);
+             //adjust balance factors}
+             if B1 = 0
+             then
+               begin P^.Bal :=1; P^.Right^.Bal :=-1; HeightChange:= false end
+             else
+               begin P^.Bal := 0; P^.Right^.Bal := 0 end;
+           end
+         else {double LR rotation}
+           begin
+             B2 := P^.Left^.Right^.Bal;
+             RotL(P^.Left);
+             RotR(P);
+             //adjust balance factors
+             if B2=-1 then P^.Right^.Bal := 1 else P^.Right^.Bal := 0;
+             if B2= 1 then P^.Left^.Bal := -1 else P^.Left^.Bal := 0;
+             P^.Bal := 0;
+           end;
+       end;{-1}
+  end{case}
+end;{BalanceRight}
+
+procedure DelRM(var R: PNode; var S: PNode; var HeightChange: Boolean);
+// Make S refer to rightmost element of tree with root R;
+// Remove that element from the tree
+begin
+  if R^.Right = nil then
+    begin S := R; R := R^.Left; HeightChange := true end
+  else
+    begin
+      DelRM(R^.Right, S, HeightChange);
+      if HeightChange then BalanceRight(R, HeightChange)
+    end
+end;
+
+//---------------------------------------
+//---****--- Class TAvlTree ---*****-----
+//---------------------------------------
+
+constructor TAvlTree.Create;
+begin
+  inherited;
+
+  FRoot := nil;
+end;
+
+destructor TAvlTree.Destroy;
+begin
+  Clear;
+
+  inherited;
+end;
+
+procedure TAvlTree.Clear;
+begin
+  TreeDispose(FRoot);
+  FRoot := nil;
+end;
+
+procedure TAvlTree.DeleteNode(X: PNode);
+begin
+  // delete handler installed?
+  if Assigned(FOnDelete) then
+    FOnDelete(Self, @X^.Data);
+
+  // dispose of memory
+  Dispose(X);
+  Dec(FCount);
+end;
+
+procedure TAvlTree.TreeDispose(X: PNode);
+var
+  P: PNode;
+begin
+  // nothing to dispose of?
+  if X = nil then
+    exit;
+
+  // use in-order visiting, maybe someone likes sequential ordering
+  TreeDispose(X^.Left);
+  P := X^.Right;
+
+  // free mem
+  DeleteNode(X);
+
+  // free right child
+  TreeDispose(P);
+end;
+
+function TAvlTree.Find(Key: TKeyType): TExtraData;
+var
+  H: PNode;
+begin
+  H := FRoot;
+  while (H <> nil) and (H^.Data.ID <> Key) do // use conditional and
+    if Key < H^.Data.ID then
+      H := H^.Left
+    else
+      H := H^.Right;
+
+  if H <> nil then
+    Result := H^.Data.ExtraData
+  else
+    Result := nil;
+end;
+
+procedure TAvlTree.Insert(Key: TKeyType; Extra: TExtraData);
+var
+  H: PNode;
+begin
+  // make new node
+  New(H);
+  with H^ do
+  begin
+    Data.ID := Key;
+    Data.ExtraData := Extra;
+    Left := nil;
+    Right := nil;
+    Bal := 0;
+  end;
+  // insert new node
+  InternalInsert(H, FRoot);
+  // check tree
+//  assert(CheckTree(FRoot));
+end;
+
+procedure TAvlTree.Delete(Key: TKeyType);
+begin
+  InternalDelete(Key, FRoot);
+//  assert(CheckTree(FRoot));
+end;
+
+procedure TAvlTree.InternalInsert(X: PNode; var P: PNode);
+begin
+  if P = nil
+  then begin P := X; Inc(FCount); FHeightChange := true end
+  else
+    if X^.Data.ID < P^.Data.ID then
+    begin
+      { less }
+      InternalInsert(X, P^.Left);
+      if FHeightChange then {Left branch has grown higher}
+        case P^.Bal of
+          1: begin P^.Bal := 0; FHeightChange := false end;
+          0: begin P^.Bal := -1 end;
+         -1: begin {Rebalance}
+               if P^.Left^.Bal = -1
+               then {single R rotation}
+                 begin
+                   RotR(P);
+                   //adjust balance factor:
+                   P^.Right^.Bal := 0;
+                 end
+               else {double LR rotation}
+                 begin
+                   RotL(P^.Left);
+                   RotR(P);
+                   //adjust balance factor:
+                   case P^.Bal of
+                     -1: begin P^.Left^.Bal :=  0; P^.Right^.Bal := 1 end;
+                      0: begin P^.Left^.Bal :=  0; P^.Right^.Bal := 0 end;
+                      1: begin P^.Left^.Bal := -1; P^.Right^.Bal := 0 end;
+                   end;
+                 end;
+               P^.Bal := 0;
+               FHeightChange := false;
+//               assert(CheckTree(P));
+             end{-1}
+        end{case}
+    end else
+    if X^.Data.ID > P^.Data.ID then
+    begin
+      { greater }
+      InternalInsert(X, P^.Right);
+      if FHeightChange then {Right branch has grown higher}
+        case P^.Bal of
+          -1: begin P^.Bal := 0; FHeightChange := false end;
+           0: begin P^.Bal := 1 end;
+           1: begin {Rebalance}
+                if P^.Right^.Bal = 1
+                then {single L rotation}
+                  begin
+                    RotL(P);
+                    //adjust balance factor:
+                    P^.Left.Bal := 0;
+                  end
+                else {double RL rotation}
+                  begin
+                    RotR(P^.Right);
+                    RotL(P);
+                    //adjust balance factor
+                    case P^.Bal of
+                       1: begin P^.Right^.Bal := 0; P^.Left^.Bal := -1 end;
+                       0: begin P^.Right^.Bal := 0; P^.Left^.Bal :=  0 end;
+                      -1: begin P^.Right^.Bal := 1; P^.Left^.Bal :=  0 end;
+                    end;
+                  end;
+                P^.Bal := 0;
+                FHeightChange := false;
+//                assert(CheckTree(P));
+              end{1}
+         end{case}
+    end {greater} else begin
+      {X already present; do not insert again}
+      FHeightChange := false;
+    end;
+
+//  assert(CheckTree(P));
+end;{InternalInsert}
+
+procedure TAvlTree.InternalDelete(X: TKeyType; var P: PNode);
+var
+  Q: PNode;
+  H: TData;
+begin
+  if P = nil then
+    FHeightChange := false
+  else
+    if X < P^.Data.ID then
+    begin
+      InternalDelete(X, P^.Left);
+      if FHeightChange then BalanceLeft(P, FHeightChange)
+    end else
+    if X > P^.Data.ID then
+    begin
+      InternalDelete(X, P^.Right);
+      if FHeightChange then BalanceRight(P, FHeightChange)
+    end else begin
+      if P^.Right = nil then
+      begin Q := P; P := P^.Left; FHeightChange := true end
+      else if P^.Left = nil then
+      begin Q := P; P := P^.Right; FHeightChange := true end
+      else
+        begin
+          DelRM(P^.Left, Q, FHeightChange);
+          H := P^.Data;
+          P^.Data := Q^.Data;
+          Q^.Data := H;
+          if FHeightChange then BalanceLeft(P, FHeightChange)
+        end;
+      DeleteNode(Q)
+    end;{eq}
+end;{InternalDelete}
+
+function TAvlTree.Lowest: PData;
+var
+  H: PNode;
+begin
+  H := FRoot;
+  if H = nil then
+  begin
+    Result := nil;
+    exit;
+  end;
+
+  while H^.Left <> nil do
+    H := H^.Left;
+  Result := @H^.Data;
+end;
+
+end.

fcl/db/dbase/Dbf_Common.inc

@@ -0,0 +1,190 @@
+// define this if you need more SPEEEEEDDDD!!!
+// useful if you index dbf files over a network
+
+{.$define USE_CACHE}
+
+// enables assembler routines, 486+ only
+
+{$define USE_ASSEMBLER_486_UP}
+
+// test compatibility
+
+{.$define TDBF_UPDATE_FIRSTLAST_NODE}
+
+// use this to enable the lookup function which is still buggy
+
+{.$define USE_BUGGY_LOOKUP}
+
+// use this directive to suppress math exceptions,
+// instead NAN is returned.
+// Using this directive is slightly less efficient
+//
+// used in Dbf_PrsDef
+//
+// NAN support needs to be rewritten and is currently absent
+
+{.$define NAN}
+
+//------------------------------------------------------
+//--- Define all SUPPORT_xxx; undef if not supported ---
+//------------------------------------------------------
+
+
+//------------------------------------------------------
+//--- Delphi versions                                ---
+//------------------------------------------------------
+
+
+{$ifdef VER80}          //	Delphi 1.0
+  #ERROR tDbf needs Delphi or C++ Builder 3 minimum.
+{$endif}
+
+{$ifdef VER90}          //	 Delphi 2.0
+  #ERROR tDbf needs Delphi or C++ Builder 3 minimum.
+{$endif}
+
+{$ifdef VER93}          //	 is BCB++ 1.0
+  #ERROR tDbf needs Delphi or C++ Builder 3 minimum.
+{$endif}
+
+{$ifdef VER100}         // Delphi 3
+  {$define DELPHI_3}
+{$endif}
+
+{$ifdef VER110}      // CBuilder 3
+  {$define DELPHI_3}
+{$endif}
+
+{$ifdef VER120}      // Delphi 4
+  {$define DELPHI_4}
+  {$define DELPHI_3}
+{$endif}
+
+{$ifdef VER125} // C++ BUILDER 4
+  {$define DELPHI_4}
+  {$define DELPHI_3}
+{$endif}
+
+{$ifdef VER130} // Delphi 5
+  {$define DELPHI_5}
+  {$define DELPHI_4}
+  {$define DELPHI_3}
+{$endif}
+
+{$ifdef VER135} // C++ Builder 5 ??
+  {$define DELPHI_5}
+  {$define DELPHI_4}
+  {$define DELPHI_3}
+{$endif}
+
+{$ifdef VER140} // Delphi 6
+  {$define DELPHI_6}
+  {$define DELPHI_5}
+  {$define DELPHI_4}
+  {$define DELPHI_3}
+{$endif}
+
+{$ifdef VER145} // C++ Builder 6
+  {$define DELPHI_6}
+  {$define DELPHI_5}
+  {$define DELPHI_4}
+  {$define DELPHI_3}
+{$endif}
+
+{$ifdef VER150} // Delphi 7 :-) For once I am not late (12/07/2001)
+  {$define DELPHI_7}
+  {$define DELPHI_6}
+  {$define DELPHI_5}
+  {$define DELPHI_4}
+  {$define DELPHI_3}
+{$endif}
+
+{$ifdef VER155} // C++ Builder 7
+  {$define DELPHI_7}
+  {$define DELPHI_6}
+  {$define DELPHI_5}
+  {$define DELPHI_4}
+  {$define DELPHI_3}
+{$endif}
+
+//-------------------------------------------------------
+//--- Conclude supported features from delphi version ---
+//-------------------------------------------------------
+
+{$ifdef DELPHI_3}
+
+  {$define SUPPORT_VARIANTS}
+
+{$ifdef DELPHI_4}
+
+  {$define SUPPORT_DEFCHANGED}
+  {$define SUPPORT_DEFAULT_PARAMS}
+  {$define SUPPORT_NEW_TRANSLATE}
+  {$define SUPPORT_INT64}
+  {$define SUPPORT_REINTRODUCE}
+  {$define SUPPORT_FIELDDEFS_UPDATED}
+  {$define SUPPORT_FIELDDEF_ATTRIBUTES}
+  {$define SUPPORT_FIELDDEF_TPERSISTENT}
+  {$define SUPPORT_FIELDDEF_INDEX}
+  {$define SUPPORT_FIELDTYPES_V4}
+  {$define SUPPORT_UINT32_CARDINAL}
+
+{$ifdef DELPHI_5}
+
+  {$define SUPPORT_BACKWARD_FIELDDATA}
+  {$define SUPPORT_NEW_FIELDDATA}
+  {$define SUPPORT_INITDEFSFROMFIELDS}
+  {$define SUPPORT_DEF_DELETE}
+  {$define SUPPORT_FREEANDNIL}
+
+{$ifdef DELPHI_6}
+
+  {$define SUPPORT_PATHDELIM}
+
+{$endif}
+{$endif}
+{$endif}
+{$endif}
+
+//------------------------------------------------------
+//--- Conclude supported features in FreePascal      ---
+//------------------------------------------------------
+
+{$ifdef FPC_VERSION}
+
+  {$mode delphi}
+  {$h+}
+  {$asmmode intel}
+
+  {$define SUPPORT_INT64}
+  {$define SUPPORT_DEFAULT_PARAMS}
+  {$define SUPPORT_NEW_TRANSLATE}
+  {$define SUPPORT_NEW_FIELDDATA}
+  {$define SUPPORT_FIELDDEF_TPERSISTENT}
+  {$define SUPPORT_FIELDTYPES_V4}
+  {$define SUPPORT_UINT32_CARDINAL}
+
+  // FPC 1.0.x exceptions: no 0/0 support
+  {$ifdef VER1_0}
+    {$undef NAN}
+    {$undef SUPPORT_DEFAULT_PARAMS}
+    {$undef SUPPORT_NEW_TRANSLATE}
+
+    #ERROR TDbf needs fpc 1.9 minimum.
+
+  {$endif}
+
+{$endif}
+
+//----------------------------------------------------------
+//--- Conclude supported features in non-Win32 platforms ---
+//----------------------------------------------------------
+
+{$ifndef WIN32}
+
+    {$define SUPPORT_PATHDELIM}
+    {$define SUPPORT_INCLUDETRAILPATHDELIM}
+    {$define SUPPORT_INCLUDETRAILBACKSLASH}
+
+{$endif}
+

fcl/db/dbase/Dbf_Common.pas

@@ -0,0 +1,519 @@
+unit Dbf_Common;
+
+interface
+
+{$I Dbf_Common.inc}
+
+uses
+  SysUtils, Classes, DB
+{$ifndef WIN32}
+  , Types, Dbf_Wtil
+{$ifdef KYLIX}
+  , Libc
+{$endif}  
+{$endif}
+  ;
+
+
+const
+  TDBF_MAJOR_VERSION      = 6;
+  TDBF_MINOR_VERSION      = 35;
+  TDBF_SUB_MINOR_VERSION  = 0;
+
+  TDBF_TABLELEVEL_FOXPRO = 25;
+
+type
+  EDbfError = class (EDatabaseError);
+  EDbfWriteError = class (EDbfError);
+
+  TDbfFieldType = char;
+  PBookMarkData = ^rBookMarkData;
+  rBookmarkData = Integer;
+
+  xBaseVersion   = (xUnknown, xClipper, xBaseIII, xBaseIV, xBaseV, xFoxPro, xBaseVII);
+  TSearchKeyType = (stEqual, stGreaterEqual, stGreater);
+
+  TDateTimeHandling       = (dtDateTime, dtBDETimeStamp);
+
+//-------------------------------------
+
+{$ifdef FPC_VERSION}
+  PDateTime = ^TDateTime;
+  TDateTimeAlias = type TDateTime;
+  TDateTimeRec = record
+    case TFieldType of
+      ftDate: (Date: Longint);
+      ftTime: (Time: Longint);
+      ftDateTime: (DateTime: TDateTimeAlias);
+  end;
+{$endif}
+
+  PSmallInt = ^SmallInt;
+  PCardinal = ^Cardinal;
+  PDouble = ^Double;
+  PString = ^String;
+  PDateTimeRec = ^TDateTimeRec;
+
+{$ifdef SUPPORT_INT64}
+  PLargeInt = ^Int64;
+{$endif}
+
+//-------------------------------------
+
+{$ifndef SUPPORT_FREEANDNIL}
+// some procedures for the less lucky who don't have newer versions yet :-)
+procedure FreeAndNil(var v);
+{$endif}
+procedure FreeMemAndNil(var P: Pointer);
+
+//-------------------------------------
+
+{$ifndef SUPPORT_PATHDELIM}
+const
+{$ifdef WIN32}
+  PathDelim = '\';
+{$else}
+  PathDelim = '/';
+{$endif}
+{$endif}
+
+{$ifndef SUPPORT_INCLTRAILPATHDELIM}
+function IncludeTrailingPathDelimiter(const Path: string): string;
+{$endif}
+
+//-------------------------------------
+
+function GetCompletePath(const Base, Path: string): string;
+function GetCompleteFileName(const Base, FileName: string): string;
+function IsFullFilePath(const Path: string): Boolean; // full means not relative
+function DateTimeToBDETimeStamp(aDT: TDateTime): double;
+function BDETimeStampToDateTime(aBT: double): TDateTime;
+function  GetStrFromInt(Val: Integer; const Dst: PChar): Integer;
+procedure GetStrFromInt_Width(Val: Integer; const Width: Integer; const Dst: PChar);
+{$ifdef SUPPORT_INT64}
+function  GetStrFromInt64(Val: Int64; const Dst: PChar): Integer;
+procedure GetStrFromInt64_Width(Val: Int64; const Width: Integer; const Dst: PChar);
+{$endif}
+procedure FindNextName(BaseName: string; var OutName: string; var Modifier: Integer);
+{$ifdef USE_CACHE}
+function GetFreeMemory: Integer;
+{$endif}
+
+// OH 2000-11-15 dBase7 support. Swap Byte order for 4 and 8 Byte Integer
+function SwapInt(const Value: Cardinal): Cardinal;
+procedure SwapInt64(Value, Result: Pointer); pascal;
+
+function TranslateString(FromCP, ToCP: Cardinal; Src, Dest: PChar; Length: Integer): Integer;
+
+// Returns a pointer to the first occurence of Chr in Str within the first Length characters
+// Does not stop at null (#0) terminator!
+function MemScan(const Buffer: Pointer; Chr: Byte; Length: Integer): Pointer;
+
+implementation
+
+{$ifdef WIN32}
+uses
+  Windows;
+{$endif}
+
+//====================================================================
+
+function GetCompletePath(const Base, Path: string): string;
+begin
+  if IsFullFilePath(Path)
+  then begin
+    Result := Path;
+  end else begin
+    if Length(Base) > 0 then
+      Result := ExpandFileName(IncludeTrailingPathDelimiter(Base) + Path)
+    else
+      Result := ExpandFileName(Path);
+  end;
+
+  // add last backslash if not present
+  if Length(Result) > 0 then
+    Result := IncludeTrailingPathDelimiter(Result);
+end;
+
+function IsFullFilePath(const Path: string): Boolean; // full means not relative
+begin
+{$ifdef WIN32}
+  Result := Length(Path) > 1;
+  if Result then
+    // check for 'x:' or '\\' at start of path
+    Result := ((Path[2]=':') and (upcase(Path[1]) in ['A'..'Z']))
+      or ((Path[1]='\') and (Path[2]='\'));
+{$else}  // Linux
+  Result := Length(Path) > 0;
+  if Result then
+    Result := Path[1]='/';
+ {$endif}
+end;
+
+//====================================================================
+
+function GetCompleteFileName(const Base, FileName: string): string;
+var
+  lpath: string;
+  lfile: string;
+begin
+  lpath := GetCompletePath(Base, ExtractFilePath(FileName));
+  lfile := ExtractFileName(FileName);
+  lpath := lpath + lfile;
+  result := lpath;
+end;
+
+// it seems there is no pascal function to convert an integer into a PChar???
+
+procedure GetStrFromInt_Width(Val: Integer; const Width: Integer; const Dst: PChar);
+var
+  Temp: array[0..10] of Char;
+  I, J, K, Sign: Integer;
+begin
+  Sign := Val;
+  Val := Abs(Val);
+  // we'll have to store characters backwards first
+  I := 0;
+  J := 0;
+  repeat
+    Temp[I] := Chr((Val mod 10) + Ord('0'));
+    Val := Val div 10;
+    Inc(I);
+  until Val = 0;
+  // add sign
+  if Sign < 0 then
+  begin
+    Dst[J] := '-';
+    Inc(J);
+  end;
+  // add spaces
+  for K := 0 to Width - I - J - 1 do
+  begin
+    Dst[J] := '0';
+    Inc(J);
+  end;
+  // if field too long, cut off
+  if J + I > Width then
+    I := Width - J;
+  // copy value, remember: stored backwards
+  repeat
+    Dst[J] := Temp[I-1];
+    Inc(J);
+    Dec(I);
+  until I = 0;
+  // done!
+end;
+
+{$ifdef SUPPORT_INT64}
+
+procedure GetStrFromInt64_Width(Val: Int64; const Width: Integer; const Dst: PChar);
+var
+  Temp: array[0..19] of Char;
+  I, J, K: Integer;
+  Sign: Int64;
+begin
+  Sign := Val;
+  Val := Abs(Val);
+  // we'll have to store characters backwards first
+  I := 0;
+  J := 0;
+  repeat
+    Temp[I] := Chr((Val mod 10) + Ord('0'));
+    Val := Val div 10;
+    inc(I);
+  until Val = 0;
+  // add sign
+  if Sign < 0 then
+  begin
+    Dst[J] := '-';
+    inc(J);
+  end;
+  // add spaces
+  for K := 0 to Width - I - J - 1 do
+  begin
+    Dst[J] := '0';
+    inc(J);
+  end;
+  // if field too long, cut off
+  if J + I > Width then
+    I := Width - J;
+  // copy value, remember: stored backwards
+  repeat
+    Dst[J] := Temp[I-1];
+    inc(J);
+    dec(I);
+  until I = 0;
+  // done!
+end;
+{$endif}
+
+// it seems there is no pascal function to convert an integer into a PChar???
+// NOTE: in dbf_dbffile.pas there is also a convert routine, but is slightly different
+
+function GetStrFromInt(Val: Integer; const Dst: PChar): Integer;
+var
+  Temp: array[0..10] of Char;
+  I, J: Integer;
+begin
+  Val := Abs(Val);
+  // we'll have to store characters backwards first
+  I := 0;
+  J := 0;
+  repeat
+    Temp[I] := Chr((Val mod 10) + Ord('0'));
+    Val := Val div 10;
+    Inc(I);
+  until Val = 0;
+
+  // remember number of digits
+  Result := I;
+  // copy value, remember: stored backwards
+  repeat
+    Dst[J] := Temp[I-1];
+    Inc(J);
+    Dec(I);
+  until I = 0;
+  // done!
+end;
+
+{$ifdef SUPPORT_INT64}
+
+function GetStrFromInt64(Val: Int64; const Dst: PChar): Integer;
+var
+  Temp: array[0..19] of Char;
+  I, J: Integer;
+begin
+  Val := Abs(Val);
+  // we'll have to store characters backwards first
+  I := 0;
+  J := 0;
+  repeat
+    Temp[I] := Chr((Val mod 10) + Ord('0'));
+    Val := Val div 10;
+    Inc(I);
+  until Val = 0;
+
+  // remember number of digits
+  Result := I;
+  // copy value, remember: stored backwards
+  repeat
+    Dst[J] := Temp[I-1];
+    inc(J);
+    dec(I);
+  until I = 0;
+  // done!
+end;
+{$endif}
+
+function DateTimeToBDETimeStamp(aDT: TDateTime): Double;
+var
+  aTS: TTimeStamp;
+begin
+  aTS := DateTimeToTimeStamp(aDT);
+  Result := TimeStampToMSecs(aTS);
+end;
+
+function BDETimeStampToDateTime(aBT: Double): TDateTime;
+var
+  aTS: TTimeStamp;
+begin
+  aTS := MSecsToTimeStamp(aBT);
+  Result := TimeStampToDateTime(aTS);
+end;
+
+//====================================================================
+
+{$ifndef SUPPORT_FREEANDNIL}
+
+procedure FreeAndNil(var v);
+var
+  Temp: TObject;
+begin
+  Temp := TObject(v);
+  TObject(v) := nil;
+  Temp.Free;
+end;
+
+{$endif}
+
+procedure FreeMemAndNil(var P: Pointer);
+var
+  Temp: Pointer;
+begin
+  Temp := P;
+  P := nil;
+  FreeMem(Temp);
+end;
+
+//====================================================================
+
+{$ifndef SUPPORT_INCLTRAILPATHDELIM}
+{$ifndef SUPPORT_INCLTRAILBACKSLASH}
+
+function IncludeTrailingPathDelimiter(const Path: string): string;
+var
+  len: Integer;
+begin
+  Result := Path;
+  len := Length(Result);
+  if len = 0 then
+    Result := PathDelim
+  else
+  if Result[len] <> PathDelim then
+    Result := Result + PathDelim;
+end;
+
+{$else}
+
+function IncludeTrailingPathDelimiter(const Path: string): string;
+begin
+{$ifdef WIN32}
+  Result := IncludeTrailingBackslash(Path);
+{$else}
+  Result := IncludeTrailingSlash(Path);
+{$endif}
+end;
+
+{$endif}
+{$endif}
+
+{$ifdef USE_CACHE}
+
+function GetFreeMemory: Integer;
+var
+  MemStatus: TMemoryStatus;
+begin
+  GlobalMemoryStatus(MemStatus);
+  Result := MemStatus.dwAvailPhys;
+end;
+
+{$endif}
+
+//====================================================================
+// Utility routines
+//====================================================================
+
+{$ifdef USE_ASSEMBLER_486_UP}
+
+function SwapInt(const Value: Cardinal): Cardinal; register;
+asm
+  BSWAP EAX;
+end;
+
+procedure SwapInt64(Value, Result: Pointer); pascal;
+begin
+  asm MOV   EAX, dword ptr [Value + 0]
+      MOV   EDX, dword ptr [Value + 4]
+
+      BSWAP EAX
+      BSWAP EDX
+
+{$ifndef FPC_VERSION}
+      MOV   dword ptr [Result + 0], EDX
+      MOV   dword ptr [Result + 4], EAX
+{$endif}
+  end;
+end;
+
+{$else}
+
+function SwapInt(const Value: Integer): Integer;
+begin
+  PByteArray(@Result)[0] := PByteArray(@Value)[3];
+  PByteArray(@Result)[1] := PByteArray(@Value)[2];
+  PByteArray(@Result)[2] := PByteArray(@Value)[1];
+  PByteArray(@Result)[3] := PByteArray(@Value)[0];
+end;
+
+procedure SwapInt64(Value, Result: Pointer); pascal;
+var
+  PtrResult: PByteArray;
+  PtrSource: PByteArray;
+begin
+  // temporary storage is actually not needed, but otherwise compiler crashes (?)
+  PtrResult := PByteArray(Result);
+  PtrSource := PByteArray(Value);
+  PtrResult[0] := PtrSource[7];
+  PtrResult[1] := PtrSource[6];
+  PtrResult[2] := PtrSource[5];
+  PtrResult[3] := PtrSource[4];
+  PtrResult[4] := PtrSource[3];
+  PtrResult[5] := PtrSource[2];
+  PtrResult[6] := PtrSource[1];
+  PtrResult[7] := PtrSource[0];
+end;
+
+{$endif}
+
+function TranslateString(FromCP, ToCP: Cardinal; Src, Dest: PChar; Length: Integer): Integer;
+var
+  WideCharStr: array[0..1023] of WideChar;
+  wideBytes: Cardinal;
+begin
+  if Length = -1 then
+    Length := StrLen(Src);
+  Result := Length;
+  if (FromCP = GetOEMCP) and (ToCP = GetACP) then
+    OemToCharBuff(Src, Dest, Length)
+  else
+  if (FromCP = GetACP) and (ToCP = GetOEMCP) then
+    CharToOemBuff(Src, Dest, Length)
+  else
+  if FromCP = ToCP then
+  begin
+    if Src <> Dest then
+      Move(Src^, Dest^, Length);
+  end else begin
+    // does this work on Win95/98/ME?
+    wideBytes := MultiByteToWideChar(FromCP, MB_PRECOMPOSED, Src, Length, LPWSTR(@WideCharStr[0]), 1024);
+    WideCharToMultiByte(ToCP, 0, LPWSTR(@WideCharStr[0]), wideBytes, Dest, Length, nil, nil);
+  end;
+end;
+
+procedure FindNextName(BaseName: string; var OutName: string; var Modifier: Integer);
+var
+  Extension: string;
+begin
+  Extension := ExtractFileExt(BaseName);
+  BaseName := Copy(BaseName, 1, Length(BaseName)-Length(Extension));
+  repeat
+    Inc(Modifier);
+    OutName := ChangeFileExt(BaseName+'_'+IntToStr(Modifier), Extension);
+  until not FileExists(OutName);
+end;
+
+{$ifdef FPC}
+
+function MemScan(const Buffer: Pointer; Chr: Byte; Length: Integer): Pointer;
+var
+  I: Integer;
+begin
+  I := System.IndexByte(Buffer, Length, Chr);
+  if I = -1 then
+    Result := nil
+  else
+    Result := Buffer+I;
+end;
+
+{$else}
+
+function MemScan(const Buffer: Pointer; Chr: Byte; Length: Integer): Pointer;
+asm
+        PUSH    EDI
+        MOV     EDI,Buffer
+        MOV     AL, Chr
+        MOV     ECX,Length
+        REPNE   SCASB
+        MOV     EAX,0
+        JNE     @@1
+        MOV     EAX,EDI
+        DEC     EAX
+@@1:    POP     EDI
+end;
+
+{$endif}
+
+end.
+
+
+

fcl/db/dbase/Dbf_Cursor.pas

@@ -0,0 +1,71 @@
+unit Dbf_Cursor;
+
+interface
+
+{$I Dbf_Common.inc}
+
+uses
+  SysUtils,
+  Classes,
+  Db,
+  Dbf_PgFile,
+  Dbf_Common;
+
+type
+
+//====================================================================
+  TVirtualCursor = class(TObject)
+  private
+    FFile: TPagedFile;
+
+  protected
+    function GetPhysicalRecno: Integer; virtual; abstract;
+    function GetSequentialRecno: Integer; virtual; abstract;
+    function GetSequentialRecordCount: Integer; virtual; abstract;
+    procedure SetPhysicalRecno(Recno: Integer); virtual; abstract;
+    procedure SetSequentialRecno(Recno: Integer); virtual; abstract;
+
+  public
+    constructor Create(pFile: TPagedFile);
+    destructor Destroy; override;
+
+    function  RecordSize: Integer;
+
+    function  Next: Boolean; virtual; abstract;
+    function  Prev: Boolean; virtual; abstract;
+    procedure First; virtual; abstract;
+    procedure Last; virtual; abstract;
+
+    function  GetBookMark: rBookmarkData; virtual; abstract;
+    procedure GotoBookmark(Bookmark: rBookmarkData); virtual; abstract;
+
+    procedure Insert(Recno: Integer; Buffer: PChar); virtual; abstract;
+    procedure Update(Recno: Integer; PrevBuffer,NewBuffer: PChar); virtual; abstract;
+
+    property PagedFile: TPagedFile read FFile;
+    property PhysicalRecNo: Integer read GetPhysicalRecNo write SetPhysicalRecNo;
+    property SequentialRecNo: Integer read GetSequentialRecNo write SetSequentialRecNo;
+    property SequentialRecordCount: Integer read GetSequentialRecordCount;
+  end;
+
+implementation
+
+constructor TVirtualCursor.Create(pFile: TPagedFile);
+begin
+  FFile := pFile;
+end;
+
+destructor TVirtualCursor.Destroy; {override;}
+begin
+end;
+
+function TVirtualCursor.RecordSize : Integer;
+begin
+  if FFile = nil then
+    Result := 0
+  else
+    Result := FFile.RecordSize;
+end;
+
+end.
+

fcl/db/dbase/Dbf_DbfFile.pas

@@ -0,0 +1,2518 @@
+unit Dbf_DbfFile;
+
+interface
+
+{$I Dbf_Common.inc}
+
+uses
+  Classes, SysUtils,
+{$ifdef WIN32}
+  Windows,
+{$else}
+{$ifdef KYLIX}
+  Libc, 
+{$endif}  
+  Types, Dbf_Wtil,
+{$endif}
+  Db,
+  Dbf_Common,
+  Dbf_Parser,
+  Dbf_Cursor,
+  Dbf_PgFile,
+  Dbf_Fields,
+  Dbf_Memo,
+  Dbf_IdxCur,
+  Dbf_IdxFile;
+
+//====================================================================
+//=== Dbf support (first part)
+//====================================================================
+//  TxBaseVersion = (xUnknown,xClipper,xBaseIII,xBaseIV,xBaseV,xFoxPro,xVisualFoxPro);
+//  TPagedFileMode = (pfOpen,pfCreate);
+//  TDbfGetMode = (xFirst,xPrev,xCurrent, xNext, xLast);
+//  TDbfGetResult = (xOK, xBOF, xEOF, xError);
+
+type
+
+//====================================================================
+  TDbfIndexMissingEvent = procedure(var DeleteLink: Boolean) of object;
+
+//====================================================================
+  TDbfGlobals = class;
+//====================================================================
+
+  TDbfFile = class(TPagedFile)
+  protected
+    FMdxFile: TIndexFile;
+    FMemoFile: TMemoFile;
+    FFieldDefs: TDbfFieldDefs;
+    FIndexNames: TStringList;
+    FIndexFiles: TList;
+    FDbfVersion: xBaseVersion;
+    FPrevBuffer: PChar;
+    FRecordBufferSize: Integer;
+    FLockFieldOffset: Integer;
+    FLockFieldLen: DWORD;
+    FLockUserLen: DWORD;
+    FFileCodePage: Cardinal;
+    FUseCodePage: Cardinal;
+    FCountUse: Integer;
+    FCurIndex: Integer;
+    FForceClose: Boolean;
+    FHasLockField: Boolean;
+    FAutoIncPresent: Boolean;
+    FOpened: Boolean;
+    FCopyDateTimeAsString: Boolean;
+    FDateTimeHandling: TDateTimeHandling;
+    FOnLocaleError: TDbfLocaleErrorEvent;
+    FOnIndexMissing: TDbfIndexMissingEvent;
+
+    procedure ConstructFieldDefs;
+    function  HasBlob: Boolean;
+    function  GetMemoExt: string;
+    procedure WriteLockInfo(Buffer: PChar);
+
+    function GetLanguageId: Integer;
+    function GetLanguageStr: string;
+    function GetUseFloatFields: Boolean;
+    procedure SetUseFloatFields(NewUse: Boolean);
+  public
+    constructor Create(lFileName: string);
+    destructor Destroy; override;
+
+    procedure Open;
+    procedure Close;
+    procedure Zap;
+
+    procedure FinishCreate(FieldDefs: TDbfFieldDefs; MemoSize: Integer);
+    function GetIndexByName(AIndexName: string): TIndexFile;
+    procedure SetRecordSize(NewSize: Integer); override;
+
+    procedure TryExclusive; override;
+    procedure EndExclusive; override;
+    procedure OpenIndex(IndexName, IndexField: string; CreateIndex: Boolean; Options: TIndexOptions);
+    function  DeleteIndex(const AIndexName: string): Boolean;
+    procedure CloseIndex(AIndexName: string);
+    procedure RepageIndex(AIndexFile: string);
+    procedure CompactIndex(AIndexFile: string);
+    procedure Insert(Buffer: PChar);
+    procedure WriteHeader; override;
+    procedure ApplyAutoIncToBuffer(DestBuf: PChar);     // dBase7 support. Writeback last next-autoinc value
+    procedure FastPackTable;
+    procedure RestructureTable(DbfFieldDefs: TDbfFieldDefs; Pack: Boolean);
+    function  GetFieldInfo(FieldName: string): TDbfFieldDef;
+    function  GetFieldData(Column: Integer; DataType: TFieldType; Src,Dst: Pointer): Boolean;
+    function  GetFieldDataFromDef(AFieldDef: TDbfFieldDef; DataType: TFieldType; Src, Dst: Pointer): Boolean;
+    procedure SetFieldData(Column: Integer; DataType: TFieldType; Src,Dst: Pointer);
+    procedure InitRecord(DestBuf: PChar);
+    procedure PackIndex(lIndexFile: TIndexFile; AIndexName: string);
+    procedure RegenerateIndexes;
+    procedure LockRecord(RecNo: Integer; Buffer: PChar);
+    procedure UnlockRecord(RecNo: Integer; Buffer: PChar);
+    procedure RecordDeleted(RecNo: Integer; Buffer: PChar);
+    procedure RecordRecalled(RecNo: Integer; Buffer: PChar);
+
+    property MemoFile: TMemoFile read FMemoFile;
+    property FieldDefs: TDbfFieldDefs read FFieldDefs;
+    property IndexNames: TStringList read FIndexNames;
+    property IndexFiles: TList read FIndexFiles;
+    property MdxFile: TIndexFile read FMdxFile;
+    property LanguageId: Integer read GetLanguageId;
+    property LanguageStr: string read GetLanguageStr;
+    property FileCodePage: Cardinal read FFileCodePage;
+    property UseCodePage: Cardinal read FUseCodePage write FUseCodePage;
+    property DbfVersion: xBaseVersion read FDbfVersion write FDbfVersion;
+    property PrevBuffer: PChar read FPrevBuffer;
+    property ForceClose: Boolean read FForceClose;
+    property HasLockField: Boolean read FHasLockField;
+    property CopyDateTimeAsString: Boolean read FCopyDateTimeAsString write FCopyDateTimeAsString;
+    property UseFloatFields: Boolean read GetUseFloatFields write SetUseFloatFields;
+    property DateTimeHandling: TDateTimeHandling read FDateTimeHandling write FDateTimeHandling;
+
+    property OnIndexMissing: TDbfIndexMissingEvent read FOnIndexMissing write FOnIndexMissing;
+    property OnLocaleError: TDbfLocaleErrorEvent read FOnLocaleError write FOnLocaleError;
+  end;
+
+//====================================================================
+  TDbfCursor = class(TVirtualCursor)
+  protected
+    FPhysicalRecNo: Integer;
+  public
+    constructor Create(DbfFile: TDbfFile);
+    function Next: Boolean; override;
+    function Prev: Boolean; override;
+    procedure First; override;
+    procedure Last; override;
+
+    function GetPhysicalRecNo: Integer; override;
+    procedure SetPhysicalRecNo(RecNo: Integer); override;
+
+    function GetSequentialRecordCount: Integer; override;
+    function GetSequentialRecNo: Integer; override;
+    procedure SetSequentialRecNo(RecNo: Integer); override;
+
+    procedure GotoBookmark(Bookmark: rBookmarkData); override;
+    procedure Insert(RecNo: Integer; Buffer: PChar); override;
+    procedure Update(RecNo: Integer; PrevBuffer,NewBuffer: PChar); override;
+    function GetBookMark: rBookmarkData; override;
+  end;
+
+//====================================================================
+  TDbfGlobals = class
+  protected
+    FCodePages: TList;
+    FCurrencyAsBCD: Boolean;
+    FDefaultOpenCodePage: Integer;
+    FDefaultCreateCodePage: Integer;
+    FDefaultCreateLocale: LCID;
+//    FDefaultCreateFoxPro: Boolean;
+    FUserName: string;
+    FUserNameLen: DWORD;
+	
+    procedure InitUserName;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    function CodePageInstalled(ACodePage: Integer): Boolean;
+
+    property CurrencyAsBCD: Boolean read FCurrencyAsBCD write FCurrencyAsBCD;
+    property DefaultOpenCodePage: Integer read FDefaultOpenCodePage write FDefaultOpenCodePage;
+    property DefaultCreateCodePage: Integer read FDefaultCreateCodePage write FDefaultCreateCodePage;
+    property DefaultCreateLocale: LCID read FDefaultCreateLocale write FDefaultCreateLocale;
+//    property DefaultCreateFoxPro: Boolean read FDefaultCreateFoxPro;
+    property UserName: string read FUserName;
+    property UserNameLen: DWORD read FUserNameLen;
+  end;
+
+var
+  DbfGlobals: TDbfGlobals;
+
+implementation
+
+uses
+{$ifndef WIN32}
+{$ifndef FPC}
+  RTLConsts,
+{$else}
+  BaseUnix,
+{$endif}
+{$endif}
+  Dbf_Str, Dbf_Lang;
+
+const
+  sDBF_DEC_SEP = '.';
+
+{$I Dbf_Struct.inc}
+
+//====================================================================
+// International separator
+// thanks to Bruno Depero from Italy
+// and Andreas Wöllenstein from Denmark
+//====================================================================
+function DbfStrToFloat(const Src: PChar; const Size: Integer): Extended;
+var
+  iPos: PChar;
+  eValue: extended;
+  endChar: Char;
+begin
+  // temp null-term string
+  endChar := (Src + Size)^;
+  (Src + Size)^ := #0;
+  // we only have to convert if decimal separator different
+  if DecimalSeparator <> sDBF_DEC_SEP then
+  begin
+    // search dec sep
+    iPos := StrScan(Src, sDBF_DEC_SEP);
+    // replace
+    if iPos <> nil then
+      iPos^ := DecimalSeparator;
+  end else
+    iPos := nil;
+  // convert to double
+  if TextToFloat(Src, eValue {$ifndef VER1_0}, fvExtended{$endif}) then
+    Result := eValue
+  else
+    Result := 0;
+  // restore dec sep
+  if iPos <> nil then
+    iPos^ := sDBF_DEC_SEP;
+  // restore Char of null-term
+  (Src + Size)^ := endChar;
+end;
+
+procedure FloatToDbfStr(const Val: Extended; const Size, Precision: Integer; const Dest: PChar);
+var
+  Buffer: array [0..24] of Char;
+  resLen: Integer;
+  iPos: PChar;
+begin
+  // convert to temporary buffer
+  resLen := FloatToText(@Buffer[0], Val, {$ifndef FPC_VERSION}fvExtended,{$endif} ffFixed, Size, Precision);
+  // null-terminate buffer
+  Buffer[resLen] := #0;
+  // we only have to convert if decimal separator different
+  if DecimalSeparator <> sDBF_DEC_SEP then
+  begin
+    iPos := StrScan(@Buffer[0], DecimalSeparator);
+    if iPos <> nil then
+      iPos^ := sDBF_DEC_SEP;
+  end;
+  // fill destination with spaces
+  FillChar(Dest^, Size, ' ');
+  // now copy right-aligned to destination
+  Move(Buffer[0], Dest[Size-resLen], resLen);
+end;
+
+function GetIntFromStrLength(Src: Pointer; Size: Integer; Default: Integer): Integer;
+var
+  endChar: Char;
+  Code: Integer;
+begin
+  // save Char at pos term. null
+  endChar := (PChar(Src) + Size)^;
+  (PChar(Src) + Size)^ := #0;
+  // convert
+  Val(PChar(Src), Result, Code);
+  // check success
+  if Code <> 0 then
+    Result := Default;
+  // restore prev. ending Char
+  (PChar(Src) + Size)^ := endChar;
+end;
+
+//====================================================================
+// TDbfFile
+//====================================================================
+constructor TDbfFile.Create(lFileName: string);
+begin
+  // init variables first
+  FFieldDefs := TDbfFieldDefs.Create(nil);
+  FIndexNames := TStringList.Create;
+  FIndexFiles := TList.Create;
+  FOnLocaleError := nil;
+  FOnIndexMissing := nil;
+  FMdxFile := nil;
+  FForceClose := false;
+  FOpened := false;
+  FCopyDateTimeAsString := false;
+
+  // pass on parameters
+  inherited Create(lFileName);
+end;
+
+destructor TDbfFile.Destroy;
+var
+  I: Integer;
+begin
+  // close file
+  Close;
+
+  // free files
+  for I := 0 to Pred(FIndexFiles.Count) do
+    TPagedFile(FIndexFiles.Items[I]).Free;
+
+  // free lists
+  FreeAndNil(FIndexFiles);
+  FreeAndNil(FIndexNames);
+  FreeAndNil(FFieldDefs);
+
+  // call ancestor
+  inherited;
+end;
+
+function TDbfFile.GetUseFloatFields: Boolean;
+begin
+  Result := FFieldDefs.UseFloatFields;
+end;
+
+procedure TDbfFile.SetUseFloatFields(NewUse: Boolean);
+begin
+  FFieldDefs.UseFloatFields := NewUse;
+end;
+
+procedure TDbfFile.Open;
+var
+  lMemoFileName: string;
+  lMdxFileName: string;
+  MemoFileClass: TMemoFileClass;
+  I: Integer;
+  deleteLink: Boolean;
+  LangStr: PChar;
+begin
+  // check if not already opened
+  if not FOpened then
+  begin
+    // open requested file
+    OpenFile;
+
+    // check if we opened an already existing file
+    if not FileCreated then
+    begin
+      HeaderSize := sizeof(rDbfHdr); // temporary
+      // OH 2000-11-15 dBase7 support. I build dBase Tables with different
+      // BDE dBase Level (1. without Memo, 2. with Memo)
+      //                          Header Byte ($1d hex) (29 dec) -> Language driver ID.
+      //  $03,$83 xBaseIII        Header Byte $1d=$00, Float -> N($13.$04) DateTime C($1E)
+      //  $03,$8B xBaseIV/V       Header Byte $1d=$58, Float -> N($14.$04)
+      //  $04,$8C xBaseVII        Header Byte $1d=$00  Float -> O($08)     DateTime @($08)
+      //  $03,$F5 FoxPro Level 25 Header Byte $1d=$03, Float -> N($14.$04)
+      // Access 97
+      //  $03,$83 dBaseIII        Header Byte $1d=$00, Float -> N($13.$05) DateTime D($08)
+      //  $03,$8B dBaseIV/V       Header Byte $1d=$00, Float -> N($14.$05) DateTime D($08)
+      //  $03,$F5 FoxPro Level 25 Header Byte $1d=$09, Float -> N($14.$05) DateTime D($08)
+
+      case (PDbfHdr(Header).VerDBF and $07) of
+        $03:
+          if LanguageID = 0 then
+            FDbfVersion := xBaseIII
+          else
+            FDbfVersion := xBaseIV;
+        $04:
+          FDbfVersion := xBaseVII;
+        $02, $05:
+          FDbfVersion := xFoxPro;
+      else
+        // check visual foxpro
+        if (PDbfHdr(Header).VerDBF and $70) = $30 then
+        begin
+          FDbfVersion := xFoxPro;
+        end else begin
+          // not a valid DBF file
+          raise EDbfError.Create(STRING_INVALID_DBF_FILE);
+        end;
+      end;
+      FFieldDefs.DbfVersion := FDbfVersion;
+      RecordSize := PDbfHdr(Header).RecordSize;
+      HeaderSize := PDbfHdr(Header).FullHdrSize;
+      if (HeaderSize = 0) or (RecordSize = 0) then
+      begin
+        HeaderSize := 0;
+        RecordSize := 0;
+        RecordCount := 0;
+        FForceClose := true;
+        exit;
+      end;
+      // check if specified recordcount correct
+      if PDbfHdr(Header).RecordCount <> RecordCount then
+      begin
+        // This message was annoying
+        // and was not understood by most people
+        // ShowMessage('Invalid Record Count,'+^M+
+        //             'RecordCount in Hdr : '+IntToStr(PDbfHdr(Header).RecordCount)+^M+
+        //             'expected : '+IntToStr(RecordCount));
+        PDbfHdr(Header).RecordCount := RecordCount;
+        WriteHeader;        // Correct it
+      end;
+      // determine codepage
+      if FDbfVersion >= xBaseVII then
+      begin
+        // cache language str
+        LangStr := @PAfterHdrVII(PChar(Header) + SizeOf(rDbfHdr)).LanguageDriverName;
+        // VdBase 7 Language strings
+        //  'DBWIN...' -> Charset 1252 (ansi)
+        //  'DB999...' -> Code page 999, 9 any digit
+        //  'DBHEBREW' -> Code page 1255 ??
+        //  'FOX..999' -> Code page 999, 9 any digit
+        //  'FOX..WIN' -> Charset 1252 (ansi)
+        if (LangStr[0] = 'D') and (LangStr[1] = 'B') then
+        begin
+          if StrLComp(LangStr+2, 'WIN', 3) = 0 then
+            FFileCodePage := 1252
+          else
+          if StrLComp(LangStr+2, 'HEBREW', 6) = 0 then
+          begin
+            FFileCodePage := 1255;
+          end else begin
+            FFileCodePage := GetIntFromStrLength(LangStr+2, 3, 0);
+            if (Ord(LangStr[5]) >= Ord('0')) and (Ord(LangStr[5]) <= Ord('9')) then
+              FFileCodePage := FFileCodePage * 10 + Ord(LangStr[5]) - Ord('0');
+          end;
+        end else
+        if StrLComp(LangStr, 'FOX', 3) = 0 then
+        begin
+          if StrLComp(LangStr+5, 'WIN', 3) = 0 then
+            FFileCodePage := 1252
+          else
+            FFileCodePage := GetIntFromStrLength(LangStr+5, 3, 0)
+        end else begin
+          FFileCodePage := 0;
+        end;
+      end else begin
+        // FDbfVersion <= xBaseV
+        FFileCodePage := LangId_To_CodePage[PDbfHdr(Header).Language];
+      end;
+      // determine used codepage, if no codepage, then use default codepage
+      FUseCodePage := FFileCodePage;
+      if FUseCodePage = 0 then
+        FUseCodePage := DbfGlobals.DefaultOpenCodePage;
+      // get list of fields
+      ConstructFieldDefs;
+      // open blob file if present
+      lMemoFileName := ChangeFileExt(FileName, GetMemoExt);
+      if HasBlob then
+      begin
+        // open blob file
+        if not FileExists(lMemoFileName) then
+          MemoFileClass := TNullMemoFile
+        else if FDbfVersion = xFoxPro then
+          MemoFileClass := TFoxProMemoFile
+        else
+          MemoFileClass := TDbaseMemoFile;
+        FMemoFile := MemoFileClass.Create(lMemoFileName);
+        FMemoFile.Mode := Mode;
+        FMemoFile.AutoCreate := false;
+        FMemoFile.MemoRecordSize := 0;
+        FMemoFile.DbfVersion := FDbfVersion;
+        FMemoFile.Open;
+        // set header blob flag corresponding to field list
+        PDbfHdr(Header).VerDBF := PDbfHdr(Header).VerDBF or $80;
+      end else
+        PDbfHdr(Header).VerDBF := PDbfHdr(Header).VerDBF and $7F;
+      // check if mdx flagged
+      if (FDbfVersion <> xFoxPro) and (PDbfHdr(Header).MDXFlag <> 0) then
+      begin
+        // open mdx file if present
+        lMdxFileName := ChangeFileExt(FileName, '.mdx');
+        if FileExists(lMdxFileName) then
+        begin
+          // open file
+          FMdxFile := TIndexFile.Create(Self, lMdxFileName);
+          FMdxFile.Mode := Mode;
+          FMdxFile.AutoCreate := false;
+          FMdxFile.OnLocaleError := FOnLocaleError;
+          FMdxFile.CodePage := UseCodePage;
+          FMdxFile.Open;
+          // is index ready for use?
+          if not FMdxFile.ForceClose then
+          begin
+            FIndexFiles.Add(FMdxFile);
+            // get index tag names known
+            FMdxFile.GetIndexNames(FIndexNames);
+          end else begin
+            // asked to close! close file
+            FreeAndNil(FMdxFile);
+          end;
+        end else begin
+          // ask user
+          deleteLink := true;
+          if Assigned(FOnIndexMissing) then
+            FOnIndexMissing(deleteLink);
+          // correct flag
+          if deleteLink then
+            PDbfHdr(Header).MDXFlag := 0
+          else
+            FForceClose := true;
+        end;
+      end;
+    end;
+
+    // open indexes
+    for I := 0 to FIndexFiles.Count - 1 do
+      TIndexFile(FIndexFiles.Items[I]).Open;
+
+    // now opened
+    FOpened := true;
+  end;
+end;
+
+procedure TDbfFile.Close;
+var
+  MdxIndex, I: Integer;
+begin
+  if FOpened then
+  begin
+    // close index files first
+    MdxIndex := -1;
+    for I := 0 to FIndexFiles.Count - 1 do
+    begin
+      TIndexFile(FIndexFiles.Items[I]).Close;
+      if FIndexFiles.Items[I] = FMdxFile then
+        MdxIndex := I;
+    end;
+    // free memo file if any
+    FreeAndNil(FMemoFile);
+
+    // now we can close physical dbf file
+    CloseFile;
+
+    // free FMdxFile, remove it from the FIndexFiles and Names lists
+    if MdxIndex >= 0 then
+      FIndexFiles.Delete(MdxIndex);
+    I := 0;
+    while I < FIndexNames.Count do
+    begin
+      if FIndexNames.Objects[I] = FMdxFile then
+      begin
+        FIndexNames.Delete(I);
+      end else begin
+        Inc(I);
+      end;
+    end;
+    FreeAndNil(FMdxFile);
+    if FPrevBuffer <> nil then
+      FreeMemAndNil(Pointer(FPrevBuffer));
+
+    // flag closed
+    FOpened := false;
+  end;
+end;
+
+procedure TDbfFile.FinishCreate(FieldDefs: TDbfFieldDefs; MemoSize: Integer);
+var
+  lFieldDescIII: rFieldDescIII;
+  lFieldDescVII: rFieldDescVII;
+  lFieldDescPtr: Pointer;
+  lFieldDef: TDbfFieldDef;
+  lMemoFileName: string;
+  I, lFieldOffset, lSize, lPrec: Integer;
+  lHasBlob: Boolean;
+
+begin
+  try
+    // first reset file
+    RecordCount := 0;
+    lHasBlob := false;
+    // prepare header size
+    if FDbfVersion = xBaseVII then
+    begin
+      // version xBaseVII without memo
+      HeaderSize := SizeOf(rDbfHdr) + SizeOf(rAfterHdrVII);
+      RecordSize := SizeOf(rFieldDescVII);
+      FillChar(Header^, HeaderSize, #0);
+      PDbfHdr(Header).VerDBF := $04;
+      // write language string
+      StrPLCopy(
+        @PAfterHdrVII(PChar(Header)+SizeOf(rDbfHdr)).LanguageDriverName[32],
+        ConstructLangName(
+          DbfGlobals.DefaultCreateCodePage,
+          DbfGlobals.DefaultCreateLocale,
+          FDbfVersion = xFoxPro),
+        63-32);
+      lFieldDescPtr := @lFieldDescVII;
+    end else begin
+      // version xBaseIII/IV/V without memo
+      HeaderSize := SizeOf(rDbfHdr) + SizeOf(rAfterHdrIII);
+      RecordSize := SizeOf(rFieldDescIII);
+      FillChar(Header^, HeaderSize, #0);
+      if FDbfVersion = xFoxPro then
+        PDbfHdr(Header).VerDBF := $05
+      else
+        PDbfHdr(Header).VerDBF := $03;
+      // standard language WE, dBase III no language support
+      if FDbfVersion = xBaseIII then
+        PDbfHdr(Header).Language := 0
+      else
+        PDbfHdr(Header).Language := ConstructLangId(
+          DbfGlobals.DefaultCreateCodePage,
+          DbfGlobals.DefaultCreateLocale,
+          FDbfVersion = xFoxPro);
+      // init field ptr
+      lFieldDescPtr := @lFieldDescIII;
+    end;
+    // begin writing fields
+    FFieldDefs.Clear;
+    // deleted mark 1 byte
+    lFieldOffset := 1;
+    for I := 1 to FieldDefs.Count do
+    begin
+      lFieldDef := FieldDefs.Items[I-1];
+
+      // check if datetime conversion
+      if FCopyDateTimeAsString then
+        if lFieldDef.FieldType = ftDateTime then
+        begin
+          // convert to string
+          lFieldDef.FieldType := ftString;
+          lFieldDef.Size := 22;
+        end;
+
+      // update source
+      lFieldDef.FieldName := AnsiUpperCase(lFieldDef.FieldName);
+      lFieldDef.Offset := lFieldOffset;
+      lFieldDef.CalcValueOffset;
+      lHasBlob := lHasBlob or lFieldDef.IsBlob;
+
+      // apply field transformation tricks
+      lSize := lFieldDef.Size;
+      lPrec := lFieldDef.Precision;
+      if lFieldDef.NativeFieldType = 'C' then
+      begin
+        lPrec := lSize div 256;
+        lSize := lSize mod 256;
+      end;
+
+      // update temp field props
+      if FDbfVersion = xBaseVII then
+      begin
+        FillChar(lFieldDescVII, SizeOf(lFieldDescVII), #0);
+        StrPLCopy(lFieldDescVII.FieldName, lFieldDef.FieldName, SizeOf(lFieldDescVII.FieldName)-1);
+        lFieldDescVII.FieldType := lFieldDef.NativeFieldType;
+        lFieldDescVII.FieldSize := lSize;
+        lFieldDescVII.FieldPrecision := lPrec;
+        lFieldDescVII.NextAutoInc := lFieldDef.AutoInc;
+        //lFieldDescVII.MDXFlag := ???
+      end else begin
+        FillChar(lFieldDescIII, SizeOf(lFieldDescIII), #0);
+        StrPLCopy(lFieldDescIII.FieldName, lFieldDef.FieldName, SizeOf(lFieldDescIII.FieldName)-1);
+        lFieldDescIII.FieldType := lFieldDef.NativeFieldType;
+        lFieldDescIII.FieldSize := lSize;
+        lFieldDescIII.FieldPrecision := lPrec;
+      end;
+
+      // update our field list
+      with FFieldDefs.AddFieldDef do
+      begin
+        Assign(lFieldDef);
+        Offset := lFieldOffset;
+        AutoInc := 0;
+        CalcValueOffset;
+      end;
+
+      // save field props
+      WriteRecord(I, lFieldDescPtr);
+      Inc(lFieldOffset, lFieldDef.Size);
+    end;
+    // end of header
+    WriteChar($0D);
+
+    // write memo bit
+    if lHasBlob then
+      if FDbfVersion = xBaseIII then
+        PDbfHdr(Header).VerDBF := PDbfHdr(Header).VerDBF or $80
+      else
+      if FDbfVersion = xFoxPro then
+        PDbfHdr(Header).VerDBF := PDbfHdr(Header).VerDBF or $F0
+      else
+        PDbfHdr(Header).VerDBF := PDbfHdr(Header).VerDBF or $88;
+
+    // update header
+    PDbfHdr(Header).RecordSize := lFieldOffset;
+    PDbfHdr(Header).FullHdrSize := HeaderSize + RecordSize * FieldDefs.Count + 1;
+
+    // write dbf header to disk
+    inherited WriteHeader;
+  finally
+    RecordSize := PDbfHdr(Header).RecordSize;
+    HeaderSize := PDbfHdr(Header).FullHdrSize;
+
+    // write full header to disk (dbf+fields)
+    WriteHeader;
+  end;
+
+  if HasBlob and (FMemoFile=nil) then
+  begin
+    lMemoFileName := ChangeFileExt(FileName, GetMemoExt);
+    if FDbfVersion = xFoxPro then
+      FMemoFile := TFoxProMemoFile.Create(lMemoFileName)
+    else
+      FMemoFile := TDbaseMemoFile.Create(lMemoFileName);
+    FMemoFile.Mode := Mode;
+    FMemoFile.AutoCreate := AutoCreate;
+    FMemoFile.MemoRecordSize := MemoSize;
+    FMemoFile.DbfVersion := FDbfVersion;
+    FMemoFile.Open;
+  end;
+end;
+
+function TDbfFile.HasBlob: Boolean;
+var
+  I: Integer;
+  HasBlob: Boolean;
+begin
+  HasBlob := false;
+  for I := 0 to FFieldDefs.Count-1 do
+  begin
+    if FFieldDefs.Items[I].IsBlob then HasBlob := true;
+  end;
+  Result := HasBlob;
+end;
+
+function TDbfFile.GetMemoExt: string;
+begin
+  if FDbfVersion = xFoxPro then
+    Result := '.fpt'
+  else
+    Result := '.dbt';
+end;
+
+procedure TDbfFile.Zap;
+begin
+  // make recordcount zero
+  RecordCount := 0;
+  // update recordcount
+  PDbfHdr(Header).RecordCount := RecordCount;
+  // update disk header
+  WriteHeader;
+  // update indexes
+  RegenerateIndexes;
+end;
+
+procedure TDbfFile.WriteHeader;
+var
+  SystemTime: TSystemTime;
+  lDataHdr: PDbfHdr;
+  EofTerminator: Byte;
+begin
+  if (HeaderSize=0) then
+    exit;
+
+  //FillHeader(0);
+  lDataHdr := PDbfHdr(Header);
+  GetLocalTime(SystemTime);
+  lDataHdr.Year := SystemTime.wYear - 1900;
+  lDataHdr.Month := SystemTime.wMonth;
+  lDataHdr.Day := SystemTime.wDay;
+//  lDataHdr.RecordCount := RecordCount;
+  inherited WriteHeader;
+
+  EofTerminator := $1A;
+  WriteBlock(@EofTerminator, 1, CalcPageOffset(RecordCount+1));
+end;
+
+procedure TDbfFile.ConstructFieldDefs;
+var
+  {lColumnCount,}lHeaderSize,lFieldSize: Integer;
+  lPropHdrOffset, lFieldOffset: Integer;
+  lFieldDescIII: rFieldDescIII;
+  lFieldDescVII: rFieldDescVII;
+  lFieldPropsHdr: rFieldPropsHdr;
+  lStdProp: rStdPropEntry;
+  TempFieldDef: TDbfFieldDef;
+  lSize,lPrec,I, lColumnCount: Integer;
+  lAutoInc: Cardinal;
+  dataPtr: PChar;
+  lNativeFieldType: Char;
+  lFieldName: string;
+begin
+  FFieldDefs.Clear;
+  if DbfVersion >= xBaseVII then
+  begin
+    lHeaderSize := SizeOf(rAfterHdrVII) + SizeOf(rDbfHdr);
+    lFieldSize := SizeOf(rFieldDescVII);
+  end else begin
+    lHeaderSize := SizeOf(rAfterHdrIII) + SizeOf(rDbfHdr);
+    lFieldSize := SizeOf(rFieldDescIII);
+  end;
+  HeaderSize := lHeaderSize;
+  RecordSize := lFieldSize;
+
+  FHasLockField := false;
+  FAutoIncPresent := false;
+  lColumnCount := (PDbfHdr(Header).FullHdrSize - lHeaderSize) div lFieldSize;
+  lFieldOffset := 1;
+  lAutoInc := 0;
+  I := 1;
+  try
+    // there has to be minimum of one field
+    repeat
+      // version field info?
+      if FDbfVersion >= xBaseVII then
+      begin
+        ReadRecord(I, @lFieldDescVII);
+        lFieldName := AnsiUpperCase(PChar(@lFieldDescVII.FieldName[0]));
+        lSize := lFieldDescVII.FieldSize;
+        lPrec := lFieldDescVII.FieldPrecision;
+        lNativeFieldType := lFieldDescVII.FieldType;
+        lAutoInc := lFieldDescVII.NextAutoInc;
+        if lNativeFieldType = '+' then
+          FAutoIncPresent := true;
+      end else begin
+        ReadRecord(I, @lFieldDescIII);
+        lFieldName := AnsiUpperCase(PChar(@lFieldDescIII.FieldName[0]));
+        lSize := lFieldDescIII.FieldSize;
+        lPrec := lFieldDescIII.FieldPrecision;
+        lNativeFieldType := lFieldDescIII.FieldType;
+      end;
+
+      // apply field transformation tricks
+      if lNativeFieldType = 'C' then
+      begin
+        lSize := lSize + lPrec shl 8;
+        lPrec := 0;
+      end;
+
+      // add field
+      with FFieldDefs.AddFieldDef do
+      begin
+        FieldName := lFieldName;
+        Offset := lFieldOffset;
+        Size := lSize;
+        Precision := lPrec;
+        AutoInc := lAutoInc;
+        NativeFieldType := lNativeFieldType;
+        CalcValueOffset;
+
+        // check valid field:
+        //  1) non-empty field name
+        //  2) known field type
+        //  {3) no changes have to be made to precision or size}
+        if (Length(lFieldName) = 0) or (FieldType = ftUnknown) then
+          raise EDbfError.Create(STRING_INVALID_DBF_FILE);
+
+        // determine if lock field present
+        IsLockField := lFieldName = '_DBASELOCK';
+        // if present, then store additional info
+        if IsLockField then
+        begin
+          FHasLockField := true;
+          FLockFieldOffset := lFieldOffset;
+          FLockFieldLen := lSize;
+          FLockUserLen := FLockFieldLen - 8;
+          if FLockUserLen > DbfGlobals.UserNameLen then
+            FLockUserLen := DbfGlobals.UserNameLen;
+        end;
+      end;
+
+      // goto next field
+      Inc(lFieldOffset, lSize);
+      Inc(I);
+
+      // continue until header termination character found
+      // or end of header reached
+    until (I > lColumnCount) or (ReadChar = $0D);
+
+    // test if not too many fields
+    if FFieldDefs.Count >= 4096 then
+      raise EDbfError.CreateFmt(STRING_INVALID_FIELD_COUNT, [FFieldDefs.Count]);
+
+{
+    // removed check because additional data could be present in record
+
+    if (lFieldOffset <> PDbfHdr(Header).RecordSize) then
+    begin
+      // I removed the message because it confuses end-users.
+      // Though there is a major problem if the value is wrong...
+      // I try to fix it but it is likely to crash
+      PDbfHdr(Header).RecordSize := lFieldOffset;
+    end;
+}
+
+    // get current position
+    lPropHdrOffset := Stream.Position;
+
+    // dBase 7 -> read field properties, test if enough space, maybe no header
+    if (FDbfVersion = xBaseVII) and (lPropHdrOffset + Sizeof(lFieldPropsHdr) <
+            PDbfHdr(Header).FullHdrSize) then
+    begin
+      // read in field properties header
+      ReadBlock(@lFieldPropsHdr, SizeOf(lFieldPropsHdr), lPropHdrOffset);
+      // read in standard properties
+      lFieldOffset := lPropHdrOffset + lFieldPropsHdr.StartStdProps;
+      for I := 0 to lFieldPropsHdr.NumStdProps - 1 do
+      begin
+        // read property data
+        ReadBlock(@lStdProp, SizeOf(lStdProp), lFieldOffset+I*SizeOf(lStdProp));
+        // is this a constraint?
+        if lStdProp.FieldOffset = 0 then
+        begin
+          // this is a constraint...not implemented
+        end else if lStdProp.FieldOffset <= FFieldDefs.Count then begin
+          // get fielddef for this property
+          TempFieldDef := FFieldDefs.Items[lStdProp.FieldOffset-1];
+          // allocate space to store data
+          TempFieldDef.AllocBuffers;
+          // dataPtr = nil -> no data to retrieve
+          dataPtr := nil;
+          // store data
+          case lStdProp.PropType of
+            FieldPropType_Required: TempFieldDef.Required := true;
+            FieldPropType_Default:
+              begin
+                dataPtr := TempFieldDef.DefaultBuf;
+                TempFieldDef.HasDefault := true;
+              end;
+            FieldPropType_Min:
+              begin
+                dataPtr := TempFieldDef.MinBuf;
+                TempFieldDef.HasMin := true;
+              end;
+            FieldPropType_Max:
+              begin
+                dataPtr := TempFieldDef.MaxBuf;
+                TempFieldDef.HasMax := true;
+              end;
+          end;
+          // get data for this property
+          if dataPtr <> nil then
+            ReadBlock(dataPtr, lStdProp.DataSize, lPropHdrOffset + lStdProp.DataOffset);
+        end;
+      end;
+      // read custom properties...not implemented
+      // read RI properties...not implemented
+    end;
+
+  finally
+    HeaderSize := PDbfHdr(Header).FullHdrSize;
+    RecordSize := PDbfHdr(Header).RecordSize;
+  end;
+end;
+
+function TDbfFile.GetLanguageId: Integer;
+begin
+  Result := PDbfHdr(Header).Language;
+end;
+
+function TDbfFile.GetLanguageStr: String;
+begin
+  if FDbfVersion >= xBaseVII then
+    Result := PAfterHdrVII(PChar(Header) + SizeOf(rDbfHdr)).LanguageDriverName;
+end;
+
+{
+  I fill the holes with the last records.
+  now we can do an 'in-place' pack
+}
+procedure TDbfFile.FastPackTable;
+var
+  iDel,iNormal: Integer;
+  pDel,pNormal: PChar;
+
+  function FindFirstDel: Boolean;
+  begin
+    while iDel<=iNormal do
+    begin
+      ReadRecord(iDel, pDel);
+      if (PChar(pDel)^ <> ' ') then
+      begin
+        Result := true;
+        exit;
+      end;
+      Inc(iDel);
+    end;
+    Result := false;
+  end;
+
+  function FindLastNormal: Boolean;
+  begin
+    while iNormal>=iDel do
+    begin
+      ReadRecord(iNormal, pNormal);
+      if (PChar(pNormal)^= ' ') then
+      begin
+        Result := true;
+        exit;
+      end;
+      dec(iNormal);
+    end;
+    Result := false;
+  end;
+
+begin
+  if RecordSize < 1 then Exit;
+
+  GetMem(pNormal, RecordSize);
+  GetMem(pDel, RecordSize);
+  try
+    iDel := 1;
+    iNormal := RecordCount;
+
+    while FindFirstDel do
+    begin
+      // iDel is definitely deleted
+      if FindLastNormal then
+      begin
+        // but is not anymore
+        WriteRecord(iDel, pNormal);
+        PChar(pNormal)^ := '*';
+        WriteRecord(iNormal, pNormal);
+      end else begin
+        // Cannot found a record after iDel so iDel must be deleted
+        dec(iDel);
+        break;
+      end;
+    end;
+    // FindFirstDel failed means than iDel is full
+    RecordCount := iDel;
+    RegenerateIndexes;
+    // Pack Memofields
+  finally
+    FreeMem(pNormal);
+    FreeMem(pDel);
+  end;
+end;
+
+procedure TDbfFile.RestructureTable(DbfFieldDefs: TDbfFieldDefs; Pack: Boolean);
+var
+  DestDbfFile: TDbfFile;
+  TempIndexDef: TDbfIndexDef;
+  TempIndexFile: TIndexFile;
+  DestFieldDefs: TDbfFieldDefs;
+  TempDstDef, TempSrcDef: TDbfFieldDef;
+  OldIndexFiles, NewIndexFiles: TStrings;
+  IndexName, NewBaseName, OldBaseName: string;
+  I, lRecNo, lFieldNo, lFieldSize, lBlobRecNo, lWRecNo: Integer;
+  pBuff, pDestBuff: PChar;
+  pBlobRecNoBuff: array[1..11] of Char;
+  BlobStream: TMemoryStream;
+begin
+  // nothing to do?
+  if (RecordSize < 1) or ((DbfFieldDefs = nil) and not Pack) then
+    exit;
+
+  // if no exclusive access, terrible things can happen!
+  CheckExclusiveAccess;
+
+  // make up some temporary filenames
+  lRecNo := 0;
+  FindNextName(FileName, NewBaseName, lRecNo);
+  FindNextName(FileName, OldBaseName, lRecNo);
+
+  // select final field definition list
+  if DbfFieldDefs = nil then
+    DestFieldDefs := FFieldDefs
+  else
+    DestFieldDefs := DbfFieldDefs;
+
+  // create temporary dbf
+  DestDbfFile := TDbfFile.Create(NewBaseName);
+  DestDbfFile.AutoCreate := true;
+  DestDbfFile.Mode := pfExclusiveCreate;
+  DestDbfFile.UseFloatFields := UseFloatFields;
+  DestDbfFile.OnIndexMissing := FOnIndexMissing;
+  DestDbfFile.OnLocaleError := FOnLocaleError;
+  DestDbfFile.DbfVersion := FDbfVersion;
+  DestDbfFile.Open;
+  // create dbf header
+  if FMemoFile <> nil then
+    DestDbfFile.FinishCreate(DestFieldDefs, FMemoFile.RecordSize)
+  else
+    DestDbfFile.FinishCreate(DestFieldDefs, 512);
+
+  // add indexes
+  TempIndexDef := TDbfIndexDef.Create(nil);
+  for I := 0 to FIndexNames.Count - 1 do
+  begin
+    // get length of extension -> determines MDX or NDX
+    IndexName := FIndexNames.Strings[I];
+    TempIndexFile := TIndexFile(FIndexNames.Objects[I]);
+    TempIndexFile.GetIndexInfo(IndexName, TempIndexDef);
+    if Length(ExtractFileExt(IndexName)) > 0 then
+    begin
+      // NDX index, get unique file name
+      lRecNo := 0;
+      FindNextName(IndexName, IndexName, lRecNo);
+    end;
+    // add this index
+    DestDbfFile.OpenIndex(IndexName, TempIndexDef.SortField, true, TempIndexDef.Options);
+  end;
+  TempIndexDef.Free;
+
+  // get memory for index file list
+  OldIndexFiles := TStringList.Create;
+  NewIndexFiles := TStringList.Create;
+  // get memory for record buffers
+  GetMem(pBuff, RecordSize);
+  BlobStream := TMemoryStream.Create;
+  // if restructure, we need memory for dest buffer, otherwise use source
+  if DbfFieldDefs = nil then
+    pDestBuff := pBuff
+  else
+    GetMem(pDestBuff, DestDbfFile.RecordSize);
+
+  // let the games begin!
+  try
+{$ifdef USE_CACHE}
+    BufferAhead := true;
+    DestDbfFile.BufferAhead := true;
+{$endif}
+    lRecNo := 1;
+    lWRecNo := 1;
+    while lRecNo <= RecordCount do
+    begin
+      // read record from original dbf
+      ReadRecord(lRecNo, pBuff);
+      // copy record?
+      if (pBuff^ <> '*') or not Pack then
+      begin
+        // if restructure, initialize dest
+        if DbfFieldDefs <> nil then
+          DestDbfFile.InitRecord(pDestBuff);
+
+        if (DbfFieldDefs <> nil) or (FMemoFile <> nil) then
+        begin
+          // copy fields
+          for lFieldNo := 0 to DestFieldDefs.Count-1 do
+          begin
+            TempDstDef := DestFieldDefs.Items[lFieldNo];
+            // handle blob fields differently
+            // don't try to copy new blob fields!
+            // DbfFieldDefs = nil -> pack only
+            // TempDstDef.CopyFrom >= 0 -> copy existing (blob) field
+            if TempDstDef.IsBlob and ((DbfFieldDefs = nil) or (TempDstDef.CopyFrom >= 0)) then
+            begin
+              // get current blob blockno
+              GetFieldData(lFieldNo, ftString, pBuff, @pBlobRecNoBuff[1]);
+              lBlobRecNo := StrToIntDef(pBlobRecNoBuff, -1);
+              // valid blockno read?
+              if lBlobRecNo >= 0 then
+              begin
+                BlobStream.Clear;
+                FMemoFile.ReadMemo(lBlobRecNo, BlobStream);
+                BlobStream.Position := 0;
+                // always append
+                DestDbfFile.FMemoFile.WriteMemo(lBlobRecNo, 0, BlobStream);
+              end;
+              // write new blockno
+              DestDbfFile.SetFieldData(lFieldNo, ftInteger, @lBlobRecNo, pDestBuff);
+            end else if (DbfFieldDefs <> nil) and (TempDstDef.CopyFrom >= 0) then
+            begin
+              // restructure and copy field, get src fielddef
+              // DbfFieldDefs <> nil -> DestFieldDefs = DbfFieldDefs
+              TempSrcDef := FFieldDefs.Items[TempDstDef.CopyFrom];
+              // get size
+              lFieldSize := TempSrcDef.Size;
+              if lFieldSize > TempDstDef.Size then
+                lFieldSize := TempDstDef.Size;
+              // copy content of field
+              Move(pBuff[TempSrcDef.Offset], pDestBuff[TempDstDef.Offset], lFieldSize);
+            end;
+          end;
+        end;
+
+        // write record
+        DestDbfFile.WriteRecord(lWRecNo, pDestBuff);
+        // update indexes
+        for I := 0 to DestDbfFile.IndexFiles.Count - 1 do
+          TIndexFile(DestDbfFile.IndexFiles.Items[I]).Insert(lWRecNo, pDestBuff);
+
+        // go to next record
+        Inc(lWRecNo);
+      end;
+      Inc(lRecNo);
+    end;
+
+{$ifdef USE_CACHE}
+    BufferAhead := false;
+    DestDbfFile.BufferAhead := false;
+{$endif}
+
+    // save index filenames
+    for I := 0 to FIndexFiles.Count - 1 do
+    begin
+      OldIndexFiles.Add(TIndexFile(FIndexFiles.Items[I]).FileName);
+      NewIndexFiles.Add(TIndexFile(DestDbfFile.IndexFiles[I]).FileName);
+    end;
+
+    // close temp file
+    DestDbfFile.Close;
+    // close dbf
+    Close;
+
+    // if restructure -> rename the old dbf files
+    // if pack only -> delete the old dbf files
+    if Pack and (DbfFieldDefs = nil) then
+    begin
+      SysUtils.DeleteFile(FileName);
+      SysUtils.DeleteFile(ChangeFileExt(FileName, GetMemoExt));
+    end else begin
+      SysUtils.RenameFile(FileName,                        OldBaseName);
+      SysUtils.RenameFile(ChangeFileExt(FileName, GetMemoExt), ChangeFileExt(OldBaseName, GetMemoExt));
+    end;
+    // delete old index files
+    for I := 0 to OldIndexFiles.Count - 1 do
+      SysUtils.DeleteFile(OldIndexFiles.Strings[I]);
+    // rename the new dbf files
+    SysUtils.RenameFile(NewBaseName,                        FileName);
+    SysUtils.RenameFile(ChangeFileExt(NewBaseName, GetMemoExt), ChangeFileExt(FileName, GetMemoExt));
+    // rename new index files
+    for I := 0 to OldIndexFiles.Count - 1 do
+      SysUtils.RenameFile(NewIndexFiles.Strings[I], OldIndexFiles.Strings[I]);
+
+    // we have to reinit fielddefs if restructured
+    Open;
+
+    // crop deleted records
+    RecordCount := lWRecNo - 1;
+    // update date/time stamp, recordcount
+    PDbfHdr(Header).RecordCount := RecordCount;
+    WriteHeader;
+  finally
+    // close temporary file
+    FreeAndNil(DestDbfFile);
+    // free mem
+    OldIndexFiles.Free;
+    NewIndexFiles.Free;
+    FreeMem(pBuff);
+    FreeAndNil(BlobStream);
+    if DbfFieldDefs <> nil then
+      FreeMem(pDestBuff);
+  end;
+end;
+
+procedure TDbfFile.RegenerateIndexes;
+var
+  lIndexNo: Integer;
+begin
+  // recreate every index in every file
+  for lIndexNo := 0 to FIndexFiles.Count-1 do
+  begin
+    PackIndex(TIndexFile(FIndexFiles.Items[lIndexNo]), EmptyStr);
+  end;
+end;
+
+function TDbfFile.GetFieldInfo(FieldName: string): TDbfFieldDef;
+var
+  I: Integer;
+  lfi: TDbfFieldDef;
+begin
+  FieldName := AnsiUpperCase(FieldName);
+  for I := 0 to FFieldDefs.Count-1 do
+  begin
+    lfi := TDbfFieldDef(FFieldDefs.Items[I]);
+    if lfi.fieldName = FieldName then
+    begin
+      Result := lfi;
+      exit;
+    end;
+  end;
+  Result := nil;
+end;
+
+// NOTE: Dst may be nil!
+function TDbfFile.GetFieldData(Column: Integer; DataType: TFieldType; Src, Dst: Pointer): Boolean;
+var
+  TempFieldDef: TDbfFieldDef;
+begin
+  TempFieldDef := TDbfFieldDef(FFieldDefs.Items[Column]);
+  Result := GetFieldDataFromDef(TempFieldDef, DataType, Src, Dst);
+end;
+
+// NOTE: Dst may be nil!
+function TDbfFile.GetFieldDataFromDef(AFieldDef: TDbfFieldDef; DataType: TFieldType; Src, Dst: Pointer): Boolean;
+var
+  FieldOffset, FieldSize: Integer;
+//  s: string;
+  ldd, ldm, ldy, lth, ltm, lts: Integer;
+  date: TDateTime;
+  timeStamp: TTimeStamp;
+
+{$ifdef SUPPORT_INT64}
+  function GetInt64FromStrLength(Src: Pointer; Size: Integer; Default: Int64): Int64;
+  var
+    endChar: Char;
+    Code: Integer;
+  begin
+    // save Char at pos term. null
+    endChar := (PChar(Src) + Size)^;
+    (PChar(Src) + Size)^ := #0;
+    // convert
+    Val(PChar(Src), Result, Code);
+    // check success
+    if Code <> 0 then Result := Default;
+    // restore prev. ending Char
+    (PChar(Src) + Size)^ := endChar;
+  end;
+{$endif}
+
+  procedure CorrectYear(var wYear: Integer);
+  var wD, wM, wY, CenturyBase: Word;
+
+{$ifndef DELPHI_5}
+  // Delphi 3 standard-behavior no change possible
+  const TwoDigitYearCenturyWindow= 0;
+{$endif}
+
+  begin
+     if wYear >= 100 then
+       Exit;
+     DecodeDate(Date, wY, wm, wD);
+     // use Delphi-Date-Window
+     CenturyBase := wY{must be CurrentYear} - TwoDigitYearCenturyWindow;
+     Inc(wYear, CenturyBase div 100 * 100);
+     if (TwoDigitYearCenturyWindow > 0) and (wYear < CenturyBase) then
+        Inc(wYear, 100);
+  end;
+
+  procedure SaveDateToDst;
+  begin
+{$ifdef SUPPORT_NEW_FIELDDATA}
+    // Delphi 5 requests a TDateTime
+    PDateTime(Dst)^ := date;
+{$else}
+    // Delphi 3 and 4 request a TDateTimeRec
+    //  date is TTimeStamp.date
+    //  datetime = msecs == BDE timestamp as we implemented it
+    if DataType = ftDateTime then
+    begin
+      PDateTimeRec(Dst).DateTime := DateTimeToBDETimeStamp(date);
+    end else begin
+      PLongInt(Dst)^ := DateTimeToTimeStamp(date).Date;
+    end;
+{$endif}
+  end;
+
+begin
+  // test if non-nil source
+  // do not check Dst = nil, called with dst = nil to check empty field
+  if (Src <> nil) then
+  begin
+    FieldOffset := AFieldDef.Offset;
+    FieldSize := AFieldDef.Size;
+    Src := PChar(Src) + FieldOffset;
+    // field types that are binary and of which the fieldsize should not be truncated
+    case AFieldDef.NativeFieldType of
+      '+', 'I':
+        begin
+          if FDbfVersion <> xFoxPro then
+          begin
+            Result := PDWord(Src)^ <> 0;
+            if Result then
+            begin
+              PInteger(Dst)^ := SwapInt(PInteger(Src)^);
+              if Result then
+                PInteger(Dst)^ := Integer(PDWord(Dst)^ - $80000000);
+            end;
+          end else begin
+            Result := true;
+            PInteger(Dst)^ := PInteger(Src)^;
+          end;
+        end;
+      'O':
+        begin
+{$ifdef SUPPORT_INT64}
+          Result := (PInt64(Src)^ <> 0);
+          if Result then
+          begin
+            SwapInt64(Src, Dst);
+            if PInt64(Dst)^ > 0 then
+              PInt64(Dst)^ := not PInt64(Dst)^
+            else
+              PDouble(Dst)^ := PDouble(Dst)^ * -1;
+          end;
+{$endif}
+        end;
+      '@':
+        begin
+{$ifdef SUPPORT_INT64}
+          Result := (PInt64(Src)^ <> 0);
+          if Result then
+            SwapInt64(Src, Dst);
+{$endif}
+        end;
+      'T':
+        begin
+          // all binary zeroes -> empty datetime
+          Result := (PInteger(Src)^ <> 0) or (PInteger(PChar(Src)+4)^ <> 0);
+          if Result then
+          begin
+            timeStamp.Date := PInteger(Src)^ - 1721425;
+            timeStamp.Time := PInteger(PChar(Src)+4)^;
+            date := TimeStampToDateTime(timeStamp);
+            SaveDateToDst;
+          end;
+        end;
+      'Y':
+        begin
+{$ifdef SUPPORT_INT64}
+          Result := true;
+          SwapInt64(Src, Dst);
+          case DataType of
+            ftCurrency:
+            begin
+              PDouble(Dst)^ := PInt64(Src)^ / 10000;
+            end;
+            ftBCD:
+            begin
+              PCurrency(Dst)^ := PCurrency(Src)^;
+            end;
+          end;
+{$endif}
+        end;
+    else
+      //    SetString(s, PChar(Src) + FieldOffset, FieldSize );
+      //    s := {TrimStr(s)} TrimRight(s);
+      // truncate spaces at end by shortening fieldsize
+      while (FieldSize > 0) and ((PChar(Src) + FieldSize - 1)^ = ' ') do
+        dec(FieldSize);
+      // if not string field, truncate spaces at beginning too
+      if DataType <> ftString then
+        while (FieldSize > 0) and (PChar(Src)^ = ' ') do
+        begin
+          inc(PChar(Src));
+          dec(FieldSize);
+        end;
+      // return if field is empty
+      Result := FieldSize > 0;
+      if Result and (Dst <> nil) then     // data not needed if Result= false or Dst=nil
+        case DataType of
+        ftBoolean:
+          begin
+            // in DBase- FileDescription lowercase t is allowed too
+            // with asking for Result= true s must be longer then 0
+            // else it happens an AV, maybe field is NULL
+            if (PChar(Src)^ = 'T') or (PChar(Src)^ = 't') then
+              PWord(Dst)^ := 1
+            else
+              PWord(Dst)^ := 0;
+          end;
+        ftSmallInt:
+          PSmallInt(Dst)^ := GetIntFromStrLength(Src, FieldSize, 0);
+{$ifdef SUPPORT_INT64}
+        ftLargeInt:
+          PLargeInt(Dst)^ := GetInt64FromStrLength(Src, FieldSize, 0);
+{$endif}
+        ftInteger:
+          PInteger(Dst)^ := GetIntFromStrLength(Src, FieldSize, 0);
+        ftFloat, ftCurrency:
+          PDouble(Dst)^ := DbfStrToFloat(Src, FieldSize);
+        ftDate, ftDateTime:
+          begin
+            // get year, month, day
+            ldy := GetIntFromStrLength(PChar(Src) + 0, 4, 1);
+            ldm := GetIntFromStrLength(PChar(Src) + 4, 2, 1);
+            ldd := GetIntFromStrLength(PChar(Src) + 6, 2, 1);
+            //if (ly<1900) or (ly>2100) then ly := 1900;
+            //Year from 0001 to 9999 is possible
+            //everyting else is an error, an empty string too
+            //Do DateCorrection with Delphis possibillities for one or two digits
+            if (ldy < 100) and (PChar(Src)[0] = #32) and (PChar(Src)[1] = #32) then
+              CorrectYear(ldy);
+            try
+              date := EncodeDate(ldy, ldm, ldd);
+            except
+              date := 0;
+            end;
+
+            // time stored too?
+            if (AFieldDef.FieldType = ftDateTime) and (DataType = ftDateTime) then
+            begin
+              // get hour, minute, second
+              lth := GetIntFromStrLength(PChar(Src) + 8,  2, 1);
+              ltm := GetIntFromStrLength(PChar(Src) + 10, 2, 1);
+              lts := GetIntFromStrLength(PChar(Src) + 12, 2, 1);
+              // encode
+              try
+                date := date + EncodeTime(lth, ltm, lts, 0);
+              except
+                date := 0;
+              end;
+            end;
+
+            SaveDateToDst;
+          end;
+        ftString:
+          StrLCopy(Dst, Src, FieldSize);
+      end else begin
+        case DataType of
+        ftString:
+          if Dst <> nil then
+            PChar(Dst)[0] := #0;
+        end;
+      end;
+    end;
+  end else begin
+    Result := false;
+  end;
+end;
+
+procedure TDbfFile.SetFieldData(Column: Integer; DataType: TFieldType; Src, Dst: Pointer);
+var
+  FieldSize,FieldPrec: Integer;
+  TempFieldDef: TDbfFieldDef;
+  Len, IntValue: Integer;
+  year, month, day: Word;
+  hour, minute, sec, msec: Word;
+  date: TDateTime;
+  timeStamp: TTimeStamp;
+
+  procedure LoadDateFromSrc;
+  begin
+{$ifdef SUPPORT_NEW_FIELDDATA}
+    // Delphi 5 passes a TDateTime
+    date := PDateTime(Src)^;
+{$else}
+    // Delphi 3 and 4 pass a TDateTimeRec with a time stamp
+    //  date = integer
+    //  datetime = msecs == BDETimeStampToDateTime as we implemented it
+    if DataType = ftDateTime then
+    begin
+      date := BDETimeStampToDateTime(PDouble(Src)^);
+    end else begin
+      timeStamp.Time := 0;
+      timeStamp.Date := PLongInt(Src)^;
+      date := TimeStampToDateTime(timeStamp);
+    end;
+{$endif}
+  end;
+
+begin
+  TempFieldDef := TDbfFieldDef(FFieldDefs.Items[Column]);
+  FieldSize := TempFieldDef.Size;
+  FieldPrec := TempFieldDef.Precision;
+
+  Dst := PChar(Dst) + TempFieldDef.Offset;
+  // if src = nil then write empty field
+  // symmetry with above
+  case TempFieldDef.NativeFieldType of
+    '+', 'I':
+      begin
+        if Src = nil then
+          IntValue := 0
+        else
+          IntValue := Integer(PDWord(Src)^ + $80000000);
+        PInteger(Dst)^ := SwapInt(IntValue);
+      end;
+    'O':
+      begin
+{$ifdef SUPPORT_INT64}
+        if Src = nil then
+        begin
+          PInt64(Dst)^ := 0;
+        end else begin
+          if PDouble(Src)^ < 0 then
+            PLargeInt(Dst)^ := not PLargeInt(Src)^
+          else
+            PDouble(Dst)^ := (PDouble(Src)^) * -1;
+        end;
+        SwapInt64(Dst, Dst);
+{$endif}
+      end;
+    '@':
+      begin
+{$ifdef SUPPORT_INT64}
+        if Src = nil then
+          PInteger(Dst)^ := 0
+        else
+          SwapInt64(Src, Dst);
+{$endif}
+      end;
+    'T':
+      begin
+        // all binary zeroes -> empty datetime
+        if Src = nil then
+        begin
+          PInteger(Dst)^ := 0;
+          PInteger(PChar(Dst)+4)^ := 0;
+        end else begin
+          LoadDateFromSrc;
+          timeStamp := DateTimeToTimeStamp(date);
+          PInteger(Dst)^ := timeStamp.Date + 1721425;
+          PInteger(PChar(Dst)+4)^ := timeStamp.Time;
+        end;
+      end;
+    'Y':
+      begin
+{$ifdef SUPPORT_INT64}
+        if Src = nil then
+        begin
+          PInt64(Dst)^ := 0
+        end else begin
+          case DataType of
+            ftCurrency:
+              PInt64(Dst)^ := Trunc(PDouble(Src)^ * 10000);
+            ftBCD:
+              PCurrency(Dst)^ := PCurrency(Src)^;
+          end;
+        end;
+        SwapInt64(Dst, Dst);
+{$endif}
+      end;
+  else
+    if Src = nil then
+    begin
+      FillChar(Dst^, FieldSize, ' ');
+    end else begin
+      case DataType of
+        ftBoolean:
+          begin
+            if PWord(Src)^ <> 0 then
+              PChar(Dst)^ := 'T'
+            else
+              PChar(Dst)^ := 'F';
+          end;
+        ftSmallInt:
+          GetStrFromInt_Width(PSmallInt(Src)^, FieldSize, PChar(Dst));
+{$ifdef SUPPORT_INT64}
+        ftLargeInt:
+          GetStrFromInt64_Width(PLargeInt(Src)^, FieldSize, PChar(Dst));
+{$endif}
+        ftFloat, ftCurrency:
+          FloatToDbfStr(PDouble(Src)^, FieldSize, FieldPrec, PChar(Dst));
+        ftInteger:
+          GetStrFromInt_Width(PInteger(Src)^, FieldSize, PChar(Dst));
+        ftDate, ftDateTime:
+          begin
+            LoadDateFromSrc;
+            // decode
+            DecodeDate(date, year, month, day);
+            // format is yyyymmdd
+            GetStrFromInt_Width(year,  4, PChar(Dst));
+            GetStrFromInt_Width(month, 2, PChar(Dst)+4);
+            GetStrFromInt_Width(day,   2, PChar(Dst)+6);
+            // do time too if datetime
+            if DataType = ftDateTime then
+            begin
+              DecodeTime(date, hour, minute, sec, msec);
+              // format is hhmmss
+              GetStrFromInt_Width(hour,   2, PChar(Dst)+8);
+              GetStrFromInt_Width(minute, 2, PChar(Dst)+10);
+              GetStrFromInt_Width(sec,    2, PChar(Dst)+12);
+            end;
+          end;
+        ftString:
+          begin
+            // copy data
+            Len := StrLen(Src);
+            if Len > FieldSize then
+              Len := FieldSize;
+            Move(Src^, Dst^, Len);
+            // fill remaining space with spaces
+            FillChar((PChar(Dst)+Len)^, FieldSize - Len, ' ');
+          end;
+      end;  // case datatype
+    end;
+  end;
+end;
+
+procedure TDbfFile.InitRecord(DestBuf: PChar);
+var
+  TempFieldDef: TDbfFieldDef;
+  I: Integer;
+begin
+  FillChar(DestBuf^, RecordSize,' ');
+  for I := 0 to FFieldDefs.Count-1 do
+  begin
+    TempFieldDef := FFieldDefs.Items[I];
+    if TempFieldDef.NativeFieldType in ['I', 'O', '@', '+'] then
+    begin
+      // integer
+      FillChar(PChar(DestBuf+TempFieldDef.Offset)^, TempFieldDef.Size, 0);
+    end;
+    // copy default value?
+    if TempFieldDef.HasDefault then
+      Move(TempFieldDef.DefaultBuf[0], DestBuf[TempFieldDef.Offset], TempFieldDef.Size);
+  end;
+end;
+
+procedure TDbfFile.ApplyAutoIncToBuffer(DestBuf: PChar);
+var
+  TempFieldDef: TDbfFieldDef;
+  I, NextVal: {LongWord} Cardinal;    {Delphi 3 does not know LongWord?}
+begin
+  if FAutoIncPresent then
+  begin
+    // if shared, reread header to find new autoinc values
+    if NeedLocks then
+    begin
+      // lock header so nobody else can use this value
+      LockPage(0, true);
+    end;
+
+    // find autoinc fields
+    for I := 0 to FFieldDefs.Count-1 do
+    begin
+      TempFieldDef := FFieldDefs.Items[I];
+      if (TempFieldDef.NativeFieldType = '+') then
+      begin
+        // read current auto inc, from header or field, depending on sharing
+        if NeedLocks then
+          ReadBlock(@NextVal, 4, TempFieldDef.ValueOffset)
+        else
+          NextVal := TempFieldDef.AutoInc;
+        // store to buffer, positive = high bit on, so flip it
+        PCardinal(DestBuf+TempFieldDef.Offset)^ := SwapInt(NextVal xor $80000000);
+        // increase
+        Inc(NextVal);
+        TempFieldDef.AutoInc := NextVal;
+        // write new value to header buffer
+        PCardinal(FHeader+TempFieldDef.ValueOffset)^ := NextVal;
+      end;
+    end;
+
+    // write modified header (new autoinc values) to file
+    WriteHeader;
+    
+    // release lock if locked
+    if NeedLocks then
+      UnlockPage(0);
+  end;
+end;
+
+procedure TDbfFile.TryExclusive;
+var
+  I: Integer;
+begin
+  inherited;
+
+  // exclusive succeeded? open index & memo exclusive too
+  if Mode in [pfMemory..pfExclusiveOpen] then
+  begin
+    // indexes
+    for I := 0 to FIndexFiles.Count - 1 do
+      TPagedFile(FIndexFiles[I]).TryExclusive;
+    // memo
+    if FMemoFile <> nil then
+      FMemoFile.TryExclusive;
+  end;
+end;
+
+procedure TDbfFile.EndExclusive;
+var
+  I: Integer;
+begin
+  // end exclusive on index & memo too
+  for I := 0 to FIndexFiles.Count - 1 do
+    TPagedFile(FIndexFiles[I]).EndExclusive;
+  // memo
+  if FMemoFile <> nil then
+    FMemoFile.EndExclusive;
+  // dbf file
+  inherited;
+end;
+
+procedure TDbfFile.OpenIndex(IndexName, IndexField: string; CreateIndex: Boolean; Options: TIndexOptions);
+  //
+  // assumes IndexName is not empty
+  //
+const
+  // mem, excr, exopen, rwcr, rwopen, rdonly
+  IndexOpenMode: array[pfMemory..pfReadOnly] of TPagedFileMode =
+    (pfMemory, pfExclusiveOpen, pfExclusiveOpen, pfReadWriteOpen, pfReadWriteOpen,
+     pfReadOnly);
+var
+  lIndexFile: TIndexFile;
+  lIndexFileName: string;
+  createMdxFile: Boolean;
+  addedIndexFile: Integer;
+  addedIndexName: Integer;
+begin
+  // init
+  addedIndexFile := -1;
+  addedIndexName := -1;
+  createMdxFile := false;
+  // index already opened?
+  lIndexFile := GetIndexByName(IndexName);
+  if (lIndexFile <> nil) and (lIndexFile = FMdxFile) and CreateIndex then
+  begin
+    // index already exists in MDX file
+    // delete it to save space, this causes a repage
+    FMdxFile.DeleteIndex(IndexName);
+    // index no longer exists
+    lIndexFile := nil;
+  end;
+  if (lIndexFile = nil) and (IndexName <> EmptyStr) then
+  begin
+    // check if no extension, then create MDX index
+    if Length(ExtractFileExt(IndexName)) = 0 then
+    begin
+      // check if mdx index already opened
+      if FMdxFile <> nil then
+      begin
+        lIndexFileName := EmptyStr;
+        lIndexFile := FMdxFile;
+      end else begin
+        lIndexFileName := ChangeFileExt(FileName, '.mdx');
+        createMdxFile := true;
+      end;
+    end else begin
+      lIndexFileName := IndexName;
+    end;
+    // do we need to open / create file?
+    if lIndexFileName <> EmptyStr then
+    begin
+      // try to open / create the file
+      lIndexFile := TIndexFile.Create(Self, lIndexFileName);
+      lIndexFile.Mode := IndexOpenMode[Mode];
+      lIndexFile.AutoCreate := CreateIndex or (Length(IndexField) > 0);
+      lIndexFile.CodePage := UseCodePage;
+      lIndexFile.OnLocaleError := FOnLocaleError;
+      lIndexFile.Open;
+      // index file ready for use?
+      if not lIndexFile.ForceClose then
+      begin
+        // if we had to create the index, store that info
+        CreateIndex := lIndexFile.FileCreated;
+        // check if trying to create empty index
+        if CreateIndex and (IndexField = EmptyStr) then
+        begin
+          FreeAndNil(lIndexFile);
+          CreateIndex := false;
+          createMdxFile := false;
+        end else begin
+          // add new index file to list
+          addedIndexFile := FIndexFiles.Add(lIndexFile);
+        end;
+        // created accompanying mdx file?
+        if createMdxFile then
+          FMdxFile := lIndexFile;
+      end else begin
+        // asked to close! close file
+        FreeAndNil(lIndexFile);
+      end;
+    end;
+
+    // check if file succesfully opened
+    if lIndexFile <> nil then
+    begin
+      // add index to list
+      addedIndexName := FIndexNames.AddObject(IndexName, lIndexFile);
+    end;
+  end;
+  // create it or open it?
+  if lIndexFile <> nil then
+  begin
+    if not CreateIndex then
+      if lIndexFile = FMdxFile then
+        CreateIndex := lIndexFile.IndexOf(IndexName) < 0;
+    if CreateIndex then
+    begin
+      // try get exclusive mode
+      if IsSharedAccess then TryExclusive;
+      // always uppercase index expression
+      IndexField := AnsiUpperCase(IndexField);
+      try
+        // create index if asked
+        lIndexFile.CreateIndex(IndexField, IndexName, Options);
+        // add all records
+        PackIndex(lIndexFile, IndexName);
+        // if we wanted to open index readonly, but we created it, then reopen
+        if Mode = pfReadOnly then
+        begin
+          lIndexFile.CloseFile;
+          lIndexFile.Mode := pfReadOnly;
+          lIndexFile.OpenFile;
+        end;
+        // if mdx file just created, write changes to dbf header
+        // set MDX flag to true
+        PDbfHdr(Header).MDXFlag := 1;
+        WriteHeader;
+      except
+        // :-( need to undo 'damage'....
+        // remove index from list(s) if just added
+        if addedIndexFile >= 0 then
+          FIndexFiles.Delete(addedIndexFile);
+        if addedIndexName >= 0 then
+          FIndexNames.Delete(addedIndexName);
+        // delete index file itself
+        lIndexFile.DeleteIndex(IndexName);
+        // if no file created, do not destroy!
+        if addedIndexFile >= 0 then
+        begin
+          lIndexFile.Close;
+          Sysutils.DeleteFile(lIndexFileName);
+          if FMdxFile = lIndexFile then
+            FMdxFile := nil;
+          lIndexFile.Free;
+        end;
+      end;
+      // return to previous mode
+      if TempMode <> pfNone then EndExclusive;
+    end;
+  end;
+end;
+
+procedure TDbfFile.PackIndex(lIndexFile: TIndexFile; AIndexName: string);
+var
+  prevMode: TIndexUpdateMode;
+  prevIndex: string;
+  cur, last: Integer;
+{$ifdef USE_CACHE}
+  prevCache: Integer;
+{$endif}
+begin
+  // save current mode in case we change it
+  prevMode := lIndexFile.UpdateMode;
+  prevIndex := lIndexFile.IndexName;
+  // check if index specified
+  if Length(AIndexName) > 0 then
+  begin
+    // only pack specified index, not all
+    lIndexFile.IndexName := AIndexName;
+    lIndexFile.ClearIndex;
+    lIndexFile.UpdateMode := umCurrent;
+  end else begin
+    lIndexFile.IndexName := EmptyStr;
+    lIndexFile.Clear;
+    lIndexFile.UpdateMode := umAll;
+  end;
+  // prepare update
+  cur := 1;
+  last := RecordCount;
+{$ifdef USE_CACHE}
+  BufferAhead := true;
+  prevCache := lIndexFile.CacheSize;
+  lIndexFile.CacheSize := GetFreeMemory;
+  if lIndexFile.CacheSize < 16384 * 1024 then
+    lIndexFile.CacheSize := 16384 * 1024;
+{$endif}
+  while cur <= last do
+  begin
+    ReadRecord(cur, FPrevBuffer);
+    lIndexFile.Insert(cur, FPrevBuffer);
+    inc(cur);
+  end;
+  // restore previous mode
+{$ifdef USE_CACHE}
+  BufferAhead := false;
+  lIndexFile.BufferAhead := true;
+{$endif}
+  lIndexFile.Flush;
+{$ifdef USE_CACHE}
+  lIndexFile.BufferAhead := false;
+  lIndexFile.CacheSize := prevCache;
+{$endif}
+  lIndexFile.UpdateMode := prevMode;
+  lIndexFile.IndexName := prevIndex;
+end;
+
+procedure TDbfFile.RepageIndex(AIndexFile: string);
+var
+  lIndexNo: Integer;
+begin
+  // DBF MDX index?
+  if Length(AIndexFile) = 0 then
+  begin
+    if FMdxFile <> nil then
+    begin
+      // repage attached mdx
+      FMdxFile.RepageFile;
+    end;
+  end else begin
+    // search index file
+    lIndexNo := FIndexNames.IndexOf(AIndexFile);
+    // index found?
+    if lIndexNo >= 0 then
+      TIndexFile(FIndexNames.Objects[lIndexNo]).RepageFile;
+  end;
+end;
+
+procedure TDbfFile.CompactIndex(AIndexFile: string);
+var
+  lIndexNo: Integer;
+begin
+  // DBF MDX index?
+  if Length(AIndexFile) = 0 then
+  begin
+    if FMdxFile <> nil then
+    begin
+      // repage attached mdx
+      FMdxFile.CompactFile;
+    end;
+  end else begin
+    // search index file
+    lIndexNo := FIndexNames.IndexOf(AIndexFile);
+    // index found?
+    if lIndexNo >= 0 then
+      TIndexFile(FIndexNames.Objects[lIndexNo]).CompactFile;
+  end;
+end;
+
+procedure TDbfFile.CloseIndex(AIndexName: string);
+var
+  lIndexNo: Integer;
+  lIndex: TIndexFile;
+begin
+  // search index file
+  lIndexNo := FIndexNames.IndexOf(AIndexName);
+  // don't close mdx file
+  if (lIndexNo >= 0) then
+  begin
+    // get index pointer
+    lIndex := TIndexFile(FIndexNames.Objects[lIndexNo]);
+    if (lIndex <> FMdxFile) then
+    begin
+      // close file
+      lIndex.Free;
+      // remove from lists
+      FIndexFiles.Remove(lIndex);
+      FIndexNames.Delete(lIndexNo);
+      // was this the current index?
+      if (FCurIndex = lIndexNo) then
+      begin
+        FCurIndex := -1;
+        //FCursor := FDbfCursor;
+      end;
+    end;
+  end;
+end;
+
+function TDbfFile.DeleteIndex(const AIndexName: string): Boolean;
+var
+  lIndexNo: Integer;
+  lIndex: TIndexFile;
+  lFileName: string;
+begin
+  // search index file
+  lIndexNo := FIndexNames.IndexOf(AIndexName);
+  Result := lIndexNo >= 0;
+  // found index?
+  if Result then
+  begin
+    // can only delete indexes from MDX files
+    lIndex := TIndexFile(FIndexNames.Objects[lIndexNo]);
+    if lIndex = FMdxFile then
+    begin
+      lIndex.DeleteIndex(AIndexName);
+      // remove it from the list
+      FIndexNames.Delete(lIndexNo);
+      // no more MDX indexes?
+      lIndexNo := FIndexNames.IndexOfObject(FMdxFile);
+      if lIndexNo = -1 then
+      begin
+        // no MDX indexes left
+        lIndexNo := FIndexFiles.IndexOf(FMdxFile);
+        if lIndexNo >= 0 then
+          FIndexFiles.Delete(lIndexNo);
+        lFileName := FMdxFile.FileName;
+        FreeAndNil(FMdxFile);
+        // erase file
+        Sysutils.DeleteFile(lFileName);
+        // clear mdx flag
+        PDbfHdr(Header).MDXFlag := 0;
+        WriteHeader;
+      end;
+    end else begin
+      // close index first
+      CloseIndex(AIndexName);
+      // delete file from disk
+      SysUtils.DeleteFile(AIndexName);
+    end;
+  end;
+end;
+
+procedure TDbfFile.Insert(Buffer: PChar);
+var
+  newRecord: Integer;
+  lIndex: TIndexFile;
+  error: Boolean;
+
+  procedure RollBackIndexesAndRaise(HighIndex: Integer; IndexError: Boolean);
+  var
+    errorMsg: string;
+    I: Integer;
+  begin
+    // rollback committed indexes
+    error := IndexError;
+    for I := 0 to HighIndex do
+    begin
+      lIndex := TIndexFile(FIndexFiles.Items[I]);
+      lIndex.Delete(newRecord, Buffer);
+      if lIndex.WriteError then
+      begin
+        lIndex.ResetError;
+        error := true;
+      end;
+    end;
+
+    // reset any dbf file error
+    ResetError;
+
+    // if part of indexes committed -> always index error msg
+    // if error while rolling back index -> index error msg
+    if error then
+      errorMsg := STRING_WRITE_INDEX_ERROR
+    else
+      errorMsg := STRING_WRITE_ERROR;
+    raise EDbfWriteError.Create(errorMsg);
+  end;
+
+var
+  I: Integer;
+begin
+  // get new record index
+  newRecord := RecordCount+1;
+  // lock record so we can write data
+  while not LockPage(newRecord, false) do
+    Inc(newRecord);
+  // write autoinc value
+  ApplyAutoIncToBuffer(Buffer);
+  // check indexes -> possible key violation
+  I := 0; error := false;
+  while (I < FIndexFiles.Count) and not error do
+  begin
+    lIndex := TIndexFile(FIndexFiles.Items[I]);
+    error := lIndex.CheckKeyViolation(Buffer);
+    Inc(I);
+  end;
+  // error occured while inserting? -> abort
+  if error then
+  begin
+    UnlockPage(newRecord);
+    lIndex.InsertError;
+    // don't have to exit -- unreachable code
+  end;
+
+  // no key violation, insert record into index(es)
+  for I := 0 to FIndexFiles.Count-1 do
+  begin
+    lIndex := TIndexFile(FIndexFiles.Items[I]);
+    lIndex.Insert(newRecord, Buffer);
+    if lIndex.WriteError then
+    begin
+      // if there's an index write error, I shouldn't
+      // try to write the dbf header and the new record,
+      // but raise an exception right away
+      RollBackIndexesAndRaise(I, True);
+    end;
+  end;
+
+  // indexes ok -> continue inserting
+  // update header record count
+  LockPage(0, true);
+  // read current header
+  ReadHeader;
+  // increase current record count
+  Inc(PDbfHdr(Header).RecordCount);
+  // write header to disk
+  WriteHeader;
+  // done with header
+  UnlockPage(0);
+
+  if WriteError then
+  begin
+    // couldn't write header, so I shouldn't
+    // even try to write the record.
+    //
+    // At this point I should "roll back"
+    // the already written index records.
+    // if this fails, I'm in deep trouble!
+    RollbackIndexesAndRaise(FIndexFiles.Count-1, False);
+  end;
+
+  // write locking info
+  if FHasLockField then
+    WriteLockInfo(Buffer);
+  // write buffer to disk
+  WriteRecord(newRecord, Buffer);
+  // done updating, unlock
+  UnlockPage(newRecord);
+  // error occurred while writing?
+  if WriteError then
+  begin
+    // -- Tobias --
+    // The record couldn't be written, so
+    // the written index records and the
+    // change to the header have to be
+    // rolled back
+    LockPage(0, true);
+    ReadHeader;
+    Dec(PDbfHdr(Header).RecordCount);
+    WriteHeader;
+    UnlockPage(0);
+    // roll back indexes too
+    RollbackIndexesAndRaise(FIndexFiles.Count-1, False);
+  end;
+end;
+
+procedure TDbfFile.WriteLockInfo(Buffer: PChar);
+//
+// *) assumes FHasLockField = true
+//
+var
+  year, month, day, hour, minute, sec, msec: Word;
+begin
+  // increase change count
+  Inc(PWord(Buffer+FLockFieldOffset)^);
+  // set time
+  DecodeDate(Now(), year, month, day);
+  DecodeTime(Now(), hour, minute, sec, msec);
+  Buffer[FLockFieldOffset+2] := Char(hour);
+  Buffer[FLockFieldOffset+3] := Char(minute);
+  Buffer[FLockFieldOffset+4] := Char(sec);
+  // set date
+  Buffer[FLockFieldOffset+5] := Char(year - 1900);
+  Buffer[FLockFieldOffset+6] := Char(month);
+  Buffer[FLockFieldOffset+7] := Char(day);
+  // set name
+  FillChar(Buffer[FLockFieldOffset+8], FLockFieldLen-8, ' ');
+  Move(DbfGlobals.UserName[1], Buffer[FLockFieldOffset+8], FLockUserLen);
+end;
+
+procedure TDbfFile.LockRecord(RecNo: Integer; Buffer: PChar);
+begin
+  if LockPage(RecNo, false) then
+  begin
+    // reread data
+    ReadRecord(RecNo, Buffer);
+    // store previous data for updating indexes
+    Move(Buffer^, FPrevBuffer^, RecordSize);
+    // lock succeeded, update lock info, if field present
+    if FHasLockField then
+    begin
+      // update buffer
+      WriteLockInfo(Buffer);
+      // write to disk
+      WriteRecord(RecNo, Buffer);
+    end;
+  end else
+    raise EDbfError.Create(STRING_RECORD_LOCKED);
+end;
+
+procedure TDbfFile.UnlockRecord(RecNo: Integer; Buffer: PChar);
+var
+  I: Integer;
+  lIndex: TIndexFile;
+begin
+  // update indexes, possible key violation
+  for I := 0 to FIndexFiles.Count - 1 do
+  begin
+    lIndex := TIndexFile(FIndexFiles.Items[I]);
+    lIndex.Update(RecNo, FPrevBuffer, Buffer);
+  end;
+  // write new record buffer, all keys ok
+  WriteRecord(RecNo, Buffer);
+  // done updating, unlock
+  UnlockPage(RecNo);
+end;
+
+procedure TDbfFile.RecordDeleted(RecNo: Integer; Buffer: PChar);
+var
+  I: Integer;
+  lIndex: TIndexFile;
+begin
+  // notify indexes: record deleted
+  for I := 0 to FIndexFiles.Count - 1 do
+  begin
+    lIndex := TIndexFile(FIndexFiles.Items[I]);
+    lIndex.RecordDeleted(RecNo, Buffer);
+  end;
+end;
+
+procedure TDbfFile.RecordRecalled(RecNo: Integer; Buffer: PChar);
+var
+  I: Integer;
+  lIndex: TIndexFile;
+begin
+  // notify indexes: record recalled
+  for I := 0 to FIndexFiles.Count - 1 do
+  begin
+    lIndex := TIndexFile(FIndexFiles.Items[I]);
+    lIndex.RecordRecalled(RecNo, Buffer);
+  end;
+end;
+
+procedure TDbfFile.SetRecordSize(NewSize: Integer);
+begin
+  if NewSize <> RecordSize then
+  begin
+    if FPrevBuffer <> nil then
+      FreeMemAndNil(Pointer(FPrevBuffer));
+
+    if NewSize > 0 then
+      GetMem(FPrevBuffer, NewSize);
+  end;
+  inherited;
+end;
+
+function TDbfFile.GetIndexByName(AIndexName: string): TIndexFile;
+var
+  I: Integer;
+begin
+  I := FIndexNames.IndexOf(AIndexName);
+  if I >= 0 then
+    Result := TIndexFile(FIndexNames.Objects[I])
+  else
+    Result := nil;
+end;
+
+//====================================================================
+// TDbfCursor
+//====================================================================
+constructor TDbfCursor.Create(DbfFile: TDbfFile);
+begin
+  inherited Create(DbfFile);
+end;
+
+function TDbfCursor.Next: Boolean;
+var
+  max: Integer;
+begin
+  max := TDbfFile(PagedFile).RecordCount;
+  if FPhysicalRecNo <= max then
+    inc(FPhysicalRecNo)
+  else
+    FPhysicalRecNo := max + 1;
+  Result := (FPhysicalRecNo <= max);
+end;
+
+function TDbfCursor.Prev: Boolean;
+begin
+  if FPhysicalRecNo > 0 then
+    dec(FPhysicalRecNo)
+  else
+    FPhysicalRecNo := 0;
+  Result := (FPhysicalRecNo > 0);
+end;
+
+procedure TDbfCursor.First;
+begin
+  FPhysicalRecNo := 0;
+end;
+
+procedure TDbfCursor.Last;
+var
+  max: Integer;
+begin
+  max := TDbfFile(PagedFile).RecordCount;
+  if max = 0 then
+    FPhysicalRecNo := 0
+  else
+    FPhysicalRecNo := max + 1;
+end;
+
+function TDbfCursor.GetPhysicalRecNo: Integer;
+begin
+  Result := FPhysicalRecNo;
+end;
+
+procedure TDbfCursor.SetPhysicalRecNo(RecNo: Integer);
+begin
+  FPhysicalRecNo := RecNo;
+end;
+
+function TDbfCursor.GetSequentialRecordCount: Integer;
+begin
+  Result := TDbfFile(PagedFile).RecordCount;
+end;
+
+function TDbfCursor.GetSequentialRecNo: Integer;
+begin
+  Result := FPhysicalRecNo;
+end;
+
+procedure TDbfCursor.SetSequentialRecNo(RecNo: Integer);
+begin
+  FPhysicalRecNo := RecNo;
+end;
+
+procedure TDbfCursor.GotoBookmark(Bookmark: rBookmarkData);
+begin
+  FPhysicalRecNo := Bookmark{.RecNo};
+end;
+
+procedure TDbfCursor.Insert(RecNo: Integer; Buffer: PChar); {override;}
+begin
+  FPhysicalRecNo := TDbfFile(PagedFile).RecordCount;
+end;
+
+procedure TDbfCursor.Update(RecNo: Integer; PrevBuffer,NewBuffer: PChar); {override;}
+begin
+end;
+
+// codepage enumeration procedure
+var
+  TempCodePageList: TList;
+
+// LPTSTR = PChar ok?
+
+function CodePagesProc(CodePageString: PChar): Cardinal; stdcall;
+begin
+  // add codepage to list
+  TempCodePageList.Add(Pointer(GetIntFromStrLength(CodePageString, StrLen(CodePageString), -1)));
+
+  // continue enumeration
+  Result := 1;
+end;
+
+function TDbfCursor.GetBookMark: rBookmarkData; {override;}
+begin
+//  Result.IndexBookmark := -1;
+  Result{.RecNo} := FPhysicalRecNo;
+end;
+
+//====================================================================
+// TDbfGlobals
+//====================================================================
+constructor TDbfGlobals.Create;
+begin
+  FCodePages := TList.Create;
+//  FDefaultOpenCodePage := GetOEMCP;
+  FDefaultOpenCodePage := GetACP;
+  FDefaultCreateCodePage := GetACP;
+  FDefaultCreateLocale := GetUserDefaultLCID;
+  FCurrencyAsBCD := true;
+//  FDefaultCreateFoxPro := false;
+  // determine which code pages are installed
+  TempCodePageList := FCodePages;
+  EnumSystemCodePages(@CodePagesProc, {CP_SUPPORTED} CP_INSTALLED);
+  TempCodePageList := nil;
+  InitUserName;
+end;
+
+procedure TDbfGlobals.InitUserName;
+{$ifdef FPC}
+var
+  TempName: UTSName;
+{$endif}
+begin
+{$ifdef WIN32}
+  FUserNameLen := MAX_COMPUTERNAME_LENGTH+1;
+  SetLength(FUserName, FUserNameLen);
+//  Windows.GetUserName(@FUserName[0], FUserNameLen);
+  Windows.GetComputerName(PChar(FUserName), FUserNameLen);
+  SetLength(FUserName, FUserNameLen);
+{$else}  
+{$ifdef FPC}
+  FpUname(TempName);
+  FUserName := TempName.machine;
+  FUserNameLen := Length(FUserName);
+{$endif}  
+{$endif}
+end;
+
+destructor TDbfGlobals.Destroy; {override;}
+begin
+  FCodePages.Free;
+end;
+
+function TDbfGlobals.CodePageInstalled(ACodePage: Integer): Boolean;
+begin
+  Result := FCodePages.IndexOf(Pointer(ACodePage)) >= 0;
+end;
+
+initialization
+finalization
+  FreeAndNil(DbfGlobals);
+
+
+(*
+  Stuffs non implemented yet
+  TFoxCDXHeader         = Record
+    PointerRootNode     : Integer;
+    PointerFreeList     : Integer;
+    Reserved_8_11       : Cardinal;
+    KeyLength           : Word;
+    IndexOption         : Byte;
+    IndexSignature      : Byte;
+    Reserved_Null       : TFoxReservedNull;
+    SortOrder           : Word;
+    TotalExpressionLen  : Word;
+    ForExpressionLen    : Word;
+    Reserved_506_507    : Word;
+    KeyExpressionLen    : Word;
+    KeyForExpression    : TKeyForExpression;
+  End;
+  PFoxCDXHeader         = ^TFoxCDXHeader;
+
+  TFoxCDXNodeCommon     = Record
+    NodeAttributes      : Word;
+    NumberOfKeys        : Word;
+    PointerLeftNode     : Integer;
+    PointerRightNode    : Integer;
+  End;
+
+  TFoxCDXNodeNonLeaf    = Record
+    NodeCommon          : TFoxCDXNodeCommon;
+    TempBlock           : Array [12..511] of Byte;
+  End;
+  PFoxCDXNodeNonLeaf    = ^TFoxCDXNodeNonLeaf;
+
+  TFoxCDXNodeLeaf       = Packed Record
+    NodeCommon          : TFoxCDXNodeCommon;
+    BlockFreeSpace      : Word;
+    RecordNumberMask    : Integer;
+    DuplicateCountMask  : Byte;
+    TrailByteCountMask  : Byte;
+    RecNoBytes          : Byte;
+    DuplicateCountBytes : Byte;
+    TrailByteCountBytes : Byte;
+    HoldingByteCount    : Byte;
+    DataBlock           : TDataBlock;
+  End;
+  PFoxCDXNodeLeaf       = ^TFoxCDXNodeLeaf;
+
+*)
+
+end.
+

fcl/db/dbase/Dbf_Fields.pas

@@ -0,0 +1,569 @@
+unit Dbf_Fields;
+
+{force CR/LF fix}
+
+interface
+
+{$I Dbf_Common.inc}
+
+uses
+  Classes,
+  SysUtils,
+  Db,
+  Dbf_Common,
+  Dbf_Str;
+
+type
+  PDbfFieldDef = ^TDbfFieldDef;
+
+  TDbfFieldDef = class(TCollectionItem)
+  private
+    FFieldName: string;
+    FFieldType: TFieldType;
+    FNativeFieldType: TDbfFieldType;
+    FDefaultBuf: PChar;
+    FMinBuf: PChar;
+    FMaxBuf: PChar;
+    FSize: Integer;
+    FPrecision: Integer;
+    FHasDefault: Boolean;
+    FHasMin: Boolean;
+    FHasMax: Boolean;
+    FAllocSize: Integer;
+    FValueOffset: Integer;
+    FCopyFrom: Integer;
+    FOffset: Integer;
+    FAutoInc: Cardinal;
+    FRequired: Boolean;
+    FIsLockField: Boolean;
+
+    function  GetDbfVersion: xBaseVersion;
+    procedure SetNativeFieldType(lFieldType: TDbfFieldType);
+    procedure SetFieldType(lFieldType: TFieldType);
+    procedure SetSize(lSize: Integer);
+    procedure SetPrecision(lPrecision: Integer);
+    procedure VCLToNative;
+    procedure NativeToVCL;
+    procedure FreeBuffers;
+  protected
+    function  GetDisplayName: string; override;
+    procedure AssignTo(Dest: TPersistent); override;
+
+    property DbfVersion: xBaseVersion read GetDbfVersion;
+  public
+    constructor Create(Collection: TCollection); override;
+    destructor Destroy; override;
+
+    procedure Assign(Source: TPersistent); override;
+    procedure AssignDb(DbSource: TFieldDef);
+
+    procedure CheckSizePrecision;
+    procedure CalcValueOffset;
+    procedure SetDefaultSize;
+    procedure AllocBuffers;
+    function  IsBlob: Boolean;
+
+    property DefaultBuf: PChar read FDefaultBuf;
+    property MinBuf: PChar read FMinBuf;
+    property MaxBuf: PChar read FMaxBuf;
+    property HasDefault: Boolean read FHasDefault write FHasDefault;
+    property HasMin: Boolean read FHasMin write FHasMin;
+    property HasMax: Boolean read FHasMax write FHasMax;
+    property ValueOffset: Integer read FValueOffset write FValueOffset;
+    property Offset: Integer read FOffset write FOffset;
+    property AutoInc: Cardinal read FAutoInc write FAutoInc;
+    property IsLockField: Boolean read FIsLockField write FIsLockField;
+    property CopyFrom: Integer read FCopyFrom write FCopyFrom;
+  published
+    property FieldName: string     read FFieldName write FFieldName;
+    property FieldType: TFieldType read FFieldType write SetFieldType;
+    property NativeFieldType: TDbfFieldType read FNativeFieldType write SetNativeFieldType;
+    property Size: Integer         read FSize      write SetSize;
+    property Precision: Integer    read FPrecision write SetPrecision;
+    property Required: Boolean     read FRequired  write FRequired;
+  end;
+
+  TDbfFieldDefs = class(TCollection)
+  private
+    FOwner: TPersistent;
+    FDbfVersion: xBaseVersion;
+    FUseFloatFields: Boolean;
+
+    function GetItem(Idx: Integer): TDbfFieldDef;
+  protected
+    function GetOwner: TPersistent; override;
+  public
+    constructor Create(Owner: TPersistent);
+
+{$ifdef SUPPORT_DEFAULT_PARAMS}
+    procedure Add(const Name: string; DataType: TFieldType; Size: Integer = 0; Required: Boolean = False);
+{$else}
+    procedure Add(const Name: string; DataType: TFieldType; Size: Integer; Required: Boolean);
+{$endif}
+    function AddFieldDef: TDbfFieldDef;
+
+    property Items[Idx: Integer]: TDbfFieldDef read GetItem;
+    property DbfVersion: xBaseVersion read FDbfVersion write FDbfVersion;
+    property UseFloatFields: Boolean read FUseFloatFields write FUseFloatFields;
+  end;
+
+implementation
+
+uses
+  Dbf_DbfFile;      // for dbf header structures
+
+{$I Dbf_Struct.inc}
+
+// I keep changing that fields...
+// Last time has been asked by Venelin Georgiev
+// Is he going to be the last ?
+const
+(*
+The theory until now was :
+    ftSmallint  16 bits = -32768 to 32767
+                          123456 = 6 digit max theorically
+                          DIGITS_SMALLINT = 6;
+    ftInteger  32 bits = -2147483648 to 2147483647
+                         12345678901 = 11 digits max
+                         DIGITS_INTEGER = 11;
+    ftLargeInt 64 bits = -9223372036854775808 to 9223372036854775807
+                         12345678901234567890 = 20 digits max
+                         DIGITS_LARGEINT = 20;
+
+But in fact if I accept 6 digits into a ftSmallInt then tDbf will not
+being able to handles fields with 999999 (6 digits).
+
+So I now oversize the field type in order to accept anithing coming from the
+database.
+    ftSmallint  16 bits = -32768 to 32767
+                           -999  to  9999
+                           4 digits max theorically
+                          DIGITS_SMALLINT = 4;
+    ftInteger  32 bits = -2147483648 to 2147483647
+                           -99999999 to  999999999                                        12345678901 = 11 digits max
+                         DIGITS_INTEGER = 9;
+    ftLargeInt 64 bits = -9223372036854775808 to 9223372036854775807
+                           -99999999999999999 to  999999999999999999
+                         DIGITS_LARGEINT = 18;
+ *)
+  DIGITS_SMALLINT = 4;
+  DIGITS_INTEGER = 9;
+  DIGITS_LARGEINT = 18;
+
+//====================================================================
+// DbfFieldDefs
+//====================================================================
+function TDbfFieldDefs.GetItem(Idx: Integer): TDbfFieldDef;
+begin
+  Result := TDbfFieldDef(inherited GetItem(Idx));
+end;
+
+constructor TDbfFieldDefs.Create(Owner: TPersistent);
+begin
+  inherited Create(TDbfFieldDef);
+  FOwner := Owner;
+end;
+
+function TDbfFieldDefs.AddFieldDef: TDbfFieldDef;
+begin
+  Result := TDbfFieldDef(inherited Add);
+end;
+
+function TDbfFieldDefs.GetOwner: TPersistent; {override;}
+begin
+  Result := FOwner;
+end;
+
+procedure TDbfFieldDefs.Add(const Name: string; DataType: TFieldType; Size: Integer; Required: Boolean);
+var
+  FieldDef: TDbfFieldDef;
+begin
+  FieldDef := AddFieldDef;
+  FieldDef.FieldName := Name;
+  FieldDef.FieldType := DataType;
+  FieldDef.Size := size;
+  FieldDef.Required := Required;
+end;
+
+//====================================================================
+// DbfFieldDef
+//====================================================================
+constructor TDbfFieldDef.Create(Collection: TCollection); {virtual}
+begin
+  inherited;
+
+  FDefaultBuf := nil;
+  FMinBuf := nil;
+  FMaxBuf := nil;
+  FAllocSize := 0;
+  FCopyFrom := -1;
+  FPrecision := 0;
+  FHasDefault := false;
+  FHasMin := false;
+  FHasMax := false;
+end;
+
+destructor TDbfFieldDef.Destroy; {override}
+begin
+  FreeBuffers;
+  inherited;
+end;
+
+procedure TDbfFieldDef.Assign(Source: TPersistent);
+var
+  DbfSource: TDbfFieldDef;
+begin
+  if Source is TDbfFieldDef then
+  begin
+    // copy from another TDbfFieldDef
+    DbfSource := TDbfFieldDef(Source);
+    FFieldName := DbfSource.FieldName;
+    FFieldType := DbfSource.FieldType;
+    FNativeFieldType := DbfSource.NativeFieldType;
+    FSize := DbfSource.Size;
+    FPrecision := DbfSource.Precision;
+    FRequired := DbfSource.Required;
+    FCopyFrom := DbfSource.Index;
+    FIsLockField := DbfSource.IsLockField;
+    // copy default,min,max
+    AllocBuffers;
+    if DbfSource.DefaultBuf <> nil then
+      Move(DbfSource.DefaultBuf^, FDefaultBuf^, FAllocSize*3);
+    FHasDefault := DbfSource.HasDefault;
+    FHasMin := DbfSource.HasMin;
+    FHasMax := DbfSource.HasMax;
+    // do we need offsets?
+    FValueOffset := DbfSource.ValueOffset;
+    FOffset := DbfSource.Offset;
+    FAutoInc := DbfSource.AutoInc;
+{$ifdef SUPPORT_FIELDDEF_TPERSISTENT}
+  end else if Source is TFieldDef then begin
+    AssignDb(TFieldDef(Source));
+{$endif}
+  end else
+    inherited Assign(Source);
+end;
+
+procedure TDbfFieldDef.AssignDb(DbSource: TFieldDef);
+begin
+  // copy from Db.TFieldDef
+  FFieldName := DbSource.Name;
+  FFieldType := DbSource.DataType;
+  FSize := DbSource.Size;
+  FPrecision := DbSource.Precision;
+  FRequired := DbSource.Required;
+{$ifdef SUPPORT_FIELDDEF_INDEX}
+  FCopyFrom := DbSource.Index;
+{$endif}
+  FIsLockField := false;
+  // convert VCL fieldtypes to native DBF fieldtypes
+  VCLToNative;
+  // for integer / float fields try fill in size/precision
+  SetDefaultSize;
+  // VCL does not have default value support
+  AllocBuffers;
+  FHasDefault := false;
+  FHasMin := false;
+  FHasMax := false;
+  FValueOffset := 0;
+  FOffset := 0;
+  FAutoInc := 0;
+end;
+
+procedure TDbfFieldDef.AssignTo(Dest: TPersistent);
+var
+  DbDest: TFieldDef;
+begin
+{$ifdef SUPPORT_FIELDDEF_TPERSISTENT}
+  // copy to VCL fielddef?
+  if Dest is TFieldDef then
+  begin
+    DbDest := TFieldDef(Dest);
+    // VCL TFieldDef does not know how to handle TDbfFieldDef!
+    // what a shame :-)
+{$ifdef SUPPORT_FIELDDEF_ATTRIBUTES}
+    DbDest.Attributes := [];
+    DbDest.ChildDefs.Clear;
+    DbDest.DataType := FFieldType;
+    DbDest.Required := FRequired;
+    DbDest.Size := FSize;
+    DbDest.Name := FFieldName;
+{$endif}
+  end else
+{$endif}
+    inherited AssignTo(Dest);
+end;
+
+procedure TDbfFieldDef.CalcValueOffset;
+begin
+  // autoinc?
+  if FNativeFieldType = '+' then
+    FValueOffset := SizeOf(rDbfHdr)+SizeOf(rAfterHdrVII) + (Index-1)*SizeOf(rFieldDescVII) + FieldDescVII_AutoIncOffset;
+end;
+
+function TDbfFieldDef.GetDbfVersion: xBaseVersion;
+begin
+  Result := TDbfFieldDefs(Collection).DbfVersion;
+end;
+
+procedure TDbfFieldDef.SetFieldType(lFieldType: tFieldType);
+begin
+  FFieldType := lFieldType;
+  VCLToNative;
+  CheckSizePrecision;
+end;
+
+procedure TDbfFieldDef.SetNativeFieldType(lFieldType: tDbfFieldType);
+begin
+  // get uppercase field type
+  if (lFieldType >= 'a') and (lFieldType <= 'z') then
+    lFieldType := Chr(Ord(lFieldType)-32);
+  FNativeFieldType := lFieldType;
+  NativeToVCL;
+  CheckSizePrecision;
+end;
+
+procedure TDbfFieldDef.SetSize(lSize: Integer);
+begin
+  FSize := lSize;
+  CheckSizePrecision;
+end;
+
+procedure TDbfFieldDef.SetPrecision(lPrecision: Integer);
+begin
+  FPrecision := lPrecision;
+  CheckSizePrecision;
+end;
+
+procedure TDbfFieldDef.NativeToVCL;
+begin
+  case FNativeFieldType of
+// OH 2000-11-15 dBase7 support.
+// Add the new fieldtypes
+    '+' : FFieldType := ftAutoInc;
+    'I' : FFieldType := ftInteger;
+    'O' : FFieldType := ftFloat;
+    '@', 'T':
+          FFieldType := ftDateTime;
+    'C',
+    #$91  {Russian 'C'}
+        : FFieldType := ftString;
+    'L' : FFieldType := ftBoolean;
+    'F', 'N':
+      begin
+        if (FPrecision = 0) then
+        begin
+          if FSize <= DIGITS_SMALLINT then
+            FFieldType := ftSmallInt
+          else
+          if TDbfFieldDefs(Collection).UseFloatFields then
+            FFieldType := ftFloat
+          else
+{$ifdef SUPPORT_INT64}
+          if FSize <= DIGITS_INTEGER then
+            FFieldType := ftInteger
+          else
+            FFieldType := ftLargeInt;
+{$else}
+            FFieldType := ftInteger;
+{$endif}
+        end else begin
+          FFieldType := ftFloat;
+        end;
+      end;
+    'D' : FFieldType := ftDate;
+    'M' : FFieldType := ftMemo;
+    'B' : FFieldType := ftBlob;
+    'G' : FFieldType := ftDBaseOle;
+    'Y' :
+      if DbfGlobals.CurrencyAsBCD then
+        FFieldType := ftBCD
+      else
+        FFieldType := ftCurrency;
+    '0' : FFieldType := ftBytes;	{ Visual FoxPro ``_NullFlags'' }
+  else
+    FNativeFieldType := #0;
+    FFieldType := ftUnknown;
+  end; //case
+end;
+
+procedure TDbfFieldDef.VCLToNative;
+begin
+  case FFieldType of
+    ftAutoInc  : FNativeFieldType  := '+';
+    ftDateTime :
+{$ifdef SUPPORT_INT64}
+      if DbfVersion = xBaseVII then
+        FNativeFieldType := '@'
+      else
+{$endif}
+        FNativeFieldType := 'T';
+{$ifdef SUPPORT_FIELDTYPES_V4}
+    ftFixedChar,
+    ftWideString,
+{$endif}
+    ftString   : FNativeFieldType  := 'C';
+    ftBoolean  : FNativeFieldType  := 'L';
+    ftFloat, ftSmallInt, ftWord
+{$ifdef SUPPORT_INT64}
+      , ftLargeInt
+{$endif}
+               : FNativeFieldType := 'N';
+    ftDate     : FNativeFieldType := 'D';
+    ftMemo     : FNativeFieldType := 'M';
+    ftBlob     : FNativeFieldType := 'B';
+    ftDBaseOle : FNativeFieldType := 'G';
+    ftInteger  :
+      if DbfVersion = xBaseVII then
+        FNativeFieldType := 'I'
+      else
+        FNativeFieldType := 'N';
+    ftBCD      : FNativeFieldType := 'Y';
+    ftCurrency : FNativeFieldType := 'Y';
+  else
+//    FFieldType := ftUnknown;
+    FNativeFieldType := #0;
+    raise EDbfError.CreateFmt(STRING_INVALID_VCL_FIELD_TYPE, [GetDisplayName, Ord(FFieldType)]);
+  end; // Case
+end;
+
+procedure TDbfFieldDef.SetDefaultSize;
+begin
+  case FFieldType of
+    ftFloat:
+      begin
+        FSize := 18;
+        FPrecision := 9;
+      end;
+    ftCurrency, ftBCD:
+      begin
+        FSize := 8;
+        FPrecision := 4;
+      end;
+    ftSmallInt, ftWord:
+      begin
+        FSize := DIGITS_SMALLINT;
+        FPrecision := 0;
+      end;
+    ftInteger:
+      begin
+        if DbfVersion = xBaseVII then
+          FSize := 4
+        else
+          FSize := DIGITS_INTEGER;
+        FPrecision := 0;
+      end;
+{$ifdef SUPPORT_INT64}
+    ftLargeInt:
+      begin
+        FSize := DIGITS_LARGEINT;
+        FPrecision := 0;
+      end;
+{$endif}
+    ftDate, ftDateTime:
+      begin
+        if FNativeFieldType = 'T' then
+          FSize := 14
+        else
+          FSize := 8;
+        FPrecision := 0;
+      end;
+  end; // case fieldtype
+end;
+
+procedure TDbfFieldDef.CheckSizePrecision;
+begin
+  case FNativeFieldType of
+    'C':
+      begin
+        if FSize < 0      then FSize := 0;
+        if FSize >= 65534 then FSize := 65534;
+        FPrecision := 0;
+      end;
+    'L':
+      begin
+        FSize := 1;
+        FPrecision := 0;
+      end;
+    'N','F':
+      begin
+        if FSize < 1       then FSize := 0;
+        if FSize >= 20     then FSize := 20;
+        if FPrecision > FSize-2 then FPrecision := FSize-2;
+        if FPrecision < 0       then FPrecision := 0;
+      end;
+    'D':
+      begin
+        FSize := 8;
+        FPrecision := 0;
+      end;
+    'M','G','B':
+      begin
+        FSize := 10;
+        FPrecision := 0;
+      end;
+    '+','I':
+      begin
+        FSize := 4;
+        FPrecision := 0;
+      end;
+    '@', 'O':
+      begin
+        FSize := 8;
+        FPrecision := 0;
+      end;
+    'T':
+      begin
+        FSize := 14;
+        FPrecision := 0;
+      end;
+    'Y':
+      begin
+        FSize := 8;
+        FPrecision := 4;
+      end;
+  else
+    // Nothing
+  end; // case
+end;
+
+function TDbfFieldDef.GetDisplayName: string; {override;}
+begin
+  Result := FieldName;
+end;
+
+function TDbfFieldDef.IsBlob: Boolean; {override;}
+begin
+  Result := FNativeFieldType in ['M','G','B'];
+end;
+
+procedure TDbfFieldDef.FreeBuffers;
+begin
+  if FDefaultBuf <> nil then
+  begin
+    // one buffer for all
+    FreeMemAndNil(Pointer(FDefaultBuf));
+    FMinBuf := nil;
+    FMaxBuf := nil;
+  end;
+  FAllocSize := 0;
+end;
+
+procedure TDbfFieldDef.AllocBuffers;
+begin
+  // size changed?
+  if FAllocSize <> FSize then
+  begin
+    // free old buffers
+    FreeBuffers;
+    // alloc new
+    GetMem(FDefaultBuf, FSize*3);
+    FMinBuf := FDefaultBuf + FSize;
+    FMaxBuf := FMinBuf + FSize;
+    // store allocated size
+    FAllocSize := FSize;
+  end;
+end;
+
+end.
+

fcl/db/dbase/Dbf_IdxCur.pas

@@ -0,0 +1,252 @@
+unit Dbf_IdxCur;
+
+{force CR/LF fix}
+
+interface
+
+{$I Dbf_Common.inc}
+
+uses
+  SysUtils,
+  Classes,
+  Db,
+  Dbf_Cursor,
+  Dbf_PgFile,
+  Dbf_IdxFile,
+  Dbf_PrsDef,
+  Dbf_Common;
+
+type
+
+//====================================================================
+//=== Index support
+//====================================================================
+  TIndexCursor = class(TVirtualCursor)
+  private
+    FIndexFile: TIndexFile;
+  protected
+    function  GetPhysicalRecNo: Integer; override;
+    function  GetSequentialRecNo: Integer; override;
+    function  GetSequentialRecordCount: Integer; override;
+    procedure SetPhysicalRecNo(RecNo: Integer); override;
+    procedure SetSequentialRecNo(RecNo: Integer); override;
+
+  public
+    constructor Create(DbfIndexFile: TIndexFile);
+    destructor Destroy; override;
+
+    function  Next: Boolean; override;
+    function  Prev: Boolean; override;
+    procedure First; override;
+    procedure Last; override;
+
+    procedure GotoBookmark(Bookmark: rBookmarkData); override;
+    function  GetBookMark: rBookmarkData; override;
+
+    procedure Insert(RecNo: Integer; Buffer: PChar); override;
+    procedure Update(RecNo: Integer; PrevBuffer, NewBuffer: PChar); override;
+
+{$ifdef SUPPORT_VARIANTS}
+    procedure VariantToBuffer(Key: Variant; ABuffer: PChar); { override; }
+{$endif}
+    function  CheckUserKey(Key: PChar; StringBuf: PChar): PChar; { override; }
+    function  SearchKey(Key: PChar; SearchType: TSearchKeyType): Boolean; { override; }
+    procedure CancelRange; { override; }
+    procedure SetBracketLow; { override;}
+    procedure SetBracketHigh; { override; }
+
+    property IndexFile: TIndexFile read FIndexFile;
+  end;
+
+//====================================================================
+//  TIndexCursor = class;
+//====================================================================
+  PIndexPosInfo = ^TIndexPage;
+
+//====================================================================
+implementation
+
+//==========================================================
+//============ TIndexCursor
+//==========================================================
+constructor TIndexCursor.Create(DbfIndexFile: TIndexFile);
+begin
+  inherited Create(DbfIndexFile);
+
+  FIndexFile := DbfIndexFile;
+end;
+
+destructor TIndexCursor.Destroy; {override;}
+begin
+  inherited Destroy;
+end;
+
+procedure TIndexCursor.Insert(RecNo: Integer; Buffer: PChar);
+begin
+  TIndexFile(PagedFile).Insert(RecNo,Buffer);
+  // TODO SET RecNo and Key
+end;
+
+procedure TIndexCursor.Update(RecNo: Integer; PrevBuffer, NewBuffer: PChar);
+begin
+  TIndexFile(PagedFile).Update(RecNo, PrevBuffer, NewBuffer);
+end;
+
+procedure TIndexCursor.First;
+begin
+  TIndexFile(PagedFile).First;
+end;
+
+procedure TIndexCursor.Last;
+begin
+  TIndexFile(PagedFile).Last;
+end;
+
+function TIndexCursor.Prev: Boolean;
+begin
+  Result := TIndexFile(PagedFile).Prev;
+end;
+
+function TIndexCursor.Next: Boolean;
+begin
+  Result := TIndexFile(PagedFile).Next;
+end;
+
+function TIndexCursor.GetPhysicalRecNo: Integer;
+begin
+  Result := TIndexFile(PagedFile).PhysicalRecNo;
+end;
+
+procedure TIndexCursor.SetPhysicalRecNo(RecNo: Integer);
+begin
+  TIndexFile(PagedFile).PhysicalRecNo := RecNo;
+end;
+
+function TIndexCursor.GetSequentialRecordCount: Integer;
+begin
+  Result := TIndexFile(PagedFile).SequentialRecordCount;
+end;
+
+function TIndexCursor.GetSequentialRecNo: Integer;
+begin
+  Result := TIndexFile(PagedFile).SequentialRecNo;
+end;
+
+procedure TIndexCursor.SetSequentialRecNo(RecNo: Integer);
+begin
+  TIndexFile(PagedFile).SequentialRecNo := RecNo;
+end;
+
+procedure TIndexCursor.GotoBookmark(Bookmark: rBookmarkData);
+begin
+  TIndexFile(PagedFile).GotoBookMark(Bookmark);
+end;
+
+function TIndexCursor.GetBookMark: rBookmarkData;
+begin
+  Result := TIndexFile(PagedFile).GetBookmark;
+end;
+
+procedure TIndexCursor.SetBracketLow;
+begin
+  TIndexFile(PagedFile).SetBracketLow;
+end;
+
+procedure TIndexCursor.SetBracketHigh;
+begin
+  TIndexFile(PagedFile).SetBracketHigh;
+end;
+
+procedure TIndexCursor.CancelRange;
+begin
+  TIndexFile(PagedFile).CancelRange;
+end;
+
+{$ifdef SUPPORT_VARIANTS}
+
+procedure TIndexCursor.VariantToBuffer(Key: Variant; ABuffer: PChar);
+// assumes ABuffer is large enough ie. at least max key size
+var
+  currLen: Integer;
+begin
+  if (TIndexFile(PagedFile).KeyType='N') then
+  begin
+    PDouble(ABuffer)^ := Key;
+    if (TIndexFile(PagedFile).IndexVersion <> xBaseIII) then
+    begin
+      // make copy of userbcd to buffer
+      Move(TIndexFile(PagedFile).PrepareKey(ABuffer, etFloat)[0], ABuffer[0], 11);
+    end
+  end else begin
+    StrPLCopy(ABuffer, Key, TIndexFile(PagedFile).KeyLen);
+    // we have null-terminated string, pad with spaces if string too short
+    currLen := StrLen(ABuffer);
+    FillChar(ABuffer[currLen], TIndexFile(PagedFile).KeyLen-currLen, ' ');
+  end;
+end;
+
+{$endif}
+
+function TIndexCursor.CheckUserKey(Key: PChar; StringBuf: PChar): PChar;
+var
+  keyLen, userLen: Integer;
+begin
+  // default is to use key
+  Result := Key;
+  // if key is double, then no check
+  if (TIndexFile(PagedFile).KeyType = 'N') then
+  begin
+    // nothing needs to be done
+  end else begin
+    // check if string long enough then no copying needed
+    userLen := StrLen(Key);
+    keyLen := TIndexFile(PagedFile).KeyLen;
+    if userLen < keyLen then
+    begin
+      // copy string
+      Move(Key^, StringBuf[0], userLen);
+      // add spaces to searchstring
+      FillChar(StringBuf[userLen], keyLen - userLen, ' ');
+      // set buffer to temporary buffer
+      Result := StringBuf;
+    end;
+  end;
+end;
+
+function TIndexCursor.SearchKey(Key: PChar; SearchType: TSearchKeyType): Boolean;
+var
+  findres, currRecNo: Integer;
+begin
+  // save current position
+  currRecNo := TIndexFile(PagedFile).SequentialRecNo;
+  // search, these are always from the root: no need for first
+  findres := TIndexFile(PagedFile).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 := TIndexFile(PagedFile).Next;
+          until not Result or (TIndexFile(PagedFile).MatchKey <> 0);
+        end else
+          Result := findres < 0;
+      end;
+    else
+      Result := false;
+  end;
+  // search failed -> restore previous position
+  if not Result then
+    TIndexFile(PagedFile).SequentialRecNo := currRecNo;
+end;
+
+end.
+

fcl/db/dbase/Dbf_IdxFile.pas

@@ -0,0 +1,3955 @@
+unit Dbf_IdxFile;
+
+interface
+
+{$I Dbf_Common.inc}
+
+uses
+{$ifdef WIN32}
+  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_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;
+  TDbfCompareKeyEvent = function(Key: PChar): Integer 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(Collection: 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;
+
+//===========================================================================
+  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;
+    FHighBracket: Integer;              //  = FHighIndex if FPageNo = FHighPage
+    FHighIndex: Integer;
+    FHighPage: 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; key: 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 DisableRange;
+
+    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;
+    FParsers: array[0..MaxIndexes-1] of TDbfParser;
+    FIndexHeaders: array[0..MaxIndexes-1] of Pointer;
+    FHeaderModified: array[0..MaxIndexes-1] of Boolean;
+    FIndexHeader: Pointer;
+    FIndexVersion: xBaseVersion;
+    FRoots: array[0..MaxIndexes-1] of TIndexPage;
+    FLeaves: array[0..MaxIndexes-1] of TIndexPage;
+    FCurrentParser: TDbfParser;
+    FRoot: TIndexPage;
+    FLeaf: TIndexPage;
+    FMdxTag: TIndexTag;
+    FTempMdxTag: TIndexTag;
+    FEntryHeaderSize: Integer;
+    FPageHeaderSize: Integer;
+    FTagSize: Integer;
+    FTagOffset: Integer;
+    FHeaderPageNo: Integer;
+    FSelectedIndex: Integer;
+    FIsDescending: Boolean;
+    FUniqueMode: TIndexUniqueType;
+    FModifyMode: TIndexModifyMode;
+    FHeaderLocked: Integer;   // used to remember which header page we have locked
+    FKeyBuffer: array[0..100] of Char;
+    FEntryBof: Pointer;
+    FEntryEof: Pointer;
+    FDbfFile: Pointer;
+    FCanEdit: Boolean;
+    FOpened: 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;
+    FLocaleID: LCID;
+    FLocaleCP: Integer;
+    FCodePage: Integer;
+    FCompareKey: TDbfCompareKeyEvent;
+    FCompareKeys: TDbfCompareKeysEvent;
+    FOnLocaleError: TDbfLocaleErrorEvent;
+
+    function  GetNewPageNo: Integer;
+    procedure TouchHeader(AHeader: Pointer);
+    function  CreateTempMemFile(BaseName: string): TPagedFile;
+    procedure WriteIndexHeader(AIndex: Integer);
+    procedure SelectIndexVars(AIndex: Integer);
+    procedure CalcKeyProperties;
+    procedure UpdateIndexProperties;
+    procedure ClearRoots;
+    function  CalcTagOffset(AIndex: Integer): Pointer;
+
+    function  FindKey(const Insert: Boolean): Integer;
+    procedure InsertKey(Buffer: PChar);
+    procedure DeleteKey(Buffer: PChar);
+    procedure InsertCurrent;
+    procedure DeleteCurrent;
+    procedure UpdateCurrent(PrevBuffer, NewBuffer: PChar);
+    procedure ReadIndexes;
+    procedure ResyncRoot;
+    procedure ResyncTree;
+
+    procedure TranslateToANSI(Src, Dest: PChar);
+    function  CompareKeyNumericNDX(Key: PChar): Integer;
+    function  CompareKeyNumericMDX(Key: PChar): Integer;
+    function  CompareKeyString(Key: PChar): Integer;
+    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);
+    procedure SetLocaleID(const NewID: LCID);
+
+    property InternalLocaleID: LCID read FLocaleID write SetLocaleID;
+
+  public
+    constructor Create(ADbfFile: Pointer; AFileName: string);
+    destructor Destroy; override;
+
+    procedure Open;
+    procedure Close;
+
+    procedure Clear;
+    procedure Flush; override;
+    procedure ClearIndex;
+    procedure AddNewLevel;
+    procedure UnlockHeader;
+    procedure InsertError;
+    procedure Insert(RecNo: Integer; Buffer: PChar);
+    procedure Update(RecNo: Integer; PrevBuffer, NewBuffer: PChar);
+    procedure Delete(RecNo: Integer; Buffer: PChar);
+    function  CheckKeyViolation(Buffer: PChar): Boolean;
+    procedure RecordDeleted(RecNo: Integer; Buffer: PChar);
+    procedure RecordRecalled(RecNo: Integer; Buffer: PChar);
+    procedure DeleteIndex(const AIndexName: string);
+    procedure RepageFile;
+    procedure CompactFile;
+
+    procedure CreateIndex(FieldDesc, TagName: string; Options: TIndexOptions);
+    function  ExtractKeyFromBuffer(Buffer: PChar): PChar;
+    function  Find(RecNo: Integer; Buffer: PChar): Integer;
+    function  IndexOf(const AIndexName: string): Integer;
+
+    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;
+
+    function  GetBookMark: rBookmarkData;
+    function  GotoBookmark(IndexBookmark: rBookmarkData): Boolean;
+
+    procedure SetBracketLow;
+    procedure SetBracketHigh;
+    procedure CancelRange;
+    function  MatchKey: Integer;
+    function  CompareKey(Key: PChar): Integer;
+    function  CompareKeys(Key1, Key2: PChar): Integer;
+    function  PrepareKey(Buffer: PChar; ResultType: TExpressionType): PChar;
+
+    property KeyLen: Integer read GetKeyLen;
+    property IndexVersion: xBaseVersion 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 LocaleID: LCID read FLocaleID;
+    property CodePage: Integer read FCodePage write FCodePage;
+
+    property OnLocaleError: TDbfLocaleErrorEvent read FOnLocaleError write FOnLocaleError;
+  end;
+
+//------------------------------------------------------------------------------
+implementation
+
+uses
+  Dbf_DbfFile,
+  Dbf_Fields,
+  Dbf_Str,
+  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;
+
+//==========================================================
+// 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, numEntries, numKeysAvail: Integer;
+begin
+  // lock page if needed; wait if not available, anyone else updating?
+  LockPage;
+  // check assertions
+  numEntries := GetNumEntries;
+  // if this is inner node, we can only store one less than max entries
+  numKeysAvail := PIndexHdr(FIndexFile.IndexHeader).NumKeys - numEntries;
+  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 := (numEntries - EntryNo) * 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;
+  // numEntries 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, numEntries: Integer;
+begin
+  // get num entries
+  numEntries := 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) * 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(numEntries);
+  dec(FHighIndex);
+  SetNumEntries(numEntries);
+  // zero last one out to not get confused about internal or leaf pages
+  // note: need to decrease numEntries 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
+  recNo, low, high: 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
+    FEntryNo := (low + high) div 2;
+    FEntry := GetEntry(FEntryNo);
+    // 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 := FEntryNo
+    else
+      low := FEntryNo+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
+  recNo := high;
+  if FEntryNo <> recNo then
+  begin
+    FEntryNo := recNo;
+    FEntry := GetEntry(recNo);
+  end;
+  // 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
+    // FLowerPage = nil -> can inspect high
+    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;
+        // get recno of current item
+        recNo := GetRecNo;
+        // test if out of range or found
+        if (Result <> 0) or (recNo = ARecNo) then
+          high := FEntryNo
+        else begin
+          // default to EOF
+          inc(FEntryNo);
+          Result := 1;
+        end;
+      end;
+      // if not found, get EOF entry
+      if (Result <> 0) then
+      begin
+        // Entry(FEntryNo) <> Entry
+        // bypass SetEntryNo check
+        FEntryNo := -1;
+        EntryNo := high;
+      end;
+    end;
+  end else begin
+    // FLowerPage <> nil -> high contains entry, can not have empty range
+    Result := 0;
+    // sync lower page
+    SyncLowerPage;
+  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; Key: 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, Key, FPageNo);
+{  if PIndexHdr(FIndexFile.IndexHeader).KeyType = 'C' then  }
+    if Key <> nil then
+      Move(Key^, keyData^, PIndexHdr(FIndexFile.IndexHeader).KeyLen)
+    else
+      PChar(keyData)^ := #0;
+{
+  else
+    if Key <> nil then
+      PDouble(keyData)^ := PDouble(Key)^
+    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, numEntries, 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
+  numEntries := GetNumEntries;
+
+  // calc split pos: split in half
+  splitRight := numEntries div 2;
+  if (FLowerPage <> nil) and (numEntries mod 2 = 1) then
+    inc(splitRight);
+  numEntriesNew := numEntries - 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 * 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
+    numEntries := numEntries - 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(numEntries);
+    end;
+    // store new number of nodes
+    // new page is right page, so update parent to point to new right page
+    NewPage.SetNumEntries(numEntriesNew);
+    SetNumEntries(numEntries);
+    // update highindex
+    FHighIndex := numEntries;
+    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 * 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;
+
+procedure TIndexPage.DisableRange;
+begin
+  // update low / high index range
+  FLowIndex := 0;
+  FHighIndex := GetNumEntries;
+  if FLowerPage = nil then
+    dec(FHighIndex);
+end;
+
+function TMdxPage.GetIsInnerNode: Boolean;
+begin
+  Result := PMdxPage(FPageBuffer).NumEntries < 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;
+
+//==============================================================================
+//============ Mdx specific access routines
+//==============================================================================
+
+function TMdxPage.GetEntry(AEntryNo: Integer): Pointer;
+begin
+  // get base + offset
+  Result := PChar(@PMdxPage(PageBuffer).FirstEntry) + (PIndexHdr(IndexFile.IndexHeader).KeyRecLen * AEntryNo);
+end;
+
+function TMdxPage.GetLowerPageNo: Integer;
+  // *) assumes LowerPage <> nil
+begin
+//  if LowerPage = nil then
+//    Result := 0
+//  else
+    Result := PMdxEntry(Entry).RecBlockNo;
+end;
+
+function TMdxPage.GetKeyData: PChar;
+begin
+  Result := @PMdxEntry(Entry).KeyData;
+end;
+
+function TMdxPage.GetNumEntries: Integer;
+begin
+  Result := PMdxPage(PageBuffer).NumEntries;
+end;
+
+function TMdxPage.GetKeyDataFromEntry(AEntry: Integer): PChar;
+begin
+  Result := @PMdxEntry(GetEntry(AEntry)).KeyData;
+end;
+
+function TMdxPage.GetRecNo: Integer;
+begin
+  Result := PMdxEntry(Entry).RecBlockNo;
+end;
+
+procedure TMdxPage.SetNumEntries(NewNum: Integer);
+begin
+  PMdxPage(PageBuffer).NumEntries := NewNum;
+end;
+
+procedure TMdxPage.IncNumEntries;
+begin
+  Inc(PMdxPage(PageBuffer).NumEntries);
+end;
+
+procedure TMdxPage.SetRecLowerPageNo(NewRecNo, NewPageNo: Integer);
+begin
+  if FLowerPage = nil then
+    PMdxEntry(Entry).RecBlockNo := NewRecNo
+  else
+    PMdxEntry(Entry).RecBlockNo := NewPageNo;
+end;
+
+procedure TMdxPage.SetRecLowerPageNoOfEntry(AEntry, NewRecNo, NewPageNo: Integer);
+begin
+  if FLowerPage = nil then
+    PMdxEntry(GetEntry(AEntry)).RecBlockNo := NewRecNo
+  else
+    PMdxEntry(GetEntry(AEntry)).RecBlockNo := NewPageNo;
+end;
+
+{$ifdef TDBF_UPDATE_FIRST_LAST_NODE}
+
+procedure TMdxPage.SetPrevBlock(NewBlock: Integer);
+begin
+  PMdxPage(PageBuffer).PrevBlock := NewBlock;
+end;
+
+{$endif}
+
+//==============================================================================
+//============ Ndx specific access routines
+//==============================================================================
+
+function TNdxPage.GetEntry(AEntryNo: Integer): Pointer;
+begin
+  // get base + offset
+  Result := PChar(@PNdxPage(PageBuffer).FirstEntry) + (PIndexHdr(FIndexFile.IndexHeader).KeyRecLen * AEntryNo);
+end;
+
+function TNdxPage.GetLowerPageNo: Integer;
+  // *) assumes LowerPage <> nil
+begin
+//  if LowerPage = nil then
+//    Result := 0
+//  else
+    Result := PNdxEntry(Entry).LowerPageNo
+end;
+
+function TNdxPage.GetRecNo: Integer;
+begin
+  Result := 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 := PNdxPage(PageBuffer).NumEntries;
+end;
+
+procedure TNdxPage.IncNumEntries;
+begin
+  Inc(PNdxPage(PageBuffer).NumEntries);
+end;
+
+procedure TNdxPage.SetNumEntries(NewNum: Integer);
+begin
+  PNdxPage(PageBuffer).NumEntries := NewNum;
+end;
+
+procedure TNdxPage.SetRecLowerPageNo(NewRecNo, NewPageNo: Integer);
+begin
+  PNdxEntry(Entry).RecNo := NewRecNo;
+  PNdxEntry(Entry).LowerPageNo := NewPageNo;
+end;
+
+procedure TNdxPage.SetRecLowerPageNoOfEntry(AEntry, NewRecNo, NewPageNo: Integer);
+begin
+  PNdxEntry(GetEntry(AEntry)).RecNo := NewRecNo;
+  PNdxEntry(GetEntry(AEntry)).LowerPageNo := NewPageNo;
+end;
+
+//==============================================================================
+//============ MDX version 4 header access routines
+//==============================================================================
+
+function TMdx4Tag.GetHeaderPageNo: Integer;
+begin
+  Result := 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
+  PMdx4Tag(Tag).HeaderPageNo := 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 := 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
+  PMdx7Tag(Tag).HeaderPageNo := 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;
+
+//==============================================================================
+//============ TIndexFile
+//==============================================================================
+constructor TIndexFile.Create(ADbfFile: Pointer; AFileName: string);
+var
+  I: Integer;
+begin
+  inherited Create(AFileName);
+
+  // clear variables
+  FOpened := false;
+  FUpdateMode := umCurrent;
+  FModifyMode := mmNormal;
+  FTempMode := TDbfFile(ADbfFile).TempMode;
+  SelectIndexVars(-1);
+  for I := 0 to MaxIndexes - 1 do
+  begin
+    FParsers[I] := nil;
+    FRoots[I] := nil;
+    FLeaves[I] := nil;
+    FHeaderModified[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] := TDbfParser.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
+      InternalLocaleID := LCID(lcidBinary);
+    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
+            InternalLocaleID := lcidBinary
+          else
+            InternalLocaleID := LangId_To_Locale[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
+            InternalLocaleID := LangId_To_Locale[DbfLangId]
+          else
+            localeError := leTableIndexMismatch;
+        end;
+        // don't overwrite previous error
+        if (FLocaleID = DbfLocale_NotFound) and (localeError = leNone) then
+          localeError := leUnknown;
+      end else begin
+        // dbase III always binary?
+        InternalLocaleID := lcidBinary;
+      end;
+      // check if selected locale is available, binary is always available...
+      if (localeError <> leNone) and (FLocaleID <> LCID(lcidBinary)) then
+      begin
+        if LCIDList.IndexOf(Pointer(FLocaleID)) < 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
+          // `trust' user knows correct locale
+          InternalLocaleID := LCID(localeSolution);
+        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;
+    FHeaderModified[I] := false;
+  end;
+  // reselect previously selected index
+  SelectIndexVars(prevIndex);
+  // deselect index
+end;
+
+procedure TIndexFile.Clear;
+var
+  year, month, day: Word;
+  HdrFileName, HdrFileExt: string;
+  pos, prevSelIndex: 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);
+    PMdxHdr(Header).MdxVersion := 2;
+    PMdxHdr(Header).Year := year - 1900;
+    PMdxHdr(Header).Month := month;
+    PMdxHdr(Header).Day := day;
+    HdrFileName := ExtractFileName(FileName);
+    HdrFileExt := ExtractFileExt(HdrFileName);
+    if Length(HdrFileExt) > 0 then
+    begin
+      pos := System.Pos(HdrFileExt, HdrFileName);
+      if pos > 0 then
+        SetLength(HdrFileName, pos - 1);
+    end;
+    if Length(HdrFileName) > 15 then
+      SetLength(HdrFileName, 15);
+    StrPCopy(PMdxHdr(Header).FileName, HdrFileName);
+    PMdxHdr(Header).BlockSize := 2;
+    PMdxHdr(Header).BlockAdder := 1024;
+    PMdxHdr(Header).ProdFlag := 1;
+    PMdxHdr(Header).NumTags := 48;
+    PMdxHdr(Header).TagSize := 32;
+//    PMdxHdr(Header).TagsUsed := 0;
+    PMdxHdr(Header).Dummy2 := 0;
+    PMdxHdr(Header).Language := GetDbfLanguageID;
+    PMdxHdr(Header).NumPages := HeaderSize div PageSize;    // = 4
+    TouchHeader(Header);
+    PMdxHdr(Header).TagFlag := 1;
+    // use locale id of parent
+    DbfLangId := GetDbfLanguageId;
+    if DbfLangId = 0 then
+      InternalLocaleID := lcidBinary
+    else
+      InternalLocaleID := LangID_To_Locale[DbfLangId];
+    WriteFileHeader;
+    // write index headers
+    prevSelIndex := FSelectedIndex;
+    for pos := 0 to PMdxHdr(Header).TagsUsed - 1 do
+    begin
+      SelectIndexVars(pos);
+      FMdxTag.HeaderPageNo := GetNewPageNo;
+      WriteRecord(FMdxTag.HeaderPageNo, FIndexHeader);
+    end;
+    // reselect previously selected index
+    SelectIndexVars(prevSelIndex);
+    // clear roots
+    ClearRoots;
+    // init vars
+    FTagSize := 32;
+    FTagOffset := 544;
+    // clear entries
+    RecordCount := PMdxHdr(Header).NumPages;
+  end else begin
+    // clear single index entry
+    ClearIndex;
+    RecordCount := 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 := HeaderSize div PageSize;
+  // clear memory of root
+  FRoot.Clear;
+  // get new page for root
+  FRoot.GetNewPage;
+  // store new root page
+  PIndexHdr(FIndexHeader).RootPage := FRoot.PageNo;
+{$ifdef TDBF_UPDATE_FIRSTLAST_NODE}
+  PIndexHdr(FIndexHeader).FirstNode := 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
+var
+  remainder: Integer;
+begin
+  // now adjust keylen to align on DWORD boundaries
+  PIndexHdr(FIndexHeader).KeyRecLen := PIndexHdr(FIndexHeader).KeyLen + FEntryHeaderSize;
+  remainder := (PIndexHdr(FIndexHeader).KeyRecLen) mod 4;
+  if (remainder > 0) then
+    PIndexHdr(FIndexHeader).KeyRecLen := PIndexHdr(FIndexHeader).KeyRecLen + 4 - remainder;
+  PIndexHdr(FIndexHeader).NumKeys := (RecordSize - FPageHeaderSize) div 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: TDbfParser;
+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 := TDbfParser.Create(FDbfFile);
+  try
+    TempParser.ParseExpression(FieldDesc);
+    // check if result type is correct
+    case TempParser.ResultType of
+      etString: fieldType := 'C';
+      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 := 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] := TDbfParser.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
+    inc(PMdxHdr(Header).TagsUsed);
+    // 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 := FCurrentParser.ResultLen
+  else if FIndexVersion >= xBaseIV then
+    PIndexHdr(FIndexHeader).KeyLen := 12
+  else
+    PIndexHdr(FIndexHeader).KeyLen := 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 := $5800;   // NDX -> same ???
+  case fieldType of
+    'C':
+      PIndexHdr(FIndexHeader).sKeyType := 0;
+    'D':
+      PIndexHdr(FIndexHeader).sKeyType := 1;
+    'N', 'F':
+      if FIndexVersion >= xBaseIV then
+        PIndexHdr(FIndexHeader).sKeyType := 0
+      else
+        PIndexHdr(FIndexHeader).sKeyType := 1;
+  else
+    PIndexHdr(FIndexHeader).sKeyType := 0;
+  end;
+
+  PIndexHdr(FIndexHeader).Version := 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[PIndexHdr(FIndexHeader).KeyLen] := #0;
+end;
+
+procedure TIndexFile.ReadIndexes;
+var
+  I: Integer;
+
+  procedure CheckHeaderIntegrity;
+  begin
+    if PIndexHdr(FIndexHeader).NumKeys * 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 PIndexHdr(FIndexHeader).KeyLen > 100 then
+        PIndexHdr(FIndexHeader).KeyLen := 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?
+    FTagSize := PMdxHdr(Header).TagSize;
+    FTagOffset := 544 + FTagSize - 32;
+    for I := 0 to 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] := TDbfParser.Create(FDbfFile);
+        FRoots[I] := TMdxPage.Create(Self);
+      end;
+      // check header integrity
+      CheckHeaderIntegrity;
+      // read tree
+      FRoots[I].PageNo := 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 := 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: TDbfParser;
+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 := 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];
+          FHeaderModified[found + I] := true;
+        end;
+        FIndexHeaders[found + moveItems] := tempHeader;
+        FParsers[found + moveItems] := tempParser;
+        FRoots[found + moveItems] := tempRoot;
+        FLeaves[found + moveItems] := tempLeaf;
+        FHeaderModified[found + moveItems] := false;    // non-existant header
+      end;
+      // one entry less left
+      dec(PMdxHdr(Header).TagsUsed);
+      // ---*** 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.CreateTempMemFile(BaseName: string): TPagedFile;
+var
+  lModifier: Integer;
+begin
+  // create temporary in-memory index file
+  lModifier := 0;
+  FindNextName(BaseName, BaseName, lModifier);
+  Result := TPagedFile.Create(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  GetNewPageNo: Integer;
+  begin
+    Result := newPageNo;
+    Inc(newPageNo, PagesPerRecord);
+    if FIndexVersion >= xBaseIV then
+      Inc(PMdxHdr(TempFile.Header).NumPages, PagesPerRecord);
+    Inc(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 := GetNewPageNo;
+    // 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 := Result;
+{$ifdef TDBF_UPDATE_FIRSTLAST_NODE}
+        // write previous node
+        if FRoot = NewPage then
+          PMdxPage(NewPage.PageBuffer).PrevBlock := 0
+        else
+          PMdxPage(NewPage.PageBuffer).PrevBlock := Result - PagesPerRecord;
+{$endif}
+      end else begin
+        PNdxEntry(NewPage.UpperPage.Entry).LowerPageNo := 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 := GetNewPageNo;
+    // use recursive function to write all pages
+    TempIdxHeader.RootPage := 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 := CreateTempMemFile(FileName);
+  if FIndexVersion >= xBaseIV then
+  begin
+    // copy header
+    Move(Header^, TempFile.Header^, HeaderSize);
+    TouchHeader(TempFile.Header);
+    // reset header
+    PMdxHdr(TempFile.Header).NumPages := HeaderSize div PageSize;
+    TempFile.WriteHeader;
+    GetMem(TempIdxHeader, RecordSize);
+    // now recreate indexes to that file
+    for I := 0 to 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  GetNewPageNo: Integer;
+  begin
+    Result := newPageNo;
+    Inc(newPageNo, PagesPerRecord);
+    if FIndexVersion >= xBaseIV then
+      Inc(PMdxHdr(TempFile.Header).NumPages, PagesPerRecord);
+    Inc(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 := GetNewPageNo;
+
+    // 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 >= 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 := GetNewPageNo;
+      // 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 := PagesPerRecord;
+    // allocate a page no for header
+    hdrPageNo := GetNewPageNo;
+
+    // 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 := APage.PageNo;
+{$ifdef TDBF_UPDATE_FIRSTLAST_NODE}
+    TempIdxHeader.FirstNode := 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 := CreateTempMemFile(FileName);
+  if FIndexVersion >= xBaseIV then
+  begin
+    // copy header
+    Move(Header^, TempFile.Header^, HeaderSize);
+    TouchHeader(TempFile.Header);
+    // reset header
+    PMdxHdr(TempFile.Header).NumPages := HeaderSize div PageSize;
+    TempFile.WriteHeader;
+    GetMem(TempIdxHeader, RecordSize);
+    // now recreate indexes to that file
+    for I := 0 to 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;
+
+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 := PMdxHdr(Header).NumPages;
+    PMdxHdr(Header).NumPages := PMdxHdr(Header).NumPages + PagesPerRecord;
+{$ifdef TDBF_UPDATE_FIRSTLAST_NODE}
+    // adjust high page
+    PIndexHdr(FIndexHeader).LastNode := Result;
+{$endif}
+    WriteFileHeader;
+  end else begin
+    Result := PIndexHdr(FIndexHeader).NumPages;
+  end;
+  PIndexHdr(FIndexHeader).NumPages := PIndexHdr(FIndexHeader).NumPages + PagesPerRecord;
+  WriteHeader;
+  // done updating header -> unlock if locked
+  if needLockHeader then
+    UnlockPage(0);
+end;
+
+procedure TIndexFile.Insert(RecNo: Integer; Buffer: PChar); {override;}
+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 PMdxHdr(Header).TagsUsed - 1 do
+    begin
+      SelectIndexVars(I);
+      InsertKey(Buffer);
+    end;
+    // restore previous selected index
+    SelectIndexVars(curSel);
+  end else begin
+    InsertKey(Buffer);
+  end;
+end;
+
+function TIndexFile.CheckKeyViolation(Buffer: PChar): Boolean;
+var
+  I, curSel: Integer;
+begin
+  Result := false;
+  FUserRecNo := -2;
+  if FIndexVersion = xBaseIV then
+  begin
+    curSel := FSelectedIndex;
+    I := 0;
+    while (I < PMdxHdr(Header).TagsUsed) and not Result do
+    begin
+      SelectIndexVars(I);
+      if FUniqueMode = iuDistinct then
+      begin
+        FUserKey := ExtractKeyFromBuffer(Buffer);
+        Result := FindKey(false) = 0;
+      end;
+      Inc(I);
+    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: PChar; 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 := 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;
+      IntSrc := 0;
+      case ResultType of
+        etInteger: IntSrc := PInteger(Result)^;
+{$ifdef SUPPORT_INT64}
+        etLargeInt:
+          begin
+            Int64Src := PLargeInt(Result)^;
+            // handle zero differently: no decimals
+            if Int64Src = 0 then
+              NumDecimals := 0
+            else
+              NumDecimals := GetStrFromInt64(Int64Src, @FloatRec.Digits[0]);
+            FloatRec.Exponent := NumDecimals;
+            FloatRec.Negative := Int64Src < 0;
+            // null-terminate string
+            FloatRec.Digits[NumDecimals] := #0;
+          end;
+{$endif}
+        etFloat:
+          begin
+            ExtValue := PDouble(Result)^;
+            FloatToDecimal(FloatRec, ExtValue, {$ifndef FPC_VERSION}fvExtended,{$endif} 9999, 15);
+            NumDecimals := StrLen(@FloatRec.Digits[0]);
+            // maximum number of decimals possible to encode in BCD is 16
+            if NumDecimals > 16 then
+              NumDecimals := 16;
+          end;
+      end;
+
+      // parse integers to string
+      case ResultType of
+        etInteger:
+          begin
+            // handle zero differently: no decimals
+            if IntSrc = 0 then
+              NumDecimals := 0
+            else
+              NumDecimals := GetStrFromInt(IntSrc, @FloatRec.Digits[0]);
+            FloatRec.Exponent := NumDecimals;
+            FloatRec.Negative := IntSrc < 0;
+            // 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 * 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: PChar): PChar;
+begin
+  // execute expression to get key
+  Result := PrepareKey(FCurrentParser.ExtractFromBuffer(Buffer), FCurrentParser.ResultType);
+end;
+
+procedure TIndexFile.InsertKey(Buffer: PChar);
+begin
+  // check proper index and modifiability
+  if FCanEdit and (PIndexHdr(FIndexHeader).KeyLen <> 0) then
+  begin
+    // get key from buffer
+    FUserKey := ExtractKeyFromBuffer(Buffer);
+    // patch through
+    InsertCurrent;
+  end;
+end;
+
+procedure TIndexFile.InsertCurrent;
+  // insert in current index
+  // assumes: FUserKey is an OEM key
+var
+  TempPage: TIndexPage;
+  SearchKey: array[0..100] of Char;
+  OemKey: PChar;
+begin
+  // only insert if not recalling or mode = distinct
+  // modify = mmDeleteRecall /\ unique <> distinct -> key already present
+  if (FModifyMode <> mmDeleteRecall) or (FUniqueMode = iuDistinct) then
+  begin
+    // translate OEM key to ANSI key for searching
+    OemKey := FUserKey;
+    if KeyType = 'C' then
+    begin
+      FUserKey := @SearchKey[0];
+      TranslateToANSI(OemKey, FUserKey);
+    end;
+    // 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
+      // switch to oem key
+      FUserKey := OemKey;
+      // 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;
+        InsertError;
+      end;
+    end;
+
+    // check range, disabled by insert
+    TempPage := FRoot;
+    repeat
+      TempPage.UpdateBounds(TempPage.LowerPage <> nil);
+      TempPage := TempPage.LowerPage;
+    until TempPage = nil;
+  end;
+end;
+
+procedure TIndexFile.InsertError;
+var
+  InfoKey: string;
+begin
+  // prepare info for user
+  InfoKey := FUserKey;
+  SetLength(InfoKey, KeyLen);
+  raise EDbfError.CreateFmt(STRING_KEY_VIOLATION, [GetName, PhysicalRecNo, TrimRight(InfoKey)]);
+end;
+
+procedure TIndexFile.Delete(RecNo: Integer; Buffer: PChar);
+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 PMdxHdr(Header).TagsUsed - 1 do
+    begin
+      SelectIndexVars(I);
+      DeleteKey(Buffer);
+    end;
+    // restore previous selected index
+    SelectIndexVars(curSel);
+  end else begin
+    DeleteKey(Buffer);
+  end;
+end;
+
+procedure TIndexFile.DeleteKey(Buffer: PChar);
+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
+var
+  SearchKey: array[0..100] of Char;
+  OemKey: PChar;
+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
+    // search correct entry to delete
+    if FLeaf.PhysicalRecNo <> FUserRecNo then
+    begin
+      // translate OEM key to ANSI key for searching
+      OemKey := FUserKey;
+      if KeyType = 'C' then
+      begin
+        FUserKey := @SearchKey[0];
+        TranslateToANSI(OemKey, FUserKey);
+      end;
+      FindKey(false);
+    end;
+    // delete selected entry
+    FLeaf.Delete;
+  end;
+end;
+
+procedure TIndexFile.Update(RecNo: Integer; PrevBuffer, NewBuffer: PChar);
+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 PMdxHdr(Header).TagsUsed - 1 do
+    begin
+      SelectIndexVars(I);
+      UpdateCurrent(PrevBuffer, NewBuffer);
+    end;
+    // restore previous selected index
+    SelectIndexVars(curSel);
+  end else begin
+    UpdateCurrent(PrevBuffer, NewBuffer);
+  end;
+end;
+
+procedure TIndexFile.UpdateCurrent(PrevBuffer, NewBuffer: PChar);
+var
+  TempBuffer: array [0..100] of Char;
+begin
+  if FCanEdit and (PIndexHdr(FIndexHeader).KeyLen <> 0) then
+  begin
+    // get key from newbuffer
+    FUserKey := ExtractKeyFromBuffer(NewBuffer);
+    Move(FUserKey^, TempBuffer, PIndexHdr(FIndexHeader).KeyLen);
+    // get key from prevbuffer
+    FUserKey := ExtractKeyFromBuffer(PrevBuffer);
+
+    // compare to see if anything changed
+    if CompareKeys(@TempBuffer[0], FUserKey) <> 0 then
+    begin
+      // first set userkey to key to delete
+      // FUserKey = KeyFrom(PrevBuffer)
+      DeleteCurrent;
+      // now set userkey to key to insert
+      FUserKey := @TempBuffer[0];
+      InsertCurrent;
+    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 := 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 := PIndexHdr(FIndexHeader).RootPage;
+end;
+
+function TIndexFile.Find(RecNo: Integer; Buffer: PChar): Integer;
+begin
+  // execute find
+  FUserRecNo := RecNo;
+  FUserKey := Buffer;
+  Result := FindKey(false);
+end;
+
+function TIndexFile.FindKey(const Insert: 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 Insert then
+      searchRecNo := -3
+    else
+      searchRecNo := FUserRecNo
+  end else begin
+    searchRecNo := -2;
+  end;
+  // disable range to prepare for insert
+  if Insert then
+  begin
+    // start from root
+    TempPage := FRoot;
+    repeat
+      TempPage.DisableRange;
+      TempPage := TempPage.LowerPage;
+    until TempPage = nil;
+  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 Insert 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 := 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: Integer;
+begin
+  // BOF and EOF always false
+  if FLeaf.Entry = FEntryBof then
+    Result := 1
+  else
+  if FLeaf.Entry = FEntryEof then
+    Result := -1
+  else
+    Result := FLeaf.MatchKey;
+end;
+
+procedure TIndexFile.RecordDeleted(RecNo: Integer; Buffer: PChar);
+begin
+  // are we distinct -> then delete record from index
+  FModifyMode := mmDeleteRecall;
+  Delete(RecNo, Buffer);
+  FModifyMode := mmNormal;
+end;
+
+procedure TIndexFile.RecordRecalled(RecNo: Integer; Buffer: PChar);
+begin
+  // are we distinct -> then reinsert record in index
+  FModifyMode := mmDeleteRecall;
+  Insert(RecNo, Buffer);
+  FModifyMode := mmNormal;
+end;
+
+function TIndexFile.GotoBookmark(IndexBookmark: rBookmarkData): Boolean;
+begin
+  if (IndexBookmark{.RecNo} = 0) then begin
+    First;
+  end else if (IndexBookmark{.RecNo} = MAXINT) then begin
+    Last;
+  end else begin
+    if (FLeaf.GetRecNo <> IndexBookmark{.RecNo}) then
+      PhysicalRecNo := IndexBookmark{.RecNo};
+  end;
+
+  Result := true;
+end;
+
+procedure TIndexFile.SetLocaleID(const NewID: LCID);
+var
+  InfoStr: array[0..7] of Char;
+begin
+  FLocaleID := NewID;
+  if NewID = lcidBinary then
+  begin
+    // no conversion on binary sort order
+    FLocaleCP := FCodePage;
+  end else begin
+    // get default ansi codepage for comparestring
+{$ifdef WIN32}
+    GetLocaleInfo(NewID, LOCALE_IDEFAULTANSICODEPAGE, InfoStr, 8);
+    FLocaleCP := StrToIntDef(InfoStr, GetACP);
+{$else}
+    FLocaleCP := GetACP;
+{$endif}
+  end;
+end;
+
+procedure TIndexFile.SetPhysicalRecNo(RecNo: Integer);
+begin
+  // read buffer of this RecNo
+  TDbfFile(FDbfFile).ReadRecord(RecNo, TDbfFile(FDbfFile).PrevBuffer);
+  // extract key
+  FUserKey := ExtractKeyFromBuffer(TDbfFile(FDbfFile).PrevBuffer);
+  // translate to a search key
+  if KeyType = 'C' then
+    TranslateToANSI(FUserKey, FUserKey);
+  // find this key
+  FUserRecNo := RecNo;
+  FindKey(false);
+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 (PMdxHdr(Header).TagsUsed <= 1) then
+    FUpdateMode := umCurrent
+  else
+    FUpdateMode := NewMode;
+end;
+
+function TIndexFile.GetBookMark: rBookmarkData;
+begin
+  // get physical recno
+  Result := FLeaf.GetRecNo;
+end;
+
+procedure TIndexFile.First;
+begin
+  // resync tree
+  if NeedLocks then
+    ResyncRoot;
+  // search first node
+  FRoot.RecurFirst;
+  // out of index - BOF
+  FLeaf.EntryNo := FLeaf.EntryNo - 1;
+end;
+
+procedure TIndexFile.Last;
+begin
+  // resync tree
+  if NeedLocks then
+    ResyncRoot;
+  // 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.ResyncTree;
+begin
+  // if at BOF or EOF, then we need to resync by first or last
+  if FLeaf.Entry = FEntryBof then
+  begin
+    First;
+  end else if FLeaf.Entry = FEntryEof then begin
+    Last;
+  end else begin
+    // read current key into buffer
+    Move(FLeaf.Key^, FKeyBuffer, PIndexHdr(FIndexHeader).KeyLen);
+    // search current in-mem key on disk
+    FUserKey := FKeyBuffer;
+    FUserRecNo := FLeaf.PhysicalRecNo;
+    // translate to searchable key
+    if KeyType = 'C' then
+      TranslateToANSI(FUserKey, FUserKey);
+    if (FindKey(false) <> 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 := FUserRecNo;
+    end;
+  end;
+end;
+
+function TIndexFile.Prev: Boolean;
+var
+  curRecNo: Integer;
+begin
+  // resync in-mem tree with tree on disk
+  if NeedLocks then
+    ResyncTree;
+  // 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.Next: Boolean;
+var
+  curRecNo: Integer;
+begin
+  // resync in-mem tree with tree on disk
+  if NeedLocks then
+    ResyncTree;
+  // 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.GetKeyLen: Integer;
+begin
+  Result := 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;
+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;
+
+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
+      // NOTE: little-endian code!
+      if PSmallInt(Key1)^ = $0134 then
+        Result := -1
+      else
+      if PSmallInt(Key2)^ = $0134 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;
+var
+  Key1T, Key2T: array [0..100] of Char;
+  FromCP, ToCP: Integer;
+begin
+  if FLocaleID = LCID(lcidBinary) then
+  begin
+    Result := StrLComp(Key1, Key2, KeyLen)
+  end else begin
+    FromCP := FCodePage;
+    ToCP := FLocaleCP;
+    TranslateString(FromCP, ToCP, Key1, Key1T, KeyLen);
+    TranslateString(FromCP, ToCP, Key2, Key2T, KeyLen);
+    Result := CompareString(FLocaleID, 0, Key1T, KeyLen, Key2T, KeyLen);
+    if Result > 0 then
+      Dec(Result, 2);
+  end
+end;
+
+function TIndexFile.CompareKey(Key: PChar): Integer;
+begin
+  // call compare routine
+  Result := FCompareKey(Key);
+
+  // if descending then reverse order
+  if FIsDescending then
+    Result := -Result;
+end;
+
+function TIndexFile.CompareKeyNumericNDX(Key: PChar): Integer;
+begin
+  Result := CompareKeysNumericNDX(FUserKey, Key);
+end;
+
+function TIndexFile.CompareKeyNumericMDX(Key: PChar): Integer;
+begin
+  Result := CompareKeysNumericMDX(FUserKey, Key);
+end;
+
+procedure TIndexFile.TranslateToANSI(Src, Dest: PChar);
+begin
+  { FromCP = FCodePage; }
+  { ToCP = FLocaleCP;   }
+  TranslateString(FCodePage, FLocaleCP, Src, Dest, KeyLen);
+end;
+
+function TIndexFile.CompareKeyString(Key: PChar): Integer;
+var
+  KeyT: array [0..100] of Char;
+begin
+  if FLocaleID = LCID(lcidBinary) then
+  begin
+    Result := StrLComp(FUserKey, Key, KeyLen)
+  end else begin
+    TranslateToANSI(Key, KeyT);
+    Result := CompareString(FLocaleID, 0, FUserKey, KeyLen, KeyT, KeyLen);
+    if Result > 0 then
+      Dec(Result, 2);
+  end
+end;
+
+function TIndexFile.IndexOf(const AIndexName: string): Integer;
+  // *) assumes FIndexVersion >= xBaseIV
+var
+  I: Integer;
+begin
+  // get index of this index :-)
+  Result := -1;
+  I := 0;
+  while (I < PMdxHdr(Header).TagsUsed) and (Result < 0) do
+  begin
+    FTempMdxTag.Tag := CalcTagOffset(I);
+    if AnsiCompareText(AIndexName, FTempMdxTag.TagName) = 0 then
+      Result := I;
+    inc(I);
+  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;
+  // we can now select by index
+  if found >= 0 then
+    SelectIndexVars(found);
+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
+  begin
+    FCompareKeys := CompareKeysString;
+    FCompareKey := CompareKeyString;
+  end else
+  if FIndexVersion >= xBaseIV then
+  begin
+    FCompareKeys := CompareKeysNumericMDX;
+    FCompareKey := CompareKeyNumericMDX;
+  end else begin
+    FCompareKeys := CompareKeysNumericNDX;
+    FCompareKey := CompareKeyNumericNDX;
+  end;
+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 FHeaderModified[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 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
+      FHeaderModified[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]);
+  FHeaderModified[AIndex] := false;
+end;
+
+//==========================================================
+//============ TDbfIndexDef
+//==========================================================
+
+constructor TDbfIndexDef.Create(Collection: TCollection); {override;}
+begin
+  inherited Create(Collection);
+  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.
+

fcl/db/dbase/Dbf_Lang.pas

@@ -0,0 +1,641 @@
+unit Dbf_Lang;
+
+{force CR/LF fix}
+
+{$i Dbf_Common.inc}
+
+interface
+
+uses
+{$ifdef WIN32}
+  Windows;
+{$else}
+{$ifdef KYLIX}
+  Libc, 
+{$endif}  
+  Types, Dbf_Wtil;
+{$endif}
+
+const
+
+//*************************************************************************//
+// DB3/DB4/FoxPro Lang ID consts, for readable code
+//*************************************************************************//
+
+// ...
+  FoxLangId_ENU_437       = $01;
+  FoxLangId_Intl_850      = $02;
+  FoxLangId_Windows_1252  = $03;
+  FoxLangId_Mac_10000     = $04;
+// ...
+  DbfLangId_DAN_865       = $08;
+  DbfLangId_NLD_437       = $09;
+  DbfLangId_NLD_850       = $0A;
+  DbfLangId_FIN_437       = $0B;
+  DbfLangId_FIN_850       = $0C;    // is it used? does not exist in BDE
+  DbfLangId_FRA_437       = $0D;
+  DbfLangId_FRA_850       = $0E;
+  DbfLangId_DEU_437       = $0F;
+  DbfLangId_DEU_850       = $10;
+  DbfLangId_ITA_437       = $11;
+  DbfLangId_ITA_850       = $12;
+  DbfLangId_JPN_932       = $13;
+  DbfLangId_ESP_850       = $14;
+  DbfLangId_SVE_437       = $15;
+  DbfLangId_SVE_850       = $16;
+  DbfLangId_NOR_865       = $17;
+  DbfLangId_ESP_437       = $18;
+  DbfLangId_ENG_437       = $19;
+  DbfLangId_ENG_850       = $1A;
+  DbfLangId_ENU_437       = $1B;
+  DbfLangId_FRC_863       = $1C;
+  DbfLangId_FRC_850       = $1D;
+// ...
+  DbfLangId_CSY_852       = $1F;
+  DbfLangId_CSY_867       = $20;
+// ...
+  DbfLangId_HUN_852       = $22;
+  DbfLangId_PLK_852       = $23;
+  DbfLangId_PTG_860       = $24;
+  DbfLangId_PTB_850       = $25;
+  DbfLangId_RUS_866       = $26;
+// ...
+  DbfLangId_ENU_850       = $37;
+// ...
+  DbfLangId_CHS_936       = $4D;
+  DbfLangId_KOR_949       = $4E;
+  DbfLangId_CHT_950       = $4F;
+  DbfLangId_THA_874       = $50;
+// ...
+  DbfLangId_JPN_DIC_932   = $56;
+  DbfLangId_Ascii_1252    = $57;
+  DbfLangId_WEurope_1252  = $58;
+  DbfLangId_Spanish_1252  = $59;
+// ...
+  FoxLangId_German_437    = $5E;
+  FoxLangId_Nordic_437    = $5F;
+  FoxLangId_Nordic_850    = $60;
+  FoxLangId_German_1252   = $61;
+  FoxLangId_Nordic_1252   = $62;
+// ...
+  FoxLangId_EEurope_852   = $64;
+  FoxLangId_Russia_866    = $65;
+  FoxLangId_Nordic_865    = $66;
+  FoxLangId_Iceland_861   = $67;
+  FoxLangId_Czech_895     = $68;
+// ...
+  DbfLangId_POL_620       = $69;
+// ...
+  FoxLangId_Greek_737     = $6A;
+  FoxLangId_Turkish_857   = $6B;
+// ...
+  FoxLangId_Taiwan_950    = $78;
+  FoxLangId_Korean_949    = $79;
+  FoxLangId_Chinese_936   = $7A;
+  FoxLangId_Japan_932     = $7B;
+  FoxLangId_Thai_874      = $7C;
+  FoxLangId_Hebrew_1255   = $7D;
+  FoxLangId_Arabic_1256   = $7E;
+// ...
+  DbfLangId_Hebrew        = $85;
+  DbfLangId_ELL_437       = $86;    // greek, code page 737 (?)
+  DbfLangId_SLO_852       = $87;
+  DbfLangId_TRK_857       = $88;
+// ...
+  DbfLangId_BUL_868       = $8E;
+// ...
+  FoxLangId_Russia_10007  = $96;
+  FoxLangId_EEurope_10029 = $97;
+  FoxLangId_Greek_10006   = $98;
+// ...
+  FoxLangId_Czech_1250    = $9B;
+  FoxLangId_Czech_850     = $9C;    // DOS
+// ...
+  FoxLangId_EEurope_1250  = $C8;
+  FoxLangId_Russia_1251   = $C9;
+  FoxLangId_Turkish_1254  = $CA;
+  FoxLangId_Greek_1253    = $CB;
+
+
+// special constants
+
+  DbfLocale_NotFound   = $010000;
+  DbfLocale_Bul868     = $020000;
+
+//*************************************************************************//
+// DB3/DB4/FoxPro Language ID to CodePage convert table
+//*************************************************************************//
+
+  LangId_To_CodePage: array[Byte] of Word =
+//      |  0|    1|    2|    3|    4|    5|    6|    7|
+//      |  8|    9|    A|    B|    C|    D|    E|    F|
+//      |   |     |     |     |     |     |     |     |
+{00}   (   0,  437,  850, 1252,10000,    0,    0,    0,
+{08}     865,  437,  850,  437,  850,  437,  850,  437,
+{10}     850,  437,  850,  932,  850,  437,  850,  865,
+{18}     437,  437,  850,  437,  863,  850,    0,  852,
+{20}     867,    0,  852,  852,  860,  850,  866,    0,
+{28}       0,    0,    0,    0,    0,    0,    0,    0,
+{30}       0,    0,    0,    0,    0,    0,    0,  850,
+{38}       0,    0,    0,    0,    0,    0,    0,    0,
+{40}       0,    0,    0,    0,    0,    0,    0,    0,
+{48}       0,    0,    0,    0,    0,  936,  949,  950,
+{50}     874,    0,    0,    0,    0,    0,  932, 1252,
+{58}    1252, 1252,    0,    0,    0,    0,  437,  437,
+{60}     850, 1252, 1252,    0,  852,  866,  865,  861,
+{68}     895,  620,  737,  857,    0,    0,    0,    0,
+{70}       0,    0,    0,    0,    0,    0,    0,    0,
+{78}     950,  949,  936,  932,  874, 1255, 1256,    0,
+{80}       0,    0,    0,    0,    0,  862,  437,  852,
+{88}     857,    0,    0,    0,    0,    0,  868,    0,
+{90}       0,    0,    0,    0,    0,    0,10007,10029,
+{98}   10006,    0,    0, 1250,  850,    0,    0,    0,
+{A0}       0,    0,    0,    0,    0,    0,    0,    0,
+{A8}       0,    0,    0,    0,    0,    0,    0,    0,
+{B0}       0,    0,    0,    0,    0,    0,    0,    0,
+{B8}       0,    0,    0,    0,    0,    0,    0,    0,
+{C0}       0,    0,    0,    0,    0,    0,    0,    0,
+{C8}    1250, 1251, 1254, 1253,    0,    0,    0,    0,
+{D0}       0,    0,    0,    0,    0,    0,    0,    0,
+{D8}       0,    0,    0,    0,    0,    0,    0,    0,
+{E0}       0,    0,    0,    0,    0,    0,    0,    0,
+{E8}       0,    0,    0,    0,    0,    0,    0,    0,
+{F0}       0,    0,    0,    0,    0,    0,    0,    0,
+{F8}       0,    0,    0,    0,    0,    0,    0,    0);
+
+{$ifdef FPC_VERSION}
+{$ifdef VER1_0}
+  LANG_ARABIC                          = $01;
+  LANG_HEBREW                          = $0d;
+  LANG_THAI                            = $1e;
+  SUBLANG_KOREAN                       = $01;    { Korean (Extended Wansung) }
+  SORT_CHINESE_PRC                     = $2;     { PRC Chinese Stroke Count order }
+{$endif}
+{$endif}
+
+//*************************************************************************//
+// DB3/DB4/FoxPro Language ID to Locale convert table
+//*************************************************************************//
+
+// table
+
+  LangId_To_Locale: array[Byte] of LCID =
+      (
+      DbfLocale_NotFound,
+{01}  LANG_ENGLISH    or (SUBLANG_ENGLISH_US           shl 10) or (SORT_DEFAULT shl 16),
+      LANG_ENGLISH    or (SUBLANG_ENGLISH_UK           shl 10) or (SORT_DEFAULT shl 16),      {international ??}
+      LANG_ENGLISH    or (SUBLANG_ENGLISH_UK           shl 10) or (SORT_DEFAULT shl 16),      {windows ??}
+      LANG_ENGLISH    or (SUBLANG_ENGLISH_UK           shl 10) or (SORT_DEFAULT shl 16),      {macintosh ??}
+      0,0,0,
+{08}  LANG_DANISH     or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_DUTCH      or (SUBLANG_DUTCH                shl 10) or (SORT_DEFAULT shl 16),
+      LANG_DUTCH      or (SUBLANG_DUTCH                shl 10) or (SORT_DEFAULT shl 16),
+      LANG_FINNISH    or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_FINNISH    or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_FRENCH     or (SUBLANG_FRENCH               shl 10) or (SORT_DEFAULT shl 16),
+      LANG_FRENCH     or (SUBLANG_FRENCH               shl 10) or (SORT_DEFAULT shl 16),
+      LANG_GERMAN     or (SUBLANG_GERMAN               shl 10) or (SORT_DEFAULT shl 16),
+      LANG_GERMAN     or (SUBLANG_GERMAN               shl 10) or (SORT_DEFAULT shl 16),
+      LANG_ITALIAN    or (SUBLANG_ITALIAN              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_ITALIAN    or (SUBLANG_ITALIAN              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_JAPANESE   or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_SPANISH    or (SUBLANG_SPANISH              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_SWEDISH    or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_SWEDISH    or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_NORWEGIAN  or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_SPANISH    or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_ENGLISH    or (SUBLANG_ENGLISH_UK           shl 10) or (SORT_DEFAULT shl 16),
+      LANG_ENGLISH    or (SUBLANG_ENGLISH_UK           shl 10) or (SORT_DEFAULT shl 16),
+      LANG_ENGLISH    or (SUBLANG_ENGLISH_US           shl 10) or (SORT_DEFAULT shl 16),
+      LANG_FRENCH     or (SUBLANG_FRENCH_CANADIAN      shl 10) or (SORT_DEFAULT shl 16),
+      LANG_FRENCH     or (SUBLANG_FRENCH_CANADIAN      shl 10) or (SORT_DEFAULT shl 16),
+{1E}  0,
+{1F}  LANG_CZECH      or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_CZECH      or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+{21}  0,
+{22}  LANG_HUNGARIAN  or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_POLISH     or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_PORTUGUESE or (SUBLANG_PORTUGUESE_BRAZILIAN shl 10) or (SORT_DEFAULT shl 16),
+      LANG_PORTUGUESE or (SUBLANG_PORTUGUESE_BRAZILIAN shl 10) or (SORT_DEFAULT shl 16),
+      LANG_RUSSIAN    or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+{27}  0,0,0,0,0,0,0,0,0,
+{30}  0,0,0,0,0,0,0,
+{37}  LANG_ENGLISH    or (SUBLANG_ENGLISH_US           shl 10) or (SORT_DEFAULT shl 16),
+{38}  0,0,0,0,0,0,0,0,
+{40}  0,0,0,0,0,0,0,0,0,0,0,0,0,
+{4D}  LANG_CHINESE    or (SUBLANG_CHINESE_SIMPLIFIED   shl 10) or (SORT_DEFAULT shl 16),
+      LANG_KOREAN     or (SUBLANG_KOREAN               shl 10) or (SORT_DEFAULT shl 16),
+      LANG_CHINESE    or (SUBLANG_CHINESE_TRADITIONAL  shl 10) or (SORT_DEFAULT shl 16),
+      LANG_THAI       or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+{51}  0,0,0,0,0,
+{56}  LANG_JAPANESE   or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),    // JPN: Dic932 ??
+      0,                                                                                    // Ascii: Binary
+      LANG_ENGLISH    or (SUBLANG_ENGLISH_UK           shl 10) or (SORT_DEFAULT shl 16),    // Western Europe ??
+      LANG_SPANISH    or (SUBLANG_SPANISH              shl 10) or (SORT_DEFAULT shl 16),
+{5A}  0,0,0,0,
+// FoxPro
+{5E}  LANG_GERMAN     or (SUBLANG_GERMAN               shl 10) or (SORT_DEFAULT shl 16),
+      LANG_NORWEGIAN  or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_NORWEGIAN  or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_GERMAN     or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_NORWEGIAN  or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+{63}  0,
+{64}  LANG_CZECH      or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),    // Eastern Europe ??
+      LANG_RUSSIAN    or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_NORWEGIAN  or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_ICELANDIC  or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_CZECH      or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_POLISH     or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_GREEK      or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_TURKISH    or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+{6C}  0,0,0,0,
+{70}  0,0,0,0,0,0,0,0,
+{78}  LANG_CHINESE    or (SUBLANG_CHINESE_HONGKONG     shl 10) or (SORT_DEFAULT shl 16),
+      LANG_KOREAN     or (SUBLANG_KOREAN               shl 10) or (SORT_DEFAULT shl 16),
+      LANG_CHINESE    or (SUBLANG_CHINESE_SINGAPORE    shl 10) or (SORT_CHINESE_PRC shl 16),
+      LANG_JAPANESE   or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),    // JPN: Dic932 ??
+      LANG_THAI       or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_HEBREW     or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_ARABIC     or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      0,
+{80}  0,0,0,0,0,
+// dBase
+{85}  LANG_HEBREW     or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_GREEK      or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_SLOVAK     or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_TURKISH    or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+{89}  0,0,0,0,0,
+{8E}  LANG_BULGARIAN  or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+{8F}  0,0,0,0,0,0,0,
+{96}  LANG_RUSSIAN    or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_CZECH      or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),    // Eastern Europe ??
+      LANG_GREEK      or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      0,0,
+// FoxPro
+{9B}  LANG_CZECH      or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_CZECH      or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+{9D}  0,0,0,
+{A0}  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+{B0}  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+{C0}  0,0,0,0,0,0,0,0,
+{C8}  LANG_CZECH      or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),    // Eastern Europe ??
+      LANG_RUSSIAN    or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_TURKISH    or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      LANG_GREEK      or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+{CC}  0,0,0,0,
+{D0}  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+{E0}  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+{F0}  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
+      );
+
+//*************************************************************************//
+// DB7 LangID Locale substrings
+//*************************************************************************//
+
+// convert table
+
+  LangId_To_LocaleStr: array[Byte] of Cardinal =
+      (
+      DbfLocale_NotFound,
+{01}  Ord('U') or (Ord('S') shl 8) or (Ord('0') shl 16),
+      Ord('U') or (Ord('K') shl 8) or (Ord('0') shl 16),
+      Ord('U') or (Ord('K') shl 8) or (Ord('0') shl 16),
+      Ord('U') or (Ord('K') shl 8) or (Ord('0') shl 16),
+      0,0,0,
+{08}  Ord('D') or (Ord('A') shl 8) or (Ord('0') shl 16),
+      Ord('N') or (Ord('L') shl 8) or (Ord('0') shl 16),
+      Ord('N') or (Ord('L') shl 8) or (Ord('0') shl 16),
+      Ord('F') or (Ord('I') shl 8) or (Ord('0') shl 16),
+      Ord('F') or (Ord('I') shl 8) or (Ord('0') shl 16),
+      Ord('F') or (Ord('R') shl 8) or (Ord('0') shl 16),
+      Ord('F') or (Ord('R') shl 8) or (Ord('0') shl 16),
+      Ord('D') or (Ord('E') shl 8) or (Ord('0') shl 16),
+      Ord('D') or (Ord('E') shl 8) or (Ord('0') shl 16),
+      Ord('I') or (Ord('T') shl 8) or (Ord('0') shl 16),
+      Ord('I') or (Ord('T') shl 8) or (Ord('1') shl 16),
+      Ord('J') or (Ord('P') shl 8) or (Ord('0') shl 16),
+      Ord('E') or (Ord('S') shl 8) or (Ord('0') shl 16),
+      Ord('S') or (Ord('V') shl 8) or (Ord('0') shl 16),
+      Ord('S') or (Ord('V') shl 8) or (Ord('1') shl 16),
+      Ord('N') or (Ord('O') shl 8) or (Ord('0') shl 16),
+      Ord('E') or (Ord('S') shl 8) or (Ord('1') shl 16),
+      Ord('U') or (Ord('K') shl 8) or (Ord('0') shl 16),
+      Ord('U') or (Ord('K') shl 8) or (Ord('0') shl 16),
+      Ord('U') or (Ord('S') shl 8) or (Ord('0') shl 16),
+      Ord('C') or (Ord('F') shl 8) or (Ord('1') shl 16),
+      Ord('C') or (Ord('F') shl 8) or (Ord('1') shl 16),
+{1E}  0,
+{1F}  Ord('C') or (Ord('Z') shl 8) or (Ord('0') shl 16),
+      Ord('C') or (Ord('Z') shl 8) or (Ord('0') shl 16),
+{21}  0,
+{22}  Ord('H') or (Ord('D') shl 8) or (Ord('C') shl 16),
+      Ord('P') or (Ord('O') shl 8) or (Ord('0') shl 16),
+      Ord('P') or (Ord('T') shl 8) or (Ord('0') shl 16),
+      Ord('P') or (Ord('T') shl 8) or (Ord('0') shl 16),
+      Ord('R') or (Ord('U') shl 8) or (Ord('0') shl 16),
+{27}  0,0,0,0,0,0,0,0,0,
+{30}  0,0,0,0,0,0,0,
+{37}  Ord('U') or (Ord('S') shl 8) or (Ord('0') shl 16),
+{38}  0,0,0,0,0,0,0,0,
+{40}  0,0,0,0,0,0,0,0,0,0,0,0,0,
+{4D}  Ord('C') or (Ord('N') shl 8) or (Ord('0') shl 16),
+      Ord('K') or (Ord('O') shl 8) or (Ord('0') shl 16),
+      Ord('T') or (Ord('W') shl 8) or (Ord('0') shl 16),
+      Ord('T') or (Ord('H') shl 8) or (Ord('0') shl 16),
+{51}  0,0,0,0,0,
+{56}  Ord('J') or (Ord('P') shl 8) or (Ord('1') shl 16),
+      Ord('U') or (Ord('S') shl 8) or (Ord('0') shl 16),
+      Ord('W') or (Ord('E') shl 8) or (Ord('0') shl 16),
+      Ord('E') or (Ord('S') shl 8) or (Ord('0') shl 16),
+{5A}  0,0,0,0,
+// FoxPro
+{5E}  Ord('D') or (Ord('E') shl 8),
+      Ord('N') or (Ord('O') shl 8),
+      Ord('N') or (Ord('O') shl 8),
+      Ord('D') or (Ord('E') shl 8),
+      Ord('N') or (Ord('O') shl 8),
+{63}  0,
+{64}  Ord('C') or (Ord('Z') shl 8) or (Ord('0') shl 16),
+      Ord('R') or (Ord('U') shl 8) or (Ord('0') shl 16),
+      Ord('N') or (Ord('O') shl 8),
+      Ord('I') or (Ord('C') shl 8) or (Ord('0') shl 16),    // made this one up: iceland
+      Ord('C') or (Ord('Z') shl 8) or (Ord('0') shl 16),
+{69}  Ord('P') or (Ord('O') shl 8) or (Ord('1') shl 16),
+      Ord('G') or (Ord('R') shl 8) or (Ord('0') shl 16),
+      Ord('T') or (Ord('R') shl 8) or (Ord('0') shl 16),
+{6C}  0,0,0,0,
+{70}  0,0,0,0,0,0,0,0,
+{78}  Ord('C') or (Ord('H') shl 8) or (Ord('0') shl 16),    // made this one up: chinese hongkong
+      Ord('K') or (Ord('O') shl 8) or (Ord('0') shl 16),
+      Ord('C') or (Ord('S') shl 8) or (Ord('0') shl 16),    // made this one up: chinese singapore
+      Ord('J') or (Ord('P') shl 8) or (Ord('0') shl 16),
+      Ord('T') or (Ord('H') shl 8) or (Ord('0') shl 16),
+      Ord('R') or (Ord('E') shl 8) or (Ord('W') shl 16),
+      Ord('A') or (Ord('R') shl 8) or (Ord('0') shl 16),    // made this one up: arabic (default)
+{7F}  0,
+{80}  0,0,0,0,0,
+// dBase
+{85}  Ord('R') or (Ord('E') shl 8) or (Ord('W') shl 16),
+      Ord('G') or (Ord('R') shl 8) or (Ord('0') shl 16),
+      Ord('S') or (Ord('L') shl 8) or (Ord('0') shl 16),
+      Ord('T') or (Ord('R') shl 8) or (Ord('0') shl 16),
+{89}  0,0,0,0,0,
+{8E}  DbfLocale_Bul868,
+{8F}  0,0,0,0,0,0,0,
+{96}  Ord('R') or (Ord('U') shl 8) or (Ord('0') shl 16),
+      Ord('C') or (Ord('Z') shl 8) or (Ord('0') shl 16),
+      Ord('G') or (Ord('R') shl 8) or (Ord('0') shl 16),
+{99}  0,0,
+// FoxPro
+{9B}  0, //LANG_CZECH      or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      0, //LANG_CZECH      or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+{9D}  0,0,0,
+{A0}  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+{B0}  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+{C0}  0,0,0,0,0,0,0,0,
+{C8}  Ord('C') or (Ord('Z') shl 8) or (Ord('0') shl 16),
+      Ord('R') or (Ord('U') shl 8) or (Ord('0') shl 16),
+      Ord('T') or (Ord('R') shl 8) or (Ord('0') shl 16),
+      Ord('G') or (Ord('R') shl 8) or (Ord('0') shl 16),
+{CC}  0,0,0,0,
+{D0}  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+{E0}  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+{F0}  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
+      );
+
+{
+  DbfLocaleId_DAN_865       = Ord('D') or (Ord('A') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_NLD_437       = Ord('N') or (Ord('L') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_NLD_850       = Ord('N') or (Ord('L') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_FIN_437       = Ord('F') or (Ord('I') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_FIN_850       = Ord('F') or (Ord('I') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_FRA_437       = Ord('F') or (Ord('R') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_FRA_850       = Ord('F') or (Ord('R') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_DEU_437       = Ord('D') or (Ord('E') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_DEU_850       = Ord('D') or (Ord('E') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_ITA_437       = Ord('I') or (Ord('T') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_ITA_850       = Ord('I') or (Ord('T') shl 8) or (Ord('1') shl 16);
+  DbfLocaleId_JPN_932       = Ord('J') or (Ord('P') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_ESP_850       = Ord('E') or (Ord('S') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_SVE_437       = Ord('S') or (Ord('V') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_SVE_850       = Ord('S') or (Ord('V') shl 8) or (Ord('1') shl 16);
+  DbfLocaleId_NOR_865       = Ord('N') or (Ord('O') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_ESP_437       = Ord('E') or (Ord('S') shl 8) or (Ord('1') shl 16);
+  DbfLocaleId_ENG_437       = Ord('U') or (Ord('K') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_ENG_850       = Ord('U') or (Ord('K') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_ENU_437       = Ord('U') or (Ord('S') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_FRC_863       = Ord('C') or (Ord('F') shl 8) or (Ord('1') shl 16);
+  DbfLocaleId_FRC_850       = Ord('C') or (Ord('F') shl 8) or (Ord('1') shl 16);
+// ...
+  DbfLocaleId_CSY_852       = Ord('C') or (Ord('Z') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_CSY_867       = Ord('C') or (Ord('Z') shl 8) or (Ord('0') shl 16);
+// ...
+  DbfLocaleId_HUN_852       = Ord('H') or (Ord('D') shl 8) or (Ord('C') shl 16);
+  DbfLocaleId_PLK_852       = Ord('P') or (Ord('O') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_PTG_860       = Ord('P') or (Ord('T') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_PTB_850       = Ord('P') or (Ord('T') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_RUS_866       = Ord('R') or (Ord('U') shl 8) or (Ord('0') shl 16);
+// ...
+  DbfLocaleId_ENU_850       = Ord('U') or (Ord('S') shl 8) or (Ord('0') shl 16);
+// ...
+  DbfLocaleId_CHS_936       = Ord('C') or (Ord('N') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_KOR_949       = Ord('K') or (Ord('O') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_CHT_950       = Ord('T') or (Ord('W') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_THA_874       = Ord('T') or (Ord('H') shl 8) or (Ord('0') shl 16);
+// ...
+  DbfLocaleId_JPN_DIC_932   = Ord('J') or (Ord('P') shl 8) or (Ord('1') shl 16);
+  DbfLocaleId_Ascii_Ansi    = Ord('U') or (Ord('S') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_WEurope_Ansi  = Ord('W') or (Ord('E') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_Spanish_Ansi  = Ord('E') or (Ord('S') shl 8) or (Ord('0') shl 16);
+// ...
+  DbfLocaleId_Hebrew        = Ord('R') or (Ord('E') shl 8) or (Ord('W') shl 16);
+  DbfLocaleId_ELL_437       = Ord('G') or (Ord('R') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_SLO_852       = Ord('S') or (Ord('L') shl 8) or (Ord('0') shl 16);
+  DbfLocaleId_TRK_857       = Ord('T') or (Ord('R') shl 8) or (Ord('0') shl 16);
+// ...
+  DbfLocaleId_BUL_868       = 'BGDB868';
+}
+
+// VdBase 7 Language strings
+//  'DBWIN...' -> Charset 1252 (ansi)
+//  'DB999...' -> Code page 999, 9 any digit
+//  'DBHEBREW' -> Code page 1255 ??
+//  'FOX..999' -> Code page 999, 9 any digit
+//  'FOX..WIN' -> Charset 1252 (ansi)
+
+//*************************************************************************//
+// reverse convert routines
+//*************************************************************************//
+
+function ConstructLangName(CodePage: Integer; Locale: LCID; IsFoxPro: Boolean): string;
+
+function ConstructLangId(CodePage: Integer; Locale: LCID; IsFoxPro: Boolean): Byte;
+
+function GetLangId_From_LangName(LocaleStr: string): Byte;
+
+implementation
+
+uses
+  SysUtils;
+
+type
+  PCardinal = ^Cardinal;
+
+function ConstructLangName(CodePage: Integer; Locale: LCID; IsFoxPro: Boolean): string;
+var
+  SubType: Cardinal;
+begin
+  // ANSI?
+  SubType := LangId_To_LocaleStr[ConstructLangId(CodePage, Locale, IsFoxPro)];
+  // found?
+  if SubType <> DbfLocale_NotFound then
+  begin
+    // foxpro or dbase?
+    if IsFoxPro then
+    begin
+      Result := 'FOX' + PChar(@SubType);
+      if CodePage = 1252 then
+        Result := Result + 'WIN'
+      else
+        Result := Result + IntToStr(CodePage);
+    end else begin
+      if SubType = DbfLocale_Bul868 then
+      begin
+        // special case
+        Result := 'BGDB868';
+      end else begin
+        // start with DB
+        Result := 'DB';
+        // add codepage
+        if CodePage = 1252 then
+          Result := Result + 'WIN'
+        else
+          Result := Result + IntToStr(CodePage);
+        // add subtype
+        Result := Result + PChar(@SubType);
+      end;
+    end;
+  end;
+end;
+
+const
+  // range of Dbase / FoxPro locale; these are INCLUSIVE
+
+  dBase_RegionCount = 4;
+  dBase_Regions: array[0..dBase_RegionCount*2-1] of Byte =
+   ($00, $00,
+    $05, $5D,
+    $69, $69, // a lonely dbf entry :-)
+    $80, $90);
+
+function FindLangId(CodePage, Info2: Cardinal; Info2Table: PCardinal; IsFoxPro: Boolean): Byte;
+var
+  I, Region, FoxRes, DbfRes: Integer;
+begin
+  Region := 0;
+  DbfRes := 0;
+  FoxRes := 0;
+  // scan
+  for I := 0 to $FF do
+  begin
+    // check if need to advance to next region
+    if Region + 2 < dBase_RegionCount then
+      if I >= dBase_Regions[Region + 2] then
+        Inc(Region, 2);
+    // it seems delphi does not properly understand pointers?
+    // what a mess :-(
+    if ((LangId_To_CodePage[I] = CodePage) or (CodePage = 0)) and (PCardinal(PChar(Info2Table)+(I*4))^ = Info2) then
+      if I <= dBase_Regions[Region+1] then
+        DbfRes := Byte(I)
+      else
+        FoxRes := Byte(I);
+  end;
+  // if we can find langid in other set, use it
+  if (DbfRes <> 0) and (not IsFoxPro or (FoxRes = 0)) then
+    Result := DbfRes
+  else  {(DbfRes = 0) or (IsFoxPro and (FoxRes <> 0)}
+  if (FoxRes <> 0) {and (IsFoxPro or (DbfRes = 0)} then
+    Result := FoxRes
+  else
+    Result := 0;
+end;
+
+{
+function FindLangId(CodePage, Info2: Cardinal; Info2Table: PCardinal; IsFoxPro: Boolean): Byte;
+var
+  I, Region, lEnd: Integer;
+  EndReached: Boolean;
+begin
+  Region := 0;
+  Result := 0;
+  repeat
+    // determine region to scan
+    if IsFoxPro then
+    begin
+      // foxpro, in between dbase regions
+      I := dBase_Regions[Region+1] + 1;
+      lEnd := dBase_Regions[Region+2] - 1;
+      EndReached := Region = dBase_RegionCount*2-4;
+    end else begin
+      // dBase, select regions
+      I := dBase_Regions[Region];
+      lEnd := dBase_Regions[Region+1];
+      EndReached := Region = dBase_RegionCount*2-2;
+    end;
+    // scan
+    repeat
+      // it seems delphi does not properly understand pointers?
+      // what a mess :-(
+      if (LangId_To_CodePage[I] = CodePage) and (PCardinal(PChar(Info2Table)+(I*4))^ = Info2) then
+        Result := Byte(I);
+      Inc(I);
+      // lEnd is included in range
+    until (Result <> 0) or (I > lEnd);
+    // goto next region
+    if (Result = 0) then
+      Inc(Region, 2);
+    // found or end?
+  until (Result <> 0) or EndReached;
+end;
+}
+
+function ConstructLangId(CodePage: Integer; Locale: LCID; IsFoxPro: Boolean): Byte;
+begin
+  // locale: lower 16bits only
+  Locale := (Locale and $FFFF) or (SORT_DEFAULT shl 16);
+  Result := FindLangId(CodePage, Locale, @LangId_To_Locale[0], IsFoxPro);
+  // not found? try any codepage
+  if Result = 0 then
+    Result := FindLangId(0, Locale, @LangId_To_Locale[0], IsFoxPro);
+end;
+
+function GetLangId_From_LangName(LocaleStr: string): Byte;
+var
+  CodePage, SubType: Integer;
+  IsFoxPro: Boolean;
+  CodePageStr: string;
+begin
+  // determine foxpro/dbase
+  IsFoxPro := CompareMem(PChar('FOX'), PChar(LocaleStr), 3);
+  // get codepage/locale subtype
+  if IsFoxPro then
+  begin
+    CodePageStr := Copy(LocaleStr, 6, 3);
+    SubType := Integer(LocaleStr[4]) or (Integer(LocaleStr[5]) shl 8);
+  end else begin
+    CodePageStr := Copy(LocaleStr, 3, 3);
+    SubType := Integer(LocaleStr[6]) or (Integer(LocaleStr[7]) shl 8) or (Integer(LocaleStr[8]) shl 16);
+  end;
+  // convert codepage string to codepage id
+  if CodePageStr = 'WIN' then
+    CodePage := 1252
+  else if CodePageStr = 'REW' then    // hebrew
+    CodePage := 1255
+  else
+    CodePage := StrToInt(CodePageStr);
+  // find lang id
+  Result := FindLangId(CodePage, SubType, @LangId_To_LocaleStr[0], IsFoxPro);
+end;
+
+end.
+

fcl/db/dbase/Dbf_Memo.pas

@@ -0,0 +1,550 @@
+unit Dbf_Memo;
+
+interface
+
+{$I Dbf_Common.inc}
+
+uses
+  Classes,
+  Dbf_PgFile,
+  Dbf_Common;
+
+type
+
+//====================================================================
+  TMemoFile = class(TPagedFile)
+  protected
+    FDbfVersion: xBaseVersion;
+    FMemoRecordSize: Integer;
+    FOpened: Boolean;
+    FBuffer: PChar;
+  protected
+    function  GetBlockLen: Integer; virtual; abstract;
+    function  GetMemoSize: Integer; virtual; abstract;
+    function  GetNextFreeBlock: Integer; virtual; abstract;
+    procedure SetNextFreeBlock(BlockNo: Integer); virtual; abstract;
+    procedure SetBlockLen(BlockLen: Integer); virtual; abstract;
+  public
+    constructor Create(AFileName: string);
+    destructor Destroy; override;
+
+    procedure Open;
+    procedure Close;
+
+    procedure ReadMemo(BlockNo: Integer; DestStream: TStream);
+    procedure WriteMemo(var BlockNo: Integer; ReadSize: Integer; Src: TStream);
+
+    property DbfVersion: xBaseVersion read FDbfVersion write FDbfVersion;
+    property MemoRecordSize: Integer read FMemoRecordSize write FMemoRecordSize;
+  end;
+
+  TFoxProMemoFile = class(TMemoFile)
+  protected
+    function  GetBlockLen: Integer; override;
+    function  GetMemoSize: Integer; override;
+    function  GetNextFreeBlock: Integer; override;
+    procedure SetNextFreeBlock(BlockNo: Integer); override;
+    procedure SetBlockLen(BlockLen: Integer); override;
+  end;
+
+  TDbaseMemoFile = class(TMemoFile)
+  protected
+    function  GetBlockLen: Integer; override;
+    function  GetMemoSize: Integer; override;
+    function  GetNextFreeBlock: Integer; override;
+    procedure SetNextFreeBlock(BlockNo: Integer); override;
+    procedure SetBlockLen(BlockLen: Integer); override;
+  end;
+
+  { TNullMemoFile, a kind /dev/null memofile ;-) }
+  { - inv: FHeaderModified == false!! (otherwise will try to write FStream) }
+  { - inv: FHeaderSize == 0 }
+  { - inv: FNeedLocks == false }
+  { - WriteTo must NOT be used }
+  { - WriteChar must NOT be used }
+
+  TNullMemoFile = class(TMemoFile)
+  protected
+    procedure SetHeaderOffset(NewValue: Integer); override;
+    procedure SetRecordSize(NewValue: Integer); override;
+    procedure SetHeaderSize(NewValue: Integer); override;
+
+    function  LockSection(const Offset, Length: Cardinal; const Wait: Boolean): Boolean; override;
+    function  UnlockSection(const Offset, Length: Cardinal): Boolean; override;
+
+    function  GetBlockLen: Integer; override;
+    function  GetMemoSize: Integer; override;
+    function  GetNextFreeBlock: Integer; override;
+    procedure SetNextFreeBlock(BlockNo: Integer); override;
+    procedure SetBlockLen(BlockLen: Integer); override;
+
+  public
+    constructor Create(AFileName: string);
+
+    procedure CloseFile; override;
+    procedure OpenFile; override;
+
+    function  ReadRecord(IntRecNum: Integer; Buffer: Pointer): Integer; override;
+    procedure WriteRecord(IntRecNum: Integer; Buffer: Pointer); override;
+  end;
+
+  PInteger = ^Integer;
+  TMemoFileClass = class of TMemoFile;
+
+implementation
+
+uses
+  SysUtils;
+
+//====================================================================
+//=== Memo and binary fields support
+//====================================================================
+type
+
+  PDbtHdr = ^rDbtHdr;
+  rDbtHdr = record
+    NextBlock : Longint;
+    Dummy     : array [4..7] of Byte;
+    DbfFile   : array [0..7] of Byte;   // 8..15
+    bVer      : Byte;                   // 16
+    Dummy2    : array [17..19] of Byte;
+    BlockLen  : Word;                   // 20..21
+    Dummy3    : array [22..511] of Byte;
+  end;
+
+  PFptHdr = ^rFptHdr;
+  rFptHdr = record
+    NextBlock : Longint;
+    Dummy     : array [4..5] of Byte;
+    BlockLen  : Word;                   // 20..21
+    Dummy3    : array [8..511] of Byte;
+  end;
+
+  PBlockHdr = ^rBlockHdr;
+  rBlockHdr = record
+    MemoType  : Cardinal;
+    MemoSize  : Cardinal;
+  end;
+
+
+//==========================================================
+//============ Dbtfile
+//==========================================================
+constructor TMemoFile.Create(AFileName: string);
+begin
+  // init vars
+  FBuffer := nil;
+  FOpened := false;
+
+  // call inherited
+  inherited Create(AFileName);
+end;
+
+destructor TMemoFile.Destroy;
+begin
+  // close file
+  Close;
+
+  // call ancestor
+  inherited;
+end;
+
+procedure TMemoFile.Open;
+begin
+  if not FOpened then
+  begin
+    // memo pages count start from begining of file!
+    PageOffsetByHeader := false;
+
+    // open physical file
+    OpenFile;
+
+    // read header
+    HeaderSize := 512;
+
+    // determine version
+    if FDbfVersion = xBaseIII then
+      PDbtHdr(Header).bVer := 3;
+    VirtualLocks := false;
+
+    if FileCreated or (HeaderSize = 0) then
+    begin
+      if (FMemoRecordSize = 0) or (FMemoRecordSize > HeaderSize) then
+        SetNextFreeBlock(1)
+      else
+        SetNextFreeBlock(HeaderSize div FMemoRecordSize);
+      SetBlockLen(FMemoRecordSize);
+      WriteHeader;
+    end;
+
+    RecordSize := GetBlockLen;
+    // checking for right blocksize not needed for foxpro?
+    if FDbfVersion <> xFoxPro then
+    begin
+      // mod 128 <> 0 <-> and 0x7F <> 0
+      if (RecordSize = 0) or ((RecordSize and $7F) <> 0) then
+      begin
+        SetBlockLen(512);
+        RecordSize := 512;
+        WriteHeader;
+      end;
+    end;
+
+    // get memory for temporary buffer
+    GetMem(FBuffer, RecordSize+2);
+    FBuffer[RecordSize] := #0;
+    FBuffer[RecordSize+1] := #0;
+
+    // now open
+    FOpened := true;
+  end;
+end;
+
+procedure TMemoFile.Close;
+begin
+  if FOpened then
+  begin
+    // close physical file
+    CloseFile;
+
+    // free mem
+    if FBuffer <> nil then
+      FreeMemAndNil(Pointer(FBuffer));
+
+    // now closed
+    FOpened := false;
+  end;
+end;
+
+procedure TMemoFile.ReadMemo(BlockNo: Integer; DestStream: TStream);
+var
+  bytesLeft,numBytes,dataStart: Integer;
+  done: Boolean;
+  lastc: char;
+  endMemo: PChar;
+begin
+  // clear dest
+  DestStream.Position := 0;
+  DestStream.Size := 0;
+  // no block to read?
+  if (BlockNo<=0) or (RecordSize=0) then
+    exit;
+  // read first block
+  if ReadRecord(BlockNo, @FBuffer[0]) = 0 then
+  begin
+    // EOF reached?
+    exit;
+  end;
+  bytesLeft := GetMemoSize;
+  // bytesLeft <> -1 -> memo size is known (FoxPro, dBase4)
+  // bytesLeft =  -1 -> memo size unknown (dBase3)
+  if bytesLeft <> -1 then
+  begin
+    dataStart := 8;
+    while bytesLeft > 0 do
+    begin
+      // get number of bytes to be read
+      numBytes := bytesLeft;
+      // too much for this block?
+      if numBytes > RecordSize - dataStart then
+        numBytes := RecordSize - dataStart;
+      // read block to stream
+      DestStream.Write(FBuffer[dataStart], numBytes);
+      // numBytes done
+      dec(bytesLeft, numBytes);
+      // still need to read bytes?
+      if bytesLeft > 0 then
+      begin
+        // read next block
+        inc(BlockNo);
+        dataStart := 0;
+        ReadRecord(BlockNo, @FBuffer[0]);
+      end;
+    end;
+  end else begin
+    // dbase III memo
+    done := false;
+    repeat
+      // scan for EOF
+      endMemo := MemScan(FBuffer, $1A, RecordSize);
+      // EOF found?
+      if endMemo <> nil then
+      begin
+        // really EOF?
+        if (endMemo-FBuffer < RecordSize - 1) and ((endMemo[1] = #$1A) or (endMemo[1] = #0)) then
+        begin
+          // yes, EOF found
+          done := true;
+          numBytes := endMemo - FBuffer;
+        end else begin
+          // no, fake
+          numBytes := RecordSize;
+        end;
+      end else begin
+        numBytes := RecordSize;
+      end;
+      // write to stream
+      DestStream.Write(FBuffer[0], numBytes);
+{
+      for i := 0 to RecordSize-2 do
+      begin
+        if (FBuffer[i]=#$1A) and (FBuffer[i+1]=#$1A) then
+        begin
+          if i>0 then
+            DestStream.Write(FBuffer[0], i);
+          done := true;
+          break;
+        end;
+      end;
+}
+      if not done then
+      begin
+{
+        DestStream.Write(FBuffer[0], 512);
+}
+        lastc := FBuffer[RecordSize-1];
+        inc(BlockNo);
+        if ReadRecord(BlockNo, @FBuffer[0]) > 0 then
+        begin
+          // check if immediate terminator at begin of block
+          done := (lastc = #$1A) and ((FBuffer[0] = #$1A) or (FBuffer[0] = #0));
+          // if so, written one character too much
+          if done then
+            DestStream.Size := DestStream.Size - 1;
+        end else begin
+          // error while reading, stop
+          done := true;
+        end;
+      end;
+    until done;
+  end;
+end;
+
+procedure TMemoFile.WriteMemo(var BlockNo: Integer; ReadSize: Integer; Src: TStream);
+var
+  bytesBefore: Integer;
+  bytesAfter: Integer;
+  totsize: Integer;
+  read: Integer;
+  append: Boolean;
+  tmpRecNo: Integer;
+begin
+  // if no data to write, then don't create new block
+  if Src.Size = 0 then
+  begin
+    BlockNo := 0;
+  end else begin
+    if FDbfVersion >= xBaseIV then      // dBase4 or FoxPro type
+    begin
+      bytesBefore := SizeOf(rBlockHdr);
+      bytesAfter := 0;
+    end else begin                      // dBase3 type
+      bytesBefore := 0;
+      bytesAfter := 2;
+    end;
+//    if ((bytesBefore + Src.Size + bytesAfter + PDbtHdr(Header).BlockLen-1) div PDbtHdr(Header).BlockLen)
+//        <= ((ReadSize + PDbtHdr(Header).BlockLen-1) div PDbtHdr(Header).BlockLen) then
+    if ((bytesBefore + Src.Size + bytesAfter + RecordSize-1) div RecordSize)
+        <= ((ReadSize + RecordSize-1) div RecordSize) then
+    begin
+      append := false;
+    end else begin
+      append := true;
+      // modifying header -> lock memo header
+      LockPage(0, true);
+      BlockNo := GetNextFreeBlock;
+      if BlockNo = 0 then
+      begin
+        SetNextFreeBlock(1);
+        BlockNo := 1;
+      end;
+    end;
+    tmpRecNo := BlockNo;
+    Src.Position := 0;
+    FillChar(FBuffer[0], RecordSize, ' ');
+    if bytesBefore=8 then
+    begin
+      totsize := Src.Size + bytesBefore + bytesAfter;
+      if FDbfVersion <> xFoxPro then
+      begin
+        PBlockHdr(FBuffer).MemoType := $0008FFFF;
+        PBlockHdr(FBuffer).MemoSize := totsize;
+      end else begin
+        PBlockHdr(FBuffer).MemoType := $01000000;
+        PBlockHdr(FBuffer).MemoSize := SwapInt(Src.Size);
+      end;
+    end;
+    repeat
+      // read bytes, don't overwrite header
+      read := Src.Read(FBuffer[bytesBefore], RecordSize{PDbtHdr(Header).BlockLen}-bytesBefore);
+      // end of input data reached ? check if need to write block terminators
+      while (read < RecordSize - bytesBefore) and (bytesAfter > 0) do
+      begin
+        FBuffer[read] := #$1A;
+        Inc(read);
+        Dec(bytesAfter);
+      end;
+      // have we read anything that is to be written?
+      if read > 0 then
+      begin
+        // clear any unused space
+        FillChar(FBuffer[bytesBefore+read], RecordSize-read-bytesBefore, ' ');
+        // write to disk
+        WriteRecord(tmpRecNo, @FBuffer[0]);
+        Inc(tmpRecNo);
+      end else break;
+      // first block read, second block can start at beginning
+      bytesBefore := 0;
+    until false;
+
+    if append then
+    begin
+      SetNextFreeBlock(tmpRecNo);
+      WriteHeader;
+      UnlockPage(0);
+    end;
+  end;
+end;
+
+// ------------------------------------------------------------------
+// dBase specific helper routines
+// ------------------------------------------------------------------
+
+function  TDbaseMemoFile.GetBlockLen: Integer;
+begin
+  // Can you tell me why the header of dbase3 memo contains 1024 and is 512 ?
+  // answer: it is not a valid field in memo db3 header
+  if FDbfVersion = xBaseIII then
+    Result := 512
+  else
+    Result := PDbtHdr(Header).BlockLen;
+end;
+
+function  TDbaseMemoFile.GetMemoSize: Integer;
+begin
+  // dBase4 memofiles contain small 'header'
+  if PInteger(@FBuffer[0])^ = $0008FFFF then
+    Result := PBlockHdr(FBuffer).MemoSize-8
+  else
+    Result := -1;
+end;
+
+function  TDbaseMemoFile.GetNextFreeBlock: Integer;
+begin
+  Result := PDbtHdr(Header).NextBlock;
+end;
+
+procedure TDbaseMemoFile.SetNextFreeBlock(BlockNo: Integer);
+begin
+  PDbtHdr(Header).NextBlock := BlockNo;
+end;
+
+procedure TDbaseMemoFile.SetBlockLen(BlockLen: Integer);
+begin
+  PDbtHdr(Header).BlockLen := BlockLen;
+end;
+
+// ------------------------------------------------------------------
+// FoxPro specific helper routines
+// ------------------------------------------------------------------
+
+function  TFoxProMemoFile.GetBlockLen: Integer;
+begin
+  Result := Swap(PFptHdr(Header).BlockLen);
+end;
+
+function  TFoxProMemoFile.GetMemoSize: Integer;
+begin
+  Result := SwapInt(PBlockHdr(FBuffer).MemoSize);
+end;
+
+function  TFoxProMemoFile.GetNextFreeBlock: Integer;
+begin
+  Result := SwapInt(PFptHdr(Header).NextBlock);
+end;
+
+procedure TFoxProMemoFile.SetNextFreeBlock(BlockNo: Integer);
+begin
+  PFptHdr(Header).NextBlock := SwapInt(BlockNo);
+end;
+
+procedure TFoxProMemoFile.SetBlockLen(BlockLen: Integer);
+begin
+  PFptHdr(Header).BlockLen := Swap(BlockLen);
+end;
+
+// ------------------------------------------------------------------
+// NULL file (no file) specific helper routines
+// ------------------------------------------------------------------
+
+constructor TNullMemoFile.Create(AFileName: string);
+begin
+  inherited;
+end;
+
+procedure TNullMemoFile.OpenFile;
+begin
+end;
+
+procedure TNullMemoFile.CloseFile;
+begin
+end;
+
+procedure TNullMemoFile.SetHeaderOffset(NewValue: Integer);
+begin
+  inherited SetHeaderOffset(0);
+end;
+
+procedure TNullMemoFile.SetRecordSize(NewValue: Integer);
+begin
+  inherited SetRecordSize(0);
+end;
+
+procedure TNullMemoFile.SetHeaderSize(NewValue: Integer);
+begin
+  inherited SetHeaderSize(0);
+end;
+
+function  TNullMemoFile.LockSection(const Offset, Length: Cardinal; const Wait: Boolean): Boolean;
+begin
+  Result := true;
+end;
+
+function  TNullMemoFile.UnlockSection(const Offset, Length: Cardinal): Boolean;
+begin
+  Result := true;
+end;
+
+function  TNullMemoFile.GetBlockLen: Integer;
+begin
+  Result := 0;
+end;
+
+function  TNullMemoFile.GetMemoSize: Integer;
+begin
+  Result := 0;
+end;
+
+function  TNullMemoFile.GetNextFreeBlock: Integer;
+begin
+  Result := 0;
+end;
+
+procedure TNullMemoFile.SetNextFreeBlock(BlockNo: Integer);
+begin
+end;
+
+procedure TNullMemoFile.SetBlockLen(BlockLen: Integer);
+begin
+end;
+
+function  TNullMemoFile.ReadRecord(IntRecNum: Integer; Buffer: Pointer): Integer;
+begin
+  Result := 0;
+end;
+
+procedure TNullMemoFile.WriteRecord(IntRecNum: Integer; Buffer: Pointer);
+begin
+end;
+
+end.

fcl/db/dbase/Dbf_Parser.pas

@@ -0,0 +1,1399 @@
+unit Dbf_Parser;
+
+interface
+
+{$I Dbf_Common.inc}
+
+uses
+  SysUtils,
+  Classes,
+{$ifdef KYLIX}
+  Libc,
+{$endif}
+{$ifndef WIN32}
+  Dbf_Wtil,
+{$endif}
+  Db,
+  Dbf_PrsCore,
+  Dbf_Common,
+  Dbf_Fields,
+  Dbf_PrsDef,
+  Dbf_PrsSupp;
+
+type
+
+  TDbfParser = class(TCustomExpressionParser)
+  private
+    FDbfFile: Pointer;
+    FFieldVarList: TStringList;
+    FResultLen: Integer;
+    FIsExpression: Boolean;       // expression or simple field?
+    FFieldType: TExpressionType;
+    FCaseInsensitive: Boolean;
+    FRawStringFields: Boolean;
+
+  protected
+    FCurrentExpression: string;
+
+    procedure FillExpressList; override;
+    procedure HandleUnknownVariable(VarName: string); override;
+    function  GetVariableInfo(VarName: string): TDbfFieldDef;
+    function  CurrentExpression: string; override;
+    function  GetResultType: TExpressionType; override;
+
+    procedure SetCaseInsensitive(NewInsensitive: Boolean);
+    procedure SetRawStringFields(NewRawFields: Boolean);
+  public
+    constructor Create(ADbfFile: Pointer);
+    destructor Destroy; override;
+
+    procedure ClearExpressions; override;
+
+    procedure ParseExpression(Expression: string); virtual;
+    function ExtractFromBuffer(Buffer: PChar): PChar; virtual;
+
+    property DbfFile: Pointer read FDbfFile write FDbfFile;
+    property Expression: string read FCurrentExpression;
+    property ResultLen: Integer read FResultLen;
+
+    property CaseInsensitive: Boolean read FCaseInsensitive write SetCaseInsensitive;
+    property RawStringFields: Boolean read FRawStringFields write SetRawStringFields;
+  end;
+
+//--Expression functions-----------------------------------------------------
+
+procedure FuncFloatToStr(Param: PExpressionRec);
+procedure FuncIntToStr_Gen(Param: PExpressionRec; Val: Integer);
+procedure FuncIntToStr(Param: PExpressionRec);
+procedure FuncDateToStr(Param: PExpressionRec);
+procedure FuncSubString(Param: PExpressionRec);
+procedure FuncUppercase(Param: PExpressionRec);
+procedure FuncLowercase(Param: PExpressionRec);
+procedure FuncAdd_F_FF(Param: PExpressionRec);
+procedure FuncAdd_F_FI(Param: PExpressionRec);
+procedure FuncAdd_F_II(Param: PExpressionRec);
+procedure FuncAdd_F_IF(Param: PExpressionRec);
+{$ifdef SUPPORT_INT64}
+procedure FuncAdd_F_FL(Param: PExpressionRec);
+procedure FuncAdd_F_IL(Param: PExpressionRec);
+procedure FuncAdd_F_LL(Param: PExpressionRec);
+procedure FuncAdd_F_LF(Param: PExpressionRec);
+procedure FuncAdd_F_LI(Param: PExpressionRec);
+{$endif}
+procedure FuncStrI_EQ(Param: PExpressionRec);
+procedure FuncStrI_NEQ(Param: PExpressionRec);
+procedure FuncStrI_LT(Param: PExpressionRec);
+procedure FuncStrI_GT(Param: PExpressionRec);
+procedure FuncStrI_LTE(Param: PExpressionRec);
+procedure FuncStrI_GTE(Param: PExpressionRec);
+procedure FuncStr_EQ(Param: PExpressionRec);
+procedure FuncStr_NEQ(Param: PExpressionRec);
+procedure FuncStr_LT(Param: PExpressionRec);
+procedure FuncStr_GT(Param: PExpressionRec);
+procedure FuncStr_LTE(Param: PExpressionRec);
+procedure FuncStr_GTE(Param: PExpressionRec);
+procedure Func_FF_EQ(Param: PExpressionRec);
+procedure Func_FF_NEQ(Param: PExpressionRec);
+procedure Func_FF_LT(Param: PExpressionRec);
+procedure Func_FF_GT(Param: PExpressionRec);
+procedure Func_FF_LTE(Param: PExpressionRec);
+procedure Func_FF_GTE(Param: PExpressionRec);
+procedure Func_FI_EQ(Param: PExpressionRec);
+procedure Func_FI_NEQ(Param: PExpressionRec);
+procedure Func_FI_LT(Param: PExpressionRec);
+procedure Func_FI_GT(Param: PExpressionRec);
+procedure Func_FI_LTE(Param: PExpressionRec);
+procedure Func_FI_GTE(Param: PExpressionRec);
+procedure Func_II_EQ(Param: PExpressionRec);
+procedure Func_II_NEQ(Param: PExpressionRec);
+procedure Func_II_LT(Param: PExpressionRec);
+procedure Func_II_GT(Param: PExpressionRec);
+procedure Func_II_LTE(Param: PExpressionRec);
+procedure Func_II_GTE(Param: PExpressionRec);
+procedure Func_IF_EQ(Param: PExpressionRec);
+procedure Func_IF_NEQ(Param: PExpressionRec);
+procedure Func_IF_LT(Param: PExpressionRec);
+procedure Func_IF_GT(Param: PExpressionRec);
+procedure Func_IF_LTE(Param: PExpressionRec);
+procedure Func_IF_GTE(Param: PExpressionRec);
+{$ifdef SUPPORT_INT64}
+procedure Func_LL_EQ(Param: PExpressionRec);
+procedure Func_LL_NEQ(Param: PExpressionRec);
+procedure Func_LL_LT(Param: PExpressionRec);
+procedure Func_LL_GT(Param: PExpressionRec);
+procedure Func_LL_LTE(Param: PExpressionRec);
+procedure Func_LL_GTE(Param: PExpressionRec);
+procedure Func_LF_EQ(Param: PExpressionRec);
+procedure Func_LF_NEQ(Param: PExpressionRec);
+procedure Func_LF_LT(Param: PExpressionRec);
+procedure Func_LF_GT(Param: PExpressionRec);
+procedure Func_LF_LTE(Param: PExpressionRec);
+procedure Func_LF_GTE(Param: PExpressionRec);
+procedure Func_FL_EQ(Param: PExpressionRec);
+procedure Func_FL_NEQ(Param: PExpressionRec);
+procedure Func_FL_LT(Param: PExpressionRec);
+procedure Func_FL_GT(Param: PExpressionRec);
+procedure Func_FL_LTE(Param: PExpressionRec);
+procedure Func_FL_GTE(Param: PExpressionRec);
+procedure Func_LI_EQ(Param: PExpressionRec);
+procedure Func_LI_NEQ(Param: PExpressionRec);
+procedure Func_LI_LT(Param: PExpressionRec);
+procedure Func_LI_GT(Param: PExpressionRec);
+procedure Func_LI_LTE(Param: PExpressionRec);
+procedure Func_LI_GTE(Param: PExpressionRec);
+procedure Func_IL_EQ(Param: PExpressionRec);
+procedure Func_IL_NEQ(Param: PExpressionRec);
+procedure Func_IL_LT(Param: PExpressionRec);
+procedure Func_IL_GT(Param: PExpressionRec);
+procedure Func_IL_LTE(Param: PExpressionRec);
+procedure Func_IL_GTE(Param: PExpressionRec);
+{$endif}
+procedure Func_AND(Param: PExpressionRec);
+procedure Func_OR(Param: PExpressionRec);
+procedure Func_NOT(Param: PExpressionRec);
+
+implementation
+
+uses
+  Dbf,
+  Dbf_DbfFile,
+  Dbf_Str
+{$ifdef WIN32}
+  ,Windows
+{$endif}
+  ;
+
+type
+// TFieldVar aids in retrieving field values from records
+// in their proper type
+
+  TFieldVar = class(TObject)
+  private
+    FFieldDef: TDbfFieldDef;
+    FDbfFile: TDbfFile;
+    FFieldName: string;
+  protected
+    function GetFieldVal: Pointer; virtual; abstract;
+    function GetFieldType: TExpressionType; virtual; abstract;
+  public
+    constructor Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
+
+    procedure Refresh(Buffer: PChar); virtual; abstract;
+
+    property FieldVal: Pointer read GetFieldVal;
+    property FieldDef: TDbfFieldDef read FFieldDef;
+    property FieldType: TExpressionType read GetFieldType;
+    property DbfFile: TDbfFile read FDbfFile;
+    property FieldName: string read FFieldName;
+  end;
+
+  TStringFieldVar = class(TFieldVar)
+  protected
+    FFieldVal: PChar;
+
+    function GetFieldVal: Pointer; override;
+    function GetFieldType: TExpressionType; override;
+  end;
+
+  TRawStringFieldVar = class(TStringFieldVar)
+  public
+    constructor Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
+
+    procedure Refresh(Buffer: PChar); override;
+  end;
+
+  TAnsiStringFieldVar = class(TStringFieldVar)
+  public
+    constructor Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
+    destructor Destroy; override;
+
+    procedure Refresh(Buffer: PChar); override;
+  end;
+
+  TFloatFieldVar = class(TFieldVar)
+  private
+    FFieldVal: Double;
+  protected
+    function GetFieldVal: Pointer; override;
+    function GetFieldType: TExpressionType; override;
+  public
+    constructor Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
+
+    procedure Refresh(Buffer: PChar); override;
+  end;
+
+  TIntegerFieldVar = class(TFieldVar)
+  private
+    FFieldVal: Integer;
+  protected
+    function GetFieldVal: Pointer; override;
+    function GetFieldType: TExpressionType; override;
+  public
+    constructor Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
+
+    procedure Refresh(Buffer: PChar); override;
+  end;
+
+{$ifdef SUPPORT_INT64}
+  TLargeIntFieldVar = class(TFieldVar)
+  private
+    FFieldVal: Int64;
+  protected
+    function GetFieldVal: Pointer; override;
+    function GetFieldType: TExpressionType; override;
+  public
+    constructor Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
+
+    procedure Refresh(Buffer: PChar); override;
+  end;
+{$endif}
+
+  TDateTimeFieldVar = class(TFieldVar)
+  private
+    FFieldVal: TDateTimeRec;
+    function GetFieldType: TExpressionType; override;
+  protected
+    function GetFieldVal: Pointer; override;
+  public
+    constructor Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
+
+    procedure Refresh(Buffer: PChar); override;
+  end;
+
+//--TFieldVar----------------------------------------------------------------
+constructor TFieldVar.Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
+begin
+  inherited Create;
+
+  // store field
+  FFieldDef := UseFieldDef;
+  FDbfFile := ADbfFile;
+  FFieldName := UseFieldDef.FieldName;
+end;
+
+//--TStringFieldVar-------------------------------------------------------------
+function TStringFieldVar.GetFieldVal: Pointer;
+begin
+  Result := @FFieldVal;
+end;
+
+function TStringFieldVar.GetFieldType: TExpressionType;
+begin
+  Result := etString;
+end;
+
+//--TRawStringFieldVar----------------------------------------------------------
+constructor TRawStringFieldVar.Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
+begin
+  inherited;
+end;
+
+procedure TRawStringFieldVar.Refresh(Buffer: PChar);
+begin
+  FFieldVal := Buffer + FieldDef.Offset;
+end;
+
+//--TAnsiStringFieldVar---------------------------------------------------------
+constructor TAnsiStringFieldVar.Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
+begin
+  inherited;
+
+  GetMem(FFieldVal, UseFieldDef.Size+1);
+end;
+
+destructor TAnsiStringFieldVar.Destroy;
+begin
+  FreeMem(FFieldVal);
+
+  inherited;
+end;
+
+procedure TAnsiStringFieldVar.Refresh(Buffer: PChar);
+var
+  Len: Integer;
+begin
+  // copy field data
+  Len := FieldDef.Size;
+  Move(Buffer[FieldDef.Offset], FFieldVal[0], Len);
+  // trim right side spaces by null-termination
+  while (Len > 1) and (FFieldVal[Len-1] = ' ') do Dec(Len);
+  FFieldVal[Len] := #0;
+  // translate to ANSI
+  TranslateString(DbfFile.UseCodePage, GetACP, FFieldVal, FFieldVal, Len);
+end;
+
+//--TFloatFieldVar-----------------------------------------------------------
+constructor TFloatFieldVar.Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
+begin
+  inherited;
+end;
+
+function TFloatFieldVar.GetFieldVal: Pointer;
+begin
+  Result := @FFieldVal;
+end;
+
+function TFloatFieldVar.GetFieldType: TExpressionType;
+begin
+  Result := etFloat;
+end;
+
+procedure TFloatFieldVar.Refresh(Buffer: PChar);
+begin
+  // database width is default 64-bit double
+  if not FDbfFile.GetFieldDataFromDef(FieldDef, FieldDef.FieldType, Buffer, @FFieldVal) then
+    FFieldVal := 0.0;
+end;
+
+//--TIntegerFieldVar----------------------------------------------------------
+constructor TIntegerFieldVar.Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
+begin
+  inherited;
+end;
+
+function TIntegerFieldVar.GetFieldVal: Pointer;
+begin
+  Result := @FFieldVal;
+end;
+
+function TIntegerFieldVar.GetFieldType: TExpressionType;
+begin
+  Result := etInteger;
+end;
+
+procedure TIntegerFieldVar.Refresh(Buffer: PChar);
+begin
+  FFieldVal := 0;
+  FDbfFile.GetFieldDataFromDef(FieldDef, FieldDef.FieldType, Buffer, @FFieldVal);
+end;
+
+{$ifdef SUPPORT_INT64}
+
+//--TLargeIntFieldVar----------------------------------------------------------
+constructor TLargeIntFieldVar.Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
+begin
+  inherited;
+end;
+
+function TLargeIntFieldVar.GetFieldVal: Pointer;
+begin
+  Result := @FFieldVal;
+end;
+
+function TLargeIntFieldVar.GetFieldType: TExpressionType;
+begin
+  Result := etLargeInt;
+end;
+
+procedure TLargeIntFieldVar.Refresh(Buffer: PChar);
+begin
+  if not FDbfFile.GetFieldDataFromDef(FieldDef, FieldDef.FieldType, Buffer, @FFieldVal) then
+    FFieldVal := 0;
+end;
+
+{$endif}
+
+//--TDateTimeFieldVar---------------------------------------------------------
+constructor TDateTimeFieldVar.Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
+begin
+  inherited;
+end;
+
+function TDateTimeFieldVar.GetFieldVal: Pointer;
+begin
+  Result := @FFieldVal;
+end;
+
+function TDateTimeFieldVar.GetFieldType: TExpressionType;
+begin
+  Result := etDateTime;
+end;
+
+procedure TDateTimeFieldVar.Refresh(Buffer: PChar);
+begin
+  if FDbfFile.GetFieldDataFromDef(FieldDef, ftDateTime, Buffer, @FFieldVal) then
+  begin
+{$ifndef SUPPORT_NEW_FIELDDATA}
+    // convert BDE timestamp to normal datetime
+    FFieldVal.DateTime := BDETimeStampToDateTime(FFieldVal.DateTime);
+{$endif}
+  end else begin
+    FFieldVal.DateTime := 0.0;
+  end;
+end;
+
+//--Expression functions-----------------------------------------------------
+
+procedure FuncFloatToStr(Param: PExpressionRec);
+var
+  width, numDigits, resWidth: Integer;
+  extVal: Extended;
+begin
+  with Param^ do
+  begin
+    // get params;
+    numDigits := 0;
+    if Args[1] <> nil then
+      width := PInteger(Args[1])^
+    else
+      width := 18;
+    if Args[2] <> nil then
+      numDigits := PInteger(Args[2])^;
+    // convert to string
+    Res.AssureSpace(width);
+    extVal := PDouble(Args[0])^;
+    resWidth := FloatToText(Res.MemoryPos^, extVal, {$ifndef FPC_VERSION}fvExtended,{$endif} ffFixed, 18, numDigits);
+    // always use dot as decimal separator
+    if numDigits > 0 then
+      Res.MemoryPos^[resWidth-numDigits-1] := '.';
+    // result width smaller than requested width? -> add space to compensate
+    if (Args[1] <> nil) and (resWidth < width) then
+    begin
+      // move string so that it's right-aligned
+      Move(Res.MemoryPos^^, (Res.MemoryPos^)[width-resWidth], resWidth);
+      // fill gap with spaces
+      FillChar(Res.MemoryPos^^, width-resWidth, ' ');
+      // resWidth has been padded, update
+      resWidth := width;
+    end else if resWidth > width then begin
+      // result width more than requested width, cut
+      resWidth := width;
+    end;
+    // advance pointer
+    Inc(Res.MemoryPos^, resWidth);
+    // null-terminate
+    Res.MemoryPos^^ := #0;
+  end;
+end;
+
+procedure FuncIntToStr_Gen(Param: PExpressionRec; Val: Integer);
+var
+  width: Integer;
+begin
+  with Param^ do
+  begin
+    // width specified?
+    if Args[1] <> nil then
+    begin
+      // convert to string
+      width := PInteger(Args[1])^;
+      GetStrFromInt_Width(Val, width, Res.MemoryPos^);
+      // advance pointer
+      Inc(Res.MemoryPos^, width);
+      // need to add decimal?
+      if Args[2] <> nil then
+      begin
+        // get number of digits
+        width := PInteger(Args[2])^;
+        // add decimal dot
+        Res.MemoryPos^^ := '.';
+        Inc(Res.MemoryPos^);
+        // add zeroes
+        FillChar(Res.MemoryPos^^, width, '0');
+        // go to end
+        Inc(Res.MemoryPos^, width);
+      end;
+    end else begin
+      // convert to string
+      width := GetStrFromInt(Val, Res.MemoryPos^);
+      // advance pointer
+      Inc(Param.Res.MemoryPos^, width);
+    end;
+    // null-terminate
+    Res.MemoryPos^^ := #0;
+  end;
+end;
+
+procedure FuncIntToStr(Param: PExpressionRec);
+begin
+  FuncIntToStr_Gen(Param, PInteger(Param.Args[0])^);
+end;
+
+procedure FuncDateToStr(Param: PExpressionRec);
+var
+  TempStr: string;
+begin
+  with Param^ do
+  begin
+    // create in temporary string
+    DateTimeToString(TempStr, 'yyyymmdd', PDateTimeRec(Args[0]).DateTime);
+    // copy to buffer
+    Res.Append(PChar(TempStr), Length(TempStr));
+  end;
+end;
+
+procedure FuncSubString(Param: PExpressionRec);
+var
+  srcLen, index, count: Integer;
+begin
+  with Param^ do
+  begin
+    srcLen := StrLen(Args[0]);
+    index := PInteger(Args[1])^ - 1;
+    count := PInteger(Args[2])^;
+    if index + count <= srcLen then
+      Res.Append(Args[0]+index, count)
+    else
+      Res.MemoryPos^^ := #0;
+  end;
+end;
+
+procedure FuncUppercase(Param: PExpressionRec);
+var
+  dest: PChar;
+begin
+  with Param^ do
+  begin
+    // first copy
+    dest := (Res.MemoryPos)^;
+    Res.Append(Args[0], StrLen(Args[0]));
+    // make uppercase
+    StrUpper(dest);
+  end;
+end;
+
+procedure FuncLowercase(Param: PExpressionRec);
+var
+  dest: PChar;
+begin
+  with Param^ do
+  begin
+    // first copy
+    dest := (Res.MemoryPos)^;
+    Res.Append(Args[0], StrLen(Args[0]));
+    // make lowercase
+    StrLower(dest);
+  end;
+end;
+
+procedure FuncAdd_F_FF(Param: PExpressionRec);
+begin
+  with Param^ do
+    PDouble(Res.MemoryPos^)^ := PDouble(Args[0])^ + PDouble(Args[1])^;
+end;
+
+procedure FuncAdd_F_FI(Param: PExpressionRec);
+begin
+  with Param^ do
+    PDouble(Res.MemoryPos^)^ := PDouble(Args[0])^ + PInteger(Args[1])^;
+end;
+
+procedure FuncAdd_F_II(Param: PExpressionRec);
+begin
+  with Param^ do
+    PInteger(Res.MemoryPos^)^ := PInteger(Args[0])^ + PInteger(Args[1])^;
+end;
+
+procedure FuncAdd_F_IF(Param: PExpressionRec);
+begin
+  with Param^ do
+    PDouble(Res.MemoryPos^)^ := PInteger(Args[0])^ + PDouble(Args[1])^;
+end;
+
+{$ifdef SUPPORT_INT64}
+
+procedure FuncAdd_F_FL(Param: PExpressionRec);
+begin
+  with Param^ do
+    PDouble(Res.MemoryPos^)^ := PDouble(Args[0])^ + PInt64(Args[1])^;
+end;
+
+procedure FuncAdd_F_IL(Param: PExpressionRec);
+begin
+  with Param^ do
+    PInt64(Res.MemoryPos^)^ := PInteger(Args[0])^ + PInt64(Args[1])^;
+end;
+
+procedure FuncAdd_F_LL(Param: PExpressionRec);
+begin
+  with Param^ do
+    PInt64(Res.MemoryPos^)^ := PInt64(Args[0])^ + PInt64(Args[1])^;
+end;
+
+procedure FuncAdd_F_LF(Param: PExpressionRec);
+begin
+  with Param^ do
+    PDouble(Res.MemoryPos^)^ := PInt64(Args[0])^ + PDouble(Args[1])^;
+end;
+
+procedure FuncAdd_F_LI(Param: PExpressionRec);
+begin
+  with Param^ do
+    PInt64(Res.MemoryPos^)^ := PInt64(Args[0])^ + PInteger(Args[1])^;
+end;
+
+{$endif}
+
+procedure FuncStrI_EQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(AnsiStrIComp(Args[0], Args[1]) = 0);
+end;
+
+procedure FuncStrI_NEQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(AnsiStrIComp(Args[0], Args[1]) <> 0);
+end;
+
+procedure FuncStrI_LT(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(AnsiStrIComp(Args[0], Args[1]) < 0);
+end;
+
+procedure FuncStrI_GT(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(AnsiStrIComp(Args[0], Args[1]) > 0);
+end;
+
+procedure FuncStrI_LTE(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(AnsiStrIComp(Args[0], Args[1]) <= 0);
+end;
+
+procedure FuncStrI_GTE(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(AnsiStrIComp(Args[0], Args[1]) >= 0);
+end;
+
+procedure FuncStr_EQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(AnsiStrComp(Args[0], Args[1]) = 0);
+end;
+
+procedure FuncStr_NEQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(AnsiStrComp(Args[0], Args[1]) <> 0);
+end;
+
+procedure FuncStr_LT(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(AnsiStrComp(Args[0], Args[1]) < 0);
+end;
+
+procedure FuncStr_GT(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(AnsiStrComp(Args[0], Args[1]) > 0);
+end;
+
+procedure FuncStr_LTE(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(AnsiStrComp(Args[0], Args[1]) <= 0);
+end;
+
+procedure FuncStr_GTE(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(AnsiStrComp(Args[0], Args[1]) >= 0);
+end;
+
+procedure Func_FF_EQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PDouble(Args[0])^   =  PDouble(Args[1])^);
+end;
+
+procedure Func_FF_NEQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PDouble(Args[0])^   <> PDouble(Args[1])^);
+end;
+
+procedure Func_FF_LT(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PDouble(Args[0])^   <  PDouble(Args[1])^);
+end;
+
+procedure Func_FF_GT(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PDouble(Args[0])^   >  PDouble(Args[1])^);
+end;
+
+procedure Func_FF_LTE(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PDouble(Args[0])^   <= PDouble(Args[1])^);
+end;
+
+procedure Func_FF_GTE(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PDouble(Args[0])^   >= PDouble(Args[1])^);
+end;
+
+procedure Func_FI_EQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PDouble(Args[0])^   =  PInteger(Args[1])^);
+end;
+
+procedure Func_FI_NEQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PDouble(Args[0])^   <> PInteger(Args[1])^);
+end;
+
+procedure Func_FI_LT(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PDouble(Args[0])^   <  PInteger(Args[1])^);
+end;
+
+procedure Func_FI_GT(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PDouble(Args[0])^   >  PInteger(Args[1])^);
+end;
+
+procedure Func_FI_LTE(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PDouble(Args[0])^   <= PInteger(Args[1])^);
+end;
+
+procedure Func_FI_GTE(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PDouble(Args[0])^   >= PInteger(Args[1])^);
+end;
+
+procedure Func_II_EQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInteger(Args[0])^  =  PInteger(Args[1])^);
+end;
+
+procedure Func_II_NEQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInteger(Args[0])^  <> PInteger(Args[1])^);
+end;
+
+procedure Func_II_LT(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInteger(Args[0])^  <  PInteger(Args[1])^);
+end;
+
+procedure Func_II_GT(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInteger(Args[0])^  >  PInteger(Args[1])^);
+end;
+
+procedure Func_II_LTE(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInteger(Args[0])^  <= PInteger(Args[1])^);
+end;
+
+procedure Func_II_GTE(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInteger(Args[0])^  >= PInteger(Args[1])^);
+end;
+
+procedure Func_IF_EQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInteger(Args[0])^  =  PDouble(Args[1])^);
+end;
+
+procedure Func_IF_NEQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInteger(Args[0])^  <> PDouble(Args[1])^);
+end;
+
+procedure Func_IF_LT(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInteger(Args[0])^  <  PDouble(Args[1])^);
+end;
+
+procedure Func_IF_GT(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInteger(Args[0])^  >  PDouble(Args[1])^);
+end;
+
+procedure Func_IF_LTE(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInteger(Args[0])^  <= PDouble(Args[1])^);
+end;
+
+procedure Func_IF_GTE(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInteger(Args[0])^  >= PDouble(Args[1])^);
+end;
+
+{$ifdef SUPPORT_INT64}
+
+procedure Func_LL_EQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInt64(Args[0])^    =  PInt64(Args[1])^);
+end;
+
+procedure Func_LL_NEQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInt64(Args[0])^    <> PInt64(Args[1])^);
+end;
+
+procedure Func_LL_LT(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInt64(Args[0])^    <  PInt64(Args[1])^);
+end;
+
+procedure Func_LL_GT(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInt64(Args[0])^    >  PInt64(Args[1])^);
+end;
+
+procedure Func_LL_LTE(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInt64(Args[0])^    <= PInt64(Args[1])^);
+end;
+
+procedure Func_LL_GTE(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInt64(Args[0])^    >= PInt64(Args[1])^);
+end;
+
+procedure Func_LF_EQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInt64(Args[0])^    =  PDouble(Args[1])^);
+end;
+
+procedure Func_LF_NEQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInt64(Args[0])^    <> PDouble(Args[1])^);
+end;
+
+procedure Func_LF_LT(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInt64(Args[0])^    <  PDouble(Args[1])^);
+end;
+
+procedure Func_LF_GT(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInt64(Args[0])^    >  PDouble(Args[1])^);
+end;
+
+procedure Func_LF_LTE(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInt64(Args[0])^    <= PDouble(Args[1])^);
+end;
+
+procedure Func_LF_GTE(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInt64(Args[0])^    >= PDouble(Args[1])^);
+end;
+
+procedure Func_FL_EQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PDouble(Args[0])^   =  PInt64(Args[1])^);
+end;
+
+procedure Func_FL_NEQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PDouble(Args[0])^   <> PInt64(Args[1])^);
+end;
+
+procedure Func_FL_LT(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PDouble(Args[0])^   <  PInt64(Args[1])^);
+end;
+
+procedure Func_FL_GT(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PDouble(Args[0])^   >  PInt64(Args[1])^);
+end;
+
+procedure Func_FL_LTE(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PDouble(Args[0])^   <= PInt64(Args[1])^);
+end;
+
+procedure Func_FL_GTE(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PDouble(Args[0])^   >= PInt64(Args[1])^);
+end;
+
+procedure Func_LI_EQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInt64(Args[0])^    =  PInteger(Args[1])^);
+end;
+
+procedure Func_LI_NEQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInt64(Args[0])^    <> PInteger(Args[1])^);
+end;
+
+procedure Func_LI_LT(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInt64(Args[0])^    <  PInteger(Args[1])^);
+end;
+
+procedure Func_LI_GT(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInt64(Args[0])^    >  PInteger(Args[1])^);
+end;
+
+procedure Func_LI_LTE(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInt64(Args[0])^    <= PInteger(Args[1])^);
+end;
+
+procedure Func_LI_GTE(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInt64(Args[0])^    >= PInteger(Args[1])^);
+end;
+
+procedure Func_IL_EQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInteger(Args[0])^  =  PInt64(Args[1])^);
+end;
+
+procedure Func_IL_NEQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInteger(Args[0])^  <> PInt64(Args[1])^);
+end;
+
+procedure Func_IL_LT(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInteger(Args[0])^  <  PInt64(Args[1])^);
+end;
+
+procedure Func_IL_GT(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInteger(Args[0])^  >  PInt64(Args[1])^);
+end;
+
+procedure Func_IL_LTE(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInteger(Args[0])^  <= PInt64(Args[1])^);
+end;
+
+procedure Func_IL_GTE(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PInteger(Args[0])^  >= PInt64(Args[1])^);
+end;
+
+{$endif}
+
+procedure Func_AND(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(Boolean(Args[0]^) and Boolean(Args[1]^));
+end;
+
+procedure Func_OR(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(Boolean(Args[0]^) or Boolean(Args[1]^));
+end;
+
+procedure Func_NOT(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(not Boolean(Args[0]^));
+end;
+
+//--TDbfParser---------------------------------------------------------------
+
+var
+  DbfWordsSensList, DbfWordsInsensList: TExpressList;
+  DbfWordsAllList: TOCollection;
+
+constructor TDbfParser.Create(ADbfFile: Pointer);
+begin
+  FDbfFile := ADbfFile;
+  FFieldVarList := TStringList.Create;
+  FCaseInsensitive := true;
+  FRawStringFields := true;
+  inherited Create;
+end;
+
+destructor TDbfParser.Destroy;
+begin
+  ClearExpressions;
+  inherited;
+  FreeAndNil(FFieldVarList);
+end;
+
+function TDbfParser.GetResultType: TExpressionType;
+begin
+  // if not a real expression, return type ourself
+  if FIsExpression then
+    Result := inherited GetResultType
+  else
+    Result := FFieldType;
+end;
+
+procedure TDbfParser.SetCaseInsensitive(NewInsensitive: Boolean);
+begin
+  if FCaseInsensitive <> NewInsensitive then
+  begin
+    // clear and regenerate functions
+    FCaseInsensitive := NewInsensitive;
+    FillExpressList;
+    if Length(Expression) > 0 then
+      ParseExpression(Expression);
+  end;
+end;
+
+procedure TDbfParser.SetRawStringFields(NewRawFields: Boolean);
+begin
+  if FRawStringFields <> NewRawFields then
+  begin
+    // clear and regenerate functions, custom fields will be deleted too
+    FRawStringFields := NewRawFields;
+    if Length(Expression) > 0 then
+      ParseExpression(Expression);
+  end;
+end;
+
+procedure TDbfParser.FillExpressList;
+begin
+  FWordsList.FreeAll;
+  if FCaseInsensitive then
+  begin
+    FWordsList.AddList(DbfWordsInsensList, 0, DbfWordsInsensList.Count - 1);
+  end else begin
+    FWordsList.AddList(DbfWordsSensList, 0, DbfWordsSensList.Count - 1);
+  end;
+end;
+
+function TDbfParser.GetVariableInfo(VarName: string): TDbfFieldDef;
+begin
+  Result := TDbfFile(FDbfFile).GetFieldInfo(VarName);
+end;
+
+procedure TDbfParser.HandleUnknownVariable(VarName: string);
+var
+  FieldInfo: TDbfFieldDef;
+  TempFieldVar: TFieldVar;
+begin
+  // is this variable a fieldname?
+  FieldInfo := GetVariableInfo(VarName);
+  if FieldInfo = nil then
+    raise EDbfError.CreateFmt(STRING_INDEX_BASED_ON_UNKNOWN_FIELD, [VarName]);
+
+  // define field in parser
+  case FieldInfo.FieldType of
+    ftString, ftBoolean:
+      begin
+        if RawStringFields then
+          TempFieldVar := TRawStringFieldVar.Create(FieldInfo, TDbfFile(FDbfFile))
+        else
+          TempFieldVar := TAnsiStringFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
+        DefineStringVariableFixedLen(VarName, TempFieldVar.FieldVal, FieldInfo.Size);
+      end;
+    ftFloat:
+      begin
+        TempFieldVar := TFloatFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
+        DefineFloatVariable(VarName, TempFieldVar.FieldVal);
+      end;
+    ftAutoInc, ftInteger, ftSmallInt:
+      begin
+        TempFieldVar := TIntegerFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
+        DefineIntegerVariable(VarName, TempFieldVar.FieldVal);
+      end;
+{
+    ftSmallInt:
+      begin
+        TempFieldVar := TSmallIntFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
+        DefineSmallIntVariable(VarName, TempFieldVar.FieldVal);
+      end;
+}
+{$ifdef SUPPORT_INT64}
+    ftLargeInt:
+      begin
+        TempFieldVar := TLargeIntFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
+        DefineLargeIntVariable(VarName, TempFieldVar.FieldVal);
+      end;
+{$endif}
+    ftDate, ftDateTime:
+      begin
+        TempFieldVar := TDateTimeFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
+        DefineDateTimeVariable(VarName, TempFieldVar.FieldVal);
+      end;
+  else
+    raise EDbfError.CreateFmt(STRING_INDEX_BASED_ON_INVALID_FIELD, [VarName]);
+  end;
+
+  // add to our own list
+  FFieldVarList.AddObject(VarName, TempFieldVar);
+end;
+
+function TDbfParser.CurrentExpression: string;
+begin
+  Result := FCurrentExpression;
+end;
+
+procedure TDbfParser.ClearExpressions;
+var
+  I: Integer;
+begin
+  inherited;
+
+  // test if already freed
+  if FFieldVarList <> nil then
+  begin
+    // free field list
+    for I := 0 to FFieldVarList.Count - 1 do
+    begin
+      // replacing with nil = undefining variable
+      ReplaceFunction(TFieldVar(FFieldVarList.Objects[I]).FieldName, nil);
+      TFieldVar(FFieldVarList.Objects[I]).Free;
+    end;
+    FFieldVarList.Clear;
+  end;
+
+  // clear expression
+  FCurrentExpression := EmptyStr;
+end;
+
+procedure TDbfParser.ParseExpression(Expression: string);
+var
+  TempBuffer: array[0..4000] of Char;
+begin
+  // clear any current expression
+  ClearExpressions;
+
+  // is this a simple field or complex expression?
+  FIsExpression := GetVariableInfo(Expression) = nil;
+  if FIsExpression then
+  begin
+    // parse requested
+    CompileExpression(Expression);
+
+    // determine length of string length expressions
+    if ResultType = etString then
+    begin
+      // make empty record
+      TDbfFile(FDbfFile).InitRecord(@TempBuffer[0]);
+      FResultLen := StrLen(ExtractFromBuffer(@TempBuffer[0]));
+    end;
+  end else begin
+    // simple field, create field variable for it
+    HandleUnknownVariable(Expression);
+    FFieldType := TFieldVar(FFieldVarList.Objects[0]).FieldType;
+    // set result len of variable length fields
+    if FFieldType = etString then
+      FResultLen := TFieldVar(FFieldVarList.Objects[0]).FieldDef.Size
+  end;
+
+  // set result len for fixed length expressions / fields
+  case ResultType of
+    etBoolean:  FResultLen := 1;
+    etInteger:  FResultLen := 4;
+    etFloat:    FResultLen := 8;
+    etDateTime: FResultLen := 8;
+  end;
+
+  // check if expression not too long
+  if FResultLen > 100 then
+    raise EDbfError.CreateFmt(STRING_INDEX_EXPRESSION_TOO_LONG, [Expression, FResultLen]);
+
+  // if no errors, assign current expression
+  FCurrentExpression := Expression;
+end;
+
+function TDbfParser.ExtractFromBuffer(Buffer: PChar): PChar;
+var
+  I: Integer;
+begin
+  // prepare all field variables
+  for I := 0 to FFieldVarList.Count - 1 do
+    TFieldVar(FFieldVarList.Objects[I]).Refresh(Buffer);
+
+  // complex expression?
+  if FIsExpression then
+  begin
+    // execute expression
+    EvaluateCurrent;
+    Result := ExpResult;
+  end else begin
+    // simple field, get field result
+    Result := TFieldVar(FFieldVarList.Objects[0]).FieldVal;
+    // if string then dereference
+    if FFieldType = etString then
+      Result := PPChar(Result)^;
+  end;
+end;
+
+var
+  GenCount, SensCount, AllCount: Integer;
+initialization
+
+  DbfWordsSensList := TExpressList.Create;
+  DbfWordsInsensList := TExpressList.Create;
+  DbfWordsAllList := TExpressList.Create;
+
+  with DbfWordsAllList do
+  begin
+    // basic function functionality
+    Add(TLeftBracket.Create('(', nil));
+    Add(TRightBracket.Create(')', nil));
+    Add(TComma.Create(',', nil));
+
+    // operators - name, param types, result type, func addr, precedence
+    Add(TFunction.CreateOper('+', 'SS', etString,   nil,          40));
+    Add(TFunction.CreateOper('+', 'FF', etFloat,    FuncAdd_F_FF, 40));
+    Add(TFunction.CreateOper('+', 'FI', etFloat,    FuncAdd_F_FI, 40));
+    Add(TFunction.CreateOper('+', 'IF', etFloat,    FuncAdd_F_IF, 40));
+    Add(TFunction.CreateOper('+', 'II', etInteger,  FuncAdd_F_II, 40));
+{$ifdef SUPPORT_INT64}
+    Add(TFunction.CreateOper('+', 'FL', etFloat,    FuncAdd_F_FL, 40));
+    Add(TFunction.CreateOper('+', 'IL', etLargeInt, FuncAdd_F_IL, 40));
+    Add(TFunction.CreateOper('+', 'LF', etFloat,    FuncAdd_F_LF, 40));
+    Add(TFunction.CreateOper('+', 'LL', etLargeInt, FuncAdd_F_LI, 40));
+    Add(TFunction.CreateOper('+', 'LI', etLargeInt, FuncAdd_F_LL, 40));
+{$endif}
+
+    Add(TFunction.CreateOper('=', 'FF', etBoolean, Func_FF_EQ , 80));
+    Add(TFunction.CreateOper('<', 'FF', etBoolean, Func_FF_LT , 80));
+    Add(TFunction.CreateOper('>', 'FF', etBoolean, Func_FF_GT , 80));
+    Add(TFunction.CreateOper('<=','FF', etBoolean, Func_FF_LTE, 80));
+    Add(TFunction.CreateOper('>=','FF', etBoolean, Func_FF_GTE, 80));
+    Add(TFunction.CreateOper('<>','FF', etBoolean, Func_FF_NEQ, 80));
+    Add(TFunction.CreateOper('=', 'FI', etBoolean, Func_FI_EQ , 80));
+    Add(TFunction.CreateOper('<', 'FI', etBoolean, Func_FI_LT , 80));
+    Add(TFunction.CreateOper('>', 'FI', etBoolean, Func_FI_GT , 80));
+    Add(TFunction.CreateOper('<=','FI', etBoolean, Func_FI_LTE, 80));
+    Add(TFunction.CreateOper('>=','FI', etBoolean, Func_FI_GTE, 80));
+    Add(TFunction.CreateOper('<>','FI', etBoolean, Func_FI_NEQ, 80));
+    Add(TFunction.CreateOper('=', 'II', etBoolean, Func_II_EQ , 80));
+    Add(TFunction.CreateOper('<', 'II', etBoolean, Func_II_LT , 80));
+    Add(TFunction.CreateOper('>', 'II', etBoolean, Func_II_GT , 80));
+    Add(TFunction.CreateOper('<=','II', etBoolean, Func_II_LTE, 80));
+    Add(TFunction.CreateOper('>=','II', etBoolean, Func_II_GTE, 80));
+    Add(TFunction.CreateOper('<>','II', etBoolean, Func_II_NEQ, 80));
+    Add(TFunction.CreateOper('=', 'IF', etBoolean, Func_IF_EQ , 80));
+    Add(TFunction.CreateOper('<', 'IF', etBoolean, Func_IF_LT , 80));
+    Add(TFunction.CreateOper('>', 'IF', etBoolean, Func_IF_GT , 80));
+    Add(TFunction.CreateOper('<=','IF', etBoolean, Func_IF_LTE, 80));
+    Add(TFunction.CreateOper('>=','IF', etBoolean, Func_IF_GTE, 80));
+    Add(TFunction.CreateOper('<>','IF', etBoolean, Func_IF_NEQ, 80));
+{$ifdef SUPPORT_INT64}
+    Add(TFunction.CreateOper('=', 'LL', etBoolean, Func_LL_EQ , 80));
+    Add(TFunction.CreateOper('<', 'LL', etBoolean, Func_LL_LT , 80));
+    Add(TFunction.CreateOper('>', 'LL', etBoolean, Func_LL_GT , 80));
+    Add(TFunction.CreateOper('<=','LL', etBoolean, Func_LL_LTE, 80));
+    Add(TFunction.CreateOper('>=','LL', etBoolean, Func_LL_GTE, 80));
+    Add(TFunction.CreateOper('<>','LL', etBoolean, Func_LL_NEQ, 80));
+    Add(TFunction.CreateOper('=', 'LF', etBoolean, Func_LF_EQ , 80));
+    Add(TFunction.CreateOper('<', 'LF', etBoolean, Func_LF_LT , 80));
+    Add(TFunction.CreateOper('>', 'LF', etBoolean, Func_LF_GT , 80));
+    Add(TFunction.CreateOper('<=','LF', etBoolean, Func_LF_LTE, 80));
+    Add(TFunction.CreateOper('>=','LF', etBoolean, Func_LF_GTE, 80));
+    Add(TFunction.CreateOper('<>','FI', etBoolean, Func_LF_NEQ, 80));
+    Add(TFunction.CreateOper('=', 'LI', etBoolean, Func_LI_EQ , 80));
+    Add(TFunction.CreateOper('<', 'LI', etBoolean, Func_LI_LT , 80));
+    Add(TFunction.CreateOper('>', 'LI', etBoolean, Func_LI_GT , 80));
+    Add(TFunction.CreateOper('<=','LI', etBoolean, Func_LI_LTE, 80));
+    Add(TFunction.CreateOper('>=','LI', etBoolean, Func_LI_GTE, 80));
+    Add(TFunction.CreateOper('<>','LI', etBoolean, Func_LI_NEQ, 80));
+    Add(TFunction.CreateOper('=', 'FL', etBoolean, Func_FL_EQ , 80));
+    Add(TFunction.CreateOper('<', 'FL', etBoolean, Func_FL_LT , 80));
+    Add(TFunction.CreateOper('>', 'FL', etBoolean, Func_FL_GT , 80));
+    Add(TFunction.CreateOper('<=','FL', etBoolean, Func_FL_LTE, 80));
+    Add(TFunction.CreateOper('>=','FL', etBoolean, Func_FL_GTE, 80));
+    Add(TFunction.CreateOper('<>','FL', etBoolean, Func_FL_NEQ, 80));
+    Add(TFunction.CreateOper('=', 'IL', etBoolean, Func_IL_EQ , 80));
+    Add(TFunction.CreateOper('<', 'IL', etBoolean, Func_IL_LT , 80));
+    Add(TFunction.CreateOper('>', 'IL', etBoolean, Func_IL_GT , 80));
+    Add(TFunction.CreateOper('<=','IL', etBoolean, Func_IL_LTE, 80));
+    Add(TFunction.CreateOper('>=','IL', etBoolean, Func_IL_GTE, 80));
+    Add(TFunction.CreateOper('<>','IL', etBoolean, Func_IL_NEQ, 80));
+{$endif}
+
+    Add(TFunction.CreateOper('NOT', 'B',  etBoolean, Func_NOT, 85));
+    Add(TFunction.CreateOper('AND', 'BB', etBoolean, Func_AND, 90));
+    Add(TFunction.CreateOper('OR',  'BB', etBoolean, Func_OR, 100));
+
+    // functions - name, description, param types, min params, result type, func addr
+    Add(TFunction.Create('STR',       '',      'FII', 1, etString, FuncFloatToStr, ''));
+    Add(TFunction.Create('STR',       '',      'III', 1, etString, FuncIntToStr, ''));
+    Add(TFunction.Create('DTOS',      '',      'D',   1, etString, FuncDateToStr, ''));
+    Add(TFunction.Create('SUBSTR',    'SUBS',  'SII', 3, etString, FuncSubString, ''));
+    Add(TFunction.Create('UPPERCASE', 'UPPER', 'S',   1, etString, FuncUppercase, ''));
+    Add(TFunction.Create('LOWERCASE', 'LOWER', 'S',   1, etString, FuncLowercase, ''));
+
+    GenCount := Count;
+
+    Add(TFunction.CreateOper('=', 'SS', etBoolean, FuncStr_EQ , 80));
+    Add(TFunction.CreateOper('<', 'SS', etBoolean, FuncStr_LT , 80));
+    Add(TFunction.CreateOper('>', 'SS', etBoolean, FuncStr_GT , 80));
+    Add(TFunction.CreateOper('<=','SS', etBoolean, FuncStr_LTE, 80));
+    Add(TFunction.CreateOper('>=','SS', etBoolean, FuncStr_GTE, 80));
+    Add(TFunction.CreateOper('<>','SS', etBoolean, FuncStr_NEQ, 80));
+
+    SensCount := Count;
+
+    Add(TFunction.CreateOper('=', 'SS', etBoolean, FuncStrI_EQ , 80));
+    Add(TFunction.CreateOper('<', 'SS', etBoolean, FuncStrI_LT , 80));
+    Add(TFunction.CreateOper('>', 'SS', etBoolean, FuncStrI_GT , 80));
+    Add(TFunction.CreateOper('<=','SS', etBoolean, FuncStrI_LTE, 80));
+    Add(TFunction.CreateOper('>=','SS', etBoolean, FuncStrI_GTE, 80));
+    Add(TFunction.CreateOper('<>','SS', etBoolean, FuncStrI_NEQ, 80));
+
+    AllCount := Count;
+  end;
+
+  DbfWordsInsensList.AddList(DbfWordsAllList, 0, GenCount - 1);
+  DbfWordsInsensList.AddList(DbfWordsAllList, SensCount, AllCount - 1);
+  DbfWordsSensList.AddList(DbfWordsAllList, 0, SensCount - 1);
+
+finalization
+
+  DbfWordsAllList.Free;
+  DbfWordsInsensList.Free;
+  DbfWordsSensList.Free;
+
+end.
+

fcl/db/dbase/Dbf_PgFile.pas

@@ -0,0 +1,881 @@
+unit Dbf_PgFile;
+
+interface
+
+{$I Dbf_Common.inc}
+
+uses
+  Classes,
+  SysUtils,
+  Dbf_Common;
+
+//const
+//  MaxHeaders = 256;
+
+type
+  EPagedFile = Exception;
+
+  TPagedFileMode = (pfNone, pfMemory, pfExclusiveCreate, pfExclusiveOpen,
+    pfReadWriteCreate, pfReadWriteOpen, pfReadOnly);
+
+  // access levels:
+  //
+  // - memory            create
+  // - exclusive         create/open
+  // - read/write        create/open
+  // - readonly                 open
+  //
+  // - memory            -*-share: N/A          -*-locks: disabled    -*-indexes: read/write
+  // - exclusive_create  -*-share: deny write   -*-locks: disabled    -*-indexes: read/write
+  // - exclusive_open    -*-share: deny write   -*-locks: disabled    -*-indexes: read/write
+  // - readwrite_create  -*-share: deny none    -*-locks: enabled     -*-indexes: read/write
+  // - readwrite_open    -*-share: deny none    -*-locks: enabled     -*-indexes: read/write
+  // - readonly          -*-share: deny none    -*-locks: disabled    -*-indexes: readonly
+
+  TPagedFile = class(TObject)
+  protected
+    FStream: TStream;
+    FHeaderOffset: Integer;
+    FHeaderSize: Integer;
+    FRecordSize: Integer;
+    FPageSize: Integer;         { need for MDX, where recordsize <> pagesize }
+    FRecordCount: Integer;      { actually FPageCount, but we want to keep existing code }
+    FPagesPerRecord: Integer;
+    FCachedSize: Integer;
+    FHeader: PChar;
+    FNeedRecalc: Boolean;
+    FHeaderModified: Boolean;
+    FPageOffsetByHeader: Boolean;   { do pages start after header or just at BOF? }
+    FMode: TPagedFileMode;
+    FTempMode: TPagedFileMode;
+    FUserMode: TPagedFileMode;
+    FAutoCreate: Boolean;
+    FNeedLocks: Boolean;
+    FVirtualLocks: Boolean;
+    FFileLocked: Boolean;
+    FFileName: string;
+    FBufferPtr: Pointer;
+    FBufferAhead: Boolean;
+    FBufferPage: Integer;
+    FBufferOffset: Integer;
+    FBufferSize: Integer;
+    FBufferReadSize: Integer;
+    FBufferMaxSize: Integer;
+    FBufferModified: Boolean;
+    FWriteError: Boolean;
+  protected
+    procedure SetHeaderOffset(NewValue: Integer); virtual;
+    procedure SetRecordSize(NewValue: Integer); virtual;
+    procedure SetHeaderSize(NewValue: Integer); virtual;
+    procedure SetPageSize(NewValue: Integer);
+    procedure SetPageOffsetByHeader(NewValue: Boolean); virtual;
+    procedure SetRecordCount(NewValue: Integer);
+    procedure SetBufferAhead(NewValue: Boolean);
+    function  LockSection(const Offset, Length: Cardinal; const Wait: Boolean): Boolean; virtual;
+    function  UnlockSection(const Offset, Length: Cardinal): Boolean; virtual;
+    procedure UpdateBufferSize;
+    procedure RecalcPagesPerRecord;
+    procedure ReadHeader;
+    procedure FlushHeader;
+    procedure FlushBuffer;
+    function  ReadChar: Byte;
+    procedure WriteChar(c: Byte);
+    procedure CheckCachedSize(const APosition: Integer);
+    procedure SynchronizeBuffer(IntRecNum: Integer);
+    function  Read(Buffer: Pointer; ASize: Integer): Integer;
+    function  ReadBlock(const BlockPtr: Pointer; const ASize, APosition: Integer): Integer;
+    function  SingleReadRecord(IntRecNum: Integer; Buffer: Pointer): Integer;
+    procedure WriteBlock(const BlockPtr: Pointer; const ASize, APosition: Integer);
+    procedure SingleWriteRecord(IntRecNum: Integer; Buffer: Pointer);
+    function  GetRecordCount: Integer;
+    function  IsSharedAccess: Boolean;
+    procedure UpdateCachedSize(CurrPos: Integer);
+
+    property VirtualLocks: Boolean read FVirtualLocks write FVirtualLocks;
+    property Stream: TStream read FStream;
+  public
+    constructor Create(AFileName: string);
+    destructor Destroy; override;
+
+    procedure CloseFile; virtual;
+    procedure OpenFile; virtual;
+    procedure DeleteFile;
+    procedure TryExclusive; virtual;
+    procedure EndExclusive; virtual;
+    procedure CheckExclusiveAccess;
+    procedure DisableForceCreate;
+    function  CalcPageOffset(const PageNo: Integer): Integer;
+    function  ReadRecord(IntRecNum: Integer; Buffer: Pointer): Integer; virtual;
+    procedure WriteRecord(IntRecNum: Integer; Buffer: Pointer); virtual;
+    procedure WriteHeader; virtual;
+    procedure WriteTo(DestFile: TPagedFile);
+    function  FileCreated: Boolean;
+    procedure ResetError;
+
+    function  LockPage(const PageNo: Integer; const Wait: Boolean): Boolean;
+    function  LockAllPages(const Wait: Boolean): Boolean;
+    procedure UnlockPage(const PageNo: Integer);
+    procedure UnlockAllPages;
+
+    procedure Flush; virtual;
+
+    property AutoCreate: Boolean read FAutoCreate write FAutoCreate;   // only write when closed!
+    property Mode: TPagedFileMode read FMode write FMode;              // only write when closed!
+    property TempMode: TPagedFileMode read FTempMode;
+    property NeedLocks: Boolean read FNeedLocks;
+    property HeaderOffset: Integer read FHeaderOffset write SetHeaderOffset;
+    property HeaderSize: Integer read FHeaderSize write SetHeaderSize;
+    property RecordSize: Integer read FRecordSize write SetRecordSize;
+    property PageSize: Integer read FPageSize write SetPageSize;
+    property PagesPerRecord: Integer read FPagesPerRecord;
+    property RecordCount: Integer read GetRecordCount write SetRecordCount;
+    property PageOffsetByHeader: Boolean read FPageOffsetbyHeader write SetPageOffsetByHeader;
+    property FileLocked: Boolean read FFileLocked;
+    property Header: PChar read FHeader;
+    property FileName: string read FFileName;
+    property BufferAhead: Boolean read FBufferAhead write SetBufferAhead;
+    property WriteError: Boolean read FWriteError;
+  end;
+
+implementation
+
+uses
+{$ifdef WIN32}
+  Windows,
+{$else}
+{$ifdef KYLIX}
+  Libc, 
+{$endif}  
+  Types, Dbf_Wtil,
+{$endif}
+  Dbf_Str;
+
+//====================================================================
+// TPagedFile
+//====================================================================
+constructor TPagedFile.Create(AFileName: string);
+begin
+  FFileName := AFileName;
+  FHeaderOffset := 0;
+  FHeaderSize := 0;
+  FRecordSize := 0;
+  FRecordCount := 0;
+  FPageSize := 0;
+  FPagesPerRecord := 0;
+  FHeaderModified := false;
+  FPageOffsetByHeader := true;
+  FNeedLocks := false;
+  FMode := pfReadOnly;
+  FTempMode := pfNone;
+  FAutoCreate := false;
+  FVirtualLocks := true;
+  FFileLocked := false;
+  FHeader := nil;
+  FBufferPtr := nil;
+  FBufferAhead := false;
+  FBufferModified := false;
+  FBufferSize := 0;
+  FBufferMaxSize := 0;
+  FBufferOffset := 0;
+  FWriteError := false;
+end;
+
+destructor TPagedFile.Destroy;
+begin
+  // close physical file
+  if FFileLocked then UnlockAllPages;
+  CloseFile;
+
+  // free mem
+  if FHeader <> nil then
+    FreeMem(FHeader);
+
+  inherited;
+end;
+
+procedure TPagedFile.OpenFile;
+var
+  fileOpenMode: Word;
+begin
+  if FStream = nil then
+  begin
+    // store user specified mode
+    FUserMode := FMode;
+    if FMode <> pfMemory then
+    begin
+      // test if file exists
+      if not FileExists(FFileName) then
+      begin
+        // if auto-creating, adjust mode
+        if FAutoCreate then case FMode of
+          pfExclusiveOpen:             FMode := pfExclusiveCreate;
+          pfReadWriteOpen, pfReadOnly: FMode := pfReadWriteCreate;
+        end;
+        // it seems the VCL cannot share a file that is created?
+        // create file first, then open it in requested mode
+        // filecreated means 'to be created' in this context ;-)
+        if FileCreated then
+          FileClose(FileCreate(FFileName))
+        else
+          raise EPagedFile.CreateFmt(STRING_FILE_NOT_FOUND,[FFileName]);
+      end;
+      // specify open mode
+      case FMode of
+        pfExclusiveCreate: fileOpenMode := fmOpenReadWrite or fmShareDenyWrite;
+        pfExclusiveOpen:   fileOpenMode := fmOpenReadWrite or fmShareDenyWrite;
+        pfReadWriteCreate: fileOpenMode := fmOpenReadWrite or fmShareDenyNone;
+        pfReadWriteOpen:   fileOpenMode := fmOpenReadWrite or fmShareDenyNone;
+      else    // => readonly
+                           fileOpenMode := fmOpenRead or fmShareDenyNone;
+      end;
+      // open file
+      FStream := TFileStream.Create(FFileName, fileOpenMode);
+      // if creating, then empty file
+      if FileCreated then
+        FStream.Size := 0;
+    end else begin
+      FStream := TMemoryStream.Create;
+    end;
+    // init size var
+    FCachedSize := Stream.Size;
+    // update whether we need locking
+{$ifdef _DEBUG}
+    FNeedLocks := true;
+{$else}
+    FNeedLocks := IsSharedAccess;
+{$endif}
+  end;
+end;
+
+procedure TPagedFile.CloseFile;
+begin
+  if FStream <> nil then
+  begin
+    FlushHeader;
+    FreeAndNil(FStream);
+
+    // mode possibly overriden in case of auto-created file
+    FMode := FUserMode;
+  end;
+end;
+
+procedure TPagedFile.DeleteFile;
+begin
+  // opened -> we can not delete
+  if FStream = nil then
+    SysUtils.DeleteFile(FileName);
+end;
+
+function TPagedFile.FileCreated: Boolean;
+const
+  CreationModes: array [pfMemory..pfReadOnly] of Boolean =
+    (true, true, false, true, false, false);
+//    mem, excr, exopn, rwcr, rwopn, rdonly
+begin
+  Result := CreationModes[FMode];
+end;
+
+function TPagedFile.IsSharedAccess: Boolean;
+begin
+  Result := (Mode <> pfExclusiveOpen) and (Mode <> pfExclusiveCreate) and (Mode <> pfMemory);
+end;
+
+procedure TPagedFile.CheckExclusiveAccess;
+begin
+  // in-memory => exclusive access!
+  if IsSharedAccess then
+    raise EDbfError.Create(STRING_NEED_EXCLUSIVE_ACCESS);
+end;
+
+function TPagedFile.CalcPageOffset(const PageNo: Integer): Integer;
+begin
+  if not FPageOffsetByHeader then
+    Result := FPageSize * PageNo
+  else if PageNo = 0 then
+    Result := 0
+  else
+    Result := FHeaderOffset + FHeaderSize + (FPageSize * (PageNo - 1))
+end;
+
+procedure TPagedFile.CheckCachedSize(const APosition: Integer);
+begin
+  // file expanded?
+  if APosition > FCachedSize then
+  begin
+    FCachedSize := APosition;
+    FNeedRecalc := true;
+  end;
+end;
+
+function TPagedFile.Read(Buffer: Pointer; ASize: Integer): Integer;
+begin
+  // if we cannot read due to a lock, then wait a bit
+  repeat
+    Result := FStream.Read(Buffer^, ASize);
+    if Result = 0 then
+    begin
+      // translation to linux???
+      if GetLastError = ERROR_LOCK_VIOLATION then
+      begin
+        // wait a bit until block becomes available
+        Sleep(1);
+      end else begin
+        // return empty block
+        exit;
+      end;
+    end else
+      exit;
+  until false;
+end;
+
+procedure TPagedFile.UpdateCachedSize(CurrPos: Integer);
+begin
+  // have we added a record?
+  if CurrPos > FCachedSize then
+  begin
+    // update cached size, always at end
+    repeat
+      Inc(FCachedSize, FRecordSize);
+      Inc(FRecordCount, PagesPerRecord);
+    until FCachedSize >= CurrPos;
+  end;
+end;
+
+procedure TPagedFile.FlushBuffer;
+begin
+  if FBufferAhead and FBufferModified then
+  begin
+    WriteBlock(FBufferPtr, FBufferSize, FBufferOffset);
+    FBufferModified := false;
+  end;
+end;
+
+function TPagedFile.SingleReadRecord(IntRecNum: Integer; Buffer: Pointer): Integer;
+begin
+  Result := ReadBlock(Buffer, RecordSize, CalcPageOffset(IntRecNum));
+end;
+
+procedure TPagedFile.SingleWriteRecord(IntRecNum: Integer; Buffer: Pointer);
+begin
+  WriteBlock(Buffer, RecordSize, CalcPageOffset(IntRecNum));
+end;
+
+procedure TPagedFile.SynchronizeBuffer(IntRecNum: Integer);
+begin
+  // record outside buffer, flush previous buffer
+  FlushBuffer;
+  // read new set of records
+  FBufferPage := IntRecNum;
+  FBufferOffset := CalcPageOffset(IntRecNum);
+  if FBufferOffset + FBufferMaxSize > FCachedSize then
+    FBufferReadSize := FCachedSize - FBufferOffset
+  else
+    FBufferReadSize := FBufferMaxSize;
+  FBufferSize := FBufferReadSize;
+  FBufferReadSize := ReadBlock(FBufferPtr, FBufferReadSize, FBufferOffset);
+end;
+
+function TPagedFile.ReadRecord(IntRecNum: Integer; Buffer: Pointer): Integer;
+var
+  Offset: Integer;
+begin
+  if FBufferAhead then
+  begin
+    Offset := (IntRecNum - FBufferPage) * PageSize;
+    if (FBufferPage <> -1) and (FBufferPage <= IntRecNum) and
+        (Offset+RecordSize <= FBufferReadSize) then
+    begin
+      // have record in buffer, nothing to do here
+    end else begin
+      // need to update buffer
+      SynchronizeBuffer(IntRecNum);
+      // check if enough bytes read
+      if RecordSize > FBufferReadSize then
+      begin
+        Result := 0;
+        exit;
+      end;
+      // reset offset into buffer
+      Offset := 0;
+    end;
+    // now we have this record in buffer
+    Move(PChar(FBufferPtr)[Offset], Buffer^, RecordSize);
+    // successful
+    Result := RecordSize;
+  end else begin
+    // no buffering
+    Result := SingleReadRecord(IntRecNum, Buffer);
+  end;
+end;
+
+procedure TPagedFile.WriteRecord(IntRecNum: Integer; Buffer: Pointer);
+var
+  RecEnd: Integer;
+begin
+  if FBufferAhead then
+  begin
+    RecEnd := (IntRecNum - FBufferPage + PagesPerRecord) * PageSize;
+    if (FBufferPage <> -1) and (FBufferPage <= IntRecNum) and
+        (RecEnd <= FBufferMaxSize) then
+    begin
+      // extend buffer?
+      if RecEnd > FBufferSize then
+        FBufferSize := RecEnd;
+    end else begin
+      // record outside buffer, need to synchronize first
+      SynchronizeBuffer(IntRecNum);
+      RecEnd := PagesPerRecord * PageSize;
+    end;
+    // we can write this record to buffer
+    Move(Buffer^, PChar(FBufferPtr)[RecEnd-RecordSize], RecordSize);
+    FBufferModified := true;
+    // update cached size
+    UpdateCachedSize(FBufferOffset+RecEnd);
+  end else begin
+    // no buffering
+    SingleWriteRecord(IntRecNum, Buffer);
+    // update cached size
+    UpdateCachedSize(FStream.Position);
+  end;
+end;
+
+procedure TPagedFile.SetBufferAhead(NewValue: Boolean);
+begin
+  if FBufferAhead <> NewValue then
+  begin
+    FlushBuffer;
+    FBufferAhead := NewValue;
+    UpdateBufferSize;
+  end;
+end;
+
+procedure TPagedFile.UpdateBufferSize;
+begin
+  if FBufferAhead then
+  begin
+    FBufferMaxSize := 65536;
+    if RecordSize <> 0 then
+      Dec(FBufferMaxSize, FBufferMaxSize mod PageSize);
+  end else begin
+    FBufferMaxSize := 0;
+  end;
+
+  if FBufferPtr <> nil then
+    FreeMem(FBufferPtr);
+  if FBufferAhead and (FBufferMaxSize <> 0) then
+    GetMem(FBufferPtr, FBufferMaxSize)
+  else
+    FBufferPtr := nil;
+  FBufferPage := -1;
+  FBufferOffset := -1;
+  FBufferModified := false;
+end;
+
+procedure TPagedFile.WriteHeader;
+begin
+  FHeaderModified := true;
+  if FNeedLocks then
+    FlushHeader;
+end;
+
+procedure TPagedFile.FlushHeader;
+begin
+  if FHeaderModified then
+  begin
+    FStream.Position := FHeaderOffset;
+    FWriteError := (FStream.Write(FHeader^, FHeaderSize) = 0) or FWriteError;
+    // test if written new header
+    if FStream.Position > FCachedSize then
+    begin
+      // new header -> record count unknown
+      FCachedSize := FStream.Position;
+      FNeedRecalc := true;
+    end;
+    FHeaderModified := false;
+  end;
+end;
+
+procedure TPagedFile.WriteTo(DestFile: TPagedFile);
+begin
+  // if we are a memory file, then support is built into VCL
+  if FMode = pfMemory then
+  begin
+    FlushHeader;
+    DestFile.FStream.Position := 0;
+    DestFile.FStream.Size := 0;
+    TMemoryStream(FStream).SaveToStream(DestFile.FStream);
+  end;
+end;
+
+procedure TPagedFile.ReadHeader;
+   { assumes header is large enough }
+var
+  size: Integer;
+begin
+  // save changes before reading new header
+  FlushHeader;
+  // check if header length zero
+  if FHeaderSize <> 0 then
+  begin
+    // get size left in file for header
+    size := FStream.Size - FHeaderOffset;
+    // header start before EOF?
+    if size >= 0 then
+    begin
+      // go to header start
+      FStream.Position := FHeaderOffset;
+      // whole header in file?
+      if size >= FHeaderSize then
+      begin
+        // read header, nothing to be cleared
+        Read(FHeader, FHeaderSize);
+        size := FHeaderSize;
+      end else begin
+        // read what we can, clear rest
+        Read(FHeader, size);
+      end;
+    end else begin
+      // header start before EOF, clear header
+      size := 0;
+    end;
+    FillChar(FHeader[size], FHeaderSize-size, 0);
+  end;
+end;
+
+procedure TPagedFile.TryExclusive;
+const NewTempMode: array[pfReadWriteCreate..pfReadOnly] of TPagedFileMode =
+    (pfReadWriteOpen, pfReadWriteOpen, pfReadOnly);
+begin
+  // already in temporary exclusive mode?
+  if (FTempMode = pfNone) and IsSharedAccess then
+  begin
+    // save temporary mode, if now creating, then reopen non-create
+    FTempMode := NewTempMode[FMode];
+    // try exclusive mode
+    CloseFile;
+    FMode := pfExclusiveOpen;
+    try
+      OpenFile;
+    except
+      on EFOpenError do
+      begin
+        // we failed, reopen normally
+        EndExclusive;
+      end;
+    end;
+  end;
+end;
+
+procedure TPagedFile.EndExclusive;
+begin
+  // are we in temporary file mode?
+  if FTempMode <> pfNone then
+  begin
+    CloseFile;
+    FMode := FTempMode;
+    FTempMode := pfNone;
+    OpenFile;
+  end;
+end;
+
+procedure TPagedFile.DisableForceCreate;
+begin
+  case FMode of
+    pfExclusiveCreate: FMode := pfExclusiveOpen;
+    pfReadWriteCreate: FMode := pfReadWriteOpen;
+  end;
+end;
+
+procedure TPagedFile.SetHeaderOffset(NewValue: Integer);
+//
+// *) assumes is called right before SetHeaderSize
+//
+begin
+  if FHeaderOffset <> NewValue then
+  begin
+    FlushHeader;
+    FHeaderOffset := NewValue;
+  end;
+end;
+
+procedure TPagedFile.SetHeaderSize(NewValue: Integer);
+begin
+  if FHeaderSize <> NewValue then
+  begin
+    FlushHeader;
+    if (FHeader <> nil) and (NewValue <> 0) then
+      FreeMem(FHeader);
+    FHeaderSize := NewValue;
+    if FHeaderSize <> 0 then
+      GetMem(FHeader, FHeaderSize);
+    FNeedRecalc := true;
+    ReadHeader;
+  end;
+end;
+
+procedure TPagedFile.SetRecordSize(NewValue: Integer);
+begin
+  if FRecordSize <> NewValue then
+  begin
+    FRecordSize := NewValue;
+    FPageSize := NewValue;
+    FNeedRecalc := true;
+    RecalcPagesPerRecord;
+  end;
+end;
+
+procedure TPagedFile.SetPageSize(NewValue: Integer);
+begin
+  if FPageSize <> NewValue then
+  begin
+    FPageSize := NewValue;
+    FNeedRecalc := true;
+    RecalcPagesPerRecord;
+    UpdateBufferSize;
+  end;
+end;
+
+procedure TPagedFile.RecalcPagesPerRecord;
+begin
+  if FPageSize = 0 then
+    FPagesPerRecord := 0
+  else
+    FPagesPerRecord := FRecordSize div FPageSize;
+end;
+
+function TPagedFile.GetRecordCount: Integer;
+var
+  currSize: Integer;
+begin
+  // file size changed?
+  if FNeedLocks then
+  begin
+    currSize := FStream.Size;
+    if currSize <> FCachedSize then
+    begin
+      FCachedSize := currSize;
+      FNeedRecalc := true;
+    end;
+  end;
+
+  // try to optimize speed
+  if FNeedRecalc then
+  begin
+    // no file? test flags
+    if (FPageSize = 0) or (FStream = nil) then
+      FRecordCount := 0
+    else
+    if FPageOffsetByHeader then
+      FRecordCount := (FCachedSize - FHeaderSize - FHeaderOffset) div FPageSize
+    else
+      FRecordCount := FCachedSize div FPageSize;
+    if FRecordCount < 0 then
+      FRecordCount := 0;
+
+    // count updated
+    FNeedRecalc := false;
+  end;
+  Result := FRecordCount;
+end;
+
+procedure TPagedFile.SetRecordCount(NewValue: Integer);
+begin
+  if RecordCount <> NewValue then
+  begin
+    if FPageOffsetByHeader then
+      FCachedSize := FHeaderSize + FHeaderOffset + FPageSize * NewValue
+    else
+      FCachedSize := FPageSize * NewValue;
+//    FCachedSize := CalcPageOffset(NewValue);
+    FRecordCount := NewValue;
+    FStream.Size := FCachedSize;
+  end;
+end;
+
+procedure TPagedFile.SetPageOffsetByHeader(NewValue: Boolean);
+begin
+  if FPageOffsetByHeader <> NewValue then
+  begin
+    FPageOffsetByHeader := NewValue;
+    FNeedRecalc := true;
+  end;
+end;
+
+procedure TPagedFile.WriteChar(c: Byte);
+begin
+  FWriteError := (FStream.Write(c, 1) = 0) or FWriteError;
+end;
+
+function TPagedFile.ReadChar: Byte;
+begin
+  Read(@Result, 1);
+end;
+
+procedure TPagedFile.Flush;
+begin
+end;
+
+function TPagedFile.ReadBlock(const BlockPtr: Pointer; const ASize, APosition: Integer): Integer;
+begin
+  FStream.Position := APosition;
+  CheckCachedSize(APosition);
+  Result := Read(BlockPtr, ASize);
+end;
+
+procedure TPagedFile.WriteBlock(const BlockPtr: Pointer; const ASize, APosition: Integer);
+  // assumes a lock is held if necessary prior to calling this function
+begin
+  FStream.Position := APosition;
+  CheckCachedSize(APosition);
+  FWriteError := (FStream.Write(BlockPtr^, ASize) = 0) or FWriteError;
+end;
+
+procedure TPagedFile.ResetError;
+begin
+  FWriteError := false;
+end;
+
+// BDE compatible lock offset found!
+const
+{$ifdef WIN32}
+  LockOffset = $EFFFFFFE;       // BDE compatible
+  FileLockSize = 2;
+{$else}
+  LockOffset = $7FFFFFFF;
+  FileLockSize = 1;
+{$endif}
+
+// dBase supports maximum of a billion records
+  LockStart  = LockOffset - 1000000000;
+
+function TPagedFile.LockSection(const Offset, Length: Cardinal; const Wait: Boolean): Boolean;
+  // assumes FNeedLock = true
+var
+  Failed: Boolean;
+begin
+  // FNeedLocks => FStream is of type TFileStream
+  Failed := false;
+  repeat
+    Result := LockFile(TFileStream(FStream).Handle, Offset, 0, Length, 0);
+    // test if lock violation, then wait a bit and try again
+    if not Result and Wait then
+    begin
+      if (GetLastError = ERROR_LOCK_VIOLATION) then
+        Sleep(10)
+      else
+        Failed := true;
+    end;
+  until Result or not Wait or Failed;
+end;
+
+function TPagedFile.UnlockSection(const Offset, Length: Cardinal): Boolean;
+begin
+  Result := UnlockFile(TFileStream(FStream).Handle, Offset, 0, Length, 0);
+end;
+
+function TPagedFile.LockAllPages(const Wait: Boolean): Boolean;
+var
+  Offset: Cardinal;
+  Length: Cardinal;
+begin
+  // do we need locking?
+  if FNeedLocks and not FFileLocked then
+  begin
+    if FVirtualLocks then
+    begin
+{$ifdef SUPPORT_UINT32_CARDINAL}
+      Offset := LockStart;
+      Length := LockOffset - LockStart + FileLockSize;
+{$else}
+      // delphi 3 has strange types:
+      // cardinal 0..2 GIG ?? does it produce correct code?
+      Offset := Cardinal(LockStart);
+      Length := Cardinal(LockOffset) - Cardinal(LockStart) + FileLockSize;
+{$endif}
+    end else begin
+      Offset := 0;
+      Length := $7FFFFFFF;
+    end;
+    // lock requested section
+    Result := LockSection(Offset, Length, Wait);
+    FFileLocked := Result;
+  end else
+    Result := true;
+end;
+
+procedure TPagedFile.UnlockAllPages;
+var
+  Offset: Cardinal;
+  Length: Cardinal;
+begin
+  // do we need locking?
+  if FNeedLocks and FFileLocked then
+  begin
+    if FVirtualLocks then
+    begin
+{$ifdef SUPPORT_UINT32_CARDINAL}
+      Offset := LockStart;
+      Length := LockOffset - LockStart + FileLockSize;
+{$else}
+      // delphi 3 has strange types:
+      // cardinal 0..2 GIG ?? does it produce correct code?
+      Offset := Cardinal(LockStart);
+      Length := Cardinal(LockOffset) - Cardinal(LockStart) + FileLockSize;
+{$endif}
+    end else begin
+      Offset := 0;
+      Length := $7FFFFFFF;
+    end;
+    // unlock requested section
+    // FNeedLocks => FStream is of type TFileStream
+    FFileLocked := not UnlockSection(Offset, Length);
+  end;
+end;
+
+function TPagedFile.LockPage(const PageNo: Integer; const Wait: Boolean): Boolean;
+var
+  Offset: Cardinal;
+  Length: Cardinal;
+begin
+  // do we need locking?
+  if FNeedLocks and not FFileLocked then
+  begin
+    if FVirtualLocks then
+    begin
+      Offset := LockOffset - Cardinal(PageNo);
+      Length := 1;
+    end else begin
+      Offset := CalcPageOffset(PageNo);
+      Length := RecordSize;
+    end;
+    // lock requested section
+    Result := LockSection(Offset, Length, Wait);
+  end else
+    Result := true;
+end;
+
+procedure TPagedFile.UnlockPage(const PageNo: Integer);
+var
+  Offset: Cardinal;
+  Length: Cardinal;
+begin
+  // do we need locking?
+  if FNeedLocks and not FFileLocked then
+  begin
+    // calc offset + length
+    if FVirtualLocks then
+    begin
+      Offset := LockOffset - Cardinal(PageNo);
+      Length := 1;
+    end else begin
+      Offset := CalcPageOffset(PageNo);
+      Length := RecordSize;
+    end;
+    // unlock requested section
+    // FNeedLocks => FStream is of type TFileStream
+    UnlockSection(Offset, Length);
+  end;
+end;
+
+end.
+

fcl/db/dbase/Dbf_PgcFile.pas

@@ -0,0 +1,234 @@
+unit Dbf_PgcFile;
+
+{force CR/LF fix}
+
+// paged, cached file
+
+interface
+
+{$I Dbf_Common.inc}
+
+{$ifdef USE_CACHE}
+
+uses
+  Classes,
+  SysUtils,
+  Dbf_Common,
+  Dbf_Avl,
+  Dbf_PgFile;
+
+type
+
+  PPageInfo = ^TPageInfo;
+  TPageInfo = record
+    TimeStamp: Cardinal;
+    Modified: Boolean;
+    Data: Char;
+  end;
+
+  TCachedFile = class(TPagedFile)
+  private
+    FPageTree: TAvlTree;
+    FUseTree: TAvlTree;
+    FTimeStamp: Cardinal;
+    FPageInfoSize: Integer;
+    FCacheSize: Integer;
+    FMaxPages: Cardinal;
+
+    function  GetTimeStamp: Cardinal;
+    procedure UpdateTimeStamp(RecNo: Integer; Data: PPageInfo);
+    procedure PageDeleted(Sender: TAvlTree; Data: PData);
+    procedure UpdateMaxPages;
+    function  AddToCache(RecNo: Integer; Buffer: Pointer): PPageInfo;
+  protected
+    procedure SetRecordSize(NewValue: Integer); override;
+    procedure SetCacheSize(NewSize: Integer);
+  public
+    constructor Create(AFileName: string);
+    destructor Destroy; override;
+
+    procedure CloseFile; override;
+    procedure Flush; override;
+
+    function  ReadRecord(RecNo: Integer; Buffer: Pointer): Integer; override;
+    procedure WriteRecord(RecNo: Integer; Buffer: Pointer); override;
+
+    property CacheSize: Integer read FCacheSize write SetCacheSize;
+  end;
+
+{$endif}
+
+implementation
+
+{$ifdef USE_CACHE}
+
+constructor TCachedFile.Create(AFileName: string);
+begin
+  inherited;
+
+  FPageTree := TAvlTree.Create;
+  FPageTree.OnDelete := PageDeleted;
+  FUseTree := TAvlTree.Create;
+  FPageInfoSize := 0;
+  FTimeStamp := 0;
+  FCacheSize := 256 * 1024;
+end;
+
+destructor TCachedFile.Destroy;
+begin
+  Flush;
+
+  FPageTree.Free;
+  FUseTree.Free;
+  FPageTree := nil;
+  FUseTree := nil;
+
+  inherited;
+end;
+
+procedure TCachedFile.Flush;
+begin
+  if FPageTree <> nil then
+  begin
+    FPageTree.Clear;
+    FUseTree.Clear;
+  end;
+  FTimeStamp := 0;
+end;
+
+procedure TCachedFile.CloseFile;
+begin
+  // flush modified pages to disk
+  Flush;
+
+  // now we can safely close
+  inherited;
+end;
+
+procedure TCachedFile.SetRecordSize(NewValue: Integer);
+begin
+  inherited;
+
+  // first flush all pages, restart caching with new parameters
+  Flush;
+
+  // calculate size of extra data of pagetree
+  FPageInfoSize := SizeOf(TPageInfo) - SizeOf(Char) + RecordSize;
+  UpdateMaxPages;
+end;
+
+procedure TCachedFile.SetCacheSize(NewSize: Integer);
+begin
+  if FCacheSize <> NewSize then
+  begin
+    FCacheSize := NewSize;
+    UpdateMaxPages;
+  end;
+end;
+
+procedure TCachedFile.UpdateMaxPages;
+begin
+  if RecordSize = 0 then
+    FMaxPages := 0
+  else
+    FMaxPages := FCacheSize div RecordSize;
+end;
+
+function TCachedFile.GetTimeStamp: Cardinal;
+begin
+  Result := FTimeStamp;
+  Inc(FTimeStamp);
+end;
+
+procedure TCachedFile.PageDeleted(Sender: TAvlTree; Data: PData);
+begin
+  // data modified? write to disk
+  if PPageInfo(Data^.ExtraData)^.Modified then
+    inherited WriteRecord(Data^.ID, @PPageInfo(Data^.ExtraData)^.Data);
+
+  // free cached page mem
+  FreeMem(Data^.ExtraData);
+end;
+
+function TCachedFile.AddToCache(RecNo: Integer; Buffer: Pointer): PPageInfo;
+var
+  oldData: PData;
+begin
+  // make sure there is a free page in the cache
+  while FPageTree.Count >= FMaxPages do
+  begin
+    // no free space, find oldest page
+    oldData := FUseTree.Lowest;
+    // remove from cache
+    FPageTree.Delete(Integer(oldData^.ExtraData));
+    FUseTree.Delete(oldData^.ID);
+  end;
+  // add to cache
+  GetMem(Result, FPageInfoSize);
+  Result^.TimeStamp := GetTimeStamp;
+  Result^.Modified := false;
+  Move(Buffer^, Result^.Data, RecordSize);
+  FPageTree.Insert(RecNo, Result);
+  FUseTree.Insert(Result^.TimeStamp, Pointer(RecNo));
+end;
+
+procedure TCachedFile.UpdateTimeStamp(RecNo: Integer; Data: PPageInfo);
+begin
+  // update time used
+  FUseTree.Delete(Data^.TimeStamp);
+  Data^.TimeStamp := GetTimeStamp;
+  FUseTree.Insert(Data^.TimeStamp, Pointer(RecNo));
+end;
+
+function TCachedFile.ReadRecord(RecNo: Integer; Buffer: Pointer): Integer;
+var
+  Data: PPageInfo;
+begin
+  // only cache when we do not need locking
+  if NeedLocks then
+  begin Result := inherited ReadRecord(RecNo, Buffer) end else begin
+    // do we have this page in cache?
+    Data := PPageInfo(FPageTree.Find(RecNo));
+    if Data <> nil then
+    begin
+      // copy from cache
+      Move(Data^.Data, Buffer^, RecordSize);
+      UpdateTimeStamp(RecNo, Data);
+      Result := RecordSize;
+    end else begin
+      // not yet in cache
+      Result := inherited ReadRecord(RecNo, Buffer);
+      // add
+      if Result > 0 then
+        AddToCache(RecNo, Buffer);
+    end;
+  end;
+end;
+
+procedure TCachedFile.WriteRecord(RecNo: Integer; Buffer: Pointer);
+var
+  Data: PPageInfo;
+begin
+  // only cache when we do not need locking
+  if NeedLocks then
+  begin inherited end else begin
+    // do we have this page in cache?
+    Data := PPageInfo(FPageTree.Find(RecNo));
+    if Data <> nil then
+    begin
+      // copy to cache
+      Move(Buffer^, Data^.Data, RecordSize);
+      UpdateTimeStamp(RecNo, Data);
+    end else begin
+      // add
+      Data := AddToCache(RecNo, Buffer);
+      // notify we've added a page
+      UpdateCachedSize(CalcPageOffset(RecNo+PagesPerRecord));
+    end;
+    Data^.Modified := true;
+  end;
+end;
+
+{$endif}  // USE_CACHE
+
+end.

fcl/db/dbase/Dbf_PrsCore.pas

@@ -0,0 +1,1122 @@
+unit Dbf_PrsCore;
+
+{force CR/LF fix}
+
+{--------------------------------------------------------------
+| TCustomExpressionParser
+|
+| - contains core expression parser
+|---------------------------------------------------------------}
+
+interface
+
+{$I Dbf_Common.inc}
+
+uses
+  SysUtils,
+  Classes,
+  Dbf_Common,
+  Dbf_PrsSupp,
+  Dbf_PrsDef;
+
+{$define ENG_NUMBERS}
+
+// ENG_NUMBERS will force the use of english style numbers 8.1 instead of 8,1
+//   (if the comma is your decimal separator)
+// the advantage is that arguments can be separated with a comma which is
+// fairly common, otherwise there is ambuigity: what does 'var1,8,4,4,5' mean?
+// if you don't define ENG_NUMBERS and DecimalSeparator is a comma then
+// the argument separator will be a semicolon ';'
+
+type
+
+  TCustomExpressionParser = class(TObject)
+  private
+    FHexChar: Char;
+    FArgSeparator: Char;
+    FDecimalSeparator: Char;
+    FOptimize: Boolean;
+    FConstantsList: TOCollection;
+    FLastRec: PExpressionRec;
+    FCurrentRec: PExpressionRec;
+    FExpResult: PChar;
+    FExpResultPos: PChar;
+    FExpResultSize: Integer;
+
+    function ParseString(AnExpression: string): TExprCollection;
+    function MakeTree(var Expr: TExprCollection): PExpressionRec;
+    function MakeRec: PExpressionRec;
+    procedure MakeLinkedList(ExprRec: PExpressionRec; Memory: PPChar;
+        MemoryPos: PPChar; MemSize: PInteger);
+    procedure Check(AnExprList: TExprCollection);
+    procedure CheckArguments(ExprRec: PExpressionRec);
+    function RemoveConstants(ExprRec: PExpressionRec): PExpressionRec;
+    function ResultCanVary(ExprRec: PExpressionRec): Boolean;
+  protected
+    FWordsList: TSortedCollection;
+
+    procedure FillExpressList; virtual; abstract;
+    procedure HandleUnknownVariable(VarName: string); virtual; abstract;
+
+    procedure CompileExpression(AnExpression: string);
+    procedure EvaluateCurrent;
+    procedure ReplaceExprWord(OldExprWord, NewExprWord: TExprWord); virtual;
+    procedure DisposeList(ARec: PExpressionRec);
+    procedure DisposeTree(ExprRec: PExpressionRec);
+    function CurrentExpression: string; virtual; abstract;
+    function GetResultType: TExpressionType; virtual;
+
+    property CurrentRec: PExpressionRec read FCurrentRec write FCurrentRec;
+    property LastRec: PExpressionRec read FLastRec write FLastRec;
+    property ExpResult: PChar read FExpResult;
+    property ExpResultPos: PChar read FExpResultPos write FExpResultPos;
+
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    procedure AddReplaceExprWord(AExprWord: TExprWord);
+    procedure DefineFloatVariable(AVarName: string; AValue: PDouble);
+    procedure DefineIntegerVariable(AVarName: string; AValue: PInteger);
+//    procedure DefineSmallIntVariable(AVarName: string; AValue: PSmallInt);
+{$ifdef SUPPORT_INT64}
+    procedure DefineLargeIntVariable(AVarName: string; AValue: PLargeInt);
+{$endif}
+    procedure DefineDateTimeVariable(AVarName: string; AValue: PDateTimeRec);
+    procedure DefineBooleanVariable(AVarName: string; AValue: PBoolean);
+    procedure DefineStringVariable(AVarName: string; AValue: PPChar);
+    procedure DefineStringVariableFixedLen(AVarName: string; AValue: PPChar; ALength: Integer);
+    procedure DefineFunction(AFunctName, AShortName, ADescription, ATypeSpec: string;
+        AMinFunctionArg: Integer; AResultType: TExpressionType; AFuncAddress: TExprFunc);
+    procedure ReplaceFunction(OldName: string; AFunction: TObject);
+    procedure Evaluate(AnExpression: string);
+    function AddExpression(AnExpression: string): Integer;
+    procedure ClearExpressions; virtual;
+//    procedure GetGeneratedVars(AList: TList);
+    procedure GetFunctionNames(AList: TStrings);
+    function GetFunctionDescription(AFunction: string): string;
+    property HexChar: Char read FHexChar write FHexChar;
+    property ArgSeparator: Char read FArgSeparator write FArgSeparator;
+    property Optimize: Boolean read FOptimize write FOptimize;
+    property ResultType: TExpressionType read GetResultType;
+
+
+    //if optimize is selected, constant expressions are tried to remove
+    //such as: 4*4*x is evaluated as 16*x and exp(1)-4*x is repaced by 2.17 -4*x
+  end;
+
+
+implementation
+
+{ TCustomExpressionParser }
+
+constructor TCustomExpressionParser.Create;
+begin
+  inherited;
+
+  FHexChar := '$';
+{$IFDEF ENG_NUMBERS}
+  FDecimalSeparator := '.';
+  FArgSeparator := ',';
+{$ELSE}
+  FDecimalSeparator := DecimalSeparator;
+  if DecimalSeparator = ',' then
+    FArgSeparator := ';'
+  else
+    FArgSeparator := ',';
+{$ENDIF}
+  FConstantsList := TOCollection.Create;
+  FWordsList := TExpressList.Create;
+  GetMem(FExpResult, ArgAllocSize);
+  FExpResultPos := FExpResult;
+  FExpResultSize := ArgAllocSize;
+  FOptimize := true;
+  FillExpressList;
+end;
+
+destructor TCustomExpressionParser.Destroy;
+begin
+  ClearExpressions;
+  FreeMem(FExpResult);
+  FConstantsList.Free;
+  FWordsList.Free;
+
+  inherited;
+end;
+
+procedure TCustomExpressionParser.CompileExpression(AnExpression: string);
+var
+  ExpColl: TExprCollection;
+  ExprTree: PExpressionRec;
+begin
+  ExprTree := nil;
+  ExpColl := nil;
+  if Length(AnExpression) > 0 then
+  begin
+    try
+      //    FCurrentExpression := anExpression;
+      ExpColl := ParseString(AnExpression);
+      Check(ExpColl);
+      ExprTree := MakeTree(ExpColl);
+      FCurrentRec := nil;
+      CheckArguments(ExprTree);
+      if Optimize then
+        ExprTree := RemoveConstants(ExprTree);
+      // all constant expressions are evaluated and replaced by variables
+      FCurrentRec := nil;
+      FExpResultPos := FExpResult;
+      MakeLinkedList(ExprTree, @FExpResult, @FExpResultPos, @FExpResultSize);
+    except
+      on E: Exception do
+      begin
+        DisposeTree(ExprTree);
+	raise;
+      end;
+    end;
+  end;
+end;
+
+procedure TCustomExpressionParser.CheckArguments(ExprRec: PExpressionRec);
+var
+  TempExprWord: TExprWord;
+  I, error: Integer;
+  foundAltFunc: Boolean;
+begin
+  with ExprRec^ do
+  begin
+    repeat
+      I := 0;
+      error := 0;
+      foundAltFunc := false;
+      while (I < ExprWord.MaxFunctionArg) and (ArgList[I] <> nil) and (error = 0) do
+      begin
+        // test subarguments first
+        CheckArguments(ArgList[I]);
+
+        // test if correct type
+        if (ArgList[I].ExprWord.ResultType <> ExprCharToExprType(ExprWord.TypeSpec[I+1])) then
+          error := 2;
+
+        // goto next argument
+        Inc(I);
+      end;
+
+      // test if enough parameters passed; I = num args user passed
+      if (error = 0) and (I < ExprWord.MinFunctionArg) then
+        error := 1;
+
+      // test if too many parameters passed
+      if (error = 0) and (I > ExprWord.MaxFunctionArg) then
+        error := 3;
+
+      // error occurred?
+      if error <> 0 then
+      begin
+        // see if we can find another function
+        I := FWordsList.IndexOf(ExprWord);
+        // check if not last function
+        if I < FWordsList.Count - 1 then
+        begin
+          TempExprWord := FWordsList.Items[I+1];
+          if FWordsList.Compare(FWordsList.KeyOf(ExprWord), FWordsList.KeyOf(TempExprWord)) = 0 then
+          begin
+            ExprWord := TempExprWord;
+            Oper := ExprWord.ExprFunc;
+            foundAltFunc := true;
+          end;
+        end;
+      end;
+    until (error = 0) or not foundAltFunc;
+
+    // fatal error?
+    case error of
+      1: raise EParserException.Create('Function or operand has too few arguments');
+      2: raise EParserException.Create('Argument type mismatch');
+      3: raise EParserException.Create('Function or operand has too many arguments');
+    end;
+  end;
+end;
+
+function TCustomExpressionParser.ResultCanVary(ExprRec: PExpressionRec):
+  Boolean;
+var
+  I: Integer;
+begin
+  with ExprRec^ do
+  begin
+    Result := ExprWord.CanVary;
+    if not Result then
+      for I := 0 to ExprWord.MaxFunctionArg - 1 do
+        if ResultCanVary(ArgList[I]) then
+        begin
+          Result := true;
+          Exit;
+        end
+  end;
+end;
+
+function TCustomExpressionParser.RemoveConstants(ExprRec: PExpressionRec): PExpressionRec;
+var
+  I: Integer;
+begin
+  Result := ExprRec;
+  with ExprRec^ do
+  begin
+    if not ResultCanVary(ExprRec) then
+    begin
+      if not ExprWord.IsVariable then
+      begin
+        // reset current record so that make list generates new
+        FCurrentRec := nil;
+        FExpResultPos := FExpResult;
+        MakeLinkedList(ExprRec, @FExpResult, @FExpResultPos, @FExpResultSize);
+
+        try
+          // compute result
+          EvaluateCurrent;
+
+          // make new record to store constant in
+          Result := MakeRec;
+
+          // check result type
+          case ResultType of
+            etBoolean: Result.ExprWord := TBooleanConstant.Create(EmptyStr, PBoolean(FExpResult)^);
+            etFloat: Result.ExprWord := TFloatConstant.CreateAsDouble(EmptyStr, PDouble(FExpResult)^);
+            etString: Result.ExprWord := TStringConstant.Create(FExpResult);
+          end;
+
+          // fill in structure
+          Result.Oper := Result.ExprWord.ExprFunc;
+          Result.Args[0] := Result.ExprWord.AsPointer;
+          FConstantsList.Add(Result.ExprWord);
+        finally
+          // only free list if succesfully evaluated expression
+          if (Result <> ExprRec) then
+            DisposeList(ExprRec);
+          FCurrentRec := nil;
+        end;
+      end;
+    end
+    else
+      for I := 0 to ExprWord.MaxFunctionArg - 1 do
+        if ArgList[I] <> nil then
+          ArgList[I] := RemoveConstants(ArgList[I]);
+  end;
+end;
+
+procedure TCustomExpressionParser.DisposeTree(ExprRec: PExpressionRec);
+var
+  I: Integer;
+begin
+  if ExprRec <> nil then
+  begin
+    with ExprRec^ do
+    begin
+      if ExprWord <> nil then
+        for I := 0 to ExprWord.MaxFunctionArg - 1 do
+          DisposeTree(ArgList[I]);
+      if Res <> nil then
+        Res.Free;
+    end;
+    Dispose(ExprRec);
+  end;
+end;
+
+procedure TCustomExpressionParser.DisposeList(ARec: PExpressionRec);
+var
+  TheNext: PExpressionRec;
+  I: Integer;
+begin
+  if ARec <> nil then
+    repeat
+      TheNext := ARec.Next;
+      if ARec.Res <> nil then
+        ARec.Res.Free;
+      I := 0;
+      while ARec.ArgList[I] <> nil do
+      begin
+        FreeMem(ARec.Args[I]);
+        Inc(I);
+      end;
+      Dispose(ARec);
+      ARec := TheNext;
+    until ARec = nil;
+end;
+
+procedure TCustomExpressionParser.MakeLinkedList(ExprRec: PExpressionRec;
+  Memory: PPChar; MemoryPos: PPChar; MemSize: PInteger);
+var
+  I: Integer;
+begin
+  // test function type
+  if @ExprRec^.ExprWord.ExprFunc = nil then
+  begin
+    // special 'no function' function
+    // indicates no function is present -> we can concatenate all instances
+    // we don't create new arguments...these 'fall' through
+    // use destination as we got it
+    I := 0;
+    while ExprRec^.ArgList[I] <> nil do
+    begin
+      // convert arguments to list
+      MakeLinkedList(ExprRec^.ArgList[I], Memory, MemoryPos, MemSize);
+      // goto next argument
+      Inc(I);
+    end;
+    // don't need this record anymore
+    Dispose(ExprRec);
+  end else begin
+    // inc memory pointer so we know if we are first
+    ExprRec^.ResetDest := MemoryPos^ = Memory^;
+    Inc(MemoryPos^);
+    // convert arguments to list
+    I := 0;
+    while ExprRec^.ArgList[I] <> nil do
+    begin
+      // save variable type for easy access
+      ExprRec^.ArgsType[I] := ExprRec^.ArgList[I].ExprWord.ResultType;
+      // check if we need to copy argument, variables in general do not
+      // need copying, except for fixed len strings which are not
+      // null-terminated
+//      if ExprRec^.ArgList[I].ExprWord.NeedsCopy then
+//      begin
+        // get memory for argument
+        GetMem(ExprRec^.Args[I], ArgAllocSize);
+        ExprRec^.ArgsPos[I] := ExprRec^.Args[I];
+        ExprRec^.ArgsSize[I] := ArgAllocSize;
+        MakeLinkedList(ExprRec^.ArgList[I], @ExprRec^.Args[I], @ExprRec^.ArgsPos[I],
+            @ExprRec^.ArgsSize[I]);
+//      end else begin
+        // copy reference
+//        ExprRec^.Args[I] := ExprRec^.ArgList[I].Args[0];
+//        ExprRec^.ArgsPos[I] := ExprRec^.Args[I];
+//        ExprRec^.ArgsSize[I] := 0;
+//        FreeMem(ExprRec^.ArgList[I]);
+//        ExprRec^.ArgList[I] := nil;
+//      end;
+
+      // goto next argument
+      Inc(I);
+    end;
+
+    // link result to target argument
+    ExprRec^.Res := TDynamicType.Create(Memory, MemoryPos, MemSize);
+
+    // link to next operation
+    if FCurrentRec = nil then
+    begin
+      FCurrentRec := ExprRec;
+      FLastRec := ExprRec;
+    end else begin
+      FLastRec.Next := ExprRec;
+      FLastRec := ExprRec;
+    end;
+  end;
+end;
+
+function TCustomExpressionParser.MakeTree(var Expr: TExprCollection): PExpressionRec;
+
+{
+- This is the most complex routine, it breaks down the expression and makes
+  a linked tree which is used for fast function evaluations
+- it is implemented recursively
+}
+
+var
+  I, IArg, IStart, IEnd, brCount: Integer;
+  FirstOper: TExprWord;
+  Expr2: TExprCollection;
+  Rec: PExpressionRec;
+begin
+  FirstOper := nil;
+  IStart := 0;
+  try
+    Result := nil;
+    repeat
+      // get new record
+      Rec := MakeRec;
+      if Result <> nil then
+      begin
+        // link operation lower down tree
+        IArg := 1;
+        Rec.ArgList[0] := Result;
+      end
+      else
+        IArg := 0;
+      Result := Rec;
+      Expr.EraseExtraBrackets;
+
+      // simple constant, variable or function?
+      if Expr.Count = 1 then
+      begin
+        Result.ExprWord := TExprWord(Expr.Items[0]);
+        Result.Oper := @Result.ExprWord.ExprFunc;
+        if Result.ExprWord.IsVariable then
+        begin
+          // copy pointer to variable
+          Result.Args[0] := Result.ExprWord.AsPointer;
+          // is this a fixed length string variable?
+          if Result.ExprWord.FixedLen >= 0 then
+          begin
+            // store length as second parameter
+            Result.Args[1] := PChar(Result.ExprWord.LenAsPointer);
+          end;
+        end;
+        exit;
+      end;
+
+      // no...with arguments, search function/operand
+      IEnd := Expr.NextOper(IStart);
+      // is this a function?
+      if (IEnd < Expr.Count) and TExprWord(Expr.Items[IEnd]).IsFunction then
+      begin
+        FirstOper := TExprWord(Expr.Items[IEnd]);
+        Result.ExprWord := FirstOper;
+        Result.Oper := FirstOper.ExprFunc;
+      end else
+        raise EParserException.Create('Operand/function missing');
+
+      if not FirstOper.IsOper then
+      begin
+        // parse function arguments
+        IArg := 0;
+        Inc(IEnd);
+        IStart := IEnd;
+        brCount := 0;
+        if TExprWord(Expr.Items[IEnd]).ResultType = etLeftBracket then
+        begin
+          Inc(brCount);
+          Inc(IStart);
+        end else
+          Inc(IEnd);
+        while (IEnd < Expr.Count - 1) and (brCount <> 0) do
+        begin
+          Inc(IEnd);
+          case TExprWord(Expr.Items[IEnd]).ResultType of
+            etLeftBracket: Inc(brCount);
+            etComma:
+              if brCount = 1 then
+              begin
+                // argument separation found, build tree of argument expression
+                Expr2 := TExprCollection.Create;
+                Expr2.Capacity := IEnd - IStart;
+                for I := IStart to IEnd - 1 do
+                  Expr2.Add(Expr.Items[I]);
+                Result.ArgList[IArg] := MakeTree(Expr2);
+                Inc(IArg);
+                IStart := IEnd + 1;
+              end;
+            etRightBracket: Dec(brCount);
+          end;
+        end;
+
+        // parse last argument
+        Expr2 := TExprCollection.Create;
+        Expr2.Capacity := IEnd - IStart + 1;
+        for I := IStart to IEnd - 1 do
+          Expr2.Add(Expr.Items[I]);
+        Result.ArgList[IArg] := MakeTree(Expr2);
+      end
+      else if IEnd - IStart > 0 then
+      begin
+        // parse expression before operand
+        Expr2 := TExprCollection.Create;
+        Expr2.Capacity := IEnd - IStart + 1;
+        for I := 0 to IEnd - 1 do
+          Expr2.Add(Expr.Items[I]);
+        Result.ArgList[IArg] := MakeTree(Expr2);
+        Inc(IArg);
+      end;
+
+      // now search next operand that is less or equal important
+      // this operand has to be higher up in tree
+      // operands in between are more important and thus lower in tree
+      // if we don't find a less or equal important operand we are done!
+      IStart := IEnd + 1;
+      IEnd := IStart - 1;
+      repeat
+        IEnd := Expr.NextOper(IEnd + 1);
+      until (IEnd >= Expr.Count) or (TFunction(Expr.Items[IEnd]).OperPrec >= TFunction(FirstOper).OperPrec);
+
+      // found operand?
+      if IEnd <> IStart then
+      begin
+        Expr2 := TExprCollection.Create;
+        Expr2.Capacity := IEnd;
+        for I := IStart to IEnd - 1 do
+          Expr2.Add(Expr.Items[I]);
+        Result.ArgList[IArg] := MakeTree(Expr2);
+      end;
+      IStart := IEnd;
+    until IEnd >= Expr.Count;
+  finally
+    FreeAndNil(Expr);
+  end;
+end;
+
+function TCustomExpressionParser.ParseString(AnExpression: string): TExprCollection;
+var
+  isConstant: Boolean;
+  I, I1, I2, Len, DecSep: Integer;
+  W, S: string;
+  TempWord: TExprWord;
+
+  procedure ReadConstant(AnExpr: string; isHex: Boolean);
+  begin
+    isConstant := true;
+    while (I2 <= Len) and ((AnExpr[I2] in ['0'..'9']) or
+      (isHex and (AnExpr[I2] in ['a'..'f', 'A'..'F']))) do
+      Inc(I2);
+    if I2 <= Len then
+    begin
+      if AnExpr[I2] = FDecimalSeparator then
+      begin
+        Inc(I2);
+        while (I2 <= Len) and (AnExpr[I2] in ['0'..'9']) do
+          Inc(I2);
+      end;
+      if (I2 <= Len) and (AnExpr[I2] = 'e') then
+      begin
+        Inc(I2);
+        if (I2 <= Len) and (AnExpr[I2] in ['+', '-']) then
+          Inc(I2);
+        while (I2 <= Len) and (AnExpr[I2] in ['0'..'9']) do
+          Inc(I2);
+      end;
+    end;
+  end;
+
+  procedure ReadWord(AnExpr: string);
+  var
+    OldI2: Integer;
+    constChar: Char;
+  begin
+    isConstant := false;
+    I1 := I2;
+    while (I1 < Len) and (AnExpr[I1] = ' ') do
+      Inc(I1);
+    I2 := I1;
+    if I1 <= Len then
+    begin
+      if AnExpr[I2] = HexChar then
+      begin
+        Inc(I2);
+        OldI2 := I2;
+        ReadConstant(AnExpr, true);
+        if I2 = OldI2 then
+        begin
+          isConstant := false;
+          while (I2 <= Len) and (AnExpr[I2] in ['a'..'z', 'A'..'Z', '_', '0'..'9']) do
+            Inc(I2);
+        end;
+      end
+      else if AnExpr[I2] = FDecimalSeparator then
+        ReadConstant(AnExpr, false)
+      else
+        case AnExpr[I2] of
+          '''', '"':
+            begin
+              isConstant := true;
+              constChar := AnExpr[I2];
+              Inc(I2);
+              while (I2 <= Len) and (AnExpr[I2] <> constChar) do
+                Inc(I2);
+              if I2 <= Len then
+                Inc(I2);
+            end;
+          'a'..'z', 'A'..'Z', '_':
+            begin
+              while (I2 <= Len) and (AnExpr[I2] in ['a'..'z', 'A'..'Z', '_', '0'..'9']) do
+                Inc(I2);
+            end;
+          '>', '<':
+            begin
+              if (I2 <= Len) then
+                Inc(I2);
+              if AnExpr[I2] in ['=', '<', '>'] then
+                Inc(I2);
+            end;
+          '=':
+            begin
+              if (I2 <= Len) then
+                Inc(I2);
+              if AnExpr[I2] in ['<', '>', '='] then
+                Inc(I2);
+            end;
+          '&':
+            begin
+              if (I2 <= Len) then
+                Inc(I2);
+              if AnExpr[I2] in ['&'] then
+                Inc(I2);
+            end;
+          '|':
+            begin
+              if (I2 <= Len) then
+                Inc(I2);
+              if AnExpr[I2] in ['|'] then
+                Inc(I2);
+            end;
+          ':':
+            begin
+              if (I2 <= Len) then
+                Inc(I2);
+              if AnExpr[I2] = '=' then
+                Inc(I2);
+            end;
+          '!':
+            begin
+              if (I2 <= Len) then
+                Inc(I2);
+              if AnExpr[I2] = '=' then //support for !=
+                Inc(I2);
+            end;
+          '+':
+            begin
+              Inc(I2);
+              if (AnExpr[I2] = '+') and FWordsList.Search(PChar('++'), I) then
+                Inc(I2);
+            end;
+          '-':
+            begin
+              Inc(I2);
+              if (AnExpr[I2] = '-') and FWordsList.Search(PChar('--'), I) then
+                Inc(I2);
+            end;
+          '^', '/', '\', '*', '(', ')', '%', '~', '$':
+            Inc(I2);
+          '0'..'9':
+            ReadConstant(AnExpr, false);
+        else
+          begin
+            Inc(I2);
+          end;
+        end;
+    end;
+  end;
+
+begin
+  Result := TExprCollection.Create;
+  try
+    I2 := 1;
+    S := Trim(AnExpression);
+    Len := Length(S);
+    repeat
+      ReadWord(S);
+      W := Trim(Copy(S, I1, I2 - I1));
+      if isConstant then
+      begin
+	if W[1] = HexChar then
+	begin
+	  // convert hexadecimal to decimal
+	  W[1] := '$';
+	  W := IntToStr(StrToInt(W));
+	end;
+	if (W[1] = '''') or (W[1] = '"') then
+	  TempWord := TStringConstant.Create(W)
+	else begin
+	  DecSep := Pos(FDecimalSeparator, W);
+	  if (DecSep > 0) then
+	  begin
+{$IFDEF ENG_NUMBERS}
+	    // we'll have to convert FDecimalSeparator into DecimalSeparator
+	    // otherwise the OS will not understand what we mean
+	    W[DecSep] := DecimalSeparator;
+{$ENDIF}
+	    TempWord := TFloatConstant.Create(W, W)
+	  end else begin
+	    TempWord := TIntegerConstant.Create(StrToInt(W));
+	  end;
+	end;
+	Result.Add(TempWord);
+	FConstantsList.Add(TempWord);
+      end
+      else if Length(W) > 0 then
+	if FWordsList.Search(PChar(W), I) then
+	begin
+	  Result.Add(FWordsList.Items[I])
+	end else begin
+	  // unknown variable -> fire event
+	  HandleUnknownVariable(W);
+	  // try to search again
+	  if FWordsList.Search(PChar(W), I) then
+	  begin
+	    Result.Add(FWordsList.Items[I])
+	  end else begin
+	    raise EParserException.Create('Unknown variable '''+W+''' found.');
+	  end;
+	end;
+    until I2 > Len;
+  except
+    on E: Exception do
+    begin
+      Result.Free;
+      raise;
+    end;
+  end;
+end;
+
+procedure TCustomExpressionParser.Check(AnExprList: TExprCollection);
+var
+  I, J, K, L: Integer;
+begin
+  AnExprList.Check;
+  with AnExprList do
+  begin
+    I := 0;
+    while I < Count do
+    begin
+      {----CHECK ON DOUBLE MINUS OR DOUBLE PLUS----}
+      if ((TExprWord(Items[I]).Name = '-') or
+        (TExprWord(Items[I]).Name = '+'))
+        and ((I = 0) or
+        (TExprWord(Items[I - 1]).ResultType = etComma) or
+        (TExprWord(Items[I - 1]).ResultType = etLeftBracket) or
+        (TExprWord(Items[I - 1]).IsOper and (TExprWord(Items[I - 1]).MaxFunctionArg
+        = 2))) then
+      begin
+        {replace e.g. ----1 with +1}
+        if TExprWord(Items[I]).Name = '-' then
+          K := -1
+        else
+          K := 1;
+        L := 1;
+        while (I + L < Count) and ((TExprWord(Items[I + L]).Name = '-')
+          or (TExprWord(Items[I + L]).Name = '+')) and ((I + L = 0) or
+          (TExprWord(Items[I + L - 1]).ResultType = etComma) or
+          (TExprWord(Items[I + L - 1]).ResultType = etLeftBracket) or
+          (TExprWord(Items[I + L - 1]).IsOper and (TExprWord(Items[I + L -
+          1]).MaxFunctionArg = 2))) do
+        begin
+          if TExprWord(Items[I + L]).Name = '-' then
+            K := -1 * K;
+          Inc(L);
+        end;
+        if L > 0 then
+        begin
+          Dec(L);
+          for J := I + 1 to Count - 1 - L do
+            Items[J] := Items[J + L];
+          Count := Count - L;
+        end;
+        if K = -1 then
+        begin
+          if FWordsList.Search(pchar('-@'), J) then
+            Items[I] := FWordsList.Items[J];
+        end
+        else if FWordsList.Search(pchar('+@'), J) then
+          Items[I] := FWordsList.Items[J];
+      end;
+      {----CHECK ON DOUBLE NOT----}
+      if (TExprWord(Items[I]).Name = 'not')
+        and ((I = 0) or
+        (TExprWord(Items[I - 1]).ResultType = etLeftBracket) or
+        TExprWord(Items[I - 1]).IsOper) then
+      begin
+        {replace e.g. not not 1 with 1}
+        K := -1;
+        L := 1;
+        while (I + L < Count) and (TExprWord(Items[I + L]).Name = 'not') and ((I
+          + L = 0) or
+          (TExprWord(Items[I + L - 1]).ResultType = etLeftBracket) or
+          TExprWord(Items[I + L - 1]).IsOper) do
+        begin
+          K := -K;
+          Inc(L);
+        end;
+        if L > 0 then
+        begin
+          if K = 1 then
+          begin //remove all
+            for J := I to Count - 1 - L do
+              Items[J] := Items[J + L];
+            Count := Count - L;
+          end
+          else
+          begin //keep one
+            Dec(L);
+            for J := I + 1 to Count - 1 - L do
+              Items[J] := Items[J + L];
+            Count := Count - L;
+          end
+        end;
+      end;
+      {-----MISC CHECKS-----}
+      if (TExprWord(Items[I]).IsVariable) and ((I < Count - 1) and
+        (TExprWord(Items[I + 1]).IsVariable)) then
+        raise EParserException.Create('Missing operator between '''+TExprWord(Items[I]).Name+''' and '''+TExprWord(Items[I]).Name+'''');
+      if (TExprWord(Items[I]).ResultType = etLeftBracket) and ((I >= Count - 1) or
+        (TExprWord(Items[I + 1]).ResultType = etRightBracket)) then
+        raise EParserException.Create('Empty brackets ()');
+      if (TExprWord(Items[I]).ResultType = etRightBracket) and ((I < Count - 1) and
+        (TExprWord(Items[I + 1]).ResultType = etLeftBracket)) then
+        raise EParserException.Create('Missing operator between )(');
+      if (TExprWord(Items[I]).ResultType = etRightBracket) and ((I < Count - 1) and
+        (TExprWord(Items[I + 1]).IsVariable)) then
+        raise EParserException.Create('Missing operator between ) and constant/variable');
+      if (TExprWord(Items[I]).ResultType = etLeftBracket) and ((I > 0) and
+        (TExprWord(Items[I - 1]).IsVariable)) then
+        raise EParserException.Create('Missing operator between constant/variable and (');
+
+      {-----CHECK ON INTPOWER------}
+      if (TExprWord(Items[I]).Name = '^') and ((I < Count - 1) and
+          (TExprWord(Items[I + 1]).ClassType = TIntegerConstant)) then
+        if FWordsList.Search(PChar('^@'), J) then
+          Items[I] := FWordsList.Items[J]; //use the faster intPower if possible
+      Inc(I);
+    end;
+  end;
+end;
+
+procedure TCustomExpressionParser.EvaluateCurrent;
+var
+  TempRec: PExpressionRec;
+begin
+  if FCurrentRec <> nil then
+  begin
+    // get current record
+    TempRec := FCurrentRec;
+    // execute list
+    repeat
+      with TempRec^ do
+      begin
+        // do we need to reset pointer?
+        if ResetDest then
+          Res.MemoryPos^ := Res.Memory^;
+
+        Oper(TempRec);
+
+        // goto next
+        TempRec := Next;
+      end;
+    until TempRec = nil;
+  end;
+end;
+
+procedure TCustomExpressionParser.DefineFunction(AFunctName, AShortName, ADescription, ATypeSpec: string;
+  AMinFunctionArg: Integer; AResultType: TExpressionType; AFuncAddress: TExprFunc);
+begin
+  AddReplaceExprWord(TFunction.Create(AFunctName, AShortName, ATypeSpec, AMinFunctionArg, AResultType, AFuncAddress, ADescription));
+end;
+
+procedure TCustomExpressionParser.DefineIntegerVariable(AVarName: string; AValue: PInteger);
+begin
+  AddReplaceExprWord(TIntegerVariable.Create(AVarName, AValue));
+end;
+
+{
+procedure TCustomExpressionParser.DefineSmallIntVariable(AVarName: string; AValue: PSmallInt);
+begin
+  AddReplaceExprWord(TSmallIntVariable.Create(AVarName, AValue));
+end;
+}
+
+{$ifdef SUPPORT_INT64}
+
+procedure TCustomExpressionParser.DefineLargeIntVariable(AVarName: string; AValue: PLargeInt);
+begin
+  AddReplaceExprWord(TLargeIntVariable.Create(AVarName, AValue));
+end;
+
+{$endif}
+
+procedure TCustomExpressionParser.DefineDateTimeVariable(AVarName: string; AValue: PDateTimeRec);
+begin
+  AddReplaceExprWord(TDateTimeVariable.Create(AVarName, AValue));
+end;
+
+procedure TCustomExpressionParser.DefineBooleanVariable(AVarName: string; AValue: PBoolean);
+begin
+  AddReplaceExprWord(TBooleanVariable.Create(AVarName, AValue));
+end;
+
+procedure TCustomExpressionParser.DefineFloatVariable(AVarName: string; AValue: PDouble);
+begin
+  AddReplaceExprWord(TFloatVariable.Create(AVarName, AValue));
+end;
+
+procedure TCustomExpressionParser.DefineStringVariable(AVarName: string; AValue: PPChar);
+begin
+  DefineStringVariableFixedLen(AVarName, AValue, -1);
+end;
+
+procedure TCustomExpressionParser.DefineStringVariableFixedLen(AVarName: string; AValue: PPChar; ALength: Integer);
+begin
+  AddReplaceExprWord(TStringVariable.Create(AVarName, AValue, ALength));
+end;
+
+{
+procedure TCustomExpressionParser.GetGeneratedVars(AList: TList);
+var
+  I: Integer;
+begin
+  AList.Clear;
+  with FWordsList do
+    for I := 0 to Count - 1 do
+    begin
+      if TObject(Items[I]).ClassType = TGeneratedVariable then
+        AList.Add(Items[I]);
+    end;
+end;
+}
+
+function TCustomExpressionParser.GetResultType: TExpressionType;
+begin
+  Result := etUnknown;
+  if FCurrentRec <> nil then
+  begin
+    //LAST operand should be boolean -otherwise If(,,) doesn't work
+    while (FLastRec^.Next <> nil) do
+      FLastRec := FLastRec^.Next;
+    if FLastRec.ExprWord <> nil then
+      Result := FLastRec.ExprWord.ResultType;
+  end;
+end;
+
+procedure TCustomExpressionParser.ReplaceExprWord(OldExprWord, NewExprWord: TExprWord);
+var
+  J: Integer;
+  Rec: PExpressionRec;
+  p, pnew: pointer;
+begin
+  if OldExprWord.MaxFunctionArg <> NewExprWord.MaxFunctionArg then
+    raise Exception.Create('Cannot replace variable/function MaxFunctionArg doesn''t match');
+
+  p := OldExprWord.AsPointer;
+  pnew := NewExprWord.AsPointer;
+  Rec := FCurrentRec;
+  repeat
+    if (Rec.ExprWord = OldExprWord) then
+    begin
+      Rec.ExprWord := NewExprWord;
+      Rec.Oper := NewExprWord.ExprFunc;
+    end;
+    if p <> nil then
+      for J := 0 to Rec.ExprWord.MaxFunctionArg - 1 do
+        if Rec.Args[J] = p then
+          Rec.Args[J] := pnew;
+    Rec := Rec.Next;
+  until Rec = nil;
+end;
+
+function TCustomExpressionParser.MakeRec: PExpressionRec;
+var
+  I: Integer;
+begin
+  New(Result);
+  Result.Oper := nil;
+  for I := 0 to MaxArg - 1 do
+  begin
+    Result.Args[I] := nil;
+    Result.ArgsPos[I] := nil;
+    Result.ArgsSize[I] := 0;
+    Result.ArgsType[I] := etUnknown;
+    Result.ArgList[I] := nil;
+  end;
+  Result.Res := nil;
+  Result.Next := nil;
+  Result.ExprWord := nil;
+  Result.ResetDest := false;
+end;
+
+procedure TCustomExpressionParser.Evaluate(AnExpression: string);
+begin
+  if Length(AnExpression) > 0 then
+  begin
+    AddExpression(AnExpression);
+    EvaluateCurrent;
+  end;
+end;
+
+function TCustomExpressionParser.AddExpression(AnExpression: string): Integer;
+begin
+  if Length(AnExpression) > 0 then
+  begin
+    Result := 0;
+    CompileExpression(AnExpression);
+  end else
+    Result := -1;
+  //CurrentIndex := Result;
+end;
+
+procedure TCustomExpressionParser.ReplaceFunction(OldName: string; AFunction:
+  TObject);
+var
+  I: Integer;
+begin
+  // clearing only allowed when expression is not present
+  if (AFunction = nil) and (FCurrentRec <> nil) then
+    raise Exception.Create('Cannot undefine function/variable while expression present');
+
+  if FWordsList.Search(PChar(OldName), I) then
+  begin
+    // if no function specified, then no need to replace!
+    if AFunction <> nil then
+      ReplaceExprWord(FWordsList.Items[I], TExprWord(AFunction));
+    FWordsList.AtFree(I);
+  end;
+  if AFunction <> nil then
+    FWordsList.Add(AFunction);
+end;
+
+procedure TCustomExpressionParser.ClearExpressions;
+begin
+  DisposeList(FCurrentRec);
+  FCurrentRec := nil;
+  FLastRec := nil;
+end;
+
+procedure TCustomExpressionParser.AddReplaceExprWord(AExprWord: TExprWord);
+var
+  IOldVar: Integer;
+begin
+  if FWordsList.Search(PChar(AExprWord.Name), IOldVar) then
+  begin
+    ReplaceExprWord(FWordsList.Items[IOldVar], AExprWord);
+    FWordsList.AtFree(IOldVar);
+    FWordsList.Add(AExprWord);
+  end
+  else
+    FWordsList.Add(AExprWord);
+end;
+
+function TCustomExpressionParser.GetFunctionDescription(AFunction: string):
+  string;
+var
+  S: string;
+  p, I: Integer;
+begin
+  S := AFunction;
+  p := Pos('(', S);
+  if p > 0 then
+    S := Copy(S, 1, p - 1);
+  if FWordsList.Search(pchar(S), I) then
+    Result := TExprWord(FWordsList.Items[I]).Description
+  else
+    Result := EmptyStr;
+end;
+
+procedure TCustomExpressionParser.GetFunctionNames(AList: TStrings);
+var
+  I, J: Integer;
+  S: string;
+begin
+  with FWordsList do
+    for I := 0 to Count - 1 do
+      with TExprWord(FWordsList.Items[I]) do
+        if Length(Description) > 0 then
+        begin
+          S := Name;
+          if MaxFunctionArg > 0 then
+          begin
+            S := S + '(';
+            for J := 0 to MaxFunctionArg - 2 do
+              S := S + ArgSeparator;
+            S := S + ')';
+          end;
+          AList.Add(S);
+        end;
+end;
+
+end.
+

fcl/db/dbase/Dbf_PrsDef.pas

@@ -0,0 +1,1060 @@
+unit Dbf_PrsDef;
+
+{force CR/LF fix}
+
+interface
+
+{$I Dbf_Common.inc}
+
+uses
+  SysUtils,
+  Classes,
+  Dbf_Common,
+  Dbf_PrsSupp;
+
+const
+  MaxArg = 6;
+  ArgAllocSize = 32;
+
+type
+  TExpressionType = (etInteger, etString, etBoolean, etLargeInt, etFloat, etDateTime,
+    etLeftBracket, etRightBracket, etComma, etUnknown);
+
+  PPChar = ^PChar;
+  PBoolean = ^Boolean;
+  PInteger = ^Integer;
+  PDateTime = ^TDateTime;
+  EParserException = class(Exception);
+  PExpressionRec = ^TExpressionRec;
+  PDynamicType = ^TDynamicType;
+
+  TExprWord = class;
+
+  TExprFunc = procedure(Expr: PExpressionRec);
+
+//-----
+
+  TDynamicType = class(TObject)
+  private
+    FMemory: PPChar;
+    FMemoryPos: PPChar;
+    FSize: PInteger;
+  public
+    constructor Create(DestMem, DestPos: PPChar; Size: PInteger);
+
+    procedure AssureSpace(ASize: Integer);
+    procedure Resize(NewSize: Integer; Exact: Boolean);
+    procedure Rewind;
+    procedure Append(Source: PChar; Length: Integer);
+    procedure AppendInteger(Source: Integer);
+
+    property Memory: PPChar read FMemory;
+    property MemoryPos: PPChar read FMemoryPos;
+    property Size: PInteger read FSize;
+  end;
+
+  TExpressionRec = record
+    //used both as linked tree and linked list for maximum evaluation efficiency
+    Oper: TExprFunc;
+    Next: PExpressionRec;
+    Res: TDynamicType;
+    ExprWord: TExprWord;
+    ResetDest: Boolean;
+    Args: array[0..MaxArg-1] of PChar;
+    ArgsPos: array[0..MaxArg-1] of PChar;
+    ArgsSize: array[0..MaxArg-1] of Integer;
+    ArgsType: array[0..MaxArg-1] of TExpressionType;
+    ArgList: array[0..MaxArg-1] of PExpressionRec;
+  end;
+
+  TExprCollection = class(TNoOwnerCollection)
+  public
+    function NextOper(IStart: Integer): Integer;
+    procedure Check;
+    procedure EraseExtraBrackets;
+  end;
+
+  TExprWordRec = record
+    Name: PChar;
+    ShortName: PChar;
+    IsOper: Boolean;
+    IsVariable: Boolean;
+    IsFunction: Boolean;
+    NeedsCopy: Boolean;
+    FixedLen: Boolean;
+    CanVary: Boolean;
+    ResultType: TExpressionType;
+    MinArg: Integer;
+    MaxArg: Integer;
+    TypeSpec: PChar;
+    Description: PChar;
+    ExprFunc: TExprFunc;
+  end;
+
+  TExprWord = class(TObject)
+  private
+    FName: string;
+    FExprFunc: TExprFunc;
+  protected
+    FRefCount: Cardinal;
+
+    function GetIsOper: Boolean; virtual;
+    function GetIsVariable: Boolean;
+    function GetNeedsCopy: Boolean;
+    function GetFixedLen: Integer; virtual;
+    function GetCanVary: Boolean; virtual;
+    function GetResultType: TExpressionType; virtual;
+    function GetMinFunctionArg: Integer; virtual;
+    function GetMaxFunctionArg: Integer; virtual;
+    function GetDescription: string; virtual;
+    function GetTypeSpec: string; virtual;
+    function GetShortName: string; virtual;
+  public
+    constructor Create(AName: string; AExprFunc: TExprFunc);
+
+    function LenAsPointer: PInteger; virtual;
+    function AsPointer: PChar; virtual;
+    function IsFunction: Boolean; virtual;
+
+    property ExprFunc: TExprFunc read FExprFunc;
+    property IsOper: Boolean read GetIsOper;
+    property CanVary: Boolean read GetCanVary;
+    property IsVariable: Boolean read GetIsVariable;
+    property NeedsCopy: Boolean read GetNeedsCopy;
+    property FixedLen: Integer read GetFixedLen;
+    property ResultType: TExpressionType read GetResultType;
+    property MinFunctionArg: Integer read GetMinFunctionArg;
+    property MaxFunctionArg: Integer read GetMaxFunctionArg;
+    property Name: string read FName;
+    property ShortName: string read GetShortName;
+    property Description: string read GetDescription;
+    property TypeSpec: string read GetTypeSpec;
+  end;
+
+  TExpressShortList = class(TSortedCollection)
+  public
+    function KeyOf(Item: Pointer): Pointer; override;
+    function Compare(Key1, Key2: Pointer): Integer; override;
+    procedure FreeItem(Item: Pointer); override;
+  end;
+
+  TExpressList = class(TSortedCollection)
+  private
+    FShortList: TExpressShortList;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Add(Item: Pointer); override;
+    function  KeyOf(Item: Pointer): Pointer; override;
+    function  Compare(Key1, Key2: Pointer): Integer; override;
+    function  Search(Key: Pointer; var Index: Integer): Boolean; override;
+    procedure FreeItem(Item: Pointer); override;
+  end;
+
+  TConstant = class(TExprWord)
+  private
+    FResultType: TExpressionType;
+  protected
+    function GetResultType: TExpressionType; override;
+  public
+    constructor Create(AName: string; AVarType: TExpressionType; AExprFunc: TExprFunc);
+  end;
+
+  TFloatConstant = class(TConstant)
+  private
+    FValue: Double;
+  public
+    // not overloaded to support older Delphi versions
+    constructor Create(AName: string; AValue: string);
+    constructor CreateAsDouble(AName: string; AValue: Double);
+
+    function AsPointer: PChar; override;
+
+    property Value: Double read FValue write FValue;
+  end;
+
+  TUserConstant = class(TFloatConstant)
+  private
+    FDescription: string;
+  protected
+    function GetDescription: string; override;
+  public
+    constructor CreateAsDouble(AName, Descr: string; AValue: Double);
+  end;
+
+  TStringConstant = class(TConstant)
+  private
+    FValue: string;
+  public
+    constructor Create(AValue: string);
+
+    function AsPointer: PChar; override;
+  end;
+
+  TIntegerConstant = class(TConstant)
+  private
+    FValue: Integer;
+  public
+    constructor Create(AValue: Integer);
+
+    function AsPointer: PChar; override;
+  end;
+
+  TBooleanConstant = class(TConstant)
+  private
+    FValue: Boolean;
+  public
+    // not overloaded to support older Delphi versions
+    constructor Create(AName: string; AValue: Boolean);
+
+    function AsPointer: PChar; override;
+
+    property Value: Boolean read FValue write FValue;
+  end;
+
+  TVariable = class(TExprWord)
+  private
+    FResultType: TExpressionType;
+  protected
+    function GetCanVary: Boolean; override;
+    function GetResultType: TExpressionType; override;
+  public
+    constructor Create(AName: string; AVarType: TExpressionType; AExprFunc: TExprFunc);
+  end;
+
+  TFloatVariable = class(TVariable)
+  private
+    FValue: PDouble;
+  public
+    constructor Create(AName: string; AValue: PDouble);
+
+    function AsPointer: PChar; override;
+  end;
+
+  TStringVariable = class(TVariable)
+  private
+    FValue: PPChar;
+    FFixedLen: Integer;
+  protected
+    function GetFixedLen: Integer; override;
+  public
+    constructor Create(AName: string; AValue: PPChar; AFixedLen: Integer);
+
+    function LenAsPointer: PInteger; override;
+    function AsPointer: PChar; override;
+
+    property FixedLen: Integer read FFixedLen;
+  end;
+
+  TDateTimeVariable = class(TVariable)
+  private
+    FValue: PDateTimeRec;
+  public
+    constructor Create(AName: string; AValue: PDateTimeRec);
+
+    function AsPointer: PChar; override;
+  end;
+
+  TIntegerVariable = class(TVariable)
+  private
+    FValue: PInteger;
+  public
+    constructor Create(AName: string; AValue: PInteger);
+
+    function AsPointer: PChar; override;
+  end;
+
+{$ifdef SUPPORT_INT64}
+
+  TLargeIntVariable = class(TVariable)
+  private
+    FValue: PLargeInt;
+  public
+    constructor Create(AName: string; AValue: PLargeInt);
+
+    function AsPointer: PChar; override;
+  end;
+
+{$endif}
+
+  TBooleanVariable = class(TVariable)
+  private
+    FValue: PBoolean;
+  public
+    constructor Create(AName: string; AValue: PBoolean);
+
+    function AsPointer: PChar; override;
+  end;
+
+  TLeftBracket = class(TExprWord)
+    function GetResultType: TExpressionType; override;
+  end;
+
+  TRightBracket = class(TExprWord)
+  protected
+    function GetResultType: TExpressionType; override;
+  end;
+
+  TComma = class(TExprWord)
+  protected
+    function GetResultType: TExpressionType; override;
+  end;
+
+  TFunction = class(TExprWord)
+  private
+    FIsOper: Boolean;
+    FOperPrec: Integer;
+    FMinFunctionArg: Integer;
+    FMaxFunctionArg: Integer;
+    FDescription: string;
+    FTypeSpec: string;
+    FShortName: string;
+    FResultType: TExpressionType;
+  protected
+    function GetDescription: string; override;
+    function GetIsOper: Boolean; override;
+    function GetMinFunctionArg: Integer; override;
+    function GetMaxFunctionArg: Integer; override;
+    function GetResultType: TExpressionType; override;
+    function GetTypeSpec: string; override;
+    function GetShortName: string; override;
+
+    procedure InternalCreate(AName, ATypeSpec: string; AMinFuncArg: Integer; AResultType: TExpressionType;
+      AExprFunc: TExprFunc; AIsOper: Boolean; AOperPrec: Integer);
+  public
+    constructor Create(AName, AShortName, ATypeSpec: string; AMinFuncArg: Integer; AResultType: TExpressionType; AExprFunc: TExprFunc; Descr: string);
+    constructor CreateOper(AName, ATypeSpec: string; AResultType: TExpressionType; AExprFunc: TExprFunc; AOperPrec: Integer);
+
+    function IsFunction: Boolean; override;
+
+    property OperPrec: Integer read FOperPrec;
+    property TypeSpec: string read FTypeSpec;
+  end;
+
+  TVaryingFunction = class(TFunction)
+    // Functions that can vary for ex. random generators
+    // should be TVaryingFunction to be sure that they are
+    // always evaluated
+  protected
+    function GetCanVary: Boolean; override;
+  end;
+
+const
+  ListChar = ','; {the delimiter used with the 'in' operator: e.g.,
+  ('a' in 'a,b') =True
+  ('c' in 'a,b') =False}
+
+function ExprCharToExprType(ExprChar: Char): TExpressionType;
+
+
+
+implementation
+
+function ExprCharToExprType(ExprChar: Char): TExpressionType;
+begin
+  case ExprChar of
+    'B': Result := etBoolean;
+    'I': Result := etInteger;
+    'L': Result := etLargeInt;
+    'F': Result := etFloat;
+    'D': Result := etDateTime;
+    'S': Result := etString;
+  else
+    Result := etUnknown;
+  end;
+end;
+
+procedure _FloatVariable(Param: PExpressionRec);
+begin
+  with Param^ do
+    PDouble(Res.MemoryPos^)^ := PDouble(Args[0])^;
+end;
+
+procedure _BooleanVariable(Param: PExpressionRec);
+begin
+  with Param^ do
+    PBoolean(Res.MemoryPos^)^ := PBoolean(Args[0])^;
+end;
+
+procedure _StringConstant(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.Append(Args[0], StrLen(Args[0]));
+end;
+
+procedure _StringVariable(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.Append(PPChar(Args[0])^, StrLen(PPChar(Args[0])^));
+end;
+
+procedure _StringVariableFixedLen(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.Append(PPChar(Args[0])^, PInteger(Args[1])^);
+end;
+
+procedure _DateTimeVariable(Param: PExpressionRec);
+begin
+  with Param^ do
+    PDateTimeRec(Res.MemoryPos^)^ := PDateTimeRec(Args[0])^;
+end;
+
+procedure _IntegerVariable(Param: PExpressionRec);
+begin
+  with Param^ do
+    PInteger(Res.MemoryPos^)^ := PInteger(Args[0])^;
+end;
+
+{
+procedure _SmallIntVariable(Param: PExpressionRec);
+begin
+  with Param^ do
+    PSmallInt(Res.MemoryPos^)^ := PSmallInt(Args[0])^;
+end;
+}
+
+{$ifdef SUPPORT_INT64}
+
+procedure _LargeIntVariable(Param: PExpressionRec);
+begin
+  with Param^ do
+    PLargeInt(Res.MemoryPos^)^ := PLargeInt(Args[0])^;
+end;
+
+{$endif}
+
+{ TExpressionWord }
+
+constructor TExprWord.Create(AName: string; AExprFunc: TExprFunc);
+begin
+  FName := AName;
+  FExprFunc := AExprFunc;
+end;
+
+function TExprWord.GetCanVary: Boolean;
+begin
+  Result := False;
+end;
+
+function TExprWord.GetDescription: string;
+begin
+  Result := EmptyStr;
+end;
+
+function TExprWord.GetShortName: string;
+begin
+  Result := EmptyStr;
+end;
+
+function TExprWord.GetIsOper: Boolean;
+begin
+  Result := False;
+end;
+
+function TExprWord.GetIsVariable: Boolean;
+begin
+  Result := (@FExprFunc = @_StringVariable)         or
+            (@FExprFunc = @_StringConstant)         or
+            (@FExprFunc = @_StringVariableFixedLen) or
+            (@FExprFunc = @_FloatVariable)          or
+            (@FExprFunc = @_IntegerVariable)        or
+//            (@FExprFunc = @_SmallIntVariable)       or
+{$ifdef SUPPORT_INT64}
+            (@FExprFunc = @_LargeIntVariable)       or
+{$endif}
+            (@FExprFunc = @_DateTimeVariable)       or
+            (@FExprFunc = @_BooleanVariable);
+end;
+
+function TExprWord.GetNeedsCopy: Boolean;
+begin
+  Result := (@FExprFunc <> @_StringConstant)         and
+//            (@FExprFunc <> @_StringVariable)         and
+//            (@FExprFunc <> @_StringVariableFixedLen) and
+// string variable cannot be used as normal parameter
+// because it is indirectly referenced and possibly
+// not null-terminated (fixed len)
+            (@FExprFunc <> @_FloatVariable)          and
+            (@FExprFunc <> @_IntegerVariable)        and
+//            (@FExprFunc <> @_SmallIntVariable)       and
+{$ifdef SUPPORT_INT64}
+            (@FExprFunc <> @_LargeIntVariable)       and
+{$endif}
+            (@FExprFunc <> @_DateTimeVariable)       and
+            (@FExprFunc <> @_BooleanVariable);
+end;
+
+function TExprWord.GetFixedLen: Integer;
+begin
+  // -1 means variable, non-fixed length
+  Result := -1;
+end;
+
+function TExprWord.GetMinFunctionArg: Integer;
+begin
+  Result := 0;
+end;
+
+function TExprWord.GetMaxFunctionArg: Integer;
+begin
+  Result := 0;
+end;
+
+function TExprWord.GetResultType: TExpressionType;
+begin
+  Result := etUnknown;
+end;
+
+function TExprWord.GetTypeSpec: string;
+begin
+  Result := EmptyStr;
+end;
+
+function TExprWord.AsPointer: PChar;
+begin
+  Result := nil;
+end;
+
+function TExprWord.LenAsPointer: PInteger;
+begin
+  Result := nil;
+end;
+
+function TExprWord.IsFunction: Boolean;
+begin
+  Result := False;
+end;
+
+{ TConstant }
+
+constructor TConstant.Create(AName: string; AVarType: TExpressionType; AExprFunc: TExprFunc);
+begin
+  inherited Create(AName, AExprFunc);
+
+  FResultType := AVarType;
+end;
+
+function TConstant.GetResultType: TExpressionType;
+begin
+  Result := FResultType;
+end;
+
+{ TFloatConstant }
+
+constructor TFloatConstant.Create(AName, AValue: string);
+begin
+  inherited Create(AName, etFloat, _FloatVariable);
+
+  if Length(AValue) > 0 then
+    FValue := StrToFloat(AValue)
+  else
+    FValue := 0.0;
+end;
+
+constructor TFloatConstant.CreateAsDouble(AName: string; AValue: Double);
+begin
+  inherited Create(AName, etFloat, _FloatVariable);
+
+  FValue := AValue;
+end;
+
+function TFloatConstant.AsPointer: PChar;
+begin
+  Result := PChar(@FValue);
+end;
+
+{ TUserConstant }
+
+constructor TUserConstant.CreateAsDouble(AName, Descr: string; AValue: Double);
+begin
+  FDescription := Descr;
+
+  inherited CreateAsDouble(AName, AValue);
+end;
+
+function TUserConstant.GetDescription: string;
+begin
+  Result := FDescription;
+end;
+
+{ TStringConstant }
+
+constructor TStringConstant.Create(AValue: string);
+var
+  firstChar, lastChar: Char;
+begin
+  inherited Create(AValue, etString, _StringConstant);
+
+  firstChar := AValue[1];
+  lastChar := AValue[Length(AValue)];
+  if (firstChar = lastChar) and ((firstChar = '''') or (firstChar = '"')) then
+    FValue := Copy(AValue, 2, Length(AValue) - 2)
+  else
+    FValue := AValue;
+end;
+
+function TStringConstant.AsPointer: PChar;
+begin
+  Result := PChar(FValue);
+end;
+
+{ TBooleanConstant }
+
+constructor TBooleanConstant.Create(AName: string; AValue: Boolean);
+begin
+  inherited Create(AName, etBoolean, _BooleanVariable);
+
+  FValue := AValue;
+end;
+
+function TBooleanConstant.AsPointer: PChar;
+begin
+  Result := PChar(@FValue);
+end;
+
+{ TIntegerConstant }
+
+constructor TIntegerConstant.Create(AValue: Integer);
+begin
+  inherited Create(IntToStr(AValue), etInteger, _IntegerVariable);
+
+  FValue := AValue;
+end;
+
+function TIntegerConstant.AsPointer: PChar;
+begin
+  Result := PChar(@FValue);
+end;
+
+{ TVariable }
+
+constructor TVariable.Create(AName: string; AVarType: TExpressionType; AExprFunc: TExprFunc);
+begin
+  inherited Create(AName, AExprFunc);
+
+  FResultType := AVarType;
+end;
+
+function TVariable.GetCanVary: Boolean;
+begin
+  Result := True;
+end;
+
+function TVariable.GetResultType: TExpressionType;
+begin
+  Result := FResultType;
+end;
+
+{ TFloatVariable }
+
+constructor TFloatVariable.Create(AName: string; AValue: PDouble);
+begin
+  inherited Create(AName, etFloat, _FloatVariable);
+  FValue := AValue;
+end;
+
+function TFloatVariable.AsPointer: PChar;
+begin
+  Result := PChar(FValue);
+end;
+
+{ TStringVariable }
+
+constructor TStringVariable.Create(AName: string; AValue: PPChar; AFixedLen: Integer);
+begin
+  // variable or fixed length?
+  if (AFixedLen < 0) then
+    inherited Create(AName, etString, _StringVariable)
+  else
+    inherited Create(AName, etString, _StringVariableFixedLen);
+
+  // store pointer to string
+  FValue := AValue;
+  FFixedLen := AFixedLen;
+end;
+
+function TStringVariable.AsPointer: PChar;
+begin
+  Result := PChar(FValue);
+end;
+
+function TStringVariable.GetFixedLen: Integer;
+begin
+  Result := FFixedLen;
+end;
+
+function TStringVariable.LenAsPointer: PInteger;
+begin
+  Result := @FFixedLen;
+end;
+
+{ TDateTimeVariable }
+
+constructor TDateTimeVariable.Create(AName: string; AValue: PDateTimeRec);
+begin
+  inherited Create(AName, etDateTime, _DateTimeVariable);
+  FValue := AValue;
+end;
+
+function TDateTimeVariable.AsPointer: PChar;
+begin
+  Result := PChar(FValue);
+end;
+
+{ TIntegerVariable }
+
+constructor TIntegerVariable.Create(AName: string; AValue: PInteger);
+begin
+  inherited Create(AName, etInteger, _IntegerVariable);
+  FValue := AValue;
+end;
+
+function TIntegerVariable.AsPointer: PChar;
+begin
+  Result := PChar(FValue);
+end;
+
+{$ifdef SUPPORT_INT64}
+
+{ TLargeIntVariable }
+
+constructor TLargeIntVariable.Create(AName: string; AValue: PLargeInt);
+begin
+  inherited Create(AName, etLargeInt, _LargeIntVariable);
+  FValue := AValue;
+end;
+
+function TLargeIntVariable.AsPointer: PChar;
+begin
+  Result := PChar(FValue);
+end;
+
+{$endif}
+
+{ TBooleanVariable }
+
+constructor TBooleanVariable.Create(AName: string; AValue: PBoolean);
+begin
+  inherited Create(AName, etBoolean, _BooleanVariable);
+  FValue := AValue;
+end;
+
+function TBooleanVariable.AsPointer: PChar;
+begin
+  Result := PChar(FValue);
+end;
+
+{ TLeftBracket }
+
+function TLeftBracket.GetResultType: TExpressionType;
+begin
+  Result := etLeftBracket;
+end;
+
+{ TRightBracket }
+
+function TRightBracket.GetResultType: TExpressionType;
+begin
+  Result := etRightBracket;
+end;
+
+{ TComma }
+
+function TComma.GetResultType: TExpressionType;
+begin
+  Result := etComma;
+end;
+
+{ TExpressList }
+
+constructor TExpressList.Create;
+begin
+  inherited;
+
+  FShortList := TExpressShortList.Create;
+end;
+
+destructor TExpressList.Destroy;
+begin
+  inherited;
+  FShortList.Free;
+end;
+
+procedure TExpressList.Add(Item: Pointer);
+var
+  I: Integer;
+begin
+  inherited;
+
+  { remember we reference the object }
+  Inc(TExprWord(Item).FRefCount);
+
+  { also add ShortName as reference }
+  if Length(TExprWord(Item).ShortName) > 0 then
+  begin
+    FShortList.Search(KeyOf(Item), I);
+    FShortList.Insert(I, Item);
+  end;
+end;
+
+function TExpressList.Compare(Key1, Key2: Pointer): Integer;
+begin
+  Result := StrIComp(PChar(Key1), PChar(Key2));
+end;
+
+function TExpressList.KeyOf(Item: Pointer): Pointer;
+begin
+  Result := PChar(TExprWord(Item).Name);
+end;
+
+procedure TExpressList.FreeItem(Item: Pointer);
+begin
+  Dec(TExprWord(Item).FRefCount);
+  FShortList.Remove(Item);
+  if TExprWord(Item).FRefCount = 0 then
+    inherited;
+end;
+
+function TExpressList.Search(Key: Pointer; var Index: Integer): Boolean;
+var
+  SecIndex: Integer;
+begin
+  Result := inherited Search(Key, Index);
+  if not Result then
+  begin
+    Result := FShortList.Search(Key, SecIndex);
+    if Result then
+      Index := IndexOf(FShortList.Items[SecIndex]);
+  end;
+end;
+
+function TExpressShortList.Compare(Key1, Key2: Pointer): Integer;
+begin
+  Result := StrIComp(PChar(Key1), PChar(Key2));
+end;
+
+function TExpressShortList.KeyOf(Item: Pointer): Pointer;
+begin
+  Result := PChar(TExprWord(Item).ShortName);
+end;
+
+procedure TExpressShortList.FreeItem(Item: Pointer);
+begin
+end;
+
+{ TExprCollection }
+
+procedure TExprCollection.Check;
+var
+  brCount, I: Integer;
+begin
+  brCount := 0;
+  for I := 0 to Count - 1 do
+  begin
+    case TExprWord(Items[I]).ResultType of
+      etLeftBracket: Inc(brCount);
+      etRightBracket: Dec(brCount);
+    end;
+  end;
+  if brCount <> 0 then
+    raise EParserException.Create('Unequal brackets');
+end;
+
+procedure TExprCollection.EraseExtraBrackets;
+var
+  I: Integer;
+  brCount: Integer;
+begin
+  if (TExprWord(Items[0]).ResultType = etLeftBracket) then
+  begin
+    brCount := 1;
+    I := 1;
+    while (I < Count) and (brCount > 0) do
+    begin
+      case TExprWord(Items[I]).ResultType of
+        etLeftBracket: Inc(brCount);
+        etRightBracket: Dec(brCount);
+      end;
+      Inc(I);
+    end;
+    if (brCount = 0) and (I = Count) and (TExprWord(Items[I - 1]).ResultType =
+      etRightBracket) then
+    begin
+      for I := 0 to Count - 3 do
+        Items[I] := Items[I + 1];
+      Count := Count - 2;
+      EraseExtraBrackets; //Check if there are still too many brackets
+    end;
+  end;
+end;
+
+function TExprCollection.NextOper(IStart: Integer): Integer;
+var
+  brCount: Integer;
+begin
+  brCount := 0;
+  Result := IStart;
+  while (Result < Count) and ((brCount > 0) or not (TExprWord(Items[Result]).IsFunction)) do
+  begin
+    case TExprWord(Items[Result]).ResultType of
+      etLeftBracket: Inc(brCount);
+      etRightBracket: Dec(brCount);
+    end;
+    Inc(Result);
+  end;
+end;
+
+{ TFunction }
+
+constructor TFunction.Create(AName, AShortName, ATypeSpec: string; AMinFuncArg: Integer; AResultType: TExpressionType;
+  AExprFunc: TExprFunc; Descr: string);
+begin
+  //to increase compatibility don't use default parameters
+  FDescription := Descr;
+  FShortName := AShortName;
+  InternalCreate(AName, ATypeSpec, AMinFuncArg, AResultType, AExprFunc, false, 0);
+end;
+
+constructor TFunction.CreateOper(AName, ATypeSpec: string; AResultType: TExpressionType;
+  AExprFunc: TExprFunc; AOperPrec: Integer);
+begin
+  InternalCreate(AName, ATypeSpec, -1, AResultType, AExprFunc, true, AOperPrec);
+end;
+
+procedure TFunction.InternalCreate(AName, ATypeSpec: string; AMinFuncArg: Integer; AResultType: TExpressionType;
+  AExprFunc: TExprFunc; AIsOper: Boolean; AOperPrec: Integer);
+begin
+  inherited Create(AName, AExprFunc);
+
+  FMaxFunctionArg := Length(ATypeSpec);
+  FMinFunctionArg := AMinFuncArg;
+  if AMinFuncArg = -1 then
+    FMinFunctionArg := FMaxFunctionArg;
+  FIsOper := AIsOper;
+  FOperPrec := AOperPrec;
+  FTypeSpec := ATypeSpec;
+  FResultType := AResultType;
+
+  // check correctness
+  if FMaxFunctionArg > MaxArg then
+    raise EParserException.Create('Too many arguments');
+end;
+
+function TFunction.GetDescription: string;
+begin
+  Result := FDescription;
+end;
+
+function TFunction.GetIsOper: Boolean;
+begin
+  Result := FIsOper;
+end;
+
+function TFunction.GetMinFunctionArg: Integer;
+begin
+  Result := FMinFunctionArg;
+end;
+
+function TFunction.GetMaxFunctionArg: Integer;
+begin
+  Result := FMaxFunctionArg;
+end;
+
+function TFunction.GetResultType: TExpressionType;
+begin
+  Result := FResultType;
+end;
+
+function TFunction.GetShortName: string;
+begin
+  Result := FShortName;
+end;
+
+function TFunction.GetTypeSpec: string;
+begin
+  Result := FTypeSpec;
+end;
+
+function TFunction.IsFunction: Boolean;
+begin
+  Result := True;
+end;
+
+{ TVaryingFunction }
+
+function TVaryingFunction.GetCanVary: Boolean;
+begin
+  Result := True;
+end;
+
+{ TDynamicType }
+
+constructor TDynamicType.Create(DestMem, DestPos: PPChar; Size: PInteger);
+begin
+  inherited Create;
+
+  FMemory := DestMem;
+  FMemoryPos := DestPos;
+  FSize := Size;
+end;
+
+procedure TDynamicType.Rewind;
+begin
+  FMemoryPos^ := FMemory^;
+end;
+
+procedure TDynamicType.AssureSpace(ASize: Integer);
+begin
+  // need more memory?
+  if ((FMemoryPos^) - (FMemory^) + ASize) > (FSize^) then
+    Resize((FMemoryPos^) - (FMemory^) + ASize, False);
+end;
+
+procedure TDynamicType.Resize(NewSize: Integer; Exact: Boolean);
+var
+  tempBuf: PChar;
+  bytesCopy, pos: Integer;
+begin
+  // if not exact requested make newlength a multiple of ArgAllocSize
+  if not Exact then
+    NewSize := NewSize div ArgAllocSize * ArgAllocSize + ArgAllocSize;
+  // create new buffer
+  GetMem(tempBuf, NewSize);
+  // copy memory
+  bytesCopy := FSize^;
+  if bytesCopy > NewSize then
+    bytesCopy := NewSize;
+  Move(FMemory^^, tempBuf^, bytesCopy);
+  // save position in string
+  pos := FMemoryPos^ - FMemory^;
+  // delete old mem
+  FreeMem(FMemory^);
+  // assign new
+  FMemory^ := tempBuf;
+  FSize^ := NewSize;
+  // assign position
+  FMemoryPos^ := FMemory^ + pos;
+end;
+
+procedure TDynamicType.Append(Source: PChar; Length: Integer);
+begin
+  // make room for string plus null-terminator
+  AssureSpace(Length+4);
+  // copy
+  Move(Source^, FMemoryPos^^, Length);
+  Inc(FMemoryPos^, Length);
+  // null-terminate
+  FMemoryPos^^ := #0;
+end;
+
+procedure TDynamicType.AppendInteger(Source: Integer);
+begin
+  // make room for number
+  AssureSpace(12);
+  Inc(FMemoryPos^, GetStrFromInt(Source, FMemoryPos^));
+  FMemoryPos^^ := #0;
+end;
+
+end.
+

fcl/db/dbase/Dbf_PrsSupp.pas

@@ -0,0 +1,187 @@
+unit Dbf_PrsSupp;
+
+{force CR/LF fix}
+
+// parse support
+
+{$i Dbf_Common.inc}
+
+interface
+
+uses
+  Classes;
+
+type
+
+  {TOCollection interfaces between OWL TCollection and VCL TList}
+
+  TOCollection = class(TList)
+  public
+    procedure AtFree(Index: Integer);
+    procedure FreeAll;
+    procedure DoFree(Item: Pointer);
+    procedure FreeItem(Item: Pointer); virtual;
+    destructor Destroy; override;
+  end;
+
+  TNoOwnerCollection = class(TOCollection)
+  public
+    procedure FreeItem(Item: Pointer); override;
+  end;
+
+  { TSortedCollection object }
+
+  TSortedCollection = class(TOCollection)
+  public
+    function Compare(Key1, Key2: Pointer): Integer; virtual; abstract;
+    function IndexOf(Item: Pointer): Integer; virtual;
+    procedure Add(Item: Pointer); virtual;
+    procedure AddReplace(Item: Pointer); virtual;
+    procedure AddList(Source: TList; FromIndex, ToIndex: Integer);
+    {if duplicate then replace the duplicate else add}
+    function KeyOf(Item: Pointer): Pointer; virtual;
+    function Search(Key: Pointer; var Index: Integer): Boolean; virtual;
+  end;
+
+  { TStrCollection object }
+
+  TStrCollection = class(TSortedCollection)
+  public
+    function Compare(Key1, Key2: Pointer): Integer; override;
+    procedure FreeItem(Item: Pointer); override;
+  end;
+
+implementation
+
+uses SysUtils;
+
+destructor TOCollection.Destroy;
+begin
+  FreeAll;
+  inherited Destroy;
+end;
+
+procedure TOCollection.AtFree(Index: Integer);
+var
+  Item: Pointer;
+begin
+  Item := Items[Index];
+  Delete(Index);
+  FreeItem(Item);
+end;
+
+
+procedure TOCollection.FreeAll;
+var
+  I: Integer;
+begin
+  try
+    for I := 0 to Count - 1 do
+      FreeItem(Items[I]);
+  finally
+    Count := 0;
+  end;
+end;
+
+procedure TOCollection.DoFree(Item: Pointer);
+begin
+  AtFree(IndexOf(Item));
+end;
+
+procedure TOCollection.FreeItem(Item: Pointer);
+begin
+  if (Item <> nil) then
+    with TObject(Item) as TObject do
+      Free;
+end;
+
+{----------------------------------------------------------------virtual;
+  Implementing TNoOwnerCollection
+  -----------------------------------------------------------------}
+
+procedure TNoOwnerCollection.FreeItem(Item: Pointer);
+begin
+end;
+
+{ TSortedCollection }
+
+function TSortedCollection.IndexOf(Item: Pointer): Integer;
+var
+  I: Integer;
+begin
+  IndexOf := -1;
+  if Search(KeyOf(Item), I) then
+  begin
+    while (I < Count) and (Item <> Items[I]) do
+      Inc(I);
+    if I < Count then IndexOf := I;
+  end;
+end;
+
+procedure TSortedCollection.AddReplace(Item: Pointer);
+var
+  Index: Integer;
+begin
+  if Search(KeyOf(Item), Index) then
+    Delete(Index);
+  Add(Item);
+end;
+
+procedure TSortedCollection.Add(Item: Pointer);
+var
+  I: Integer;
+begin
+  Search(KeyOf(Item), I);
+  Insert(I, Item);
+end;
+
+procedure TSortedCollection.AddList(Source: TList; FromIndex, ToIndex: Integer);
+var
+  I: Integer;
+begin
+  for I := FromIndex to ToIndex do
+    Add(Source.Items[I]);
+end;
+
+function TSortedCollection.KeyOf(Item: Pointer): Pointer;
+begin
+  Result := Item;
+end;
+
+function TSortedCollection.Search(Key: Pointer; var Index: Integer): Boolean;
+var
+  L, H, I, C: Integer;
+begin
+  Search := False;
+  L := 0;
+  H := Count - 1;
+  while L <= H do
+  begin
+    I := (L + H) div 2;
+    C := Compare(KeyOf(Items[I]), Key);
+    if C < 0 then
+      L := I + 1
+    else
+    begin
+      H := I - 1;
+      if C = 0 then
+        Search := True;
+    end;
+  end;
+  Index := L;
+end;
+
+{ TStrCollection }
+
+function TStrCollection.Compare(Key1, Key2: Pointer): Integer;
+begin
+  Compare := StrComp(Key1, Key2);
+end;
+
+procedure TStrCollection.FreeItem(Item: Pointer);
+begin
+  StrDispose(Item);
+end;
+
+end.
+

fcl/db/dbase/Dbf_Reg.pas

@@ -0,0 +1,368 @@
+unit Dbf_Reg;
+
+{tab fix}
+
+{===============================================================================
+||         TDbf Component         ||         http://tdbf.sf.net               ||
+===============================================================================}
+(*
+  tDBF is supplied "AS IS". The author disclaims all warranties,
+  expressed or implied, including, without limitation, the warranties of
+  merchantability and or fitness for any purpose. The author assumes no
+  liability for damages, direct or consequential, which may result from the
+  use of TDBF.
+
+  TDbf is licensed under the LGPL (lesser general public license).
+
+  You are allowed to use this component in any project free of charge.
+  You are
+  - NOT allowed to claim that you have created this component.  You are
+  - NOT allowed to copy this component's code into your own component and
+      claim that the code is your idea.
+
+*)
+
+interface
+
+{$I Dbf_Common.inc}
+
+procedure Register;
+
+implementation
+
+{$ifndef FPC}
+{$R Dbf.dcr}
+{$endif}
+
+uses
+  SysUtils,
+  Classes,
+{$ifdef KYLIX}
+  QGraphics,
+  QControls,
+  QForms,
+  QDialogs,
+{$else}
+  Controls,
+  Forms,
+  Dialogs,
+{$endif}
+  Dbf,
+  Dbf_DbfFile,
+  Dbf_IdxFile,
+  Dbf_Fields,
+  Dbf_Common,
+  Dbf_Str
+{$ifndef FPC}
+  ,ExptIntf
+{$endif}
+{$ifdef DELPHI_6}
+  ,DesignIntf,DesignEditors
+{$else}
+{$ifndef FPC}
+  ,DsgnIntf
+{$else}
+  ,PropEdits
+  ,LazarusPackageIntf
+  ,LResources
+  {,ComponentEditors}
+{$endif}
+{$endif}
+  ;
+
+//==========================================================
+//============ DESIGNONLY ==================================
+//==========================================================
+(*
+//==========================================================
+//============ TFilePathProperty
+//==========================================================
+type
+  TFilePathProperty = class(TStringProperty)
+  public
+    function GetValue: string; override;
+  end;
+
+function TFilePathProperty.GetValue: string;
+begin
+  Result := inherited GetValue;
+  if Result = EmptyStr then
+  begin
+    SetValue(ExtractFilePath(ToolServices.GetProjectName));
+    Result := inherited GetValue;
+  end;
+end;
+*)
+
+//==========================================================
+//============ TTableNameProperty
+//==========================================================
+type
+  TTableNameProperty = class(TStringProperty)
+  public
+    procedure Edit; override;
+    function GetAttributes: TPropertyAttributes; override;
+  end;
+
+procedure TTableNameProperty.Edit; {override;}
+var
+  FileOpen: TOpenDialog;
+  Dbf: TDbf;
+begin
+  FileOpen := TOpenDialog.Create(Application);
+  try
+    with fileopen do begin
+      Dbf := GetComponent(0) as TDbf;
+{$ifndef FPC}
+      if Dbf.FilePath = EmptyStr then
+        FileOpen.InitialDir := ExtractFilePath(ToolServices.GetProjectName)
+      else
+{$endif}
+        FileOpen.InitialDir := Dbf.AbsolutePath;
+      Filename := GetValue;
+      Filter := 'Dbf table|*.dbf';
+      if Execute then begin
+        SetValue(Filename);
+      end;
+    end;
+  finally
+    Fileopen.free;
+  end;
+end;
+
+function TTableNameProperty.GetAttributes: TPropertyAttributes; {override;}
+begin
+  Result := [paDialog, paRevertable];
+end;
+
+//==========================================================
+//============ TIndexFileNameProperty
+//==========================================================
+
+type
+  TIndexFileNameProperty = class(TStringProperty)
+  public
+    procedure Edit; override;
+    function GetAttributes: TPropertyAttributes; override;
+  end;
+
+procedure TIndexFileNameProperty.Edit; {override;}
+var
+  FileOpen: TOpenDialog;
+  IndexDef: TDbfIndexDef;
+  Indexes: TDbfIndexDefs;
+  Dbf: TDbf;
+begin
+  FileOpen := TOpenDialog.Create(Application);
+  try
+    with fileopen do begin
+      IndexDef := GetComponent(0) as TDbfIndexDef;
+      Indexes := TDbfIndexDefs(IndexDef.Collection);
+      Dbf := TDbf(Indexes.FOwner);
+      FileOpen.InitialDir := Dbf.AbsolutePath;
+      Filename := GetValue;
+      Filter := 'Simple index (ndx)|*.ndx'{|Multiple index (mdx)|*.mdx'};
+      if Execute then begin
+        SetValue(ExtractFileName(Filename));
+      end;
+    end;
+  finally
+    Fileopen.free;
+  end;
+end;
+
+function TIndexFileNameProperty.GetAttributes: TPropertyAttributes; {override;}
+begin
+  Result := [paDialog, paRevertable];
+end;
+
+//==========================================================
+//============ TSortFieldProperty
+//==========================================================
+
+type
+  TSortFieldProperty = class(TStringProperty)
+  public
+    function GetAttributes: TPropertyAttributes; override;
+    procedure GetValues(Proc: TGetStrProc); override;
+  end;
+
+
+function TSortFieldProperty.GetAttributes: TPropertyAttributes; {override;}
+begin
+  Result := [paValueList, paSortList, paRevertable];
+end;
+
+procedure TSortFieldProperty.GetValues(Proc: TGetStrProc);
+var
+  IndexDef: TDbfIndexDef;
+  Indexes: TDbfIndexDefs;
+  Dbf: TDbf;
+  I: integer;
+begin
+  IndexDef := GetComponent(0) as TDbfIndexDef;
+  Indexes := TDbfIndexDefs(IndexDef.Collection);
+  Dbf :=  TDbf(Indexes.FOwner);
+  for I := 0 to Dbf.FieldCount-1 do
+  begin
+    Proc(Dbf.Fields[i].FieldName);
+  end;
+end;
+
+//==========================================================
+//============ TIndexNameProperty
+//==========================================================
+
+type
+  TIndexNameProperty = class(TStringProperty)
+  public
+    function GetAttributes: TPropertyAttributes; override;
+    procedure GetValues(Proc: TGetStrProc); override;
+    procedure SetValue(const Value: string); override;
+    function GetValue: string; override;
+  end;
+
+function TIndexNameProperty.GetAttributes: TPropertyAttributes; {override;}
+begin
+  Result := [paValueList, paRevertable];
+end;
+
+procedure TIndexNameProperty.GetValues(Proc: TGetStrProc);
+var
+  Dbf: TDbf;
+  I: Integer;
+begin
+  Dbf := GetComponent(0) as TDbf;
+  Dbf.UpdateIndexDefs;
+  for I := 0 to Dbf.Indexes.Count - 1 do
+    Proc(Dbf.Indexes[I].IndexFile);
+end;
+
+procedure TIndexNameProperty.SetValue(const Value: string); {override}
+var
+  Dbf: TDbf;
+begin
+  Dbf := GetComponent(0) as TDbf;
+  Dbf.IndexName := Value;
+end;
+
+function TIndexNameProperty.GetValue: string; {override;}
+var
+  Dbf: TDbf;
+begin
+  Dbf := GetComponent(0) as TDbf;
+  Result := Dbf.IndexName;
+end;
+
+//==========================================================
+//============ TVersionProperty
+//==========================================================
+type
+  TVersionProperty = class(TStringProperty)
+  public
+    procedure Edit; override;
+    function GetAttributes: TPropertyAttributes; override;
+  end;
+
+procedure TVersionProperty.Edit; {override;}
+begin
+  ShowMessage(
+    Format(STRING_VERSION,[TDBF_MAJOR_VERSION, TDBF_MINOR_VERSION]) +
+      ' : a dBase component'+#13+
+      'for Delphi and c++ builder with no BDE.'+#13+
+      #13 +
+      'To get the latest version, please visit'+#13+
+      'the website: http://www.tdbf.net'+#13+
+      'or SourceForge: http://tdbf.sf.net');
+end;
+
+function TVersionProperty.GetAttributes: TPropertyAttributes; {override;}
+begin
+  Result := [paDialog, paReadOnly, paRevertable];
+end;
+
+//==========================================================
+//============ TNativeFieldTypeProperty
+//==========================================================
+type
+  TNativeFieldTypeProperty = class(TCharProperty)
+  public
+    function GetAttributes: TPropertyAttributes; override;
+    procedure GetValues(Proc: TGetStrProc); override;
+    procedure SetValue(const Value: string); override;
+  end;
+
+procedure TNativeFieldTypeProperty.SetValue(const Value: string);
+var
+  L: Longint;
+begin
+  if Length(Value) = 0 then L := 0 else
+  if Value[1] = '#' then L := StrToInt(Copy(Value, 2, Maxint))
+  else L := Ord(Value[1]);
+  SetOrdValue(L);
+end;
+
+function TNativeFieldTypeProperty.GetAttributes: TPropertyAttributes; {override;}
+begin
+  result := [paRevertable,paValueList];
+end;
+
+procedure TNativeFieldTypeProperty.GetValues(Proc: TGetStrProc);
+begin
+  Proc('C Character');
+  Proc('N Numeric');
+  Proc('D Date');
+  Proc('L Logical');
+  Proc('M Memo');
+  Proc('B Blob');
+  Proc('F Float');
+  Proc('O Double');
+  Proc('I Integer');
+  Proc('G Graphic');
+  Proc('+ AutoIncrement');
+  Proc('@ DateTime');
+end;
+
+//==========================================================
+//============ initialization
+//==========================================================
+function IDE_DbfDefaultPath:string;
+begin
+{$ifndef FPC}
+  if ToolServices<>nil then
+    Result := ExtractFilePath(ToolServices.GetProjectName)
+  else
+{$endif}
+    Result := GetCurrentDir
+end;
+
+{$ifdef FPC}
+procedure RegisterUnitDbf;
+{$else}
+procedure Register;
+{$endif}
+begin
+  Dbf.DbfBasePath := IDE_DbfDefaultPath;
+  RegisterComponents('Data Access', [TDbf]);
+//  RegisterPropertyEditor(TypeInfo(string), TDbf, 'FilePath', TFilePathProperty);
+  RegisterPropertyEditor(TypeInfo(string), TDbf, 'TableName', TTableNameProperty);
+  RegisterPropertyEditor(TypeInfo(string), TDbf, 'Version', TVersionProperty);
+  RegisterPropertyEditor(TypeInfo(string), TDbf, 'IndexName', TIndexNameProperty);
+  RegisterPropertyEditor(TypeInfo(string), TDbfIndexDef, 'IndexFile', TIndexFileNameProperty);
+  RegisterPropertyEditor(TypeInfo(string), TDbfIndexDef, 'SortField', TSortFieldProperty);
+  RegisterPropertyEditor(TypeInfo(char), TDbfFieldDef, 'NativeFieldType', TNativeFieldTypeProperty);
+end;
+
+{$ifdef FPC}
+procedure Register;
+begin
+  RegisterUnit('Dbf', @RegisterUnitDbf);
+end;
+{$endif}
+
+{$ifdef FPC}
+initialization
+  {$i tdbf.lrs}
+{$endif}
+
+end.

fcl/db/dbase/Dbf_Str.inc

@@ -0,0 +1,24 @@
+var
+  STRING_FILE_NOT_FOUND: string;
+  STRING_VERSION: string;
+
+  STRING_RECORD_LOCKED: string;
+  STRING_WRITE_ERROR: string;
+  STRING_WRITE_INDEX_ERROR: string;
+  STRING_KEY_VIOLATION: string;
+
+  STRING_INVALID_DBF_FILE: string;
+  STRING_FIELD_TOO_LONG: string;
+  STRING_INVALID_FIELD_COUNT: string;
+  STRING_INVALID_FIELD_TYPE: string;
+  STRING_INVALID_VCL_FIELD_TYPE: string;
+
+  STRING_INDEX_BASED_ON_UNKNOWN_FIELD: string;
+  STRING_INDEX_BASED_ON_INVALID_FIELD: string;
+  STRING_INDEX_EXPRESSION_TOO_LONG: string;
+  STRING_INVALID_INDEX_TYPE: string;
+  STRING_CANNOT_OPEN_INDEX: string;
+  STRING_TOO_MANY_INDEXES: string;
+  STRING_INDEX_NOT_EXIST: string;
+  STRING_NEED_EXCLUSIVE_ACCESS: string;
+

fcl/db/dbase/Dbf_Str.pas

@@ -0,0 +1,38 @@
+unit Dbf_Str;
+
+{fix CR/LF}
+
+interface
+
+{$I Dbf_Common.inc}
+{$I Dbf_Str.inc}
+
+implementation
+
+initialization
+
+  STRING_FILE_NOT_FOUND               := 'Open: file not found: "%s".';
+  STRING_VERSION                      := 'TDbf V%d.%d';
+
+  STRING_RECORD_LOCKED                := 'Record locked.';
+  STRING_WRITE_ERROR                  := 'Error while writing occurred. (Disk full?)';
+  STRING_WRITE_INDEX_ERROR            := 'Error while writing occurred; indexes probably corrupted. (Disk full?)';
+  STRING_KEY_VIOLATION                := 'Key violation. (Key already present in file).'+#13+#10+
+                                         'Index: %s'+#13+#10+'Record=%d Key=''%s''.';
+
+  STRING_INVALID_DBF_FILE             := 'Invalid DBF file.';
+  STRING_FIELD_TOO_LONG               := 'Value is too long: %d characters (it can''t be more than %d).';
+  STRING_INVALID_FIELD_COUNT          := 'Invalid field count: %d (must be between 1 and 4095).';
+  STRING_INVALID_FIELD_TYPE           := 'Invalid field type ''%s'' for field ''%s''.';
+  STRING_INVALID_VCL_FIELD_TYPE       := 'Cannot create field "%s", VCL field type %x not supported by DBF.';
+
+  STRING_INDEX_BASED_ON_UNKNOWN_FIELD := 'Index based on unknown field "%s".';
+  STRING_INDEX_BASED_ON_INVALID_FIELD := 'Field "%s" is an invalid field type to base index on.';
+  STRING_INDEX_EXPRESSION_TOO_LONG    := 'Index result for "%s" too long, >100 characters (%d).';
+  STRING_INVALID_INDEX_TYPE           := 'Invalid index type: can only be string or float.';
+  STRING_CANNOT_OPEN_INDEX            := 'Cannot open index: "%s".';
+  STRING_TOO_MANY_INDEXES             := 'Can not create index: too many indexes in file.';
+  STRING_INDEX_NOT_EXIST              := 'Index "%s" does not exist.';
+  STRING_NEED_EXCLUSIVE_ACCESS        := 'Exclusive access is required for this operation.';
+end.
+

fcl/db/dbase/Dbf_Str_FR.pas

@@ -0,0 +1,56 @@
+unit Dbf_Str;
+
+{fix CR/LF}
+
+interface
+
+{$I Dbf_Common.inc}
+
+var
+  STRING_FILE_NOT_FOUND: string;
+  STRING_VERSION: string;
+
+  STRING_RECORD_LOCKED: string;
+  STRING_KEY_VIOLATION: string;
+
+  STRING_INVALID_DBF_FILE: string;
+  STRING_FIELD_TOO_LONG: string;
+  STRING_INVALID_FIELD_COUNT: string;
+  STRING_INVALID_FIELD_TYPE: string;
+
+  STRING_INDEX_BASED_ON_UNKNOWN_FIELD: string;
+  STRING_INDEX_BASED_ON_INVALID_FIELD: string;
+  STRING_INDEX_EXPRESSION_TOO_LONG: string;
+  STRING_INVALID_INDEX_TYPE: string;
+  STRING_CANNOT_OPEN_INDEX: string;
+  STRING_TOO_MANY_INDEXES: string;
+  STRING_INDEX_NOT_EXIST: string;
+  STRING_NEED_EXCLUSIVE_ACCESS: string;
+
+implementation
+
+initialization
+
+  STRING_FILE_NOT_FOUND               := 'Ouverture: fichier non trouvé: "%s"';
+  STRING_VERSION                      := 'TDbf V%d.%d';
+
+  STRING_RECORD_LOCKED                := 'Enregistrement verrouillé.';
+  STRING_KEY_VIOLATION                := 'Violation de clé. (doublon dans un index).'+#13+#10+
+                                         'Index: %s'+#13+#10+'Enregistrement=%d Cle=''%s''';
+
+  STRING_INVALID_DBF_FILE             := 'Fichier DBF invalide.';
+  STRING_FIELD_TOO_LONG               := 'Valeur trop longue: %d caractères (ne peut dépasser %d).';
+  STRING_INVALID_FIELD_COUNT          := 'Nombre de champs non valide: %d (doit être entre 1 et 4095).';
+  STRING_INVALID_FIELD_TYPE           := 'Type de champ ''%s'' invalide pour le champ %s.';
+  STRING_INVALID_VCL_FIELD_TYPE       := 'Impossible de créer le champ "%s", champ type %x VCL non supporté par DBF';
+
+  STRING_INDEX_BASED_ON_UNKNOWN_FIELD := 'Index basé sur un champ inconnu %s';
+  STRING_INDEX_BASED_ON_INVALID_FIELD := 'Impossible de contruire un index sur ce type de champ "%s"';
+  STRING_INDEX_EXPRESSION_TOO_LONG    := 'Résultat d''Index trop long pour "%s", >100 caractères (%d).';
+  STRING_INVALID_INDEX_TYPE           := 'Type d''index non valide: doit être string ou float';
+  STRING_CANNOT_OPEN_INDEX            := 'Impossible d''ouvrir l''index: "%s"';
+  STRING_TOO_MANY_INDEXES             := 'Impossible de créer l''index: trop d''index dans le fichier.';
+  STRING_INDEX_NOT_EXIST              := 'L''index "%s" n''existe pas.';
+  STRING_NEED_EXCLUSIVE_ACCESS        := 'Access exclusif requis pour cette opération.';
+end.
+

fcl/db/dbase/Dbf_Str_ITA.pas

@@ -0,0 +1,47 @@
+unit Dbf_Str;
+
+{fix CR/LF}
+
+interface
+
+{$I Dbf_Common.inc}
+
+var
+  STRING_FILE_NOT_FOUND: string;
+  STRING_VERSION: string;
+
+  STRING_RECORD_LOCKED: string;
+
+  STRING_INVALID_DBF_FILE: string;
+  STRING_FIELD_TOO_LONG: string;
+  STRING_INVALID_FIELD_COUNT: string;
+
+  STRING_INDEX_BASED_ON_UNKNOWN_FIELD: string;
+  STRING_INDEX_BASED_ON_INVALID_FIELD: string;
+  STRING_INVALID_INDEX_TYPE: string;
+  STRING_CANNOT_OPEN_INDEX: string;
+  STRING_TOO_MANY_INDEXES: string;
+  STRING_INDEX_NOT_EXIST: string;
+  STRING_NEED_EXCLUSIVE_ACCESS: string;
+
+implementation
+
+initialization
+
+  STRING_FILE_NOT_FOUND               := 'Apertura: file non trovato: "%s"';
+  STRING_VERSION                      := 'TDbf V%d.%d';
+
+  STRING_RECORD_LOCKED                := 'Record già in uso.';
+
+  STRING_INVALID_DBF_FILE             := 'File DBF non valido.';
+  STRING_FIELD_TOO_LONG               := 'Valore troppo elevato: %d caratteri (esso non può essere più di %d).';
+  STRING_INVALID_FIELD_COUNT          := 'Campo non valido (count): %d (deve essere tra 1 e 4095).';
+
+  STRING_INDEX_BASED_ON_UNKNOWN_FIELD := 'Indice basato su un campo sconosciuto "%s"';
+  STRING_INDEX_BASED_ON_INVALID_FIELD := 'Campo "%s" è di tipo non valido per un indice';
+  STRING_INVALID_INDEX_TYPE           := 'Tipo indice non valido: Può essere solo string o float';
+  STRING_CANNOT_OPEN_INDEX            := 'Non è possibile aprire indice : "%s"';
+  STRING_TOO_MANY_INDEXES             := 'Non è possibile creare indice: Troppi indici aperti.';
+  STRING_INDEX_NOT_EXIST              := 'Indice "%s" non esiste.';
+  STRING_NEED_EXCLUSIVE_ACCESS        := 'L''Accesso in esclusiva è richiesto per questa operazione.';
+end.

fcl/db/dbase/Dbf_Str_NL.pas

@@ -0,0 +1,57 @@
+unit Dbf_Str;
+
+{fix CR/LF}
+
+interface
+
+{$I Dbf_Common.inc}
+
+var
+  STRING_FILE_NOT_FOUND: string;
+  STRING_VERSION: string;
+
+  STRING_RECORD_LOCKED: string;
+  STRING_KEY_VIOLATION: string;
+
+  STRING_INVALID_DBF_FILE: string;
+  STRING_FIELD_TOO_LONG: string;
+  STRING_INVALID_FIELD_COUNT: string;
+  STRING_INVALID_FIELD_TYPE: string;
+
+  STRING_INDEX_BASED_ON_UNKNOWN_FIELD: string;
+  STRING_INDEX_BASED_ON_INVALID_FIELD: string;
+  STRING_INDEX_EXPRESSION_TOO_LONG: string;
+  STRING_INVALID_INDEX_TYPE: string;
+  STRING_CANNOT_OPEN_INDEX: string;
+  STRING_TOO_MANY_INDEXES: string;
+  STRING_INDEX_NOT_EXIST: string;
+  STRING_NEED_EXCLUSIVE_ACCESS: string;
+
+implementation
+
+initialization
+
+  STRING_FILE_NOT_FOUND               := 'Openen: bestand niet gevonden: "%s"';
+  STRING_VERSION                      := 'TDbf V%d.%d';
+
+  STRING_RECORD_LOCKED                := 'Record in gebruik.';
+  STRING_WRITE_ERROR                  := 'Error tijdens schrijven. (Disk vol?)';
+  STRING_KEY_VIOLATION                := 'Indexsleutel bestond al in bestand.'+#13+#10+
+                                         'Index: %s'+#13+#10+'Record=%d Sleutel=''%s''';
+
+  STRING_INVALID_DBF_FILE             := 'Ongeldig DBF bestand.';
+  STRING_FIELD_TOO_LONG               := 'Waarde is te lang: %d karakters (maximum is %d).';
+  STRING_INVALID_FIELD_COUNT          := 'Ongeldig aantal velden: %d (moet tussen 1 en 4095).';
+  STRING_INVALID_FIELD_TYPE           := 'Veldtype ''%s'' is ongeldig voor veld ''%s''.';
+  STRING_INVALID_VCL_FIELD_TYPE       := 'Veld "%s": VCL veldtype %x wordt niet ondersteund door DBF.';
+
+  STRING_INDEX_BASED_ON_UNKNOWN_FIELD := 'Index gebaseerd op onbekend veld "%s".';
+  STRING_INDEX_BASED_ON_INVALID_FIELD := 'Veld "%s" heeft een ongeldig veldtype om index op te baseren.';
+  STRING_INDEX_EXPRESSION_TOO_LONG    := 'Index expressie resultaat "%s" is te lang, >100 karakters (%d).';
+  STRING_INVALID_INDEX_TYPE           := 'Ongeldig index type: kan alleen karakter of numeriek.';
+  STRING_CANNOT_OPEN_INDEX            := 'Openen index gefaald: "%s".';
+  STRING_TOO_MANY_INDEXES             := 'Toevoegen index onmogenlijk: te veel indexen in bestand.';
+  STRING_INDEX_NOT_EXIST              := 'Index "%s" bestaat niet.';
+  STRING_NEED_EXCLUSIVE_ACCESS        := 'Exclusieve toegang is vereist voor deze actie.';
+end.
+

fcl/db/dbase/Dbf_Str_PL.pas

@@ -0,0 +1,36 @@
+unit Dbf_Str;
+
+interface
+
+{$I Dbf_Common.inc}
+{$I Dbf_Str.inc}
+
+implementation
+
+initialization
+
+  STRING_FILE_NOT_FOUND               := 'Open: brak pliku: "%s"';
+  STRING_VERSION                      := 'TDbf V%d.%d';
+
+  STRING_RECORD_LOCKED                := 'Rekord zablokowany.';
+  STRING_WRITE_ERROR                  := 'Niezapisano(Brak miejsca na dysku?)';
+  STRING_KEY_VIOLATION                := 'Konflikt klucza. (Klucz obecny w pliku).'+#13+#10+
+                                         'Indeks: %s'+#13+#10+'Rekord=%d Klucz=''%s''';
+
+  STRING_INVALID_DBF_FILE             := 'Uszkodzony plik bazy.';
+  STRING_FIELD_TOO_LONG               := 'Dana za d³uga : %d znaków (dopuszczalne do %d).';
+  STRING_INVALID_FIELD_COUNT          := 'Z³a liczba pól: %d (dozwolone 1 do 4095).';
+  STRING_INVALID_FIELD_TYPE           := 'B³êdny typ pola ''%c'' dla pola ''%s''.';
+  STRING_INVALID_VCL_FIELD_TYPE       := 'Nie mogê tworzyæ pola "%s", typ pola VCL %x nie wspierany przez DBF.';
+
+
+  STRING_INDEX_BASED_ON_UNKNOWN_FIELD := 'Kluczowe pole indeksu "%s" nie istnieje';
+  STRING_INDEX_BASED_ON_INVALID_FIELD := 'Typ pola "%s" niedozwolony dla indeksów';
+  STRING_INDEX_EXPRESSION_TOO_LONG    := 'Zbyt d³ugi wynik "%s", >100 znaków (%d).';
+  STRING_INVALID_INDEX_TYPE           := 'Z³y typ indeksu: tylko string lub float';
+  STRING_CANNOT_OPEN_INDEX            := 'Nie mogê otworzyæ indeksu: "%s"';
+  STRING_TOO_MANY_INDEXES             := 'Nie mogê stworzyæ indeksu: za du¿o w pliku.';
+  STRING_INDEX_NOT_EXIST              := 'Brak indeksu "%s".';
+  STRING_NEED_EXCLUSIVE_ACCESS        := 'Operacja wymaga dostêpu w trybie Exclusive.';
+end.
+

fcl/db/dbase/Dbf_Str_RU.pas

@@ -0,0 +1,42 @@
+unit Dbf_Str_RU;
+
+{fix CR/LF}
+
+// file is encoded in Windows-1251 encoding
+// for using with Linux/Kylix must be re-coded to KOI8-R
+// for use with DOS & OS/2 (if it will be possible with FreePascal or VirtualPascal)
+//    file should be recoded to cp866
+
+interface
+
+{$I Dbf_Common.inc}
+{$I Dbf_Str.inc}
+
+implementation
+
+initialization
+
+  STRING_FILE_NOT_FOUND               := 'Ôàéë "%s" íå ñóùåñòâóåò. Îòêðûòü íåâîçìîæíî.';
+  STRING_VERSION                      := 'TDbf V%d.%d';
+
+  STRING_RECORD_LOCKED                := 'Çàïèñü (ñòðîêà òàáëèöû) çàáëîêèðîâàíà.';
+  STRING_WRITE_ERROR                  := 'Îøèáêà çàïèñè íà äèñê (Äèñê çàïîëíåí?)';
+  STRING_KEY_VIOLATION                := 'Êëþ÷åâîå çíà÷åíèå íå äîëæíî ïîâòîðÿòüñÿ!.'+#13+#10+
+                                         'Èíäåêñ: %s'+#13+#10+'Çàïèñü (ñòðîêà)=%d  Êëþ÷="%s".';
+
+  STRING_INVALID_DBF_FILE             := 'Ôàéë DBF ïîâðåæäåí èëè åãî ñòðóêòóðà íå DBF.';
+  STRING_FIELD_TOO_LONG               := 'Äëèíà çíà÷åíèÿ - %d ñèìâîëîâ, ýòî áîëüøå ìàêñèìóìà - %d.';
+  STRING_INVALID_FIELD_COUNT          := 'Êîëè÷åñòâî ïîëåé â òàáëèöå (%d) íåâîçìîæíî. Äîïóñòèìî îò 1 äî 4095.';
+  STRING_INVALID_FIELD_TYPE           := 'Òèï çíà÷åíèÿ "%s", çàòðåáîâàííûé ïîëåì "%s" íåâîçìîæåí.';
+  STRING_INVALID_VCL_FIELD_TYPE       := 'Íåâîçìîæíî ñîçäàòü ïîëå "%s", Òèï äàííûõ VCL[%x] íå ìîæåò áûòü çàïèñàí â DBF.';
+
+  STRING_INDEX_BASED_ON_UNKNOWN_FIELD := 'Èíäåêñ ññûëàåòñÿ íà íåñóùåñòâóþùåå ïîëå "%s".';
+  STRING_INDEX_BASED_ON_INVALID_FIELD := 'Ïîëå "%s" íå ìîæåò áûòü èíäåêñèðîâàííî. Èíäåêñû íå ïîääåðæèâàþò òàêîé òèï ïîëÿ.';
+  STRING_INDEX_EXPRESSION_TOO_LONG    := '%s: Ñëèøêîì äëèííîå çíà÷åíèå äëÿ èíäåêñà (%d). Äîëæíî áûòü íå áîëüøå 100 ñèìâîëîâ.';
+  STRING_INVALID_INDEX_TYPE           := 'Íåâîçìîæíûé òèï èíäåêñà: èíäåêñàöèÿ âîçìîæíî òîëüêî ïî ÷èñëó èëè ñòðîêå';
+  STRING_CANNOT_OPEN_INDEX            := 'Íåâîçìîæíî îòêðûòü èíäåêñ "%s".';
+  STRING_TOO_MANY_INDEXES             := 'Íåâîçìîæíî ñîçäàòü åùå îäèí èíäåêñ. Ôàéë ïîëîí.';
+  STRING_INDEX_NOT_EXIST              := 'Èíäåêñ "%s" íå ñóùåñòâóåò.';
+  STRING_NEED_EXCLUSIVE_ACCESS        := 'Íåâîçìîæíî âûïîëíèòü - ñíà÷àëà íóæíî ïîëó÷èòü ìîíîïîëüíûé äîñòóï.';
+end.
+

fcl/db/dbase/Dbf_Struct.inc

@@ -0,0 +1,142 @@
+
+const
+
+//====================================================================
+  FieldPropType_Required    = $01;
+  FieldPropType_Min         = $02;
+  FieldPropType_Max         = $03;
+  FieldPropType_Default     = $04;
+  FieldPropType_Constraint  = $06;
+
+  FieldDescVII_AutoIncOffset = 40;
+
+//====================================================================
+// File structures
+//====================================================================
+
+type
+
+  PDbfHdr = ^rDbfHdr;
+  rDbfHdr = packed record
+    VerDBF      : Byte;     // 0
+    Year        : Byte;     // 1
+    Month       : Byte;     // 2
+    Day         : Byte;     // 3
+    RecordCount : Integer;  // 4-7
+    FullHdrSize : Word;     // 8-9
+    RecordSize  : Word;     // 10-11
+    Dummy1      : Word;     // 12-13
+    IncTrans    : Byte;     // 14
+    Encrypt     : Byte;     // 15
+    MultiUse    : Integer;  // 16-19
+    LastUserID  : Integer;  // 20-23
+    Dummy2      : array[24..27] of Byte;
+    MDXFlag     : Byte;     // 28
+    Language    : Byte;     // 29
+    Dummy3      : Word;     // 30-31
+  end;
+//====================================================================
+  PAfterHdrIII = ^rAfterHdrIII;
+  rAfterHdrIII = packed record // Empty
+  end;
+//====================================================================
+  PAfterHdrVII = ^rAfterHdrVII;
+  rAfterHdrVII = packed record
+    LanguageDriverName  : array[32..63] of Char;
+    Dummy               : array[64..67] of Byte;
+  end;
+//====================================================================
+  PFieldDescIII = ^rFieldDescIII;
+  rFieldDescIII = packed record
+    FieldName       : array[0..10] of Char;
+    FieldType       : Char;     // 11
+    FieldOffset     : Integer;  // 12..15   only applicable to foxpro databases
+    FieldSize       : Byte;     // 16
+    FieldPrecision  : Byte;     // 17
+    FoxProFlags	    : Byte;	// 18
+    Dummy2          : array[19..31] of Byte;
+  end;
+//====================================================================
+// OH 2000-11-15 dBase7 support. Header Update (add fields like Next AutoInc Value)
+  rFieldDescVII = packed record
+    FieldName      : array [0..31] of Char;
+    FieldType      : Char;  // 32
+    FieldSize      : Byte;  // 33
+    FieldPrecision : Byte;  // 34
+    Reserved1      : Word;  // 35-36
+    MDXFlag        : Byte;  // 37
+    Reserved2      : Cardinal; // 38-39
+    NextAutoInc    : Cardinal; // 40-43
+    Reserved3      : Word;  // 44-47
+  end;
+//====================================================================
+  PFieldPropsHdr = ^rFieldPropsHdr;
+  rFieldPropsHdr = packed record
+    NumStdProps      : Word;  // 0..1
+    StartStdProps    : Word;  // 2..3
+    NumCustomProps   : Word;  // 4..5
+    StartCustomProps : Word;  // 6..7
+    NumRIProps       : Word;  // 8..9
+    StartRIProps     : Word;  // 10..11
+    StartData        : Word;  // 12..13 ; this points past the Descriptor arrays to data used by the arrays - for example Custom property names are stored here.
+    Size             : Word;  // 14..15 ; Actual size of structure, including data
+  end;
+//====================================================================
+  PStdPropEntry = ^rStdPropEntry;
+  rStdPropEntry = packed record
+    GenNumber    : Word;  // 0..1   ; Generational number. More than one value may exist for a property. The current value is the value with the highest generational number.
+    FieldOffset  : Word;  // 2..3   ; Table field offset - base one. 01 for the first field in the table, 02 for the second field, etc. Note: this will be 0 in the case of a constraint.
+    PropType     : Byte;  // 4      ; Which property is described in this record:
+                          //            01 Required
+                          //            02 Min
+                          //            03 Max
+                          //            04 Default
+                          //            06 Database constraint
+    FieldType    : Byte;  // 5      ; Field Type:
+                          //            00 No type - constraint
+                          //            01 Char
+                          //            02 Numeric
+                          //            03 Memo
+                          //            04 Logical
+                          //            05 Date
+                          //            06 Float
+                          //            08 OLE
+                          //            09 Binary
+                          //            11 Long
+                          //            12 Timestamp
+                          //            13 Double
+                          //            14 AutoIncrement (not settable from the Inspector)
+    IsConstraint : Byte;  // 6      ; 0x00 if the array element is a constraint, 0x02 otherwise.
+    Reserved     : array[7..10] of Char;
+    DataOffset   : Word;  // 11..12 ; Offset from the start of this structure to the data for the property. The Required property has no data associated with it, so it is always 0.
+    DataSize     : Word;  // 13..14 ; Width of database field associated with the property, and hence size of the data (includes 0 terminator in the case of a constraint).
+  end;
+//====================================================================
+  PCustomPropEntry = ^rCustomPropEntry;
+  rCustomPropEntry = packed record
+    GenNumber    : Word;  // 0..1   ; same as standard
+    FieldOffset  : Word;  // 2..3   ; same as standard
+    FieldType    : Byte;  // 4      ; same as standard
+    Reserved     : Byte;  // 5
+    NameOffset   : Word;  // 6..7   ; Offset from the start of this structure to the Custom property name.
+    NameLength   : Word;  // 8..9   ; Length of the Custom property name.
+    DataOffset   : Word;  // 10..11 ; Offset from the start of this structure to the Custom property data.
+    DataLength   : Word;  // 12..13 ; Length of the Custom property data (does not include null terminator).
+  end;
+//====================================================================
+  PRIPropEntry = ^rRIPropEntry;
+  rRIPropEntry = packed record
+    RelationType    : Byte;  // 0      ; 0x07 if Master (parent), 0x08 if Dependent (child).
+    Number          : Word;  // 1..2   ; Sequential number, 1 based counting. If this number is 0, this RI rule has been dropped.
+    NameOffset      : Word;  // 3..4   ; Offset of the RI rule name - 0 terminated.
+    NameSize        : Word;  // 5..6   ; Size of ...
+    ForeignOffset   : Word;  // 7..8   ; Offset of the name of the Foreign Table - 0 terminated.
+    ForeignSize     : Word;  // 9..10  ; Size of ...
+    UpdateType      : Byte;  // 11     ; Update & delete behaviour: Update Cascade=0x10, Delete Cascade=0x01
+    NumFieldsKey    : Word;  // 12..13 ; Number of fields in the linking key.
+    LocalTagOffset  : Word;  // 14..15 ; Offset of the Local Table tag name - 0 terminated.
+    LocalTagSize    : Word;  // 16..17 ; Size of ...
+    ForeignTagOffset: Word;  // 18..19 ; Offset of the Foreign Table tag name - 0 terminated.
+    ForeignTagSize  : Word;  // 20..21 ; Size of ...
+  end;
+

fcl/db/dbase/Dbf_Wtil.pas

@@ -0,0 +1,587 @@
+unit Dbf_Wtil;
+
+{$i Dbf_Common.inc}
+
+interface
+
+{$ifndef WIN32}
+uses
+{$ifdef KYLIX}
+  Libc, 
+{$endif}
+{$ifdef FPC}
+  BaseUnix,
+{$endif}
+  Types, SysUtils, Classes;
+
+const
+  LCID_INSTALLED = $00000001;  { installed locale ids }
+  LCID_SUPPORTED = $00000002;  { supported locale ids }
+  CP_INSTALLED   = $00000001;  { installed code page ids }
+  CP_SUPPORTED   = $00000002;  { supported code page ids }
+(*
+ *  Language IDs.
+ *
+ *  The following two combinations of primary language ID and
+ *  sublanguage ID have special semantics:
+ *
+ *    Primary Language ID   Sublanguage ID      Result
+ *    -------------------   ---------------     ------------------------
+ *    LANG_NEUTRAL          SUBLANG_NEUTRAL     Language neutral
+ *    LANG_NEUTRAL          SUBLANG_DEFAULT     User default language
+ *    LANG_NEUTRAL          SUBLANG_SYS_DEFAULT System default language
+ *)
+{ Primary language IDs. }
+  LANG_NEUTRAL                         = $00;
+  LANG_AFRIKAANS                       = $36;
+  LANG_ALBANIAN                        = $1c;
+  LANG_ARABIC                          = $01;
+  LANG_BASQUE                          = $2d;
+  LANG_BELARUSIAN                      = $23;
+  LANG_BULGARIAN                       = $02;
+  LANG_CATALAN                         = $03;
+  LANG_CHINESE                         = $04;
+  LANG_CROATIAN                        = $1a;
+  LANG_CZECH                           = $05;
+  LANG_DANISH                          = $06;
+  LANG_DUTCH                           = $13;
+  LANG_ENGLISH                         = $09;
+  LANG_ESTONIAN                        = $25;
+  LANG_FAEROESE                        = $38;
+  LANG_FARSI                           = $29;
+  LANG_FINNISH                         = $0b;
+  LANG_FRENCH                          = $0c;
+  LANG_GERMAN                          = $07;
+  LANG_GREEK                           = $08;
+  LANG_HEBREW                          = $0d;
+  LANG_HUNGARIAN                       = $0e;
+  LANG_ICELANDIC                       = $0f;
+  LANG_INDONESIAN                      = $21;
+  LANG_ITALIAN                         = $10;
+  LANG_JAPANESE                        = $11;
+  LANG_KOREAN                          = $12;
+  LANG_LATVIAN                         = $26;
+  LANG_LITHUANIAN                      = $27;
+  LANG_NORWEGIAN                       = $14;
+  LANG_POLISH                          = $15;
+  LANG_PORTUGUESE                      = $16;
+  LANG_ROMANIAN                        = $18;
+  LANG_RUSSIAN                         = $19;
+  LANG_SERBIAN                         = $1a;
+  LANG_SLOVAK                          = $1b;
+  LANG_SLOVENIAN                       = $24;
+  LANG_SPANISH                         = $0a;
+  LANG_SWEDISH                         = $1d;
+  LANG_THAI                            = $1e;
+  LANG_TURKISH                         = $1f;
+  LANG_UKRAINIAN                       = $22;
+  LANG_VIETNAMESE                      = $2a;
+{ Sublanguage IDs. }
+  { The name immediately following SUBLANG_ dictates which primary
+    language ID that sublanguage ID can be combined with to form a
+    valid language ID.
+  }
+  SUBLANG_NEUTRAL                      = $00;    { language neutral }
+  SUBLANG_DEFAULT                      = $01;    { user default }
+  SUBLANG_SYS_DEFAULT                  = $02;    { system default }
+  SUBLANG_ARABIC_SAUDI_ARABIA          = $01;    { Arabic (Saudi Arabia) }
+  SUBLANG_ARABIC_IRAQ                  = $02;    { Arabic (Iraq) }
+  SUBLANG_ARABIC_EGYPT                 = $03;    { Arabic (Egypt) }
+  SUBLANG_ARABIC_LIBYA                 = $04;    { Arabic (Libya) }
+  SUBLANG_ARABIC_ALGERIA               = $05;    { Arabic (Algeria) }
+  SUBLANG_ARABIC_MOROCCO               = $06;    { Arabic (Morocco) }
+  SUBLANG_ARABIC_TUNISIA               = $07;    { Arabic (Tunisia) }
+  SUBLANG_ARABIC_OMAN                  = $08;    { Arabic (Oman) }
+  SUBLANG_ARABIC_YEMEN                 = $09;    { Arabic (Yemen) }
+  SUBLANG_ARABIC_SYRIA                 = $0a;    { Arabic (Syria) }
+  SUBLANG_ARABIC_JORDAN                = $0b;    { Arabic (Jordan) }
+  SUBLANG_ARABIC_LEBANON               = $0c;    { Arabic (Lebanon) }
+  SUBLANG_ARABIC_KUWAIT                = $0d;    { Arabic (Kuwait) }
+  SUBLANG_ARABIC_UAE                   = $0e;    { Arabic (U.A.E) }
+  SUBLANG_ARABIC_BAHRAIN               = $0f;    { Arabic (Bahrain) }
+  SUBLANG_ARABIC_QATAR                 = $10;    { Arabic (Qatar) }
+  SUBLANG_CHINESE_TRADITIONAL          = $01;    { Chinese (Taiwan) }
+  SUBLANG_CHINESE_SIMPLIFIED           = $02;    { Chinese (PR China) }
+  SUBLANG_CHINESE_HONGKONG             = $03;    { Chinese (Hong Kong) }
+  SUBLANG_CHINESE_SINGAPORE            = $04;    { Chinese (Singapore) }
+  SUBLANG_DUTCH                        = $01;    { Dutch }
+  SUBLANG_DUTCH_BELGIAN                = $02;    { Dutch (Belgian) }
+  SUBLANG_ENGLISH_US                   = $01;    { English (USA) }
+  SUBLANG_ENGLISH_UK                   = $02;    { English (UK) }
+  SUBLANG_ENGLISH_AUS                  = $03;    { English (Australian) }
+  SUBLANG_ENGLISH_CAN                  = $04;    { English (Canadian) }
+  SUBLANG_ENGLISH_NZ                   = $05;    { English (New Zealand) }
+  SUBLANG_ENGLISH_EIRE                 = $06;    { English (Irish) }
+  SUBLANG_ENGLISH_SOUTH_AFRICA         = $07;    { English (South Africa) }
+  SUBLANG_ENGLISH_JAMAICA              = $08;    { English (Jamaica) }
+  SUBLANG_ENGLISH_CARIBBEAN            = $09;    { English (Caribbean) }
+  SUBLANG_ENGLISH_BELIZE               = $0a;    { English (Belize) }
+  SUBLANG_ENGLISH_TRINIDAD             = $0b;    { English (Trinidad) }
+  SUBLANG_FRENCH                       = $01;    { French }
+  SUBLANG_FRENCH_BELGIAN               = $02;    { French (Belgian) }
+  SUBLANG_FRENCH_CANADIAN              = $03;    { French (Canadian) }
+  SUBLANG_FRENCH_SWISS                 = $04;    { French (Swiss) }
+  SUBLANG_FRENCH_LUXEMBOURG            = $05;    { French (Luxembourg) }
+  SUBLANG_GERMAN                       = $01;    { German }
+  SUBLANG_GERMAN_SWISS                 = $02;    { German (Swiss) }
+  SUBLANG_GERMAN_AUSTRIAN              = $03;    { German (Austrian) }
+  SUBLANG_GERMAN_LUXEMBOURG            = $04;    { German (Luxembourg) }
+  SUBLANG_GERMAN_LIECHTENSTEIN         = $05;    { German (Liechtenstein) }
+  SUBLANG_ITALIAN                      = $01;    { Italian }
+  SUBLANG_ITALIAN_SWISS                = $02;    { Italian (Swiss) }
+  SUBLANG_KOREAN                       = $01;    { Korean (Extended Wansung) }
+  SUBLANG_KOREAN_JOHAB                 = $02;    { Korean (Johab) }
+  SUBLANG_NORWEGIAN_BOKMAL             = $01;    { Norwegian (Bokmal) }
+  SUBLANG_NORWEGIAN_NYNORSK            = $02;    { Norwegian (Nynorsk) }
+  SUBLANG_PORTUGUESE                   = $02;    { Portuguese }
+  SUBLANG_PORTUGUESE_BRAZILIAN         = $01;    { Portuguese (Brazilian) }
+  SUBLANG_SERBIAN_LATIN                = $02;    { Serbian (Latin) }
+  SUBLANG_SERBIAN_CYRILLIC             = $03;    { Serbian (Cyrillic) }
+  SUBLANG_SPANISH                      = $01;    { Spanish (Castilian) }
+  SUBLANG_SPANISH_MEXICAN              = $02;    { Spanish (Mexican) }
+  SUBLANG_SPANISH_MODERN               = $03;    { Spanish (Modern) }
+  SUBLANG_SPANISH_GUATEMALA            = $04;    { Spanish (Guatemala) }
+  SUBLANG_SPANISH_COSTA_RICA           = $05;    { Spanish (Costa Rica) }
+  SUBLANG_SPANISH_PANAMA               = $06;    { Spanish (Panama) }
+  SUBLANG_SPANISH_DOMINICAN_REPUBLIC   = $07;  { Spanish (Dominican Republic) }
+  SUBLANG_SPANISH_VENEZUELA            = $08;    { Spanish (Venezuela) }
+  SUBLANG_SPANISH_COLOMBIA             = $09;    { Spanish (Colombia) }
+  SUBLANG_SPANISH_PERU                 = $0a;    { Spanish (Peru) }
+  SUBLANG_SPANISH_ARGENTINA            = $0b;    { Spanish (Argentina) }
+  SUBLANG_SPANISH_ECUADOR              = $0c;    { Spanish (Ecuador) }
+  SUBLANG_SPANISH_CHILE                = $0d;    { Spanish (Chile) }
+  SUBLANG_SPANISH_URUGUAY              = $0e;    { Spanish (Uruguay) }
+  SUBLANG_SPANISH_PARAGUAY             = $0f;    { Spanish (Paraguay) }
+  SUBLANG_SPANISH_BOLIVIA              = $10;    { Spanish (Bolivia) }
+  SUBLANG_SPANISH_EL_SALVADOR          = $11;    { Spanish (El Salvador) }
+  SUBLANG_SPANISH_HONDURAS             = $12;    { Spanish (Honduras) }
+  SUBLANG_SPANISH_NICARAGUA            = $13;    { Spanish (Nicaragua) }
+  SUBLANG_SPANISH_PUERTO_RICO          = $14;    { Spanish (Puerto Rico) }
+  SUBLANG_SWEDISH                      = $01;    { Swedish }
+  SUBLANG_SWEDISH_FINLAND              = $02;    { Swedish (Finland) }
+{ Sorting IDs. }
+  SORT_DEFAULT                         = $0;     { sorting default }
+  SORT_JAPANESE_XJIS                   = $0;     { Japanese XJIS order }
+  SORT_JAPANESE_UNICODE                = $1;     { Japanese Unicode order }
+  SORT_CHINESE_BIG5                    = $0;     { Chinese BIG5 order }
+  SORT_CHINESE_PRCP                    = $0;     { PRC Chinese Phonetic order }
+  SORT_CHINESE_UNICODE                 = $1;     { Chinese Unicode order }
+  SORT_CHINESE_PRC                     = $2;     { PRC Chinese Stroke Count order }
+  SORT_KOREAN_KSC                      = $0;     { Korean KSC order }
+  SORT_KOREAN_UNICODE                  = $1;     { Korean Unicode order }
+  SORT_GERMAN_PHONE_BOOK               = $1;     { German Phone Book order }
+(*
+ *  A language ID is a 16 bit value which is the combination of a
+ *  primary language ID and a secondary language ID.  The bits are
+ *  allocated as follows:
+ *
+ *       +-----------------------+-------------------------+
+ *       |     Sublanguage ID    |   Primary Language ID   |
+ *       +-----------------------+-------------------------+
+ *        15                   10 9                       0   bit
+ *
+ *
+ *
+ *  A locale ID is a 32 bit value which is the combination of a
+ *  language ID, a sort ID, and a reserved area.  The bits are
+ *  allocated as follows:
+ *
+ *       +-------------+---------+-------------------------+
+ *       |   Reserved  | Sort ID |      Language ID        |
+ *       +-------------+---------+-------------------------+
+ *        31         20 19     16 15                      0   bit
+ *
+ *)
+{ Default System and User IDs for language and locale. }
+  LANG_SYSTEM_DEFAULT   = (SUBLANG_SYS_DEFAULT shl 10) or LANG_NEUTRAL;
+  LANG_USER_DEFAULT     = (SUBLANG_DEFAULT shl 10) or LANG_NEUTRAL;
+  LOCALE_SYSTEM_DEFAULT = (SORT_DEFAULT shl 16) or LANG_SYSTEM_DEFAULT;
+  LOCALE_USER_DEFAULT   = (SORT_DEFAULT shl 16) or LANG_USER_DEFAULT;
+
+(*
+  Error const of File Locking
+*)
+{$ifdef FPC}
+  ERROR_LOCK_VIOLATION = ESysEACCES;
+{$else}  
+  ERROR_LOCK_VIOLATION = EACCES;
+{$endif}  
+
+{ MBCS and Unicode Translation Flags. }
+  MB_PRECOMPOSED = 1; { use precomposed chars }
+  MB_COMPOSITE = 2; { use composite chars }
+  MB_USEGLYPHCHARS = 4; { use glyph chars, not ctrl chars }
+
+type
+  LCID = DWORD;
+  BOOL = LongBool;
+  PBOOL = ^BOOL;
+  WCHAR = WideChar;
+  PWChar = PWideChar;
+  LPSTR = PAnsiChar;
+  PLPSTR = ^LPSTR;
+  LPCSTR = PAnsiChar;
+  LPCTSTR = PAnsiChar; { should be PWideChar if UNICODE }
+  LPTSTR = PAnsiChar; { should be PWideChar if UNICODE }
+  LPWSTR = PWideChar;
+  PLPWSTR = ^LPWSTR;
+  LPCWSTR = PWideChar;
+
+  { System time is represented with the following structure: }
+  PSystemTime = ^TSystemTime;
+  TSystemTime = record
+    wYear: Word;
+    wMonth: Word;
+    wDayOfWeek: Word;
+    wDay: Word;
+    wHour: Word;
+    wMinute: Word;
+    wSecond: Word;
+    wMilliseconds: Word;
+  end;
+
+  TFarProc = Pointer;
+  TFNLocaleEnumProc = TFarProc;
+  TFNCodepageEnumProc = TFarProc;
+  TFNDateFmtEnumProc = TFarProc;
+  TFNTimeFmtEnumProc = TFarProc;
+  TFNCalInfoEnumProc = TFarProc;
+
+function LockFile(hFile: THandle; dwFileOffsetLow, dwFileOffsetHigh: DWORD; nNumberOfBytesToLockLow, nNumberOfBytesToLockHigh: DWORD): BOOL;
+function UnlockFile(hFile: THandle; dwFileOffsetLow, dwFileOffsetHigh: DWORD; nNumberOfBytesToUnlockLow, nNumberOfBytesToUnlockHigh: DWORD): BOOL;
+procedure GetLocalTime(var lpSystemTime: TSystemTime);
+function GetOEMCP: Cardinal;
+function GetACP: Cardinal;
+function OemToChar(lpszSrc: PChar; lpszDst: PChar): BOOL;
+function CharToOem(lpszSrc: PChar; lpszDst: PChar): BOOL;
+function OemToCharBuff(lpszSrc: PChar; lpszDst: PChar; cchDstLength: DWORD): BOOL;
+function CharToOemBuff(lpszSrc: PChar; lpszDst: PChar; cchDstLength: DWORD): BOOL;
+function MultiByteToWideChar(CodePage: DWORD; dwFlags: DWORD; const lpMultiByteStr: LPCSTR; cchMultiByte: Integer; lpWideCharStr: LPWSTR; cchWideChar: Integer): Integer;
+function WideCharToMultiByte(CodePage: DWORD; dwFlags: DWORD; lpWideCharStr: LPWSTR; cchWideChar: Integer; lpMultiByteStr: LPSTR; cchMultiByte: Integer; lpDefaultChar: LPCSTR; lpUsedDefaultChar: PBOOL): Integer;
+function CompareString(Locale: LCID; dwCmpFlags: DWORD; lpString1: PChar; cchCount1: Integer; lpString2: PChar; cchCount2: Integer): Integer;
+function EnumSystemCodePages(lpCodePageEnumProc: TFNCodepageEnumProc; dwFlags: DWORD): BOOL;
+function EnumSystemLocales(lpLocaleEnumProc: TFNLocaleEnumProc; dwFlags: DWORD): BOOL;
+function GetUserDefaultLCID: LCID;
+
+{$ifdef FPC}
+function  GetLastError: Integer;
+procedure SetLastError(Value: Integer);
+{$endif}
+{$endif}
+
+implementation
+
+{$ifndef WIN32}
+{$ifdef FPC}
+uses
+  unix;
+{$endif}
+
+(*
+NAME
+       fcntl - manipulate file descriptor
+
+SYNOPSIS
+       #include <unistd.h>
+       #include <fcntl.h>
+
+       int fcntl(int fd, int cmd);
+       int fcntl(int fd, int cmd, long arg);
+       int fcntl(int fd, int cmd, struct flock * lock);
+
+DESCRIPTION
+       fcntl  performs one of various miscellaneous operations on
+       fd.  The operation in question is determined by cmd:
+
+       F_GETLK, F_SETLK and F_SETLKW are used to  manage  discreð
+       tionary  file locks.  The third argument lock is a pointer
+       to a struct flock (that may be overwritten by this  call).
+
+       F_GETLK
+              Return  the  flock  structure that prevents us from
+              obtaining the lock, or set the l_type field of  the
+              lock to F_UNLCK if there is no obstruction.
+
+       F_SETLK
+              The lock is set (when l_type is F_RDLCK or F_WRLCK)
+              or cleared (when it is F_UNLCK).  If  the  lock  is
+              held by someone else, this call returns -1 and sets
+              errno to EACCES or EAGAIN.
+
+       F_SETLKW
+              Like F_SETLK, but instead of returning an error  we
+              wait for the lock to be released.  If a signal that
+              is to be caught is received while fcntl is waiting,
+              it is interrupted and (after the signal handler has
+              returned) returns immediately (with return value -1
+              and errno set to EINTR).
+
+       Using  these  mechanisms,  a  program  can implement fully
+       asynchronous I/O without using select(2) or  poll(2)  most
+       of the time.
+
+       The  use of O_ASYNC, F_GETOWN, F_SETOWN is specific to BSD
+       and Linux.   F_GETSIG  and  F_SETSIG  are  Linux-specific.
+       POSIX  has asynchronous I/O and the aio_sigevent structure
+       to achieve similar things; these  are  also  available  in
+       Linux as part of the GNU C Library (Glibc).
+
+RETURN VALUE
+       For  a  successful  call,  the return value depends on the
+       operation:
+
+       F_GETFD  Value of flag.
+
+       F_GETFL  Value of flags.
+
+       F_GETOWN Value of descriptor owner.
+
+       F_GETSIG Value of signal sent when read or  write  becomes
+                possible,   or   zero   for   traditional   SIGIO
+                behaviour.
+
+       All other commands
+                Zero.
+
+       On error, -1 is returned, and errno is set  appropriately.
+
+ERRORS
+       EACCES   Operation  is  prohibited  by locks held by other
+                processes.
+
+       EAGAIN   Operation is prohibited because the file has been
+                memory-mapped by another process.
+
+       EBADF    fd is not an open file descriptor.
+
+       EDEADLK  It  was detected that the specified F_SETLKW comð
+                mand would cause a deadlock.
+
+       EFAULT   lock is outside your accessible address space.
+
+       EINTR    For F_SETLKW, the command was  interrupted  by  a
+                signal.  For F_GETLK and F_SETLK, the command was
+                interrupted by  a  signal  before  the  lock  was
+                checked  or acquired.  Most likely when locking a
+                remote file (e.g.  locking  over  NFS),  but  can
+                sometimes happen locally.
+
+       EINVAL   For  F_DUPFD,  arg is negative or is greater than
+                the maximum allowable value.  For  F_SETSIG,  arg
+                is not an allowable signal number.
+
+       EMFILE   For  F_DUPFD, the process already has the maximum
+                number of file descriptors open.
+
+       ENOLCK   Too many segment locks open, lock table is  full,
+                or a remote locking protocol failed (e.g. locking
+                over NFS).
+
+       EPERM    Attempted to clear the O_APPEND flag  on  a  file
+                that has the append-only attribute set.
+
+typedef long  __kernel_off_t;
+typedef int   __kernel_pid_t;
+
+struct flock {
+        short l_type;
+        short l_whence;
+        off_t l_start;
+        off_t l_len;
+        pid_t l_pid;
+};
+
+whence:
+--------
+const
+  SEEK_SET        = 0;      { Seek from beginning of file.  }
+  SEEK_CUR        = 1;      { Seek from current position.  }
+  SEEK_END        = 2;      { Seek from end of file.  }
+
+{ Old BSD names for the same constants; just for compatibility.  }
+  L_SET           = SEEK_SET;
+  L_INCR          = SEEK_CUR;
+  L_XTND          = SEEK_END;
+*)
+
+const
+
+{$IFDEF FPC}
+{$IFNDEF VER1_9_4}
+   F_RDLCK = 0;
+   F_WRLCK = 1;
+   F_UNLCK = 2;
+   F_EXLCK = 4;
+   F_SHLCK = 8;
+
+   LOCK_SH = 1;
+   LOCK_EX = 2;
+   LOCK_NB = 4;
+   LOCK_UN = 8;
+
+   LOCK_MAND = 32;
+   LOCK_READ = 64;
+   LOCK_WRITE = 128;
+   LOCK_RW = 192;
+{$ENDIF}
+
+   EACCES = ESysEACCES;
+   EAGAIN = ESysEAGAIN;
+{$ENDIF}
+
+function LockFile(hFile: THandle; dwFileOffsetLow, dwFileOffsetHigh: DWORD; nNumberOfBytesToLockLow, nNumberOfBytesToLockHigh: DWORD): BOOL;
+var
+  FLockInfo: {$ifdef FPC}BaseUnix.FLock{$else}TFLock{$endif};
+  FLastError: Cardinal;
+begin
+  FLockInfo.l_type := F_WRLCK;
+  FLockInfo.l_whence := SEEK_SET;
+  FLockInfo.l_start := dwFileOffsetLow;
+  FLockInfo.l_len := nNumberOfBytesToLockLow;
+  FLockInfo.l_pid := {$ifdef FPC}fpgetpid{$else}getpid{$endif}();
+  Result := {$ifdef FPC}fpfcntl{$else}fcntl{$endif}(hFile, F_SETLK, FLockInfo) <> -1;
+  if not Result then
+  begin
+    FLastError := GetLastError();
+    if (FLastError = EACCES) or (FLastError = EAGAIN) then
+      SetLastError(ERROR_LOCK_VIOLATION)
+    else
+      Result := True; // If errno is ENOLCK or EINVAL
+  end;
+end;
+
+function UnlockFile(hFile: THandle; dwFileOffsetLow, dwFileOffsetHigh: DWORD; nNumberOfBytesToUnlockLow, nNumberOfBytesToUnlockHigh: DWORD): BOOL;
+var
+  FLockInfo: {$ifdef FPC}BaseUnix.FLock{$else}TFLock{$endif};
+begin
+  FLockInfo.l_type := F_UNLCK;
+  FLockInfo.l_whence := SEEK_SET;
+  FLockInfo.l_start := dwFileOffsetLow;
+  FLockInfo.l_len := nNumberOfBytesToUnLockLow;
+  FLockInfo.l_pid := {$ifdef FPC}fpgetpid{$else}getpid{$endif}();
+  Result := {$ifdef FPC}fpfcntl{$else}fcntl{$endif}(hFile, F_SETLK, FLockInfo) <> -1;
+end;
+
+procedure DateTimeToSystemTime(const DateTime: TDateTime; var SystemTime: TSystemTime);
+begin
+  with SystemTime do
+  begin
+    DecodeDateFully(DateTime, wYear, wMonth, wDay, wDayOfWeek);
+    Dec(wDayOfWeek);
+    DecodeTime(DateTime, wHour, wMinute, wSecond, wMilliseconds);
+  end;
+end;
+
+function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime;
+begin
+  with SystemTime do
+  begin
+    Result := EncodeDate(wYear, wMonth, wDay);
+    if Result >= 0 then
+      Result := Result + EncodeTime(wHour, wMinute, wSecond, wMilliSeconds)
+    else
+      Result := Result - EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);
+  end;
+end;
+
+procedure GetLocalTime(var lpSystemTime: TSystemTime);
+begin
+  DateTimeToSystemTime(NOW, lpSystemTime);
+end;
+
+function GetOEMCP: Cardinal;
+begin
+  Result := $FFFFFFFF;
+end;
+
+function GetACP: Cardinal;
+begin
+  Result := 1252;
+end;
+
+function OemToChar(lpszSrc: PChar; lpszDst: PChar): BOOL;
+begin
+  if lpszDst <> lpszSrc then
+    StrCopy(lpszDst, lpszSrc);
+  Result := TRUE;
+end;
+
+function CharToOem(lpszSrc: PChar; lpszDst: PChar): BOOL;
+begin
+  if lpszDst <> lpszSrc then
+    StrCopy(lpszDst, lpszSrc);
+  Result := TRUE;
+end;
+
+function OemToCharBuff(lpszSrc: PChar; lpszDst: PChar; cchDstLength: DWORD): BOOL;
+begin
+  if lpszDst <> lpszSrc then
+    StrLCopy(lpszDst, lpszSrc, cchDstLength);
+  Result := TRUE;
+end;
+
+function CharToOemBuff(lpszSrc: PChar; lpszDst: PChar; cchDstLength: DWORD): BOOL;
+begin
+  if lpszDst <> lpszSrc then
+    StrLCopy(lpszDst, lpszSrc, cchDstLength);
+  Result := TRUE;
+end;
+
+function MultiByteToWideChar(CodePage: DWORD; dwFlags: DWORD; const lpMultiByteStr: LPCSTR; cchMultiByte: Integer; lpWideCharStr: LPWSTR; cchWideChar: Integer): Integer;
+var
+  TempA: AnsiString;
+  TempW: WideString;
+begin
+  TempA := String(lpMultiByteStr^);
+  TempW := TempA;
+  Result := Length(TempW);
+  System.Move(TempW, lpWideCharStr^, Result);
+end;
+
+function WideCharToMultiByte(CodePage: DWORD; dwFlags: DWORD; lpWideCharStr: LPWSTR; cchWideChar: Integer; lpMultiByteStr: LPSTR; cchMultiByte: Integer; lpDefaultChar: LPCSTR; lpUsedDefaultChar: PBOOL): Integer;
+var
+  TempA: AnsiString;
+  TempW: WideString;
+begin
+  TempW := WideString(lpWideCharStr^);
+  TempA := TempW;
+  Result := Length(TempA);
+  System.Move(TempA, lpMultiByteStr^, Result);
+end;
+
+function CompareString(Locale: LCID; dwCmpFlags: DWORD; lpString1: PChar; cchCount1: Integer; lpString2: PChar; cchCount2: Integer): Integer;
+begin
+  Result := StrLComp(lpString1, lpString2, cchCount1) + 2;
+end;
+
+function EnumSystemCodePages(lpCodePageEnumProc: TFNCodepageEnumProc; dwFlags: DWORD): BOOL;
+begin
+  Result := True;
+end;
+
+function EnumSystemLocales(lpLocaleEnumProc: TFNLocaleEnumProc; dwFlags: DWORD): BOOL;
+begin
+  Result := True;
+end;
+
+function GetUserDefaultLCID: LCID; stdcall;
+begin
+  Result := LANG_ENGLISH or (SUBLANG_ENGLISH_UK shl 10);
+end;
+
+{$ifdef FPC}
+
+function GetLastError: Integer;
+begin
+  Result := FpGetErrno;
+end;
+
+procedure SetLastError(Value: Integer);
+begin
+  FpSetErrno(Value);
+end;
+
+{$endif}
+{$endif}
+
+end.

fcl/db/dbase/Makefile

@@ -1,25 +1,15 @@
 #
-# Don't edit, this file is generated by FPCMake Version 1.1 [2004/05/23]
+# Don't edit, this file is generated by FPCMake Version 1.1 [2003/09/24]
 #
 default: all
-MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos darwin emx watcom
-BSDs = freebsd netbsd openbsd darwin
-UNIXs = linux $(BSDs) sunos qnx
-FORCE:
-.PHONY: FORCE
-override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
-ifneq ($(findstring darwin,$(OSTYPE)),)
-inUnix=1 #darwin
-SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
-else
+MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos darwin emx
+override PATH:=$(subst \,/,$(PATH))
 ifeq ($(findstring ;,$(PATH)),)
 inUnix=1
 SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
 else
 SEARCHPATH:=$(subst ;, ,$(PATH))
 endif
-endif
-SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
 PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
 ifeq ($(PWD),)
 PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
@@ -46,13 +36,22 @@ ifneq ($(findstring cygdrive,$(PATH)),)
 inCygWin=1
 endif
 endif
+ifeq ($(OS_TARGET),freebsd)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),netbsd)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),openbsd)
+BSDhier=1
+endif
 ifdef inUnix
-SRCBATCHEXT=.sh
+BATCHEXT=.sh
 else
 ifdef inOS2
-SRCBATCHEXT=.cmd
+BATCHEXT=.cmd
 else
-SRCBATCHEXT=.bat
+BATCHEXT=.bat
 endif
 endif
 ifdef inUnix
@@ -155,12 +154,6 @@ ifeq ($(findstring $(OS_TARGET),$(MAKEFILETARGETS)),)
 $(error The Makefile doesn't support target $(OS_TARGET), please run fpcmake first)
 endif
 endif
-ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
-BSDhier=1
-endif
-ifeq ($(OS_TARGET),linux)
-linuxHier=1
-endif
 export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE CROSSCOMPILE
 ifdef FPCDIR
 override FPCDIR:=$(subst \,/,$(FPCDIR))
@@ -190,14 +183,11 @@ override FPCDIR:=$(FPCDIR)/..
 ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
 override FPCDIR:=$(FPCDIR)/..
 ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
-override FPCDIR:=$(BASEDIR)
-ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
 override FPCDIR=c:/pp
 endif
 endif
 endif
 endif
-endif
 ifndef CROSSDIR
 CROSSDIR:=$(FPCDIR)/cross/$(FULL_TARGET)
 endif
@@ -214,8 +204,10 @@ UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
 endif
 PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
 override PACKAGE_NAME=fcl
-override TARGET_UNITS+=dbf
+override TARGET_UNITS+=Dbf
 override TARGET_EXAMPLES+=testdbf
+override CLEAN_UNITS+=Dbf_Common Dbf_Cursor Dbf_DbfFile Dbf_Fields Dbf_IdxCur Dbf_IdxFile Dbf_Lang Dbf_Memo Dbf_Parser Dbf_PgFile Dbf_PrsCore Dbf_PrsDef Dbf_PrsSupp Dbf_Str Dbf_Wtil
+override INSTALL_UNITS+=Dbf_Common Dbf_Cursor Dbf_DbfFile Dbf_Fields Dbf_IdxCur Dbf_IdxFile Dbf_Lang Dbf_Memo Dbf_Parser Dbf_PgFile Dbf_PrsCore Dbf_PrsDef Dbf_PrsSupp Dbf_Str Dbf_Wtil
 override INSTALL_FPCPACKAGE=y
 override COMPILER_OPTIONS+=-S2 -Sh
 override COMPILER_TARGETDIR+=../../$(OS_TARGET)
@@ -226,12 +218,42 @@ ifdef REQUIRE_PACKAGESDIR
 override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
 endif
 ifdef ZIPINSTALL
-ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
-UNIXHier=1
+ifeq ($(OS_TARGET),linux)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_TARGET),freebsd)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_TARGET),netbsd)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_TARGET),openbsd)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_TARGET),sunos)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_TARGET),qnx)
+UNIXINSTALLDIR=1
 endif
 else
-ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
-UNIXHier=1
+ifeq ($(OS_SOURCE),linux)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_SOURCE),freebsd)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_SOURCE),netbsd)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_SOURCE),openbsd)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_TARGET),sunos)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_TARGET),qnx)
+UNIXINSTALLDIR=1
 endif
 endif
 ifndef INSTALL_PREFIX
@@ -240,7 +262,7 @@ INSTALL_PREFIX=$(PREFIX)
 endif
 endif
 ifndef INSTALL_PREFIX
-ifdef UNIXHier
+ifdef UNIXINSTALLDIR
 INSTALL_PREFIX=/usr/local
 else
 ifdef INSTALL_FPCPACKAGE
@@ -259,7 +281,7 @@ DIST_DESTDIR:=$(BASEDIR)
 endif
 export DIST_DESTDIR
 ifndef INSTALL_BASEDIR
-ifdef UNIXHier
+ifdef UNIXINSTALLDIR
 ifdef INSTALL_FPCPACKAGE
 INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
 else
@@ -270,18 +292,10 @@ INSTALL_BASEDIR:=$(INSTALL_PREFIX)
 endif
 endif
 ifndef INSTALL_BINDIR
-ifdef UNIXHier
-ifdef CROSSCOMPILE
-INSTALL_BINDIR:=$(INSTALL_BASEDIR)/cross/$(FULL_TARGET)/bin
-else
+ifdef UNIXINSTALLDIR
 INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
-endif
-else
-ifdef CROSSCOMPILE
-INSTALL_BINDIR:=$(INSTALL_BASEDIR)/cross/$(FULL_TARGET)/bin
 else
 INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
-endif
 ifdef INSTALL_FPCPACKAGE
 INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(OS_TARGET)
 endif
@@ -300,23 +314,19 @@ endif
 endif
 endif
 ifndef INSTALL_LIBDIR
-ifdef UNIXHier
+ifdef UNIXINSTALLDIR
 INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
 else
 INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
 endif
 endif
 ifndef INSTALL_SOURCEDIR
-ifdef UNIXHier
+ifdef UNIXINSTALLDIR
 ifdef BSDhier
 SRCPREFIXDIR=share/src
 else
-ifdef linuxHier
-SRCPREFIXDIR=share/src
-else
 SRCPREFIXDIR=src
 endif
-endif
 ifdef INSTALL_FPCPACKAGE
 ifdef INSTALL_FPCSUBDIR
 INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
@@ -339,16 +349,12 @@ endif
 endif
 endif
 ifndef INSTALL_DOCDIR
-ifdef UNIXHier
+ifdef UNIXINSTALLDIR
 ifdef BSDhier
 DOCPREFIXDIR=share/doc
 else
-ifdef linuxHier
-DOCPREFIXDIR=share/doc
-else
 DOCPREFIXDIR=doc
 endif
-endif
 ifdef INSTALL_FPCPACKAGE
 INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
 else
@@ -363,28 +369,20 @@ endif
 endif
 endif
 ifndef INSTALL_EXAMPLEDIR
-ifdef UNIXHier
+ifdef UNIXINSTALLDIR
 ifdef INSTALL_FPCPACKAGE
 ifdef BSDhier
 INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
 else
-ifdef linuxHier
-INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
-else
 INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
 endif
-endif
 else
 ifdef BSDhier
 INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
 else
-ifdef linuxHier
-INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
-else
 INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
 endif
 endif
-endif
 else
 ifdef INSTALL_FPCPACKAGE
 INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
@@ -406,7 +404,6 @@ endif
 else
 CROSSBINDIR=
 endif
-BATCHEXT=.bat
 LOADEREXT=.as
 EXEEXT=.exe
 PPLEXT=.ppl
@@ -430,37 +427,25 @@ STATICLIBPREFIX=
 FPCMADE=fpcmade.dos
 ZIPSUFFIX=go32
 endif
-ifeq ($(OS_TARGET),watcom)
-STATICLIBPREFIX=
-FPCMADE=fpcmade.wat
-ZIPSUFFIX=watc
-OEXT=.obj
-ASMEXT=.asm
-SHAREDLIBEXT=.dll
-endif
 ifeq ($(OS_TARGET),linux)
-BATCHEXT=.sh
 EXEEXT=
 HASSHAREDLIB=1
 FPCMADE=fpcmade.lnx
 ZIPSUFFIX=linux
 endif
 ifeq ($(OS_TARGET),freebsd)
-BATCHEXT=.sh
 EXEEXT=
 HASSHAREDLIB=1
 FPCMADE=fpcmade.freebsd
 ZIPSUFFIX=freebsd
 endif
 ifeq ($(OS_TARGET),netbsd)
-BATCHEXT=.sh
 EXEEXT=
 HASSHAREDLIB=1
 FPCMADE=fpcmade.netbsd
 ZIPSUFFIX=netbsd
 endif
 ifeq ($(OS_TARGET),openbsd)
-BATCHEXT=.sh
 EXEEXT=
 HASSHAREDLIB=1
 FPCMADE=fpcmade.openbsd
@@ -472,7 +457,6 @@ FPCMADE=fpcmade.w32
 ZIPSUFFIX=w32
 endif
 ifeq ($(OS_TARGET),os2)
-BATCHEXT=.cmd
 AOUTEXT=.out
 STATICLIBPREFIX=
 SHAREDLIBEXT=.dll
@@ -481,7 +465,6 @@ ZIPSUFFIX=os2
 ECHO=echo
 endif
 ifeq ($(OS_TARGET),emx)
-BATCHEXT=.cmd
 AOUTEXT=.out
 STATICLIBPREFIX=
 SHAREDLIBEXT=.dll
@@ -499,19 +482,16 @@ EXEEXT=.ttp
 FPCMADE=fpcmade.ata
 endif
 ifeq ($(OS_TARGET),beos)
-BATCHEXT=.sh
 EXEEXT=
 FPCMADE=fpcmade.be
 ZIPSUFFIX=be
 endif
 ifeq ($(OS_TARGET),sunos)
-BATCHEXT=.sh
 EXEEXT=
 FPCMADE=fpcmade.sun
 ZIPSUFFIX=sun
 endif
 ifeq ($(OS_TARGET),qnx)
-BATCHEXT=.sh
 EXEEXT=
 FPCMADE=fpcmade.qnx
 ZIPSUFFIX=qnx
@@ -523,14 +503,10 @@ FPCMADE=fpcmade.nw
 ZIPSUFFIX=nw
 endif
 ifeq ($(OS_TARGET),macos)
-BATCHEXT=
 EXEEXT=
-FPCMADE=fpcmade.macos
-ZIPSUFFIX=macos
-DEBUGSYMEXT=.xcoff
+FPCMADE=fpcmade.mcc
 endif
 ifeq ($(OS_TARGET),darwin)
-BATCHEXT=.sh
 EXEEXT=
 HASSHAREDLIB=1
 FPCMADE=fpcmade.darwin
@@ -553,34 +529,25 @@ STATICLIBPREFIX=
 FPCMADE=fpcmade.dos
 ZIPSUFFIX=go32
 endif
-ifeq ($(OS_TARGET),watcom)
-STATICLIBPREFIX=
-FPCMADE=fpcmade.dos
-ZIPSUFFIX=watcom
-endif
 ifeq ($(OS_TARGET),linux)
-BATCHEXT=.sh
 EXEEXT=
 HASSHAREDLIB=1
 FPCMADE=fpcmade.lnx
 ZIPSUFFIX=linux
 endif
 ifeq ($(OS_TARGET),freebsd)
-BATCHEXT=.sh
 EXEEXT=
 HASSHAREDLIB=1
 FPCMADE=fpcmade.freebsd
 ZIPSUFFIX=freebsd
 endif
 ifeq ($(OS_TARGET),netbsd)
-BATCHEXT=.sh
 EXEEXT=
 HASSHAREDLIB=1
 FPCMADE=fpcmade.netbsd
 ZIPSUFFIX=netbsd
 endif
 ifeq ($(OS_TARGET),openbsd)
-BATCHEXT=.sh
 EXEEXT=
 HASSHAREDLIB=1
 FPCMADE=fpcmade.openbsd
@@ -597,7 +564,6 @@ FPCMADE=fpcmade.w32
 ZIPSUFFIX=w32
 endif
 ifeq ($(OS_TARGET),os2)
-BATCHEXT=.cmd
 PPUEXT=.ppo
 ASMEXT=.so2
 OEXT=.oo2
@@ -630,7 +596,6 @@ EXEEXT=.ttp
 FPCMADE=fpcmade.ata
 endif
 ifeq ($(OS_TARGET),beos)
-BATCHEXT=.sh
 PPUEXT=.ppu
 ASMEXT=.s
 OEXT=.o
@@ -641,7 +606,6 @@ FPCMADE=fpcmade.be
 ZIPSUFFIX=be
 endif
 ifeq ($(OS_TARGET),sunos)
-BATCHEXT=.sh
 PPUEXT=.ppu
 ASMEXT=.s
 OEXT=.o
@@ -652,7 +616,6 @@ FPCMADE=fpcmade.sun
 ZIPSUFFIX=sun
 endif
 ifeq ($(OS_TARGET),qnx)
-BATCHEXT=.sh
 PPUEXT=.ppu
 ASMEXT=.s
 OEXT=.o
@@ -675,15 +638,13 @@ ZIPSUFFIX=nw
 EXEEXT=.nlm
 endif
 ifeq ($(OS_TARGET),macos)
-BATCHEXT=
 PPUEXT=.ppu
 ASMEXT=.s
 OEXT=.o
 SMARTEXT=.sl
 STATICLIBEXT=.a
 EXEEXT=
-DEBUGSYMEXT=.xcoff
-FPCMADE=fpcmade.macos
+FPCMADE=fpcmade.mcc
 endif
 endif
 ifndef ECHO
@@ -691,7 +652,7 @@ ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
 ifeq ($(ECHO),)
 ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
 ifeq ($(ECHO),)
-ECHO= __missing_command__
+ECHO=
 else
 ECHO:=$(firstword $(ECHO))
 endif
@@ -705,7 +666,7 @@ DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
 ifeq ($(DATE),)
 DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
 ifeq ($(DATE),)
-DATE= __missing_command__
+DATE=
 else
 DATE:=$(firstword $(DATE))
 endif
@@ -719,7 +680,7 @@ GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
 ifeq ($(GINSTALL),)
 GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
 ifeq ($(GINSTALL),)
-GINSTALL= __missing_command__
+GINSTALL=
 else
 GINSTALL:=$(firstword $(GINSTALL))
 endif
@@ -731,7 +692,7 @@ export GINSTALL
 ifndef CPPROG
 CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
 ifeq ($(CPPROG),)
-CPPROG= __missing_command__
+CPPROG=
 else
 CPPROG:=$(firstword $(CPPROG))
 endif
@@ -740,7 +701,7 @@ export CPPROG
 ifndef RMPROG
 RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
 ifeq ($(RMPROG),)
-RMPROG= __missing_command__
+RMPROG=
 else
 RMPROG:=$(firstword $(RMPROG))
 endif
@@ -749,18 +710,14 @@ export RMPROG
 ifndef MVPROG
 MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
 ifeq ($(MVPROG),)
-MVPROG= __missing_command__
+MVPROG=
 else
 MVPROG:=$(firstword $(MVPROG))
 endif
 endif
 export MVPROG
 ifndef ECHOREDIR
-ifndef inUnix
-ECHOREDIR=echo
-else
-ECHOREDIR=$(ECHO)
-endif
+ECHOREDIR:=$(subst /,$(PATHSEP),$(ECHO))
 endif
 ifndef COPY
 COPY:=$(CPPROG) -fp
@@ -798,7 +755,7 @@ export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
 ifndef PPUMOVE
 PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
 ifeq ($(PPUMOVE),)
-PPUMOVE= __missing_command__
+PPUMOVE=
 else
 PPUMOVE:=$(firstword $(PPUMOVE))
 endif
@@ -807,7 +764,7 @@ export PPUMOVE
 ifndef FPCMAKE
 FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
 ifeq ($(FPCMAKE),)
-FPCMAKE= __missing_command__
+FPCMAKE=
 else
 FPCMAKE:=$(firstword $(FPCMAKE))
 endif
@@ -816,7 +773,7 @@ export FPCMAKE
 ifndef ZIPPROG
 ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
 ifeq ($(ZIPPROG),)
-ZIPPROG= __missing_command__
+ZIPPROG=
 else
 ZIPPROG:=$(firstword $(ZIPPROG))
 endif
@@ -825,25 +782,21 @@ export ZIPPROG
 ifndef TARPROG
 TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
 ifeq ($(TARPROG),)
-TARPROG= __missing_command__
+TARPROG=
 else
 TARPROG:=$(firstword $(TARPROG))
 endif
 endif
 export TARPROG
-ASNAME=$(BINUTILSPREFIX)as
-LDNAME=$(BINUTILSPREFIX)ld
-ARNAME=$(BINUTILSPREFIX)ar
-RCNAME=$(BINUTILSPREFIX)rc
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
+ASNAME=as
+LDNAME=ld
+ARNAME=ar
+RCNAME=rc
 ifeq ($(OS_TARGET),win32)
-ifeq ($(CROSSBINDIR),)
 ASNAME=asw
 LDNAME=ldw
 ARNAME=arw
 endif
-endif
-endif
 ifndef ASPROG
 ifdef CROSSBINDIR
 ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
@@ -876,7 +829,7 @@ AS=$(ASPROG)
 LD=$(LDPROG)
 RC=$(RCPROG)
 AR=$(ARPROG)
-PPAS=ppas$(SRCBATCHEXT)
+PPAS=ppas$(BATCHEXT)
 ifdef inUnix
 LDCONFIG=ldconfig
 else
@@ -941,11 +894,6 @@ ifeq ($(CPU_TARGET),x86_64)
 REQUIRE_PACKAGES_RTL=1
 endif
 endif
-ifeq ($(OS_TARGET),linux)
-ifeq ($(CPU_TARGET),arm)
-REQUIRE_PACKAGES_RTL=1
-endif
-endif
 ifeq ($(OS_TARGET),go32v2)
 ifeq ($(CPU_TARGET),i386)
 REQUIRE_PACKAGES_RTL=1
@@ -971,11 +919,6 @@ ifeq ($(CPU_TARGET),m68k)
 REQUIRE_PACKAGES_RTL=1
 endif
 endif
-ifeq ($(OS_TARGET),freebsd)
-ifeq ($(CPU_TARGET),x86_64)
-REQUIRE_PACKAGES_RTL=1
-endif
-endif
 ifeq ($(OS_TARGET),beos)
 ifeq ($(CPU_TARGET),i386)
 REQUIRE_PACKAGES_RTL=1
@@ -991,16 +934,6 @@ ifeq ($(CPU_TARGET),m68k)
 REQUIRE_PACKAGES_RTL=1
 endif
 endif
-ifeq ($(OS_TARGET),netbsd)
-ifeq ($(CPU_TARGET),powerpc)
-REQUIRE_PACKAGES_RTL=1
-endif
-endif
-ifeq ($(OS_TARGET),netbsd)
-ifeq ($(CPU_TARGET),sparc)
-REQUIRE_PACKAGES_RTL=1
-endif
-endif
 ifeq ($(OS_TARGET),amiga)
 ifeq ($(CPU_TARGET),m68k)
 REQUIRE_PACKAGES_RTL=1
@@ -1066,11 +999,6 @@ ifeq ($(CPU_TARGET),i386)
 REQUIRE_PACKAGES_RTL=1
 endif
 endif
-ifeq ($(OS_TARGET),watcom)
-ifeq ($(CPU_TARGET),i386)
-REQUIRE_PACKAGES_RTL=1
-endif
-endif
 ifdef REQUIRE_PACKAGES_RTL
 PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/$(OS_TARGET)/Makefile.fpc,$(PACKAGESDIR))))))
 ifneq ($(PACKAGEDIR_RTL),)
@@ -1106,14 +1034,6 @@ endif
 ifeq ($(OS_SOURCE),openbsd)
 override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
 endif
-ifndef CROSSBOOTSTRAP
-ifneq ($(BINUTILSPREFIX),)
-override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
-endif
-ifneq ($(BINUTILSPREFIX),)
-override FPCOPT+=-Xr$(RLINKPATH)
-endif
-endif
 ifdef UNITDIR
 override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
 endif
@@ -1140,12 +1060,8 @@ ifdef RELEASE
 ifeq ($(CPU_TARGET),i386)
 FPCCPUOPT:=-OG2p3
 else
-ifeq ($(CPU_TARGET),powerpc)
-FPCCPUOPT:=-O1
-else
 FPCCPUOPT:=
 endif
-endif
 override FPCOPT+=-Xs $(FPCCPUOPT) -n
 override FPCOPTDEF+=RELEASE
 endif
@@ -1227,7 +1143,7 @@ EXECPPAS:=@$(PPAS)
 endif
 endif
 .PHONY: fpc_units
-ifneq ($(TARGET_UNITS),)
+ifdef TARGET_UNITS
 override ALLTARGET+=fpc_units
 override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
 override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS))
@@ -1240,9 +1156,9 @@ override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
 override CLEANRSTFILES+=$(RSTFILES)
 endif
 .PHONY: fpc_examples
-ifneq ($(TARGET_EXAMPLES),)
+ifdef TARGET_EXAMPLES
 HASEXAMPLES=1
-override EXAMPLESOURCEFILES:=$(wildcard $(addsuffix .pp,$(TARGET_EXAMPLES)) $(addsuffix .pas,$(TARGET_EXAMPLES)) $(addsuffix .dpr,$(TARGET_EXAMPLES)))
+override EXAMPLESOURCEFILES:=$(wildcard $(addsuffix .pp,$(TARGET_EXAMPLES)) $(addsuffix .pas,$(TARGET_EXAMPLES)))
 override EXAMPLEFILES:=$(addsuffix $(EXEEXT),$(TARGET_EXAMPLES))
 override EXAMPLEOFILES:=$(addsuffix $(OEXT),$(TARGET_EXAMPLES)) $(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_EXAMPLES)))
 override CLEANEXEFILES+=$(EXAMPLEFILES) $(EXAMPLEOFILES)
@@ -1253,7 +1169,7 @@ ifeq ($(OS_TARGET),emx)
 override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_EXAMPLES))
 endif
 endif
-ifneq ($(TARGET_EXAMPLEDIRS),)
+ifdef TARGET_EXAMPLEDIRS
 HASEXAMPLES=1
 endif
 fpc_examples: all $(EXAMPLEFILES) $(addsuffix _all,$(TARGET_EXAMPLEDIRS))
@@ -1267,7 +1183,7 @@ fpc_debug:
 	$(MAKE) all DEBUG=1
 fpc_release:
 	$(MAKE) all RELEASE=1
-.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .dpr .pp .rc .res
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp .rc .res
 %$(PPUEXT): %.pp
 	$(COMPILER) $<
 	$(EXECPPAS)
@@ -1280,14 +1196,10 @@ fpc_release:
 %$(EXEEXT): %.pas
 	$(COMPILER) $<
 	$(EXECPPAS)
-%$(EXEEXT): %.dpr
-	$(COMPILER) $<
-	$(EXECPPAS)
 %.res: %.rc
 	windres -i $< -o $@
 vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
 vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
-vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
 vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
 .PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
 ifdef INSTALL_UNITS
@@ -1364,9 +1276,6 @@ override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
 endif
 ifdef CLEANPPUFILES
 override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
-ifdef DEBUGSYMEXT
-override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES)) 
-endif
 override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
 override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
 endif
@@ -1390,7 +1299,6 @@ ifdef LIB_NAME
 	-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
 endif
 	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
-	-$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
 fpc_distclean: clean
 ifdef COMPILER_UNITTARGETDIR
 TARGETDIRCLEAN=fpc_clean
@@ -1402,13 +1310,9 @@ endif
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 	-$(DELTREE) *$(SMARTEXT)
 	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
-	-$(DEL) *_ppas$(BATCHEXT)
 ifdef AOUTEXT
 	-$(DEL) *$(AOUTEXT)
 endif
-ifdef DEBUGSYMEXT
-	-$(DEL) *$(DEBUGSYMEXT)
-endif
 .PHONY: fpc_baseinfo
 override INFORULES+=fpc_baseinfo
 fpc_baseinfo:

fcl/db/dbase/Makefile.fpc

@@ -6,7 +6,7 @@
 main=fcl
 
 [target]
-units=dbf
+units=Dbf
 examples=testdbf
 
 [compiler]
@@ -15,6 +15,14 @@ targetdir=../../$(OS_TARGET)
 
 [install]
 fpcpackage=y
+units=Dbf_Common Dbf_Cursor Dbf_DbfFile Dbf_Fields Dbf_IdxCur \
+      Dbf_IdxFile Dbf_Lang Dbf_Memo Dbf_Parser Dbf_PgFile \
+      Dbf_PrsCore Dbf_PrsDef Dbf_PrsSupp Dbf_Str Dbf_Wtil
 
 [default]
 fpcdir=../../..
+
+[clean]
+units=Dbf_Common Dbf_Cursor Dbf_DbfFile Dbf_Fields Dbf_IdxCur \
+      Dbf_IdxFile Dbf_Lang Dbf_Memo Dbf_Parser Dbf_PgFile \
+      Dbf_PrsCore Dbf_PrsDef Dbf_PrsSupp Dbf_Str Dbf_Wtil

fcl/db/dbase/dbf.pas

@@ -1,2895 +0,0 @@
-unit dbf;
-{===============================================================================
-||         TDbf Component         ||         http://tdbf.netfirms.com         ||
-===============================================================================}
-interface
-
-uses
-{$ifdef fpc}
-  SysUtils, Classes, db;
-{$else}
-  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
-  Db,  DsgnIntf, ExptIntf;
-{$endif}
-// If you got a compilation error here or asking for dsgntf.pas, then just add
-// this file in your project:
-// dsgnintf.pas in 'C:\Program Files\Borland\Delphi5\Source\Toolsapi\dsgnintf.pas'
-
-const
-  _MAJOR_VERSION = 3;
-  _MINOR_VERSION = 007;
-
-
-{$ifdef VER100}      // Delphi 3
-   {$define DELPHI_3}
-{$endif}
-
-{$ifdef VER110}      // CBuilder 3
-   {$define DELPHI_3}
-{$endif}
-
-{$ifdef unix}
-  DirSeparator = '/';
-{$else}
-  DirSeparator = '\';
-{$endif}
-
-//====================================================================
-// Delphi is a bit to permissive for me,  I mean protected doesn't work within
-// one unit. So i decided that convention:
-//    private member begins by '_'
-// It's forbidden to access any '_something' except from the class where it
-// is defined. To check that, I just have to look for '._' anywhere in the code.
-//====================================================================
-type
-
-//====================================================================
-//=== Common exceptions and constants
-//====================================================================
-  EBinaryDataSetError = class (Exception);
-  EFieldToLongError = class (Exception);
-
-  xBaseVersion = (xBaseIII,xBaseIV,xBaseV);
-
-//====================================================================
-//=== Utility classes
-//====================================================================
-  TPagedFile = class(TObject)
-  protected
-    Stream : TStream;
-    HeaderSize : Integer;
-    RecordSize : Integer;
-    _cntuse:integer;
-    _Filename:string;
-  public
-    constructor Create(const FileName: string; Mode: Word);
-    destructor Destroy; override;
-
-    procedure Release;
-    function CalcRecordCount:Integer;
-    procedure _Seek(page:Integer);
-    procedure ReadRecord(IntRecNum:Integer;Buffer:Pointer);
-    procedure WriteRecord(IntRecNum:Integer;Buffer:Pointer);
-  end;
-//====================================================================
-//=== Dbf support (first part)
-//====================================================================
-  rDbfHdr = record
-    VerDBF      : byte;   // 0
-    Year        : byte;   // 1
-    Month       : byte;   // 2
-    Day         : byte;   // 3
-    RecordCount : Integer;  // 4-7
-    FullHdrSize : word;   // 8-9
-    RecordSize  : word;   // 10-11
-    Dummy1      : Word;   // 12-13
-    IncTrans    : byte;   // 14
-    Encrypt     : byte;   // 15
-    Dummy2      : Integer; // 16-19
-    Dummy3      : array[20..27] of byte; // 20-27
-    MDXFlag     : char; // 28
-    Language    : char; // 29
-    dummy4      : word; // 30-31
-  end;
-//====================================================================
-  TMyFieldInfo = class
-  public
-    FieldName:string;
-    Size:Integer;
-    Prec:Integer;
-    Offset:Integer;
-  end;
-//====================================================================
-  TDbfFile = class(TPagedFile)
-  protected
-    _RecordBufferSize:integer;
-    _DataHdr : rDbfHdr;
-    _DbfVersion : xBaseVersion;
-    _MyFieldInfos: TList;
-  public
-    constructor Create(const FileName: string; Mode: Word);
-    destructor Destroy; override;
-    function RecordCount:integer;
-    procedure CreateFieldDefs(FieldDefs:TFieldDefs);
-    procedure ClearMyFieldInfos;
-    procedure DbfFile_CreateTable(FieldDefs:TFieldDefs);
-    procedure DbfFile_PackTable;
-    function GetFieldInfo(FieldName:string):TMyFieldInfo;
-    function GetFieldData(Column:Integer;DataType:TFieldType; Src,Dst: Pointer): Boolean;
-    procedure SetFieldData(Column:integer;DataType:TFieldType; Src,Dst: Pointer);
-    procedure WriteHeader;
-
-  end;
-//====================================================================
-//=== Index support
-//====================================================================
-  TIndex = class;
-//====================================================================
-  rNdxHdr = record
-    startpage : Integer; // 0..3
-    nbPage : Integer; // 4..7
-    keyformat: Char; //8
-    keytype : char; //9
-    dummy : Word; // 10..11
-    keylen : Word; // 12..13
-    nbkey : Word; // 14..15
-    skeytype : Word; // 16..17
-    keyreclen : Word; // 18..19
-    dummy2 : Word; // 20..21
-    dummy3 : Byte; // 22
-    Unique : Byte; // 23
-    KeyDesc : array[0..255] of char; // 24...
-  end;
-
-  rMdxTag = record
-    pageno      : Integer; // 0..3
-    tagname      : array [0..11] of char; // 4..14
-    keyformat    : byte; // 15
-    forwardTag1  : char; // 16
-    forwardTag2 : byte; // 17
-    backwardTag : byte; // 18
-    dummy       : byte; // 19
-    keytype     : byte; // 20
-  end;
-
-  NdxKeyType = (N,C);
-  PNdxPage  = ^rNdxPage;
-  rNdxPage  = record
-    NbEntries : longint;  //  0..3 lower page
-    Entries   : ARRAY [0..507] OF char;
-  end;
-
-  PNdxentry  = ^rNdxentry;
-  rNdxentry  = record
-    _LowerPage : longint;  //  0..3 lower page
-    RecNo     : Longint;  //  4..7 recno
-    case NdxKeyType of
-      N: ( NKey: double);
-      C: ( CKey: array [0..503] of char);
-  end;
-//====================================================================
-  rMdxHdr = record
-    MdxHdr   : byte;       // 0
-    Year        : byte;       // 1
-    Month       : byte;       // 2
-    Day         : byte;      // 3
-    FileName    : array[0..15] of char; // 4..19 of byte
-    BlockSize    : word; // 20 21
-    BlockAdder  : word; // 22 23
-    IndexFlag   : byte; // 24
-    NoTag       : byte; // 25
-    TagSize     : byte; // 26
-    Dummy1      : byte; // 27
-    TagUsed     : word; // 28..29
-    Dummy2      : word; // 30..31
-    NbPage      : Integer; // 32..35
-    FreePage    : Integer; // 36..39
-    BlockFree   : Integer; // 40..43
-    UpdYear     : byte; // 44
-    UpdMonth    : byte; // 45
-    UpdDay      : byte; // 46
-  end;
-//====================================================================
-  TIndexFile = class(TPagedFile)
-  protected
-    _IndexVersion : xBaseVersion;
-    _MdxHdr : rMdxHdr;
-  public
-    constructor Create(const FileName: string; Mode: Word);
-    destructor Destroy; override;
-  end;
-//====================================================================
-  PIndexPosInfo = ^TIndexPage;
-  TIndexPage = class
-  protected
-    _Index : TIndex;
-    _PageNo : Integer;
-    _EntryNo : Integer;
-    Entry : PNdxentry;
-    _LowerLevel : TIndexPage;
-    _UpperLevel : TIndexPage;
-    _PageBuff:rNdxPage;
-
-    procedure LocalFirst;
-    procedure LocalLast;
-    function  LocalPrev:boolean;
-    function  LocalNext:boolean;
-    function  LastEntryNo:integer;
-    function  LocalInsert(Recno:Integer; Buffer:PChar; LowerPage:integer):boolean;
-    function  LocalDelete:boolean;
-
-    function  GetPEntry(EntryNo:integer):PNdxEntry;
-    procedure First;
-    procedure Last;
-    function Prev:boolean;
-    function Next:boolean;
-    procedure Write;
-    procedure AddNewLevel;
-  public
-    constructor Create(Parent:TIndex);
-    destructor Destroy; override;
-
-    procedure SetPageNo(page:Integer);
-    procedure SetEntryNo(entryno:Integer);
-    procedure WritePage(Page:integer);
-    function FindNearest(Recno:integer; Key:PChar):integer;
-    function Insert(Recno:integer; Buffer:pchar; LowerPage:integer):boolean;
-    procedure SetEntry(Recno:integer; key:pchar; LowerPage:integer);
-    function Delete:boolean;
-    function LowerLevel : TIndexPage;
-  end;
-//====================================================================
-  TIndex = class(TObject)
-  protected
-    _IndexFile:TIndexFile;
-    _NdxHdr:rNdxHdr;
-    _Root:TIndexPage;
-    _TagPosition:Integer;
-    _FieldPos : integer;
-    _FieldLen : integer;
-    _NbLevel : integer;
-    _RootPage: integer;
-
-    function Pos:TIndexPage;
-  public
-    IndexRecNo:integer;
-    function Prev:boolean;
-    function Next:boolean;
-    procedure First;
-    procedure Last;
-    function Find(Recno:integer; Buffer:PChar; var pPos:TIndexPage):integer;
-    procedure Insert(Recno:integer; Buffer:PChar);
-    function Delete:boolean;
-    procedure GotoKey(Recno:integer; Buffer:PChar);
-    procedure Update(Recno: integer; PrevBuffer,NewBuffer: PChar);
-//    procedure ResyncInd;
-    function GetRealRecNo: Integer;
-    constructor Create(Parent:TIndexFile; RootPage:integer;CreateIt:boolean);
-    procedure InitFieldDef(dbfFile:TDbfFile;FieldDesc:string);
-    destructor Destroy; override;
-// optionnal
-    function GuessRecordCount: Integer;
-    function GuessRecNo: Integer;
-  end;
-//====================================================================
-//=== Memo and binary fields support
-//====================================================================
-  rDbtHdr = record
-    NextBlock:Longint;
-    Dummy : array [4..7] of byte;
-    _dbfFile : array [0..7] of Byte; //8..15
-    bVer : Byte; //16
-    Dummy2 : array [17..19] of byte;
-    BlockLen:  Word;
-  end;
-//====================================================================
-  TDbtFile = class(TPagedFile)
-  protected
-    _DbtVersion:xBaseVersion;
-    _MemoHdr:rDbtHdr;
-  public
-    constructor Create(const FileName: string; Mode: Word; Ver:xBaseVersion);
-    procedure ReadMemo(recno:Integer;Dst:TStream);
-    procedure WriteMemo(var MemoRecno:Integer;ReadSize:Integer;Src:TStream);
-  end;
-//====================================================================
-  TMyBlobFile = class(TMemoryStream)
-  public
-    Mode: TBlobStreamMode;
-    Field:TField;
-    MemoRecno:Integer;
-    ReadSize:Integer;
-    constructor Create(ModeVal:TBlobStreamMode; FieldVal:TField);
-    destructor destroy;  override;
-  end;
-//====================================================================
-//=== Dbf support 2
-//====================================================================
-  rFieldHdrIII = record
-    FieldName   : array[0..10] of char;
-    FieldType   : char; // 11
-    Dummy        : array[12..15] of byte;
-    FieldSize   : byte; // 16
-    FieldPrecision  : byte; //17
-    dummy2      : array[18..31] of byte;
-  end;
-//====================================================================
-  rFieldHdrV = record
-    FieldName   : array[0..10] of char;
-    Dummy0        : array[11..31] of byte;
-    FieldType   : char; // 32
-    FieldSize   : byte; // 33
-    FieldPrecision  : byte; //34
-    dummy2      : array[35..47] of byte;
-  end;
-//====================================================================
-  PBookMarkData = ^rBookMarkData;
-  rBookmarkData = record
-    RecNo:longint;
-  end;
-//====================================================================
-  rBeforeRecord = record
-    BookmarkData: rBookmarkData;
-    BookmarkFlag: TBookmarkFlag;
-    //... record come here
-  end;
-//====================================================================
-  pDbfRecord = ^rDbfRecord;
-  rDbfRecord = record
-    BookmarkData: rBookmarkData;
-    BookmarkFlag: TBookmarkFlag;
-    DeletedFlag : char;
-    Fields : array[0..4000] of char;
-  end;
-//====================================================================
-  PRecInfo = ^TRecInfo;
-  TRecInfo = record
-    Bookmark: Longint;
-    IdxBookmark: Longint;
-    BookmarkFlag: TBookmarkFlag;
-  end;
-//====================================================================
-  pRecordHdr = ^tRecordHdr;
-  tRecordHdr = record
-    DeletedFlag : char;
-  end;
-
-// and at LEAST the most useful class : TDbf
-//====================================================================
-  TDbf = class(TDataSet)
-  private
-    _ShowDeleted:boolean;
-    _TableName: string;    // table path and file name
-    _RunTimePath: string;    // table path and file name
-    _DesignTimePath: string;    // table path and file name
-    _ReadOnly : Boolean;
-    _FilterBuffer:pchar;
-    _PrevBuffer:pchar;
-    _IndexFiles:TStrings;
-  protected
-    function _FullRecordSize:integer;
-    function _FilterRecord(Buffer: PChar): Boolean;
-    procedure _OpenFiles(CreateIt:boolean);
-    procedure _CloseFiles;
-    procedure _ResyncIndexes(Buffer: PChar);
-    function _GetIndexName: string;
-    procedure _SetIndexName(const Value: string);
-    function _GetIndex(filename:string):TIndex;
-    function _GetPath:string;
-    function _ComponentInfo:string;
-  public
-    { my own methods and properties}
-    { most looks like ttable functions but they are not tdataset related
-     I use the same syntax to facilitate the conversion between bde and tdbf  }
-    easyfilter:string;
-    procedure CreateTable; //(FieldDefs:TFieldDefs);
-    procedure DeleteIndex(const AName: string);
-    property IndexName: string read _GetIndexName write _SetIndexName;
-
-{$ifdef DELPHI_3}
-    procedure AddIndex(const IndexName, Fields: String; Options: TIndexOptions);
-{$else}
-{$ifndef FPC}
-    procedure AddIndex(const IndexName, Fields: String; Options: TIndexOptions; const DescFields: String='');
-{$else}
-    procedure AddIndex(const AnIndexName, IndexFields: String; Options: TIndexOptions);
-    procedure AddIndex(const AnIndexName, IndexFields: String; Options: TIndexOptions; const DescFields: String);
-
-{$endif}
-{$endif}
-    procedure CloseIndexFile(const IndexFileName: string);
-    procedure OpenIndexFile(AnIndexName:string);
-    procedure PackTable;
-  public
-    { abstract methods }
-    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override; {virtual abstract}
-    {virtual methods (mostly optionnal) }
-    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override; {virtual}
-{$ifdef DELPHI_3}
-    procedure Translate(Src, Dest: PChar; ToOem: Boolean); override; {virtual}
-{$else}
-    function Translate(Src, Dest: PChar; ToOem: Boolean): Integer; override; {virtual}
-{$endif}
-    procedure ClearCalcFields(Buffer : PChar); override;
-  protected
-    { abstract methods }
-    function AllocRecordBuffer: PChar; override; {virtual abstract}
-    procedure FreeRecordBuffer(var Buffer: PChar); override; {virtual abstract}
-    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override; {virtual abstract}
-    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override; {virtual abstract}
-    function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override; {virtual abstract}
-    function GetRecordSize: Word; override; {virtual abstract}
-    procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean); override; {virtual abstract}
-    procedure InternalClose; override; {virtual abstract}
-    procedure InternalDelete; override; {virtual abstract}
-    procedure InternalFirst; override; {virtual abstract}
-    procedure InternalGotoBookmark(ABookmark: Pointer); override; {virtual abstract}
-    procedure InternalHandleException; override; {virtual abstract}
-    procedure InternalInitFieldDefs; override; {virtual abstract}
-    procedure InternalInitRecord(Buffer: PChar); override; {virtual abstract}
-    procedure InternalLast; override; {virtual abstract}
-    procedure InternalOpen; override; {virtual abstract}
-    procedure InternalPost; override; {virtual abstract}
-    procedure InternalSetToRecord(Buffer: PChar); override; {virtual abstract}
-    function IsCursorOpen: Boolean; override; {virtual abstract}
-    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override; {virtual abstract}
-    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override; {virtual abstract}
-    procedure SetFieldData(Field: TField; Buffer: Pointer); override; {virtual abstract}
-    {virtual methods (mostly optionnal) }
-
-    function GetRecordCount: Integer; override; {virtual}
-    function GetRecNo: Integer; override; {virtual}
-    procedure SetRecNo(Value: Integer); override; {virual}
-
-  public
-    constructor Create(AOwner: TComponent); override;
-    destructor Destroy; override;
-
-  published
-    property ComponentInfo: string  read _ComponentInfo;
-    property TableName: string  read _TableName write _TableName;
-    property RunTimePath: string  read _RunTimePath write _RunTimePath;
-    property DesignTimePath: string  read _DesignTimePath write _DesignTimePath;
-    property ReadOnly : Boolean read _ReadOnly write _Readonly default False;
-    property ShowDeleted:boolean read _ShowDeleted write _ShowDeleted;
-    // redeclared data set properties
-    property Active;
-    property Filtered;
-    property BeforeOpen;
-    property AfterOpen;
-    property BeforeClose;
-    property AfterClose;
-    property BeforeInsert;
-    property AfterInsert;
-    property BeforeEdit;
-    property AfterEdit;
-    property BeforePost;
-    property AfterPost;
-    property BeforeCancel;
-    property AfterCancel;
-    property BeforeDelete;
-    property AfterDelete;
-    property BeforeScroll;
-    property AfterScroll;
-    property OnCalcFields;
-    property OnDeleteError;
-    property OnEditError;
-    property OnFilterRecord;
-    property OnNewRecord;
-    property OnPostError;
-
-//my datas....
-  protected
-    _IsCursorOpen:boolean;
-    _PhysicalRecno:integer;
-    _CurIndex: TIndex;
-    _Indexes:TList;      // index
-    _indexFile : TIndexFile;
-    _dbtFile : TDbtFile;
-  public
-    _dbfFile:TDbfFile;
-    property PhysicalRecno:integer read _PhysicalRecno;
-    function _RecordDataSize:integer;
-  end;
-
-{$ifndef fpc}
-procedure Register;
-{$endif}
-
-var
-  tDbf_TrimFields : boolean;
-
-implementation
-
-var
-    _PagedFiles : TList;
-
-//====================================================================
-// Some types and consts which are not useful in the interface.
-//====================================================================
-(*
- * tSmallint  16 bits = -32768 to 32767
- *                      123456 = 6 digit max
- * ftInteger  32 bits = -2147483648 to 2147483647
- *                      12345678901 = 11 digits max
- * ftLargeInt 64 bits = -9223372036854775808 to 9223372036854775807
- *                      12345678901234567890 = 20 digits max
- *)
-const
-  DIGITS_SMALLINT = 6;
-  DIGITS_INTEGER = 11;
-  DIGITS_LARGEINT = 20;
-  sDBF_DEC_SEP= '.';
-
-type
-  rAfterHdrIII = record // Empty
-  end;
-
-  rAfterHdrV = record
-    Dummy   : array[32..67] of byte;
-  end;
-
-  PMdxTag = ^rMdxTag;
-
-  rMdxTagHdr = record
-    RootPage        : longint;// 0..3
-    FilePages        : longint;// 4..7
-    KeyFormat        : byte;   // 8
-    KeyType          : char;   // 9
-    dummy            : word;   // 10..11
-    IndexKeyLength   : word;   // 12..13
-    MaxNbKeys       : word;   // 14..15
-    SecondKeyType   : word;   // 16..17
-    IndexKeyItemLen  : word;   // 18..19
-    dummy2           : array [20..22] of byte;
-    UniqueFlag      : byte;   // 23
-  end;
-
-
-  rAfterHdrV3 = record
-    Dummy   : array[12..31] of byte;
-  end;
-
-  rAfterHdrV4 = record
-    Dummy   : array[12..67] of byte;
-  end;
-
-  rFieldHdrV3 = record
-    FieldName   : array[0..10] of char;
-    FieldType   : char; // 11
-    Dummy        : array[12..15] of byte;
-    FieldSize   : byte; // 16
-    FieldPrecision  : byte; //17
-    dummy2      : array[18..31] of byte;
-  end;
-
-  rFieldHdrV4 = record
-    FieldName   : array[0..10] of char;
-    Dummy0        : array[11..31] of byte;
-    FieldType   : char; // 32
-    FieldSize   : byte; // 33
-    FieldPrecision  : byte; //34
-    dummy2      : array[35..47] of byte;
-  end;
-  PDouble = ^double;
-//====================================================================
-// Now some common functions and procedure
-//====================================================================
-// ****************************************************************************
-// International separator
-// thanks to Bruno Depero from Italy
-// and Andreas Wöllenstein from Denmark
-
-function DbfStrToFloat(s: string): Extended;
-var iPos: integer;
-     eValue: extended;
-begin
-    iPos:= Pos(sDBF_DEC_SEP, s);
-    if iPos> 0 then
-      s[iPos]:= DecimalSeparator;
-{$ifndef fpc}
-    if TextToFloat(pchar(s), eValue, fvExtended) then
-{$else}
-                Val(s,eValue,Ipos);
-                If Ipos=0 then
-{$endif}
-      Result:= eValue
-    else Result:= 0;
-end;
-
-function FloatToDbfStr(f: Extended; size, prec: integer): string;
-var iPos: integer;
-begin
-    Result:= FloatToStrF(f, ffFixed, Size, prec);
-    iPos:= Pos(DecimalSeparator, Result);
-    if iPos> 0 then
-      Result[iPos]:= sDBF_DEC_SEP;
-end;
-
-procedure MyMove(Source, Dest:PChar; Count: Integer);
-var
-  c:char;
-  i:integer;
-begin
-  i:=0;
-  while i<Count do begin
-    c:=PChar(Source)[i];
-    if c=#0 then break;
-    PChar(Dest)[i]:=c;
-    Inc(i);
-  end;
-  while i<Count do begin
-    PChar(Dest)[i]:=' ';
-    Inc(i);
-  end;
-end;
-//====================================================================
-// TPagedFile
-//====================================================================
-function GetPagedFile(FileName: string):TPagedFile;
-var
-  idx:integer;
-  idf:TPagedFile;
-begin
-  FileName:=LowerCase(FileName);
-  for idx:=0 to _PagedFiles.Count-1 do begin
-    idf:= TPagedFile(_PagedFiles[idx]);
-    if idf._FileName=FileName then begin
-      result:=idf;
-      exit;
-    end;
-  end;
-  result:=nil;
-end;
-
-procedure TPagedFile.Release;
-var
-    i: integer;
-begin
-  dec(_cntuse);
-  if _cntuse<=0 then begin
-    i:=_PagedFiles.IndexOf(self);
-    if i>=0 then _PagedFiles.Delete(i);
-    Free;
-  end;
-end;
-
-function TPagedFile.CalcRecordCount:Integer;
-begin
-  if RecordSize = 0 then Result:=0
-  else Result:=(Stream.Size - HeaderSize) div RecordSize;
-end;
-
-constructor TPagedFile.Create(const FileName: string; Mode: Word);
-begin
-  if filename='' then Stream:=TMemoryStream.Create()
-  else begin
-    Stream:=TFileStream.Create(FileName,Mode);
-  end;
-  HeaderSize:=0;
-  RecordSize:=0;
-  _cntuse:=0;
-  _filename:=lowercase(filename);
-  _PagedFiles.Add(Self);
-end;
-
-destructor TPagedFile.Destroy;
-begin
-  Stream.Free;
-  Stream:=nil;
-  inherited;
-end;
-
-procedure TPagedFile._Seek(page:Integer);
-var
-  p:Integer;
-begin
-  p:=HeaderSize + (RecordSize * page );
-  Stream.Position := p;
-end;
-
-Procedure TPagedFile.ReadRecord(IntRecNum:Integer; Buffer:Pointer);
-begin
-  _Seek(IntRecNum);
-  Stream.Read(Buffer^,RecordSize);
-end;
-
-procedure TPagedFile.WriteRecord(IntRecNum:Integer; Buffer:Pointer);
-begin
-  _Seek(IntRecNum);
-  Stream.Write(Buffer^, RecordSize);
-end;
-
-//====================================================================
-// TDbfFile
-//====================================================================
-constructor TDbfFile.Create(const FileName: string; Mode: Word);
-var
-  lRecordCount:Integer;
-begin
-  _MyFieldInfos:=TList.Create;
-  // check if the file exists
-  inherited Create(Filename, Mode);
-
-
-  if Mode = fmCreate then begin
-    FillChar(_DataHdr,sizeof(_DataHdr),0);
-    HeaderSize:=0;
-    RecordSize:=0;
-    _DataHdr.VerDBF:=$03; // Default version xBaseIV without memo
-    _DataHdr.Language:='X';
-  end else begin
-    Stream.Seek(0,soFromBeginning);
-    Stream.ReadBuffer (_DataHdr, SizeOf(_DataHdr));
-    case _DataHdr.VerDBF of
-    $03,$83:          _DbfVersion:=xBaseIII;
-    $04,$8B,$8E,$7B:  _DbfVersion:=xBaseIV;
-    $05 :             _DbfVersion:=xbaseV;
-    else
-      _DbfVersion:=xBaseIV; // My favorite...
-    end;
-    HeaderSize:=_DataHdr.FullHdrSize;
-    RecordSize:=_DataHdr.RecordSize;
-    lRecordCount:=CalcRecordCount;
-    if _DataHdr.RecordCount <> lRecordCount then begin
-{$ifndef fpc}
-      ShowMessage('Invalid Record Count,'+^M+
-      'RecordCount in Hdr : '+IntToStr(_DataHdr.RecordCount)+^M+
-      'expected : '+IntToStr(lRecordCount));
-{$endif}
-      _DataHdr.RecordCount := lRecordCount;
-    end;
-  end;
-
-end;
-
-
-destructor TDbfFile.Destroy;
-begin
-  inherited;
-  ClearMyFieldInfos;
-  _MyFieldInfos.Free;
-  _MyFieldInfos:=nil;
-
-end;
-
-function TDbfFile.RecordCount:integer;
-begin
-  if RecordSize=0 then result:=0
-  else result:=(Stream.Size - HeaderSize) div RecordSize;
-  if result<0 then result:=0;
-end;
-
-procedure TDbfFile.ClearMyFieldInfos;
-var
-  i:Integer;
-begin
-  for i:=0 to _MyFieldInfos.Count-1 do begin
-    TMyFieldInfo(_MyFieldInfos.Items[i]).Free;
-  end;
-  _MyFieldInfos.Clear;
-end;
-
-procedure TDbfFile.CreateFieldDefs(FieldDefs:TFieldDefs);
-var
-  lColumnCount,lHeaderSize,lFieldSize:Integer;
-  Il : Integer;
-  lFieldOffset : Integer;
-  fn:string;
-  ft:TFieldType;
-  fs,nfs,fd:Integer;
-  MyFieldInfo:TMyFieldInfo;
-  lFieldHdrIII:rFieldHdrIII;
-  lFieldHdrV:rFieldHdrV;
-
-  function ToFieldType(dbasetype:char;fs,fd:Integer):TFieldType;
-  begin
-    case dbasetype of
-    'C' :
-      begin
-        Result:=ftString;
-      end;
-    'L' :
-      begin
-        Result:=ftBoolean;
-      end;
-    'F' :
-      begin
-        Result:=ftFloat;
-      end;
-    'N' :
-      begin
-        if fd=0 then begin
-          if fs <= DIGITS_SMALLINT then begin
-            Result:=ftSmallInt;
-          end else begin
-{$ifdef DELPHI_3}
-            Result:=ftInteger;
-{$else}
-            if fs <= DIGITS_INTEGER then Result:=ftInteger
-            else Result:=ftLargeInt;
-{$endif}
-          end;
-        end else begin
-          Result:=ftFloat;
-        end;
-      end;
-    'D' :
-      begin
-        Result:=ftDate;
-      end;
-    'M' :
-      begin
-        Result:=ftMemo;
-      end;
-    else
-      begin
-        Result:=ftString;
-      end;
-    end; //case
-  end;
-begin
-  ClearMyFieldInfos;
-
-  if _DbfVersion>=xBaseV then begin
-    lHeaderSize:=SizeOf(rAfterHdrV) + SizeOf(rDbfHdr);
-    lFieldSize:=SizeOf(rFieldHdrV);
-  end else begin
-    lHeaderSize:=SizeOf(rAfterHdrIII) + SizeOf(rDbfHdr);
-    lFieldSize:=SizeOf(rFieldHdrIII);
-  end;
-  lColumnCount:= (_DataHdr.FullHdrSize - lHeaderSize) div lFieldSize;
-
-  if (lColumnCount <= 0) or (lColumnCount > 255) then
-      Raise eBinaryDataSetError.Create('Invalid field count : ' + IntToStr(lColumnCount) + ' (must be between 1 and 255)');
-
-  lFieldOffset := 1;
-
-  Stream.Position := lHeaderSize;
-  for Il:=0 to lColumnCount-1 do begin
-    if _DbfVersion>=xBaseV then begin
-      Stream.ReadBuffer(lFieldHdrV,SizeOf(lFieldHdrV));
-      fn:=PCHAR(@lFieldHdrV.FieldName[0]);
-      fs:=lFieldHdrV.FieldSize;
-      fd:=lFieldHdrV.FieldPrecision;
-      nfs:=fs;
-      ft:=ToFieldType(lFieldHdrV.FieldType,nfs,fd);
-    end else begin
-      Stream.ReadBuffer(lFieldHdrIII,SizeOf(lFieldHdrIII));
-      fn:=PCHAR(@lFieldHdrIII.FieldName[0]);
-      fs:=lFieldHdrIII.FieldSize;
-      fd:=lFieldHdrIII.FieldPrecision;
-      nfs:=fs;
-      ft:=ToFieldType(lFieldHdrIII.FieldType,nfs,fd);
-
-    end;
-    // first create the bde field
-    if ft in [ftString,ftBCD] then fieldDefs.Add(fn,ft,fs,false)
-    else fieldDefs.Add(fn,ft,0,false);
-    // then create the for our own fieldinfo
-    MyFieldInfo:=TMyFieldInfo.Create;
-    MyFieldInfo.Offset:=lFieldOffset;
-    MyFieldInfo.Size:=fs;
-    MyFieldInfo.Prec:=fd;
-    MyFieldInfo.FieldName:=lowercase(fn);
-
-    _MyFieldInfos.Add(MyFieldInfo);
-    Inc(lFieldOffset,fs);
-  end;
-  if (lFieldOffset <> _DataHdr.RecordSize) then begin
-{$ifndef fpc}
-    ShowMessage('Invalid Record Size,'+^M+
-                                     'Record Size in Hdr : '+IntToStr(_DataHdr.RecordSize)+^M+
-                                     'Expected : '+IntToStr(lFieldOffset));
-{$endif}
-    _DataHdr.RecordSize := lFieldOffset;
-  end;
-end;
-
-procedure TDbfFile.DbfFile_CreateTable(FieldDefs:TFieldDefs);
-var
-  ix:Integer;
-  lFieldHdrIII:rFieldHdrIII;
-  lType:Char;
-  lSize,lPrec:Integer;
-  Offs:Integer;
-  lterminator:Byte;
-begin
-  // first reset file.
-  Stream.Size:= 0;
-  Stream.Position:=SizeOf(rDbfHdr) + SizeOf(rAfterHdrIII);
-  Offs:=1; // deleted mark count 1.
-  for Ix:=0 to FieldDefs.Count-1 do
-  begin
-    with FieldDefs.Items[Ix] do
-    begin
-      FillChar(lFieldHdrIII,SizeOf(lFieldHdrIII),#0);
-      lPrec:=0;
-      case DataType of
-        ftString:
-          begin
-            ltype:='C';
-            lSize := Size;
-          end;
-        ftBoolean:
-          begin
-            ltype:='L';
-            lSize := 1;
-          end;
-        ftSmallInt:
-          begin
-            ltype:='N';
-            lSize := 6;
-          end;
-        ftInteger:
-          begin
-            ltype:='N';
-            lSize := 11;
-          end;
-        ftCurrency:
-          begin
-            ltype:='N';
-            lSize := 20;
-            lPrec := 2;
-          end;
-{$ifndef DELPHI_3}
-        ftLargeInt:
-          begin
-            ltype:='N';
-            lSize := 20;
-            lPrec := 0;
-          end;
-{$endif}
-        ftFloat:
-          begin
-            ltype:='N';
-            lSize := 20;
-            lPrec := 4;
-          end;
-        ftDate:
-          begin
-            ltype:='D';
-            lSize := 8;
-          end;
-        ftMemo:
-          begin
-            ltype:='M';
-            lSize := 10;
-          end;
-        else
-          begin
-            raise EBinaryDataSetError.Create(
-             'InitFieldDefs: Unsupported field type');
-          end;
-      end; // case
-
-      lFieldHdrIII.FieldType:=ltype; //DataType;
-      StrPCopy(lFieldHdrIII.FieldName,FieldDefs.Items[Ix].Name);
-      lFieldHdrIII.FieldSize:=lSize;
-      lFieldHdrIII.FieldPrecision:=lPrec;
-
-      Stream.Write(lFieldHdrIII,SizeOf(lFieldHdrIII));
-      Inc(Offs,lSize);
-    end;
-  end;
-  // end of header
-  lterminator := $0d;
-  Stream.Write(lterminator,SizeOf(lterminator));
-
-  // update header
-  _DataHdr.RecordSize := Offs;
-  _DataHdr.FullHdrSize := Stream.Position;
-  RecordSize := _DataHdr.RecordSize;
-  HeaderSize := _DataHdr.FullHdrSize;
-  // write the updated header
-  WriteHeader;
-end;
-
-procedure TDbfFile.DbfFile_PackTable;
-var
-  first,last:integer;
-  p: Pointer;
-begin
-  // Non tested.
-  if (RecordSize <> 0) then
-  begin
-    first:=0;
-    last:=CalcRecordCount-1;
-    GetMem(p, RecordSize);
-    try
-      while first<last do begin
-        // first find the first hole
-        while first<last do begin
-          ReadRecord(first, p);
-          if (pRecordHdr(p)^.DeletedFlag <> ' ') then break;
-          inc(first);
-        end;
-        // now find last one non deleted.
-        while first<last do begin
-          ReadRecord(last, p);
-          if (pRecordHdr(p)^.DeletedFlag = ' ') then break;
-          dec(last);
-        end;
-        if first<last then begin
-          // found a non deleted record to put in the hole.
-          WriteRecord(first, p);
-          inc(first);
-          dec(last);
-        end;
-      end;
-    last:=CalcRecordCount;
-      Stream.Size:=(last+1) * RecordSize + HeaderSize;
-    finally
-      FreeMem(p);
-    end;
-  end;
-end;
-
-function TDbfFile.GetFieldInfo(FieldName:string):TMyFieldInfo;
-var
-  i:Integer;
-  lfi:TMyFieldInfo;
-begin
-  FieldName:=LowerCase(FieldName);
-  for i:=0 to _MyFieldInfos.Count-1 do begin
-    lfi:=TMyFieldInfo(_MyFieldInfos.Items[i]);
-    if lfi.FieldName = FieldName then begin
-      result:=lfi;
-      exit;
-    end;
-  end;
-  result:=nil;
-end;
-
-function TDbfFile.GetFieldData(Column:Integer;DataType:TFieldType; Src,Dst:Pointer): Boolean;
-var
-  FieldOffset: Integer;
-  FieldSize: Integer;
-  s:string;
-  d:TDateTime;
-  ld,lm,ly: word;
-  MyFieldInfo:TMyFieldInfo;
-  function TrimStr(const s: string): string;
-  var
-    iPos: integer;
-  begin
-    if DataType=ftString then
-    begin
-      if tDbf_TrimFields then Result:=Trim(s)
-      else Result:=TrimRight(s);
-    end
-    else Result:= Trim(s);
-  end;
-  procedure CorrectYear(var wYear: word);
-  var wD, wM, wY, CenturyBase: word;
-{$ifdef DELPHI_3}
-  // Delphi 3 standard-behavior no change possible
-  const TwoDigitYearCenturyWindow= 0;
-{$endif}
-  begin
-     if wYear>= 100 then
-       Exit;
-     DecodeDate(Date, wY, wm, wD);
-     // use Delphi-Date-Window
-     CenturyBase := wY{must be CurrentYear} - TwoDigitYearCenturyWindow;
-     Inc(wYear, CenturyBase div 100 * 100);
-     if (TwoDigitYearCenturyWindow > 0) and (wYear < CenturyBase) then
-        Inc(wYear, 100);
-  end;
-begin
-  MyFieldInfo:=TMyFieldInfo(_MyFieldInfos.Items[Column]);
-  FieldOffset := MyFieldInfo.Offset;
-  FieldSize := MyFieldInfo.Size;
-  SetString(s, PChar(Src) + FieldOffset, FieldSize );
-  s:=TrimStr(s);
-  result:=length(s)>0; // return if field is empty
-  if Result and (Dst<>nil) then// data not needed if Result= FALSE or Dst=nil
-    case DataType of
-    ftBoolean:
-      begin
-        // in DBase- FileDescription lowercase t is allowed too
-        // with asking for Result= TRUE s must be longer then 0
-        // else it happens an AV, maybe field is NULL
-        if (UpCase(s[1])='T') then Word(Dst^) := 1
-        else Word(Dst^) := 0;
-      end;
-    ftInteger, ftSmallInt{$ifndef DELPHI_3},ftLargeInt{$endif}:
-      begin
-        case DataType of
-        ftSmallInt : SmallInt(Dst^):= StrToIntDef(s, 0);
-        {$ifndef DELPHI_3}
-        ftLargeint : LargeInt(Dst^):= StrToInt64Def(s, 0);
-        {$endif}
-        else // ftInteger :
-          Integer(Dst^):= StrToIntDef(s, 0);
-        end; // case
-      end;
-    ftFloat:
-      begin
-        Extended(Dst^) := DBFStrToFloat(s);
-      end;
-    ftCurrency:
-      begin
-        Extended(Dst^) := DBFStrToFloat(s);
-      end;
-    ftDate:
-      begin
-        ld:=StrToIntDef(Copy(s,7,2),1);
-        lm:=StrToIntDef(Copy(s,5,2),1);
-        ly:=StrToIntDef(Copy(s,1,4),0);
-        if ld=0 then ld:=1;
-        if lm=0 then lm:=1;
-//           if (ly<1900) or (ly>2100) then ly:=1900;
-//           Year from 0001 to 9999 is possible
-//           everyting else is an error, an empty string too
-//           Do DateCorrection with Delphis possibillities for one or two digits
-        if (ly< 100) and (Length(Trim(Copy(s,1,4)))in [1, 2]) then CorrectYear(ly);
-        try
-          d:=EncodeDate(ly,lm,ld);
-          if Assigned(Dst) then  Integer(Dst^) := DateTimeToTimeStamp(d).Date;
-        except
-          Integer(Dst^) := 0;
-        end;
-      end;
-        ftString: begin
-        StrPCopy(Dst,s);
-      end;
-   end;
-end;
-
-procedure TDbfFile.SetFieldData(Column:integer;DataType:TFieldType; Src,Dst:Pointer);
-var
-  FieldSize,FieldPrec: Integer;
-  s:string;
-  fl:Double;
-  ts:TTimeStamp;
-  MyFieldInfo:TMyFieldInfo;
-begin
-  MyFieldInfo:=TMyFieldInfo(_MyFieldInfos.Items[Column]);
-  FieldSize := MyFieldInfo.Size;
-  FieldPrec := MyFieldInfo.Prec;
-
-  Dst:=PChar(Dst)+MyFieldInfo.Offset;
-  if src<>nil then begin
-    case DataType of
-    ftBoolean:
-      begin
-        if Word(Src^) = 1 then s:='T'
-        else s:='F';
-      end;
-    ftInteger, ftSmallInt {$ifndef DELPHI_3},ftLargeInt{$endif}:
-      begin
-        case DataType of
-        ftSmallInt : s:= IntToStr(SmallInt(Src^));
-        {$ifndef DELPHI_3}
-        ftLargeInt: s:= IntToStr(LargeInt(Src^));
-        {$endif}
-        else //ftInteger
-          s:= IntToStr(Integer(Src^));
-        end;
-        // left filling
-        if Length(s)<FieldSize then s:=StringOfChar(' ',FieldSize-Length(s)) + s;
-      end;
-    ftFloat,ftCurrency:
-      begin
-        fl := Double(Src^);
-        s:=FloatToDbfStr(fl,FieldSize,FieldPrec);
-        if Length(s)<FieldSize then s:=StringOfChar(' ',FieldSize-Length(s)) + s;
-      end;
-    ftDate:
-      begin
-        ts.Time:=0;
-        ts.Date:=Integer(Src^);
-        s:= FormatDateTime('yyyymmdd', TimeStampToDateTime(ts));
-      end;
-    ftString:
-      begin
-        s:=PChar(Src); // finish with first 0
-      end;
-    end; // case
-  end; // if src<>nil (thanks andreas)
-  if Length(s)<FieldSize then begin
-    s:=s+StringOfChar(' ',FieldSize-Length(s));
-  end else if (Length(s)>FieldSize) then begin
-    if DataType= ftString then begin
-      // never raise for strings to long, its not customary
-      // TTable never raises
-      SetLength(s, FieldSize)
-    end else begin
-      raise eFieldToLongError.Create('Fielddata too long :' + IntToStr(Length(s))
-        + ' (must be between 1 and ' + IntToStr(FieldSize) + ').');
-    end;
-  end;
-  Move(PChar(s)^, Dst^, FieldSize);
-end;
-
-
-procedure TDbfFile.WriteHeader;
-var
-  SystemTime: TSystemTime;
-  lAfterHdrIII:rAfterHdrIII;
-  lAfterHdrV:rAfterHdrV;
-  lterminator:Byte;
-begin
-  Assert(Stream<>nil,'_dbfFile=Nil');
-
-  Stream.Position:=0;
-  GetLocalTime(SystemTime);
-{$ifndef fpc}
-  _DataHdr.Year := SystemTime.wYear - 1900;
-  _DataHdr.Month := SystemTime.wMonth;
-  _DataHdr.Day := SystemTime.wDay;
-{$else}
-  _DataHdr.Year := SystemTime.Year - 1900;
-  _DataHdr.Month := SystemTime.Month;
-  _DataHdr.Day := SystemTime.Day;
-{$endif}
-  Stream.Seek(0,soFromBeginning);
-  Stream.WriteBuffer (_DataHdr, SizeOf(_DataHdr));
-  _DataHdr.RecordCount := CalcRecordCount;
-
-  if _DbfVersion >= xBaseV then begin
-    FillChar(lAfterHdrV,SizeOf(lAfterHdrV),0);
-    Stream.WriteBuffer (lAfterHdrV, SizeOf(lAfterHdrV));
-  end else begin
-    FillChar(lAfterHdrIII,SizeOf(lAfterHdrIII),0);
-    Stream.WriteBuffer (lAfterHdrIII, SizeOf(lAfterHdrIII));
-  end;
-  _Seek(_DataHdr.RecordCount); // last byte usually...
-  lterminator := $1A;
-  Stream.Write(lterminator,SizeOf(lterminator));
-end;
-
-function TDbf._ComponentInfo:string;
-begin
-  Result:='TDbf V' + IntToStr(_MAJOR_VERSION) + '.' + IntToStr(_MINOR_VERSION);
-end;
-
-procedure TDbf._OpenFiles(CreateIt:boolean);
-var
-  fileopenmode : integer;
-  lPath,lFilename,lIndexName,lMemoName : string;
-  isAbsolute:boolean;
-  design,doreadonly:boolean;
-
-begin
-  design:=(csDesigning in ComponentState);
-  doreadonly:=design or _ReadOnly;
-
-  lPath:=_GetPath;
-  isAbsolute:=((length(_TableName)>=1) and (_TableName[1]='\'))
-    or ((length(_TableName)>=2) and (_TableName[2]=':'));
-  if isAbsolute then lfilename:=_TableName
-  else lFilename:=lPath+_TableName;
-  lFilename:=ChangeFileExt(lFilename,'.dbf');
-  lIndexName:=ChangeFileExt(lFilename,'.mdx');
-  lMemoName:=ChangeFileExt(lFilename,'.dbt');
-
-  // check if the file exists
-  _dbfFile:=TDbfFile(GetPagedFile(lFileName));
-  _indexFile:=TIndexFile(GetPagedFile(lIndexName));
-  _dbtFile:=TDbtFile(GetPagedFile(lMemoName));
-
-  if CreateIt then begin
-    if _dbfFile=nil then _dbfFile:=TDbfFile.Create(lFileName,fmCreate);
-    //if _indexfile=nil then _indexFile := TIndexFile.Create(lIndexName, fmCreate);
-    if _dbtfile=nil then _dbtFile := TDbtFile.Create(lMemoName, fmCreate,_dbfFile._DbfVersion);
-  end else if not FileExists(lFileName) then begin
-    raise eBinaryDataSetError.Create ('Open: Table file not found : ' + lFileName);
-  end else begin
-    if DoReadOnly  then
-      fileopenmode := fmOpenRead + fmShareDenyNone
-    else
-      fileopenmode := fmOpenReadWrite + fmShareDenyWrite;
-
-    if _dbfFile=nil then _dbfFile := TDBFFile.Create(lFileName, fileopenmode);
-    if (_indexFile=nil) and FileExists (lIndexName) then begin
-      _indexFile := TIndexFile.Create(lIndexName, fileopenmode);
-    end;
-    if (_dbtFile=nil) and FileExists (lMemoName) then begin
-      _dbtFile := TDbtFile.Create(lMemoName, fileopenmode,_dbfFile._DbfVersion);
-    end;
-  end;
-  _PrevBuffer:=AllocRecordBuffer;
-  _IsCursorOpen:=true;
-
-end;
-
-function TDbf._GetPath:string;
-var
-  lPath:string;
-begin
-  if (csDesigning in ComponentState) then begin
-    lPath:=_DesignTimePath;
-  end else begin
-    if ((length(_RunTimePath)>=1) and (_RunTimePath[1]=DirSeparator))
-      or ((length(_RunTimePath)>=2) and (_RunTimePath[2]=':'))
-      then begin
-      // if the _RunTimePath is absolute...
-      // it is either \ or \blahblah or c:\
-      lPath:=_RunTimePath;
-    end else begin
-{$ifndef fpc}
-      lPath:=extractfilepath(Application.Exename)+_RunTimePath;
-{$else}
-      lPath:=extractfilepath(paramstr(0))+_RunTimePath;
-{$endif}
-    end;
-  end;
-  lPath:=ExpandFileName(trim(lPath));
-  if (length(lPath)>0) and (lPath[length(lPath)]<>DirSeparator) then lPath:=lPath+DirSeparator;
-  result:=lPath;
-end;
-
-procedure TDbf._CloseFiles;
-var
-  i:integer;
-begin
-  if _dbfFile<>nil then begin
-    if not _ReadOnly then _dbfFile.WriteHeader;
-    _dbfFile.Release;
-    _dbfFile:=nil;
-  end;
-  if _indexFile<>nil then begin
-    _indexFile.Release;
-    _indexFile:=nil;
-  end;
-
-  if _dbtFile<>nil then begin
-    _dbtFile.Release;
-    _dbtFile:=nil;
-  end;
-
-  if _indexes<>nil then begin
-    for i:=0 to _Indexes.Count-1 do begin
-      TIndex(_Indexes[i]).Free;
-    end;
-    _Indexes.Clear;
-    _CurIndex:=nil;
-  end;
-  if (_PrevBuffer<>nil) then begin
-    FreeRecordBuffer(_PrevBuffer);
-    _PrevBuffer:=nil;
-  end;
-  _IsCursorOpen:=false;
-end;
-
-procedure TDbf._SetIndexName(const Value: string);
-begin
-  _CurIndex:=_GetIndex(Value);
-  Resync([]);
-end;
-
-function TDbf._GetIndexName: string;
-begin
-  if _CurIndex=nil then Result:=''
-  else Result:=_CurIndex._IndexFile._Filename;
-end;
-
-function TDbf._GetIndex(filename:string):TIndex;
-var
-  i:integer;
-  lindex:TIndex;
-begin
-  result:=nil;
-  filename:=lowercase(_GetPath + filename);
-  for i:=0 to _indexes.Count-1 do begin
-    lindex:=TIndex(_indexes.Items[i]);
-    if lindex._IndexFile._Filename=filename then begin
-      result:=lindex;
-      exit;
-    end;
-  end;
-end;
-
-
-//==========================================================
-//============ TMyBlobFile
-//==========================================================
-constructor TMyBlobFile.Create(ModeVal:TBlobStreamMode;FieldVal:TField);
-begin
-  Mode:=ModeVal;
-  Field:=FieldVal;
-end;
-
-destructor TMyBlobFile.destroy;
-var
-  Dbf:TDbf;
-begin
-  if (Mode=bmWrite) then begin
-    Size:=Position; // Strange but it leave tailing trash bytes if I do not write that.
-    Dbf:=TDbf(Field.DataSet);
-    Dbf._dbtFile.WriteMemo(MemoRecno,ReadSize,Self);
-
-    Dbf._dbfFile.SetFieldData(Field.FieldNo-1,
-      ftInteger,@MemoRecno,@pDbfRecord(TDbf(Field.DataSet).ActiveBuffer)^.deletedflag);
-    // seems not bad
-{$ifndef fpc}
-    // FPC doesn't allow to call protected methods ?!!
-    Dbf.SetModified(true);
-{$endif}
-    // but would that be better
-    //if not (State in [dsCalcFields, dsFilter, dsNewValue]) then begin
-    //  DataEvent(deFieldChange, Longint(Field));
-    //end;
-  end;
-  inherited;
-end;
-
-//====================================================================
-// TDbf = TDataset Descendant.
-//====================================================================
-constructor TDbf.Create(AOwner: TComponent); {override;}
-begin
-  inherited create(aOwner);
-  BookmarkSize:=sizeof(rBookmarkData);
-
-  _RunTimePath:='.';
-  _IsCursorOpen:=false;
-  _Indexes:=TList.Create;
-  _CurIndex:=nil;
-  _IndexFiles:=TStringList.Create;
-end;
-
-destructor TDbf.Destroy; {override;}
-var
-  i:integer;
-begin
-  inherited;
-  _CurIndex:=nil;
-  for i:=0 to _Indexes.Count-1 do begin
-    TIndex(_Indexes[i]).Free;
-  end;
-  _Indexes.Free;
-  _IndexFiles.Free;
-//  _MemIndex.Free;
-end;
-
-
-function TDbf._FilterRecord(Buffer: PChar): Boolean;
-var
-  SaveState: TDatasetState;
-  s:string;
-begin
-  Result:=True;
-  if Length(easyfilter)<>0 then begin
-    SetString(s,buffer,RecordSize);
-    s:=LowerCase(s);
-    if Pos(easyfilter,s)=0 then begin
-      Result:=False;
-      Exit;
-    end;
-  end;
-  if not Assigned(OnFilterRecord) then Exit;
-  if not Filtered then Exit;
-  _FilterBuffer:=buffer;
-  SaveState:=SetTempState(dsFilter);
-  OnFilterRecord(self,Result);
-  RestoreState(SaveState);
-end;
-
-function TDbf._RecordDataSize:integer;
-begin
-  if _dbfFile=nil then result:=0
-  else result:=_dbfFile.RecordSize;
-end;
-
-function TDbf._FullRecordSize:integer;
-begin
-  result:=sizeof(rBeforeRecord) + _RecordDataSize + CalcFieldsSize;
-end;
-
-function TDbf.AllocRecordBuffer: PChar; {override virtual abstract from TDataset}
-begin
-  result:=StrAlloc(_FullRecordSize);
-  InternalInitRecord(result);
-end;
-
-procedure TDbf.FreeRecordBuffer(var Buffer: PChar); {override virtual abstract from TDataset}
-begin
-  StrDispose(Buffer);
-end;
-
-procedure TDbf.GetBookmarkData(Buffer: PChar; Data: Pointer); {override virtual abstract from TDataset}
-var
-  prec:pDbfRecord;
-begin
-  prec:=pDbfRecord(Buffer);
-  pBookMarkData(Data)^:=prec^.BookMarkData;
-end;
-
-function TDbf.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; {override virtual abstract from TDataset}
-var
-  prec:pDbfRecord;
-begin
-  prec:=pDbfRecord(Buffer);
-  result:=prec^.BookMarkFlag;
-end;
-
-function TDbf.GetFieldData(Field: TField; Buffer: Pointer): Boolean; {override virtual abstract from TDataset}
-var
-  ptr:pointer;
-begin
-  Result := False;
-  if State=dsFilter then begin
-    Ptr:=_FilterBuffer;
-  end else   if State = dsCalcFields then  begin
-    // ***** calc fields *****  set correct buffer
-    ptr := @(pDbfRecord(CalcBuffer)^.deletedflag);
-  end else begin
-    if IsEmpty then exit;
-    ptr:=@(pDbfRecord(ActiveBuffer)^.deletedflag);
-  end;
-
-  if Field.FieldNo>0 then begin
-    Result:=_dbfFile.GetFieldData(Field.FieldNo - 1,Field.DataType,ptr,Buffer);
-  end else begin { calculated fields.... }
-    Inc(PChar(Ptr), Field.Offset + GetRecordSize);
-{$ifndef fpc}
-    Result := Boolean(PChar(Ptr)[0]);
-{$else}
-    Result := (Pchar(ptr)[0]<>#0);
-{$endif}
-    if Result and (Buffer <> nil) then
-      Move(PChar(Ptr)[1], Buffer^, Field.DataSize);
-  end;
-end;
-
-
-function TDbf.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; {override virtual abstract from TDataset}
-var
-  Acceptable : Boolean;
-  prec:pDBFRecord;
-begin
-  prec:=pDBFRecord(Buffer);
-  if _dbfFile.RecordCount < 1 then
-    Result := grEOF
-  else repeat
-    result := grOk;
-    case GetMode of
-      gmCurrent :
-        begin
-          if prec^.BookmarkData.Recno=_PhysicalRecno then begin
-            exit;    // try to fasten a bit...
-          end;
-        end;
-      gmNext :
-        begin
-          if _curIndex<>nil then begin
-            Acceptable:=_curIndex.Next;
-          end else begin
-            inc(_PhysicalRecno);
-            Acceptable:=(_PhysicalRecno<_dbfFile.RecordCount);
-          end;
-          if Acceptable then begin
-            result:= grOk;
-          end else begin
-            InternalLast;
-            result:= grEOF
-          end;
-        end;
-      gmPrior :
-        begin
-          if _curIndex<>nil then begin
-            Acceptable:=_curIndex.Prev;
-          end else begin
-            dec(_PhysicalRecno);
-            Acceptable:=(_PhysicalRecno>=0);
-          end;
-          if Acceptable then begin
-            result:= grOk;
-          end else begin
-            InternalFirst;
-            result:= grBOF
-          end;
-        end;
-    end;
-    if result=grOk then begin
-      if _curIndex<>nil then _PhysicalRecno:=_CurIndex.GetRealRecNo;
-      if (_PhysicalRecno>=_dbfFile.RecordCount)
-        or (_PhysicalRecno<0) then begin
-        result:=grError;
-      end else begin
-        _dbfFile.ReadRecord(_PhysicalRecno,@prec^.DeletedFlag);
-        result:=grOk;
-      end;
-      if Result = grOK then begin
-        ClearCalcFields(Buffer);
-        GetCalcFields(Buffer);
-        prec^.BookmarkFlag := bfCurrent;
-        prec^.BookmarkData.Recno:=PhysicalRecno;
-      end else if (Result = grError) and DoCheck then
-          raise eBinaryDataSetError.Create ('GetRecord: Invalid record');
-    end;
-    Acceptable := (_ShowDeleted or (prec^.DeletedFlag = ' '))
-      and _FilterRecord(Buffer);
-    if (GetMode=gmCurrent) and Not Acceptable then Result := grError;
-  until (Result <> grOK) or Acceptable;
-end;
-
-function TDbf.GetRecordSize: Word; {override virtual abstract from TDataset}
-begin
-  Result := _RecordDataSize; // data only
-end;
-
-procedure TDbf.InternalAddRecord(Buffer: Pointer; DoAppend: Boolean); {override virtual abstract from TDataset}
-begin
-end;
-
-procedure TDbf.InternalClose; {override virtual abstract from TDataset}
-begin
-  _CloseFiles;
-
-  // disconnect field objects
-  BindFields(False);
-  // destroy field object (if not persistent)
-  if DefaultFields then
-    DestroyFields;
-end;
-
-procedure TDbf.InternalDelete; {override virtual abstract from TDataset}
-begin
-//  CheckActive;
-  pRecordHdr(ActiveBuffer)^.DeletedFlag := '*'; //_DataHdr.LastDeleted;
-  _dbfFile.WriteRecord(_PhysicalRecNo,ActiveBuffer);
-  Resync([]);
-end;
-
-procedure TDbf.InternalFirst; {override virtual abstract from TDataset}
-begin
-  if _dbfFile.RecordCount=0 then InternalLast
-  else if _curindex=nil then _PhysicalRecno:=-1
-  else _curIndex.First;
-end;
-
-procedure TDbf.InternalGotoBookmark(ABookmark: Pointer); {override virtual abstract from TDataset}
-var
-  RecInfo: TRecInfo;
-begin
-  RecInfo := TRecInfo(ABookmark^);
-  if (RecInfo.Bookmark >= 0) and (RecInfo.Bookmark < _dbfFile.RecordCount) then begin
-    _PhysicalRecno:=RecInfo.Bookmark;
-  end else
-    raise eBinaryDataSetError.Create ('Bookmark ' +
-      IntToStr (RecInfo.Bookmark) + ' not found');
-end;
-
-procedure TDbf.InternalHandleException; {override virtual abstract from TDataset}
-begin
-{$ifndef fpc}
-  Application.HandleException(Self);
-{$endif}
-end;
-
-procedure TDbf.InternalInitFieldDefs; {override virtual abstract from TDataset}
-begin
-  FieldDefs.Clear;
-  with FieldDefs do
-  begin
-    if IsCursorOpen  then begin
-      _dbfFile.CreateFieldDefs(FieldDefs);
-    end else begin
-      _OpenFiles(false);
-      _dbfFile.CreateFieldDefs(FieldDefs);
-      Close();
-    end;
-  end;
-end;
-
-procedure TDbf.InternalInitRecord(Buffer: PChar); {override virtual abstract from TDataset}
-var
-  prec:pDbfRecord;
-begin
-  prec:=pDbfRecord(Buffer);
-  prec^.BookmarkData.RecNo:=-1;
-  prec^.BookmarkFlag:=TBookmarkFlag(0);
-  fillchar(prec^.DeletedFlag,_RecordDataSize,' ');
-end;
-
-procedure TDbf.InternalLast; {override virtual abstract from TDataset}
-begin
-  if _curindex=nil then _PhysicalRecno:=_dbfFile.RecordCount
-  else _curIndex.Last;
-end;
-
-procedure TDbf.InternalOpen; {override virtual abstract from TDataset}
-begin
-  _OpenFiles(false);
-  // if there are no persistent field objects,
-  InternalInitFieldDefs;
-  // create the fields dynamically
-  if DefaultFields then begin
-    CreateFields;
-  end;
-  BindFields (True);
-  // connect the TField objects with the actual fields
-
-  InternalFirst;
-end;
-
-procedure TDbf.InternalPost; {override virtual abstract from TDataset}
-var
-  prec:pDbfRecord;
-  lIndex:TIndex;
-  i:integer;
-begin
-  CheckActive;
-  prec:=pDbfRecord(ActiveBuffer);
-  prec^.DeletedFlag:=' ';
-
-  if State = dsEdit then
-  begin
-    // replace data with new data
-    if _indexes.Count>0 then begin
-      _dbfFile.ReadRecord(_PhysicalRecno,_PrevBuffer);
-      for i:=0 to _indexes.Count-1 do begin
-        lindex:=TIndex(_indexes.Items[i]);
-        lindex.Update(_PhysicalRecno,_PrevBuffer,@prec^.DeletedFlag);
-      end;
-    end;
-  end else begin
-    // append
-    _PhysicalRecno:=_dbfFile._DataHdr.RecordCount;
-    inc(_dbfFile._DataHdr.RecordCount);
-    if _indexes.Count>0 then begin
-      _dbfFile.ReadRecord(_PhysicalRecno,_PrevBuffer);
-      for i:=0 to _indexes.Count-1 do begin
-        lindex:=TIndex(_indexes.Items[i]);
-        lindex.Insert(_PhysicalRecno,@prec^.DeletedFlag);
-      end;
-    end;
-  end;
-  _dbfFile.WriteRecord(_PhysicalRecno,@prec^.DeletedFlag);
-end;
-
-
-procedure TDbf.CreateTable; //(FieldDefs:TFieldDefs);
-var
-  ix:integer;
-begin
-  CheckInactive;
-  //  InternalInitFieldDefs;
-  if FieldDefs.Count = 0 then
-  begin
-    for Ix := 0 to FieldCount - 1 do
-    begin
-      with Fields[Ix] do
-      begin
-        if FieldKind = fkData then
-          FieldDefs.Add(FieldName,DataType,Size,Required);
-      end;
-    end;
-  end;
-  _OpenFiles(true);
-  try
-    _dbfFile.DbfFile_CreateTable(FieldDefs);
-  finally
-    // close the file
-    _CloseFiles;
-  end;
-end;
-
-procedure TDbf.PackTable;
-begin
-  _dbfFile.dbfFile_PackTable;
-  Resync([]);
-end;
-
-
-function TDbf.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; {override virtual}
-var
-  Memoi:array[1..32] of char;
-  lBlob:TMyBlobFile;
-begin
-  lBlob:=TMyBlobFile.Create(Mode,Field);
-  if _dbfFile.GetFieldData(Field.FieldNo-1, ftString,@pDbfRecord(ActiveBuffer)^.deletedflag,@Memoi[1]) then begin
-    lBlob.MemoRecno:=StrToIntDef(Memoi,0);
-    _dbtFile.ReadMemo(lBlob.MemoRecno,lBlob);
-    lBlob.ReadSize:=lBlob.Size;
-  end else lBlob.MemoRecno:=0;
-  Result:=lBlob;
-end;
-
-{$ifdef DELPHI_3}
-procedure TDbf.Translate(Src, Dest: PChar; ToOem: Boolean); {override virtual}
-begin
-  if (Src <> nil) and (Dest<>nil) then begin
-    if ToOem then CharToOem(Src,Dest)
-    else OemToChar(Src,Dest);
-  end;
-end;
-{$else}
-{$ifndef fpc}
-function TDbf.Translate(Src, Dest: PChar; ToOem: Boolean): Integer; {override virtual}
-begin
-  if (Src <> nil) and (Dest<>nil) then begin
-    if ToOem then CharToOem(Src,Dest)
-    else OemToChar(Src,Dest);
-    result:= StrLen(Dest);
-  end else result:=0;
-end;
-{$else}
-function TDbf.Translate(Src, Dest: PChar; ToOem: Boolean): Integer; {override virtual}
-begin
-end;
-{$endif}
-{$endif}
-
-procedure TDbf.ClearCalcFields(Buffer: PChar);
-begin
-  FillChar(Buffer[_dbfFile.RecordSize], CalcFieldsSize, 0);
-end;
-
-procedure TDbf.InternalSetToRecord(Buffer: PChar); {override virtual abstract from TDataset}
-var
-  prec:pDbfRecord;
-begin
-  if Buffer=nil then exit;
-  prec:=pDbfRecord(Buffer);
-  _PhysicalRecno:=prec^.BookmarkData.RecNo;
-  _ResyncIndexes(Buffer);
-end;
-
-procedure TDbf._ResyncIndexes(Buffer: PChar);
-var
-  i:integer;
-  lindex:TIndex;
-begin
-  if _indexes.Count>0 then begin
-    _dbfFile.ReadRecord(_PhysicalRecno,_PrevBuffer);
-    for i:=0 to _indexes.Count-1 do begin
-      lindex:=TIndex(_indexes.Items[i]);
-      lindex.GotoKey(_physicalRecno,nil);
-    end;
-  end;
-end;
-
-function TDbf.IsCursorOpen: Boolean; {override virtual abstract from TDataset}
-begin
-  result:=_IsCursorOpen;
-end;
-
-procedure TDbf.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); {override virtual abstract from TDataset}
-var
-  prec:pDbfRecord;
-begin
-  prec:=pDbfRecord(Buffer);
-  prec^.BookMarkFlag:=Value;
-end;
-
-procedure TDbf.SetBookmarkData(Buffer: PChar; Data: Pointer); {override virtual abstract from TDataset}
-var
-  prec:pDbfRecord;
-begin
-  prec:=pDbfRecord(Buffer);
-  prec^.BookMarkData:=pBookMarkData(Data)^;
-end;
-
-procedure TDbf.SetFieldData(Field: TField; Buffer: Pointer); {override virtual abstract from TDataset}
-var
-  prec:pDbfRecord;
-  dst:pointer;
-begin
-  if (Field.FieldNo >= 0) then begin
-    prec:=pDbfRecord(ActiveBuffer);
-    dst:=@prec^.DeletedFlag;
-    _dbfFile.SetFieldData(Field.FieldNo - 1,Field.DataType,Buffer,Dst);
-  end else begin    { ***** fkCalculated, fkLookup ***** }
-    prec:=pDbfRecord(CalcBuffer);
-    dst:=@prec^.DeletedFlag;
-    Inc(pchar(dst), GetRecordSize + Field.Offset);
-    Boolean(dst^) := (Buffer<>nil);
-    if Boolean(dst^) then begin
-      Inc(Pchar(dst), 1);
-      Move(Buffer^, dst^, Field.DataSize);
-    end;
-  end;     { end of ***** fkCalculated, fkLookup ***** }
-  if not (State in [dsCalcFields, dsFilter, dsNewValue]) then begin
-    DataEvent(deFieldChange, Ptrint(Field));
-  end;
-end;
-
-
-// this function is just for the grid scrollbars
-// it doesn't have to be perfectly accurate, but fast.
-function TDbf.GetRecordCount: Integer; {override virtual}
-begin
-  if _curIndex=nil then begin
-    result:=_dbfFile.RecordCount;
-  end else begin
-    result:=_curIndex.GuessRecordCount;
-  end;
-end;
-
-// this function is just for the grid scrollbars
-// it doesn't have to be perfectly accurate, but fast.
-function TDbf.GetRecNo: Integer; {override virtual}
-begin
-  UpdateCursorPos;
-  if _curIndex=nil then begin
-    result:=_PhysicalRecno+1;
-  end else begin
-    result:=_curIndex.GuessRecNo;
-  end;
-end;
-
-procedure TDbf.SetRecNo(Value: Integer); {override virual}
-begin
-  if _curIndex=nil then begin
-    _PhysicalRecno:=Value-1;
-  end else begin
-    //result:=_curIndex.GuessRecNo;
-  end;
-  Resync([rmExact]);
-end;
-
-procedure TDBf.DeleteIndex(const AName: string);
-
-begin
-  // I must admit that is seems a bit expeditive.
-  // but I does implement this method because TTable does
-  DeleteFile(_GetPath + Name);
-end;
-
-procedure TDbf.CloseIndexFile(const IndexFileName: string);
-var
-  lindex:tindex;
-begin
-  lindex:=_GetIndex(IndexFileName);
-  if lindex<>nil then begin
-    lindex.Free;
-    _indexes.Delete(_indexes.IndexOf(lindex));
-    if _curindex = lindex then begin
-      _curindex:=nil;
-      resync([]);
-    end;
-  end;
-end;
-
-procedure TDbf.OpenIndexFile(AnIndexName:string);
-var
-  lIndexFile:TIndexFile;
-  lIndex:TIndex;
-begin
-  lindex:=_GetIndex(IndexName);
-  if lindex=nil then begin
-    IndexName:=lowercase(_GetPath + IndexName);
-    lIndexFile:=TIndexFile(GetPagedFile(IndexName));
-    if lIndexFile=nil then begin
-      lIndexFile:=TIndexFile.Create(IndexName,fmOpenReadWrite + fmShareDenyWrite);
-    end;
-    lIndex:=TIndex.Create(lIndexFile,0,false);
-    _Indexes.Add(lIndex);
-    lIndex.InitFieldDef(_DbfFile,lIndex._NdxHdr.KeyDesc);
-  end;
-end;
-
-(*
-procedure TDbfFile.DbfFile_PackTable;
-var
-begin
-end;
-*)
-{$ifdef fpc}
-procedure TDbf.AddIndex(const AnIndexName, IndexFields: String; Options: TIndexOptions);
-
-begin
-  AddIndex(indexName,IndexFields,options,'');
-end;
-{$endif}
-
-{$ifdef DELPHI_3}
-procedure TDbf.AddIndex(const IndexName, Fields: String; Options: TIndexOptions);
-var
-  DescFields:string;
-{$else}
-{$ifndef fpc}
-procedure TDbf.AddIndex(const IndexName, Fields: String; Options: TIndexOptions; const DescFields: String='');
-var
-{$else}
-procedure TDbf.AddIndex(const AnIndexName, IndexFields: String; Options: TIndexOptions; const DescFields: String);
-var
-{$endif}
-{$endif}
-  lfilename:string;
-  lIndexFile:TIndexFile;
-  lIndex:TIndex;
-  cur,thelast:integer;
-begin
-  lfilename:=lowercase(_GetPath+IndexName);
-  lIndexFile:=TIndexFile(GetPagedFile(lfilename));
-  if lIndexFile<>nil then exit;
-  lIndexFile:=TIndexFile.Create(lfilename,fmCreate);
-  lIndex:=TIndex.Create(lIndexFile,0,true);
-{$ifndef fpc}
-  lIndex.InitFieldDef(_DbfFile,Fields);
-{$else}
-  lIndex.InitFieldDef(_DbfFile,IndexFields);
-{$endif}
-  with lIndex._NdxHdr do begin
-    startpage:=1;
-    nbPage:=1;
-    keyformat:=#0;
-    keytype:='C';
-    dummy:=$5800;
-    keylen:=lindex._FieldLen;
-    nbkey:=(512-8) div (lindex._FieldLen+8);
-    keyreclen:=lindex._FieldLen+8;
-    Unique:=0;
-    KeyDesc[0]:=' ';
-{$ifndef fpc}
-    StrLCopy(KeyDesc,PChar(UpperCase(Fields)),255);
-{$else}
-    StrLCopy(KeyDesc,PChar(UpperCase(IndexFields)),255);
-{$endif}
-  end;
-  lindex._IndexFile._Seek(lindex._RootPage);
-  lindex._IndexFile.Stream.Write(lindex._NdxHdr,SizeOf(lindex._NdxHdr));
-
-  cur:=0;
-  thelast:=_DbfFile.CalcRecordCount;
-
-  while cur<thelast do begin
-    _DbfFile.ReadRecord(cur, _PrevBuffer);
-    lIndex.Insert(cur,_PrevBuffer);
-    inc(cur);
-  end;
-  _Indexes.Add(lIndex);
-end;
-//==========================================================
-//============ dbtfile
-//==========================================================
-constructor TDbtFile.Create(const FileName: string; Mode: Word; Ver:xBaseVersion);
-begin
-  inherited Create(FileName,Mode);
-  _DbtVersion:=Ver;
-  if mode = fmCreate then begin
-    FillChar(_MemoHdr,sizeof(_MemoHdr),0);
-  end else begin
-    Stream.Position:=0;
-    Stream.read(_MemoHdr,SizeOf(_MemoHdr));
-  end;
-  HeaderSize:=0;
-  RecordSize:=_MemoHdr.BlockLen;
-
-  if (RecordSize=0) or ((RecordSize mod 128)<>0) then begin
-    _MemoHdr.BlockLen := $200;
-    RecordSize := $200;
-  end;
-  // Can you tell me why the header of dbase3 memo contains 1024 and it 512 ?
-  if _DbtVersion=xBaseIII then RecordSize:=512;
-end;
-
-procedure TDbtFile.ReadMemo(recno:Integer;Dst:TStream);
-var
-  Buff:array[0..511] of char;
-  i,lsize:integer;
-  finish:boolean;
-  lastc:char;
-begin
-  if recno=0 then Exit;
-  Stream.Position:= RecordSize * recno;
-  if _DbtVersion >= xBaseIV then begin // dBase4 memofiles
-    Stream.read(Buff[0],8);
-    if (Buff[0]=#$ff) and  (Buff[1]=#$ff) and
-      (Buff[2]=#$08) and (Buff[3]=#$00) then begin
-          // dbase IV memo
-      lsize:=(PInteger(@Buff[4])^)-8;
-    end else begin
-      lsize:=0;
-    end;
-    repeat
-      if lsize>SizeOf(Buff) then begin
-        Stream.read(Buff,SizeOf(Buff));
-        Dst.Write(buff,SizeOf(Buff));
-        Dec(lsize,SizeOf(Buff));
-      end else if lsize>0 then begin
-        Stream.read(Buff,lsize);
-        Dst.Write(buff,lsize);
-        lsize:=0;
-      end;
-    until lsize=0;
-  end else begin
-    finish:=False;
-    Stream.read(Buff,SizeOf(Buff));
-    lastc:=#0;
-    repeat
-      for i:=0 to SizeOf(Buff)-2 do begin
-        if ((Buff[i]=#$1A) and
-          ((Buff[i+1]=#$1A) or ((i=0) and (lastc=#$1A))))
-          or (Buff[i]=#$0)
-          then begin
-          if i>0 then Dst.Write(buff,i);
-          finish:=True;
-          break;
-        end;
-      end;
-      if finish then Break;
-      Dst.Write(buff,512);
-      lastc:=Buff[511];
-      Stream.read(Buff,SizeOf(Buff));
-    until finish;
-  end;
-  Dst.Seek(0,0);
-end;
-
-procedure TDbtFile.WriteMemo(var MemoRecno:Integer;ReadSize:Integer;Src:TStream);
-var
-  ByteBefore:Integer;
-  ByteAfter:Integer;
-  Buff:array[0..511] of char;
-  i:Integer;
-  c:Byte;
-  Append:Boolean;
-begin
-  if _DbtVersion >= xBaseIV then begin // dBase4 memofiles
-    ByteBefore:=8;
-    ByteAfter:=0;
-  end else begin // stupid files
-    ByteBefore:=0;
-    ByteAfter:=2;
-  end;
-  if Src.Size = 0 then begin
-    MemoRecno:=0;
-  end else begin
-    if ((ByteBefore+Src.Size+ByteAfter+_MemoHdr.BlockLen-1) div _MemoHdr.BlockLen)
-      <= ((ReadSize+_MemoHdr.BlockLen-1) div _MemoHdr.BlockLen)
-      then begin
-      Append:=false;
-      //MemoRecno:=MemoRecno;
-    end else begin
-      Append:=True;
-      MemoRecno:=_MemoHdr.NextBlock;
-      if MemoRecno=0 then begin
-        _MemoHdr.NextBlock:=1;
-        MemoRecno:=1;
-      end;
-    end;
-    Stream.Seek(_MemoHdr.BlockLen * MemoRecno,0);
-    i:=Src.Position;
-    Src.Seek(0,0);
-    if ByteBefore=8 then begin
-      i:=$0008ffff;
-      Stream.Write(i,4);
-      i:=Src.Size+ByteBefore+ByteAfter;
-      Stream.Write(i,4);
-    end;
-    repeat
-      i:=Src.Read(buff,512);
-      if i=0 then break;
-      Inc(_MemoHdr.NextBlock);
-      Stream.Write(Buff,i);
-    until i<512;
-    if ByteAfter=2 then begin
-      c:=$1A;
-      Stream.Write(c,1);
-      Stream.Write(c,1);
-    end;
-    if Append then begin
-      Stream.Seek(0,0);
-      Stream.Write(_MemoHdr,SizeOf(_MemoHdr))
-    end;
-  end;
-end;
-
-//==========================================================
-//============ TIndexFile
-//==========================================================
-constructor TIndexFile.Create(const FileName: string; Mode: Word);
-var
-  ext:string;
-  i:Integer;
-begin
-  inherited Create(FileName,Mode);
-  HeaderSize:=0;
-  RecordSize:=512;
-
-  ext:=ExtractFileExt(FileName);
-  if (ext='.mdx') then begin
-    _IndexVersion:=xBaseIV;
-    if Mode = fmCreate then begin
-      FillChar(_MdxHdr,sizeof(_MdxHdr),0);
-    end else begin
-      Stream.read(_MdxHdr,SizeOf(_MdxHdr));
-    end;
-    for i:= 0 to _MdxHdr.TagUsed-1 do begin
-//      Stream.Position :=544 + i * _MdxHdr.TagSize;
-//      Stream.read(lMdxTag,SizeOf(rMdxTag));
-//      lIndex:=TIndex.Create(Self,lMdxTag.pageno);
-//      _Indexes.Add(lIndex);
-//      if i=0 then lIndex.ReadPage(lIndex._NdxHdr.startpage);
-    end;
-  end else begin
-    _IndexVersion:=xBaseIII;
-(*
-      _IndexFile._Seek(Pos);
-      _IndexFile.Stream.Read(_NdxHdr,SizeOf(_NdxHdr));
-      _Root:=TIndexPage.Create(Self);
-      _Root.SetPageNo(_NdxHdr.startpage);
-      lPos:=_Root;
-      _nblevel:=1;
-      repeat
-        lPos.LocalFirst;
-        if lPos.Entry._LowerPage=0 then break;
-        inc(_nblevel);
-    lChild:=TIndexPage.Create(Self);
-    lChild._UpperLevel:=lPos;
-    lPos._LowerLevel:=lChild;
-    lChild.SetPageNo(lPos.Entry._LowerPage);
-    lPos:=lChild;
-  until false;
-
-  _Spare:=TIndexPage.Create(Self);
-//  _Field:=_IndexFile._Dbf.FindField(_NdxHdr.KeyDesc);
-  First;
-*)
-  end;
-end;
-
-destructor TIndexFile.Destroy;
-begin
-  inherited;
-end;
-
-//==========================================================
-//============ TIndexPage
-//==========================================================
-constructor TIndexPage.Create(Parent:TIndex);
-begin
-  _LowerLevel:=nil;
-  _UpperLevel:=nil;
-  _Index:=Parent;
-  _PageNo:=-1;
-  _EntryNo:=-1;
-end;
-
-destructor TIndexPage.Destroy;
-begin
-  if _LowerLevel<>nil then _LowerLevel.Free;
-end;
-
-function  TIndexPage.GetPEntry(EntryNo:integer):PNdxEntry;
-begin
-  Result:=PNdxentry(@_PageBuff.Entries[_Index._NdxHdr.keyreclen*entryno]);
-end;
-
-function  TIndexPage.LocalInsert(Recno:integer; Buffer:Pchar;LowerPage:integer):boolean;
-var
-  src,dst:pointer;
-  siz:integer;
-begin
-  if _PageBuff.NbEntries < _Index._NdxHdr.nbkey then begin
-    src:=Entry;
-    dst:=GetPEntry(_EntryNo+1);
-    siz:=(_PageBuff.NbEntries - _EntryNo)
-      * _Index._NdxHdr.keyreclen + 8;
-    Move(Src^, Dst^, Siz);
-    inc(_PageBuff.NbEntries);
-    SetEntry(Recno,Buffer,LowerPage);
-    Write;
-    Result:=true;
-  end else begin
-    Result:=false;
-  end;
-end;
-
-
-function  TIndexPage.LocalDelete:boolean;
-var
-  src,dst:pointer;
-  siz:integer;
-begin
-  if _PageBuff.NbEntries >=0 then begin
-    if _EntryNo<_PageBuff.NbEntries then begin
-      src:=GetPEntry(_EntryNo+1);
-      dst:=Entry;
-      siz:=(_PageBuff.NbEntries - _EntryNo - 1)
-        * _Index._NdxHdr.keyreclen + 8;
-      Move(Src^, Dst^, Siz);
-    end;
-    dec(_PageBuff.NbEntries);
-    Write;
-    if ((_PageBuff.NbEntries=0) and (_lowerlevel=nil))
-      or (_PageBuff.NbEntries<0) then begin
-      if _UpperLevel<>nil then begin
-        _UpperLevel.LocalDelete;
-      end;
-    end else if (_EntryNo>LastEntryNo) then begin
-      SetEntryNo(LastEntryNo); // We just removed the last on this page.
-      if (_UpperLevel<>nil)  then begin
-        _UpperLevel.SetEntry(0,Entry^.CKey,_PageNo);
-      end;
-    end;
-    Result:=true;
-  end else begin
-    Result:=false;
-  end;
-end;
-
-function  TIndexPage.LastEntryNo:integer;
-begin
-  if (_LowerLevel=nil) then begin
-    result := _PageBuff.NbEntries - 1;
-  end else begin
-    result := _PageBuff.NbEntries;
-  end;
-end;
-
-procedure TIndexPage.LocalFirst;
-begin
-  SetEntryNo(0);
-end;
-
-procedure TIndexPage.LocalLast;
-begin
-  SetEntryNo(LastEntryNo);
-end;
-
-function TIndexPage.LocalPrev:boolean;
-begin
-  if _EntryNo>0 then begin
-    SetEntryNo(_EntryNo-1);
-    Result:=true;
-  end else begin
-    Result:=false;
-  end;
-end;
-
-function TIndexPage.LocalNext:boolean;
-begin
-  if (_EntryNo<LastEntryNo) then begin
-    SetEntryNo(_EntryNo+1);
-    Result:=true;
-  end else begin
-    Result:=false;
-  end;
-end;
-
-procedure TIndexPage.First;
-begin
-  LocalFirst;
-  if (_LowerLevel<>nil) then LowerLevel.First;
-end;
-
-procedure TIndexPage.Last;
-begin
-  LocalLast;
-  if (_LowerLevel<>nil) then LowerLevel.Last;
-end;
-
-function TIndexPage.Prev:boolean;
-begin
-  if (_LowerLevel<>nil) and LowerLevel.Prev then begin
-    result:=true;
-    exit;
-  end;
-  Result:=LocalPrev;
-  if Result and (Entry^._LowerPage>0) then LowerLevel.Last;
-end;
-
-function TIndexPage.Next:boolean;
-begin
-  if (_LowerLevel<>nil) and LowerLevel.next then begin
-    result:=true;
-    exit;
-  end;
-  Result:=LocalNext;
-  if Result and (Entry^._LowerPage>0) then LowerLevel.First;
-end;
-
-
-function TIndexPage.FindNearest(Recno:integer; Key:pchar):integer;
-var
-  cmpres:integer;
-  v1,v2:double;
-  p:TIndexPage;
-begin
-  Result:=-1;
-  if @Key=nil then begin
-    Exit;
-  end;
-  SetEntryNo(0);
-  while _EntryNo<=_PageBuff.NbEntries do begin
-    if _EntryNo=_PageBuff.NbEntries then break;
-    if _Index._NdxHdr.keytype='C' then begin
-      cmpres:=StrLIComp(PChar(Key),Entry^.CKey,_Index._FieldLen);
-    end else begin
-      // Numeric field... to do
-      v1:=PDouble(Key)^;
-      v2:=Entry^.NKey;
-      if v1>v2 then cmpres:=1
-      else if v1<v2 then cmpres:=-1
-      else cmpres:=0;
-    end;
-    if cmpres=0 then begin
-      if _LowerLevel=nil then begin
-        if (Entry^.RecNo=Recno) then begin
-          result:=0;
-          Exit;
-        end else if (Entry^.Recno>Recno) then begin
-          result:=-1;
-          Exit;
-        end;
-      end else begin
-        p:=self;
-        while p._LowerLevel<>nil do begin
-          p:=p.LowerLevel;
-          p.LocalLast;
-        end;
-        if (p.Entry^.Recno>=Recno) then begin
-          result:=-1;
-          Exit;
-        end;
-      end;
-    end else if cmpres<0 then begin
-      result:=-1;
-      exit;
-    end;
-    SetEntryNo(_EntryNo+1);
-  end;
-  result:=1;
-  Exit;
-end;
-
-procedure TIndexPage.SetEntry(Recno:Integer; key:PChar; LowerPage:integer);
-begin
-  assert((_EntryNo>=0) and (_EntryNo<=_PageBuff.NbEntries));
-  if (_EntryNo=self._PageBuff.NbEntries) then begin
-    if (_UpperLevel<>nil)  then begin
-      _UpperLevel.SetEntry(0,key,Self._PageNo);
-    end;
-  end else begin
-    if _Index._NdxHdr.keytype='C' then begin
-      mymove(key,Entry^.CKey,_Index._NdxHdr.keylen);
-    end else begin
-      Entry^.NKey:=PDouble(key)^;
-    end;
-  end;
-  Entry^.RecNo:=RecNo;
-  Entry^._LowerPage:=LowerPage;
-  Write;
-end;
-function TIndexPage.LowerLevel : TIndexPage;
-begin
-  if (_LowerLevel<>nil) and (_LowerLevel._PageNo<>Entry^._LowerPage) then begin
-    _LowerLevel.SetPageNo(Entry^._LowerPage);
-  end;
-  result:=_LowerLevel;
-end;
-
-function TIndexPage.Insert(Recno:Integer; Buffer:PChar; LowerPage:integer):boolean;
-var
-  src,dst:PNdxEntry;
-  siz:integer;
-  split,old_entry:integer;
-  lSpare:TIndexPage;
-begin
-  if not LocalInsert(recno,buffer,lowerpage) then begin
-    // The entry is FULL so we will split this page
-    // 1 - Check parent exist
-    if _UpperLevel=nil then begin
-      AddNewLevel;
-    end;
-
-    old_entry:=_EntryNo;
-    split:=_EntryNo;
-    if split < _Index._NdxHdr.nbkey div 2 then begin
-      split:=_Index._NdxHdr.nbkey div 2;
-    end;
-    lSpare:=TIndexPage.Create(_Index);
-    try
-      // 2 - Create new page with first part
-      inc(_Index._NdxHdr.nbPage);
-      lSpare._PageNo:=_Index._NdxHdr.nbPage;
-      _Index._IndexFile._Seek(_Index._RootPage);
-      _Index._IndexFile.Stream.WriteBuffer (_Index._NdxHdr, SizeOf(_Index._NdxHdr));
-
-      if _lowerlevel=nil then begin
-        lSpare._PageBuff.NbEntries:=split;
-      end else begin
-        lSpare._PageBuff.NbEntries:=split-1;
-      end;
-      siz:=split*_Index._NdxHdr.keyreclen+8;
-      src:=@_PageBuff.Entries;
-      dst:=@lSpare._PageBuff.Entries;
-      Move(src^,dst^,siz);
-      lSpare.Write;
-
-      // 3 - Keep only end-part in this page
-      siz:=(_PageBuff.NbEntries-Split);
-      _PageBuff.NbEntries:=siz;
-
-      siz:=siz*_Index._NdxHdr.keyreclen+8;
-      SetEntryNo(split);
-      src:=Entry;
-      SetEntryNo(0);
-      dst:=Entry;
-      Move(src^,dst^,siz);
-
-      // 3 - Update upper level
-      lSpare.SetEntryNo(split-1);
-      _UpperLevel.Insert(0,lSpare.Entry^.CKey,lSpare._PageNo);
-
-      // We just need to go on inserted record now
-
-      if old_entry>=split then begin
-        _UpperLevel.LocalNext;
-        SetEntryNo(old_entry - split);
-        LocalInsert(Recno,Buffer,LowerPage);
-        lSpare.Write;
-      end else begin
-        lSpare.SetEntryNo(old_entry);
-        lSpare.LocalInsert(Recno,Buffer,LowerPage);
-        Write;
-      end;
-    finally
-      lspare.free;
-    end;
-  end;
-    Result:=true;
-end;
-
-function TIndexPage.Delete:boolean;
-begin
-  Result:=LocalDelete;
-end;
-
-procedure TIndexPage.SetPageNo(page:Integer);
-begin
-  if (_PageNo<>page) and (page>0) then begin
-    _Index._IndexFile.ReadRecord(Page,@_PageBuff);
-    _PageNo:=page;
-    _EntryNo:=-1;
-  end;
-end;
-
-procedure TIndexPage.AddNewLevel;
-var
-  lNewPage:TIndexPage;
-begin
-  lNewPage:=TIndexPage.Create(_Index);
-  inc(_Index._NdxHdr.nbPage);
-  lNewPage._PageNo:= _Index._NdxHdr.nbPage;
-  _Index._NdxHdr.startpage:= _Index._NdxHdr.nbPage;
-  _Index._IndexFile._Seek(_Index._RootPage);
-  _Index._IndexFile.Stream.WriteBuffer (_Index._NdxHdr, SizeOf(_Index._NdxHdr));
-
-  lNewPage._PageBuff.NbEntries:=0;
-  lNewPage._UpperLevel:=nil;
-  lNewPage._LowerLevel:=_Index._Root;
-  lNewPage.SetEntryNo(0);
-  lNewPage.SetEntry(0,nil,_PageNo);
-  _Index._Root._UpperLevel:=lNewPage;
-  _Index._Root:=lNewPage;
-  lNewPage:=nil;
-end;
-
-procedure TIndexPage.Write;
-begin
-  _Index._IndexFile.WriteRecord(_PageNo,@_PageBuff);
-end;
-
-procedure TIndexPage.SetEntryNo(entryno:Integer);
-begin
-  if (_EntryNo<>entryno) then begin
-    _EntryNo:=entryno;
-    if _EntryNo>=0 then Entry:=PNdxentry(@_PageBuff.Entries[_Index._NdxHdr.keyreclen*entryno]);
-  end;
-end;
-
-procedure TIndexPage.WritePage(Page:integer);
-begin
-  _Index._IndexFile.WriteRecord(Page,@_PageBuff);
-end;
-
-//==========================================================
-//============ TIndex
-//==========================================================
-constructor TIndex.Create(Parent:TIndexFile; RootPage:integer;CreateIt:boolean);
-var
-  lPos:TIndexPage;
-  lChild:TIndexPage;
-begin
-  _RootPage:=RootPage;
-  _IndexFile:=Parent;
-  //_IndexOrder:=TList.Create;
-  if CreateIt then begin
-    FillChar(_NdxHdr,sizeof(_NdxHdr),0);
-    _NdxHdr.startpage:=1;
-    _NdxHdr.nbPage:=2;
-    _NdxHdr.keyformat:=#0;
-    _NdxHdr.keytype:='C';
-
-    _IndexFile._Seek(RootPage);
-    _IndexFile.Stream.Write(_NdxHdr,SizeOf(_NdxHdr));
-    _FieldPos := 0;
-    _FieldLen := 0;
-  end else begin
-    _IndexFile._Seek(RootPage);
-    _IndexFile.Stream.Read(_NdxHdr,SizeOf(_NdxHdr));
-  end;
-
-  _Root:=TIndexPage.Create(Self);
-  _Root.SetPageNo(_NdxHdr.startpage);
-  lPos:=_Root;
-  _nblevel:=1;
-  repeat
-    lPos.LocalFirst;
-    if lPos.Entry^._LowerPage=0 then break;
-    inc(_nblevel);
-    lChild:=TIndexPage.Create(Self);
-    lChild._UpperLevel:=lPos;
-    lPos._LowerLevel:=lChild;
-    lChild.SetPageNo(lPos.Entry^._LowerPage);
-    lPos:=lChild;
-  until false;
-
-  inc(_IndexFile._cntuse);
-  First;
-end;
-
-destructor TIndex.Destroy;
-begin
-  _IndexFile.Release;
-   _Root.Free;
-end;
-
-
-function TIndex.Find(Recno:integer; Buffer:PChar; var pPos:TIndexPage):integer;
-var
-  res:integer;
-begin
-  pPos:=_Root;
-  repeat
-    res:=pPos.FindNearest(Recno,Buffer);
-    if res<>0 then begin
-      if pPos.Entry^._LowerPage<>0 then begin
-        pPos:=pPos.LowerLevel;
-        res:=2;
-      end;
-    end;
-  until res<>2;
-  Result:=res;
-end;
-
-procedure TIndex.Update(Recno: integer; PrevBuffer,NewBuffer: PChar);
-var
-  lPos:TIndexPage;
-begin
-  if _FieldLen=0 then exit;
-
-  inc(PrevBuffer,_FieldPos);
-  inc(NewBuffer,_FieldPos);
-
-  if StrLIComp(PrevBuffer,NewBuffer,_FieldLen)<>0 then begin
-    Delete;
-    Find(Recno+1,NewBuffer,lPos);
-    lPos.Insert(Recno+1,NewBuffer,0);
-  end;
-end;
-
-procedure TIndex.Insert(Recno:integer; Buffer:PChar);
-var
-  lPos:TIndexPage;
-begin
-  if _FieldLen=0 then exit;
-
-  inc(Buffer,_FieldPos);
-
-  Find(Recno+1,Buffer,lPos);
-  lPos.Insert(Recno+1,Buffer,0);
-end;
-
-function TIndex.Delete:boolean;
-var
-  lPos:TIndexPage;
-begin
-  lpos:=_root;
-  while lpos._LowerLevel<>nil do begin
-    lPos:=lPos.LowerLevel;
-  end;
-  lPos.Delete;
-  Result:=true;
-end;
-
-
-function TIndex.Pos:TIndexPage;
-var
-  p:TIndexPage;
-begin
-  p:=_Root;
-  while p.Entry^._LowerPage>0 do begin
-    p:=p.LowerLevel;
-  end;
-  result:=p;
-end;
-
-procedure TIndex.First;
-begin
-  _Root.First;
-  dec(Pos._EntryNo);
-end;
-
-procedure TIndex.Last;
-begin
-  _Root.Last;
-  inc(Pos._EntryNo);
-end;
-
-function TIndex.Prev:boolean;
-begin
-  result:=_Root.Prev;
-end;
-
-function TIndex.Next:boolean;
-begin
-  result:=_Root.Next;
-end;
-
-(*
-procedure TIndex.SetRecNo(Value: Integer);
-var
-  pos:integer;
-  p:TIndexPage;
-  i:integer;
-  ldiv:integer;
-begin
-  p:=_Root;
-  ldiv:=1;
-  while p.Entry^._LowerPage>0 do begin
-    ldiv:=ldiv*(_NdxHdr.nbkey+1);
-    p:=p._LowerLevel;
-  end;
-  pos:=value div ldiv;
-  p:=_Root;
-  while p.Entry^._LowerPage>0 do begin
-    p._EntryNo:=pos;
-    value:=value - pos * (_NdxHdr.nbkey+1);
-    ldiv:=ldiv div (_NdxHdr.nbkey+1);
-    pos:=value div ldiv;
-    p:=p._LowerLevel;
-  end;
-{
-  pos:=1;
-  First;
-  While pos<value do begin
-    if Next = false then break;
-    inc(pos);
-  end;
-}
-end;
-*)
-function TIndex.GuessRecordCount: Integer;
-var
-  lPos:TIndexPage;
-  nbrecord:integer;
-begin
-  // I just read first level and Guess an approximate record count...
-  nbrecord:=_Root._PageBuff.NbEntries;
-  lPos:=_Root.LowerLevel;
-  while lpos<>nil do begin
-    nbrecord:=nbrecord*(_NdxHdr.nbkey+1);
-    lPos:=lPos.LowerLevel;
-  end;
-  result:=nbrecord;
-end;
-
-
-function TIndex.GuessRecNo:Integer;
-var
-  p:TIndexPage;
-begin
-  p:=_Root;
-  result:=p._EntryNo;
-  while p.Entry^._LowerPage>0 do begin
-    p:=p.LowerLevel;
-    Result:=Result*(_NdxHdr.nbkey+1) + p._EntryNo;
-  end;
-end;
-
-function TIndex.GetRealRecNo:integer;
-var
-  ippos : TIndexPage;
-begin
-  ippos:=_Root;
-  while ippos._LowerLevel<>nil do begin
-    ippos:=pos.LowerLevel;
-  end;
-  if (ippos._EntryNo<0) or (ippos._EntryNo>=ippos._PageBuff.NbEntries) then Result:=-1
-  else Result:=ippos.Entry^.RecNo-1;
-end;
-
-procedure TIndex.GotoKey(recno:integer; buffer:pchar);
-begin
-  // very temporary implementation
-  // could definitely be a bit faster.
-  _Root.First;
-  repeat
-    if self.Pos.Entry^.RecNo=(recno+1) then begin
-      exit;
-    end;
-  until Next=false;
-end;
-
-procedure TIndex.InitFieldDef(dbfFile:TDbfFile;FieldDesc:string);
-var
-  FieldInfo:TMyFieldInfo;
-begin
-  FieldInfo:=DbfFile.GetFieldInfo(FieldDesc);
-  if FieldInfo<>nil then begin
-    _FieldPos:=FieldInfo.Offset;
-    _FieldLen:=FieldInfo.Size;
-  end;
-end;
-
-//==========================================================
-//============ initialization
-//==========================================================
-
-{$ifndef fpc}
-type
-
-  TTableNameProperty = class(TStringProperty)
-  public
-    procedure Edit; override;
-    function GetAttributes: TPropertyAttributes; override;
-  end;
-
-procedure TTableNameProperty.Edit; {override;}
-var
-  FileOpen: TOpenDialog;
-  Dbf: TDbf;
-begin
-  FileOpen := TOpenDialog.Create(Application);
-  try
-    with fileopen do begin
-      Dbf:=GetComponent(0) as TDbf;
-      Filename := Dbf.DesignTimePath + GetValue;
-      Filter := 'Dbf table|*.dbf';
-      if Execute then begin
-        SetValue(ExtractFilename(Filename));
-        Dbf.DesignTimePath:=ExtractFilePath(Filename);
-      end;
-    end;
-  finally
-    Fileopen.free;
-  end;
-end;
-
-function TTableNameProperty.GetAttributes: TPropertyAttributes; {override;}
-begin
-  Result := [paDialog, paRevertable];
-end;
-
-
-
-type
-  TRunTimePathProperty = class(TStringProperty)
-  end;
-
-  TDesignTimePathProperty = class(TStringProperty)
-  end;
-
-//==========================================================
-//============ initialization
-//==========================================================
-
-procedure Register;
-begin
-  RegisterComponents('Exemples', [TDbf]);
-  RegisterPropertyEditor(TypeInfo(string), TDbf, 'TableName', TTableNameProperty);
-  RegisterPropertyEditor(TypeInfo(string), TDbf, 'RunTimePath', TRunTimePathProperty);
-  RegisterPropertyEditor(TypeInfo(string), TDbf, 'DesignTimePath', TDesignTimePathProperty);
-//  RegisterPropertyEditor(TypeInfo(TStrings), TDbf, 'IndexFiles', TIndexFilesProperty);
-//  ShowMessage(ToolServices.GetProjectName);
-end;
-{$endif fpc}
-
-initialization
-    _PagedFiles := TList.Create;
-    tDbf_TrimFields := true;
-
-finalization
-    _PagedFiles.free;
-
-end.

fcl/db/dbase/dbf_str.inc

@@ -0,0 +1,24 @@
+var
+  STRING_FILE_NOT_FOUND: string;
+  STRING_VERSION: string;
+
+  STRING_RECORD_LOCKED: string;
+  STRING_WRITE_ERROR: string;
+  STRING_WRITE_INDEX_ERROR: string;
+  STRING_KEY_VIOLATION: string;
+
+  STRING_INVALID_DBF_FILE: string;
+  STRING_FIELD_TOO_LONG: string;
+  STRING_INVALID_FIELD_COUNT: string;
+  STRING_INVALID_FIELD_TYPE: string;
+  STRING_INVALID_VCL_FIELD_TYPE: string;
+
+  STRING_INDEX_BASED_ON_UNKNOWN_FIELD: string;
+  STRING_INDEX_BASED_ON_INVALID_FIELD: string;
+  STRING_INDEX_EXPRESSION_TOO_LONG: string;
+  STRING_INVALID_INDEX_TYPE: string;
+  STRING_CANNOT_OPEN_INDEX: string;
+  STRING_TOO_MANY_INDEXES: string;
+  STRING_INDEX_NOT_EXIST: string;
+  STRING_NEED_EXCLUSIVE_ACCESS: string;
+

fcl/db/dbase/history.txt

@@ -0,0 +1,914 @@
+History of TDBF:
+
+------------------------
+Authors:
+
+- Pascal Ganaye - upto V5.002
+- Micha Nelissen - from there
+
+thanks to various people helping on details
+
+------------------------
+BUGS & WARNINGS
+  (not complete)
+
+- Multi-user support
+  - not tested well...
+  - ranges are not fully multi-user 'aware' (yet) because range is cached
+    -> race conditions can occur
+- use FIXED LENGTH index expressions: an expression which will always return
+  a string which is the same length. When returning a float you don't have to
+  worry about this of course (always fixed #bytes). String fields also return
+  fixed length expression, complete field with spaces.
+- BCB4/D4 and lower:
+    - restructure probably does not work correctly, because the field defs
+      don't know the index of the field they have to copy from (Dbf_Fields)
+- BCB3/D3 compatibility:
+    - you will NOT be able to use Int64 features:
+      - large numeric fields with zero precision (set UseFloatFields to true)
+      - datetime fields '@'
+      - double fields 'O'
+      - maybe more...look in source where Int64 is used
+    - no codepage conversion available other than oem<->ansi
+    - storedefs is not updated automatically when fielddefs are changed
+
+
+
+------------------------
+V6.3.5
+
+- fixed: crash when finalizing Dbf_Parser unit
+
+
+------------------------
+V6.3.4
+
+- fixed: improved exception handling in expression parser
+- fixed: remove temporary indexdefs at close, fixes CreateTable index creation
+- added: NULLFLAGS field recognition (foxpro field)
+- fixed: date field retrieval parser (rep by luchop)
+- fixed: BCB5 installation needs Pascal switch to link dsgnintf unit
+- fixed: avoid dependency on libc unit for freepascal target
+- fixed: index open after packtable forgot tempmode; so endexclusive did not
+    work properly (rep by sysklop)
+- chang: make TDbf.GetCurrentBuffer public
+- chang: rename TVarType to TExpressionType
+- chang: remove all SmallInt constructs from parser
+- added: export expression functions from Dbf_Parser
+- added: FFieldName to TFieldVar, to prevent need for TFieldDef to exist to get name for deletion from expression words list
+- added: "<>", not equal, expression functions
+- added: reference counting for TExprWord
+- added: shortname functionality for each function, function can be referenced by name and shortname
+- fixed: memory leak in parser upon encountering unknown variable
+- fixed: when adding record write new autoinc value to header, to file
+
+
+------------------------
+V6.3.3
+
+- fixed: compiles with freepascal, usable in lazarus
+- fixed: index delete record bug (deleting not-last entry in full page)
+- fixed: index delete record bug (deleting the only entry on a page)
+- fixed: lazarus registration issues
+- fixed: scan for $1A, not RecordSize (rep by avink)
+
+
+------------------------
+V6.3.2
+
+- fixed: use default codepage if file codepage not installed
+- fixed: range check error using swapint
+- fixed: flush index header when index flushed, ie. when creating index
+- fixed: update TDbf.IndexDefs when index added or deleted
+- fixed: update internal index names and files list when mdx index deleted
+- fixed: remove max 4000 character record length requirement
+    TDbf.GetExactRecordCount (rep by dpproj)
+- fixed: accept russian 'C' too as string field (rep by dpproj)
+- fixed: datetime native fieldtype 'T' handling, size (rep by kjteng)
+- added: support for currency field type, type 'Y' in foxpro tables
+    - nativeformat handling is re-enabled due to much easier implementation
+    - delphi 4 and higher only
+- fixed: close,open files reset indexnames,files list (rep by paez)
+- fixed: reselect index after repage, compact (rep by paez)
+- added: support for foxpro datetime fields
+- fixed: support for foxpro integer fields
+- fixed: tdbf doesn't use default codepage when opening file with langid #0
+- added: OnLanguageWarning can now specify to use default codepage (see above)
+- fixed: MDX float index with decimals (rep by emled)
+- fixed: removal of mdx flag in foxpro file; means cdx index
+
+
+------------------------
+V6.3.1
+
+- added: freepascal support, needs 1.9 (or higher)
+- fixed: strange bugs due to fparser not initialized correctly, for example
+    with expression of different index (rep by sysklop)
+- added: findrecord implemented -> find{first,next,prior,last} should now work
+- fixed: index deletion bug corner case, no records left (rep by sysklop)
+- fixed: repagefile creating empty index file (rep by paez)
+
+
+------------------------
+V6.3.0
+
+- fixed: tdbf.physicalrecno not in sync with tdataset
+- added: loPartialKey functionality on index search
+- fixed: mdx file presence not written to dbf header; index does not work (rep by paez)
+- fixed: searchkey on deleted row returns true (rep by sysklop)
+- fixed: primary index creation throws "list index out of bounds(0)" (rep by sysklop)
+
+
+------------------------
+V6.2.9
+
+- fixed: checkkeyviolation bug; should solve locking problem
+- fixed: packed structures
+- fixed: delphi 3 compatibility tdbf.translate, compile prob (rep by ferdok)
+- fixed: numeric MDX compare, translate bugs (rep by rpoverdijk)
+- fixed: GetIndexNames returns open (available) indexes
+- added: TDbf.GetAllIndexFiles returns index files present in dbf directory
+- added: TDbf.PhysicalRecordCount returns physical number of records present
+- added: TDbf.IndexDefs ( = TDbf.Indexes) for VCL compatibility
+- added: TDbfIndexDef.(Name and Expression) for VCL compatibility where
+    Name = IndexFile and Expression = SortField
+- fixed: memory leak expression tree
+- fixed: index cache flush problem causing index corruption; triggered by,
+    for example, regenerateindexes (rep by smokexjc)
+
+
+------------------------
+V6.2.8
+
+- fixed: character fields support upto 65534 characters now
+- fixed: detect, allow visual foxpro file
+- chngd: getfielddata clears user field buffer is string field empty
+- fixed: tdbf version number in delphi 7 package
+- fixed: index update on record insert (thx kirill)
+- fixed: selecting index when cursor is bof,eof; cursor moves (thx kirill)
+- fixed: create first index in mdx file fails AV, file not deleted (rep by pyostrike)
+
+
+------------------------
+V6.2.7
+
+- added: TDbf.GetKeySize, if index is active retrieves key size
+- added: TDbf.ExtractKey, extracts key for current record and index
+- fixed: TDbf.GetRecordCount AV when no dbf file open
+- fixed: memory leak not releasing fmdxfile
+- fixed: index using field datetime has time encode error (rep by paez)
+- fixed: end-of-memo not found, packtable creates large files (rep by stayathome)
+- fixed: distinct index, keys added while duplicate error (rep by sysklop)
+- fixed: when packing a table, no files are left behind
+- fixed: AV when packing while index active (rep by ltolean)
+
+
+------------------------
+V6.2.6
+
+- fixed: fcanedit is false causing indexes not to update (rep dvdneg)
+- fixed: autoinc when packing/restructuring table (rep aerceg)
+- fixed: allow creation of tablelevel 25 tables (rep cherednichenko)
+- fixed: delete last entry from index page caused overflowerror (rep by tekkan)
+
+
+------------------------
+V6.2.5
+
+- fixed: foxpro memo data size is w/o record header size
+- fixed: index search on extended ASCII values
+- added: filter options; caseinsensitive works; partialmatch does not
+    filter expressions never have partial matching
+- fixed: filter field strings compare with extended ASCII values
+- added: TDbf.GetFileNames, retrieves file names in use with current dbf
+- fixed: open exclusive, close, open exclusive triggers 'can not open'
+    happens ie. when calling PackTable (rep by tekkan)
+- added: getfilenamesstring function to retrieve filenames in a string
+- fixed: Blank memo returns data (thx aerceg)
+- fixed: no inherited call on indexdef assign (thx kirill)
+- fixed: international issue with locate (thx kirill)
+
+
+------------------------
+V6.2.4
+
+- fixed: setting memo contents overwrites only first x bytes, not all (rep by avink)
+- fixed: possible corruption in writememo, wrong offset (thx aerceg)
+- fixed: indexname truncated causing inability to select index v7 (thx delphiguru)
+- fixed: (includetrailingpathdelimiter) delphi 4 compatibility (thx bobmitch)
+- fixed: (dbffile.openindex) open NDX file fails due to empty field (thx wschenk)
+- fixed: codepage problems with dbase3 (thx arioch)
+- fixed: result of boolean fields is string type (rep by delphiguru)
+- fixed: blobstreams delphi 3 compatibility
+- fixed: remove automatically detected indexdefs of previous file at design time
+- fixed: index MDX numeric search (rep by arioch)
+- fixed: index navigation when having a lot of records with the same key
+    (rep by ledoux)
+- fixed: try harder to find a matching locale / codepage combination; any
+    codepage will do if no specific codepage is found
+
+
+------------------------
+V6.2.3
+
+- added: new assembler implementation for swapint, swapint64 (thx arioch)
+    - NOTE: 486+ if you need old, remove USE_ASSEMBLER_486_UP define
+- fixed: datetime handling in index, eg. DTOS(DATE_FIELD)
+- added: FilePathFull, this is path where the dbf is going to be opened (arioch)
+    - is not stored, only relative path is stored
+    - when set, overwrites relative path too, and relative path sets full path
+- fixed: possible AV when executing (get|set)fielddata with nil buffer
+- fixed: reading dbase 7 index tags, new structure, long index names supported
+- fixed: bug storedefs = true after .open; indirect fielddefs.update
+- fixed: index version bug causing AV; caused by new DB7 support (rep by arioch)
+- fixed: SearchKey in Edit without Post -> record twice (thx ralf)
+- fixed: TDataSet.(InsertRecord | AppendRecord) now really work instead of doing
+   nothing. NOTE: they do the same thing, as you cannot insert a record in DBF,
+   only append.
+- fixed: index bug; insert in wrong page sometimes causing various assert fails
+- added: a bunch of freeandnil instead of [x.Free; x := nil;]; should be safer
+- added: more language / locale combinations; now combinations using windows
+    codepages (1250,1251,1253,...) and (russian, greek, etc) should be possible
+- fixed: delphi 3 compatibility
+- fixed: cancel memo bug; when memo modified, release focus, cancel record then
+    memo has already written contents to file
+- chngd: absolute/relativepath properties use same handler (thx arioch)
+- fixed: AV when SearchKey called with NULL variant
+- fixed: when creating dbf, tablelevel = 25 indicates foxpro
+    NOTE: dbfglobals.defaultcreatefoxpro removed
+- added: SetIndexName throws exception when try to select non-existing index
+- fixed: index needs to convert strings OEM->ANSI before comparing; I think
+    the sorting works very nicely now, eg.: e, E, e-accent-grave, etc all same
+    NOTE: you need to rebuild all indexes because of this change
+- fixed: when creating dbf: also foxpro langids will be used and the
+    other way around...increases number of combinations
+- fixed: index bugs; first record insert in distinct index, EOF insert caused
+    AV on closing app (report thx germain)
+- fixed: memo bug; memo files with large pages (>512) had incorrect calculation
+    of position, reading false data (rep by kjteng)
+
+
+------------------------
+V6.2.2
+
+- added: IndexFieldNames property to set current index by fieldname
+- added: foxpro memo files (.fpt) support
+- fixed: indexing bug, when inserting same key at end
+- fixed: more indexing bugs...
+    - NOTE: non-leaf keys assume searchkey < nodekey
+        - this is default B+ tree
+        - previously tdbf assumed searchkey <= nodekey
+        - you may have to recreate indexes
+- chngd: FinishCreate does not need memo extension anymore
+- chngd: PackTable uses different filename now abc_1.dbf etc
+- chngd: Dbf_PgFile.pas: renamed LockFile to LockAllPages;
+    -> Kylix users should be able to compile with LockFile from Dbf_Wtil.pas
+- chngd: default locale now retrieved from GetUserDefaultLCID
+- fixed: when closing/opening dbf file, reopens indexes too (thx oleg)
+    -> fixed an AV when packtable is done and you try access an index
+- fixed: (caused by above index bug) does not find last record in index
+    -> caused dbgrid to display records twice or not at all
+- fixed: packindex now properly selects single index, so that it can be edited
+    -> previously no expression was parsed creating empty indexes (thx oleg)
+- fixed: insert/modify/delete/find records while index range active (thx paul)
+    -> findnearest function rewritten
+- fixed: foxpro table level less than dBase7 table level, now reads fields
+    correctly in dBaseIII alike format
+- fixed: when reading memo, negative blockno return empty memo instead of crash
+- fixed: using AnsiUppercase instead of Uppercase, better internalization
+- fixed: ignore addindex calls with empty index names / fields
+- fixed: Get/SetFieldData NativeFormat issue with DB7:datetime fields (thx tophet)
+- fixed: tdbfindexdef; name and field now stored uppercase to prevent
+    differences in case (thx arioch)
+- chngd: tablename property editor starts in project directory not delphi/bin
+    directory when no filepath given; if you want filepath to be current path
+    at startup of app: use '.' or '.\' as filepath (current dir)
+- chngd: dbf_globals.defaultopencode changed to getacp, seems to be more
+    compatible, especially when your codepage is not supported by dbase
+- fixed: fix for empty path in IncludeTrailingPathDelim
+
+
+------------------------
+V6.2.1
+
+- added: BeforeAutoCreate event: set DoCreate to false to prevent autocreate
+- added: polish + french message strings up to date, thx tophet+lecho
+- added: fielddefs, storedefs published property alike ttable
+    WARNING: ALPHA feature, not tested well
+- added: error handling for dbf creation, fields now checked before creating dbf
+- added: fieldtypestr in error invalid_field_type, better error string
+- fixed: preparing numeric index search, Move function had parameters wrong
+    way around....arrggh
+- fixed: error message invalid field type had invalid format type
+- fixed: index out of bounds checking better (SetEntryNo, RecurPrev)
+- fixed: lost designtime MDX indexes when opening
+- fixed: numeric indexes changes to database were not detected well causing
+    index corruption (thx ralf)
+
+
+------------------------
+V6.2
+
+- added: table level locking (TDbf.LockTable / TDbf.UnlockTable)
+    NOTE: if you're still editing a record, then LockTable will fail. Post or
+      cancel changes before trying to lock table.
+- added: filter expressions (thx paul)
+    - WARNING: feature is currently in ALPHA state !
+    - TDbf.Filter := 'your dbase expression';
+    - index functions available for filter too
+- added: expressions operators implemented: '=,<,>,<=,>=,and,or,not'
+    - you can use these for filter (but for index too)
+- added: more types for operator '+'
+- added: GetIndexNames, retrieves indexes from MDX or NDX's in dbf directory
+- added: TDbf.RegenerateIndexes, recreates all indexes active for table
+- added: index expression length checking in parser
+    new error message: STRING_INDEX_EXPRESSION_TOO_LONG
+- added: polish error messages in Dbf_Str_PL.pas
+- fixed: pass index options from object inspector to createindex (thx germain)
+- fixed: now when closing dbf file, at runtime MDX indexes are removed from
+  indexes list, but not at design time, to keep indexes from disappearing from
+  list. You should always add/remove NDX indexes yourself! (because the dbf
+  file does not know about them).
+- fixed: bug '0.0 is not valid timestamp' is fixed (thx felipe)
+    - I now understand VCL TDataSet..NativeFormat better -> TDbf retrieves in
+      native format, then VCL translates to destination format
+    - it'll be a little slower, but more compatible
+    - get/setfielddata override in TDbf removed
+
+
+
+------------------------
+V6.1.4
+
+- fixed: it now compiles (shame on me)
+- note:  experimental new index insert order to check first before
+    inserting record into database
+
+
+------------------------
+V6.1.3
+
+- chnge: same functionality, clearer implementation of autocreate in
+    TDbf.InternalOpen
+- fixed: automagic creation of MDX indexes in TDbf.Indexes property if not exist
+- added: on creation of MDX indexes now automagically tries exclusive mode
+    itself, if fails, then same as old behaviour (exception)
+- fixed: order autoinc assignment to new record and updating index, previously
+    empty index. Now first autoinc is assigned, then indexes updated.
+- fixed: auto-detect non-present index in MDX file and create it
+- fixed: crash on master/detail range when no index or no field selected
+- fixed: try exclusive when creating, reopened creating causing filesize = 0
+    now it reopens non-create, ie normally
+- added: checking whether field type okay for specified table level;
+    new error string: 'STRING_INVALID_FIELD_TYPE'
+- fixed: searchkey (using variants) on numeric MDX index; code inserted to
+    convert to bcd
+
+
+------------------------
+V6.1.2
+
+- fixed: delphi 3 compatibility issues
+- fixed: bug in check exclusive access (thx martin)
+- fixed: correct dbf version when creating dbf from fielddefs (thx martin)
+- fixed: correct dbf version when creating memo file along with dbf ( " )
+- added: set method for physicalrecno
+- fixed: when using masterlink on non-string field, proper field conversion
+- fixed: master/detail bug, empty range at start of file
+
+
+------------------------
+V6.1.1
+
+- fixed: bug when opening dbf file with index in indexes property that does
+  not yet exist. Now it will create index.
+- fixed: delphi 4 compatibility (thx dayman)
+- fixed: readonly mode now also shared access, bug not showing new records
+- fixed: bug when reading past EOF in memo results in crash or garbage
+- fixed: bug when index somewhat corrupt ( = record duplicate in index),
+  - bug caused repeats of the same record
+  - now skips records which are the same; based on recno
+- fixed: bug in IDE, when table open, clicking on IndexName caused table to
+  close, (internal exception was generated)
+
+
+------------------------
+V6.1
+
+- added: project file for BCB6 (tdbf_c6*)
+- added: polish mazovia support (db4 id $69, codepage 620, locale LANG_POLISH,
+    dbase7 id: 'DB620PO1')
+- added: Locate uses index search if simple index
+- fixed: bug 'divide by zero', in 1024b memo (thx ltolean)
+- fixed: bug in decimal separator, read & not write field (thx michaelbelling)
+- fixed: bug in indexing: extracting string field values from database
+- NOTE: index function UPPERCASE/LOWERCASE introduced, but you should use
+    UPPER/LOWER for dbase compatibility
+- fixed: dbase 7 files, if no extra properties present, don't read them
+- added: buffering & caching
+  - disabled by default, see Dbf_Common.Inc 'USE_CACHE'
+  - you will need to add 'dbf_avl.pas' and 'dbf_pgcfile.pas' to tdbf project
+    to be able to use them (already done in tdbf_c5r.bpk)
+  - buffering: read & write ahead for files
+  - caching: of index pages in memory
+  - can improve indexing speed over network connections A LOT, especially
+    if you have some memory to spare, to save the new index in
+
+
+------------------------
+V6.0.3
+
+- fixed: bug in pagefile, writerecord not increasing recordcount well (arghh)
+- fixed: bug in SetRange (empty range) (thx jenswahl)
+- fixed: bug when appending records, header record count not updated (thx ron)
+- fixed: bug when translating empty memo, AV (thx vern baker)
+- fixed: bug when indexing empty table, unusable index (thx nogueira)
+- fixed: bugs in RegenerateIndexes, index header 'lost'
+- chang: handling of making valid key in SearchKey -> could solve bug stefano?
+    - now use StringOfChar, instead of manual fill with spaces
+- added: zap, emptytable (you can guess what it does ;-))
+- added: dutch error messages (Dbf_Str_NL.pas)
+
+
+------------------------
+V6.0.2
+
+- fixed: bug in TryExclusive
+- fixed: bug in SearchKey, wrong array index causing searches to fail
+- fixed: bug in TPageFile, chopping file size on multipage record (MDX indexes)
+- fixed: bug in RepageFile, crashes when deleting/reindexing MDX index
+- chang: speed optimisation in TPagedFile.WriteRecord, calc new record count
+- fixed: specifying indexname for MDX longer than 10 characters, now truncates
+
+
+------------------------
+V6.0.1
+
+- added: french strings in Dbf_Str_FR.pas
+- added: index functions uppercase and lowercase
+- fixed: index bug using dbase III files
+- fixed: re-indexing existing (NDX) file fails
+- fixed: index bug (NDX) concerning expression index
+- chnge: TPagedFile.GetRecordCount now only retrieves file size if not in
+    multi-user share mode, to speed up things a little bit
+- fixed: index bug splitting pages
+- fixed: page file set record count, now using pageoffset next page
+- fixed: reading of type III memos
+- added: translation of memo text fields (transliterate = true). Handling of
+    translation should now be consistent between memo fields and char fields.
+
+
+------------------------
+V6.0
+
+- fixed: ftDateTime handling field size
+- fixed: writing memo version byte
+- added: VCL ftFixedChar will be converted to 'C' (character) field
+- added: property DateTimeHandling (dtDateTime, dtBDETimeStamp)
+
+  Up to now TDbf used to store values in '@' (ftDateTime) fields as Delphi
+  type TDateTime. To be compatible with the BDE, however, datetimes need to be
+  stored as BDE type TimeStamp (which is milliseconds elapsed since 01/01/0001
+  plus one day). To provide backward compatibility you can use this property
+  to determine whether TDbf will read and write datetime values as TDateTime
+  or as BDE TimeStamp. Default now is dtBDETimeStamp but in order to read
+  values in existing TDbf tables you need to choose dtDateTime. If you want to
+  convert your data to be BDE compatible have a look at the new procedure
+  CopyFrom.
+
+- added: procedure CopyFrom(DataSet: TDataSet; FileName: string;
+            DateTimeAsString: boolean; Level: Integer);
+
+  Use this procedure to copy the contents of a given DataSet into a new TDbf
+  table. DataSet is the TDataSet you want to copy from, FileName is the
+  complete (including path and extension) filename of the new table.
+  DateTimeAsString determines whether datetime fields should be converted to
+  string fields in the target table. This is especially useful if you want to
+  use TDbf to create mailing sources for a text processor for example. If this
+  parameter is set True an event OnCopyDateTimeAsString is triggered where you
+  can override the default datetime-to-string conversion which is based on
+  your current local settings. Level determines the TableLevel of the target
+  table.
+
+  In order to convert existing datetime values into a BDE compatible format
+  use this procedure as follows: drop two instances of TDbf on a form, set
+  DateTimeHandling of TDbf1 to dtDateTime and connect it with the existing
+  table. Make sure TDbf2 is set to dtBDETimeStamp and call CopyFrom with
+  DataSet = TDbf1 and DateTimeAsString = False. You can then replace the old
+  table with the new one and use TDbf in dtBDETimeStamp mode in your
+  application.
+
+
+------------------------
+V5.9.9
+
+- added: TryExclusive method to 'try go exclusive' eg.:
+    ...
+    Dbf1.TryExclusive;
+    if Dbf1.Exclusive then
+    begin
+      Dbf1.AddIndex(....);
+      Dbf1.EndExclusive;
+    end else begin
+      ShowMessage('somebody else is using file');
+    end;
+    ...
+- fixed bug: adding records while string index active don't show up
+- fixed bug: clear field when backspace hit
+- fixed bug: not saving memo byte in version data correctly
+- fixed bug: sometimes crash when opening empty database
+- fixed bug: DB desktop writes index type 'F' instead of 'N'
+- fixed bug: writing negative integer values to fields
+- fixed bug: assertion failure when adding a lot of the same data in index
+- changed: default open mode is now normal instead of autocreate
+
+
+------------------------
+V5.9.8
+
+- added integer and smallint support to STR() in expression indexes
+- fixed bug: creating dbf files, index field not found, due to uppercase names
+- fixed bug: float conversion in STR() more alike dbase
+- fixed bug: parser crashes while removing constants in optional parameters
+
+
+------------------------
+V5.9.7
+
+- added Variant support to SearchKey & SetRange
+- fixed bug: NDX index split
+- fixed bug: DeleteIndex could not find index
+- fixed bug: MDX with dBaseIII locale problem
+- fixed bug: descending sort index
+- demo app v1.3 will compile with this package
+- much thanks to Paul v.H. for help on this release
+
+
+------------------------
+V5.9.6
+
+- added Int64 support for index expressions
+- updates to support for Kylix (dbf_wtil.pas)
+- fixed bug: Parser.GetResultType for single field indexes
+- fixed bug: IndexFile.ExtractKeyFromBuffer integer -> numeric conversion
+- fixed bug: creating NDX index crashes
+- fixed bug: creating NDX index wrong locale
+- fixed bug: while filtering wrong memo contents retrieved
+
+
+------------------------
+V5.9.5
+
+- added: beta support for Kylix (2)
+- fixed: last field missing (reported by wimb and many others)
+- fixed: Delphi 3 compatibility problem in Dbf_Fields.pas
+- fixed: calculated fields bug (sometimes not show data)
+
+
+------------------------
+V5.9.4
+
+- added: beta support for numeric indexes in MDX
+- changes Delphi 3 compatible (as reported by crest)
+- change Delphi 4 compatible: .Items[I].Free instead of .Delete(I)
+- fixed store that an index is an expression index -> indexes read from
+  file are 'always' tagged as expression index...will keep you updated
+- change TDbf_D6*.dpk -> they work now...dbf.dcr problem resolved
+- fixed bug: detect end of header, invalid dbf
+
+
+------------------------
+V5.9.3
+
+- added IndexName property list...listing MDX / NDX indexes
+- added distinct index support
+  - use ixPrimary in IndexOptions to create
+  - checks key violations
+- removed RES file requirement from CB packages
+- fixed NDX index bug: opening index fails (out of bounds) (report by thx)
+- fixed MDX open dBase VII index bug...language id mismatch
+- fixed MDX multiple index bug: key was calculated before selection
+  instead of after, oops :-(
+
+
+------------------------
+V5.9.2
+
+- added support for creating tables in different locales/codepages
+  - default is ANSI / Western European (= ENGLISH_UK currently)
+  - eg. to create table in US locale
+      DbfGlobals.CodePage := 437;
+      DbfGlobals.Locale := LANG_ENGLISH or (SUBLANG_ENGLISH_US shl 10);
+- changed structure: Mdx & Ndx implemented as descendants of TIndexPage
+- new (public) DisableResyncOnPost property, if enabled, will suppress resync
+  after post -> will increase speed. Use it if you are editing all records.
+- removed global variable FDbfExePath
+- fixed memory leak: expression record
+- fixed setfielddata.string bug (reported by atilla)
+
+
+------------------------
+V5.9.1
+
+- added duplicate field name handling
+- fixed index close bug
+- added TDbfIndexDef.Assign
+- added TDbf.TableLevel property, indicates table level like TTable
+- added support for creating dBase7 databases
+  - set TTable.TableLevel to 7 before calling CreateTable
+- added fieldlist copy feature VCL->DBF
+  - eg.:
+    FieldDefs: TFieldDefs;
+    DbfFieldDefs: TDbfFieldDefs;
+    ...
+    DbfFieldDefs.Assign(FieldDefs);
+  - float/integer fields will get a default size / precision
+  - CopyFrom will get index of field that is assigned
+- added restructure procedure
+  - probably still buggy -> TEST WELL before using
+  - table needs to be closed before calling restructuretable
+  - create TDbfFieldDefs list
+  - TDbfFieldDef.CopyFrom
+    - is index of current table field to copy
+    - CopyFrom = -1 means add
+  - eg.:
+    NewFieldDefs: TDbfFieldDefs;
+    NewFieldDef: TDbfFieldDef;
+    Dbf1: TDbf;
+    ...
+    // create new field list
+    NewFieldDefs := TDbfFieldDefs.Create(Self);
+    // assign current list
+    NewFieldDefs.Assign(Dbf1.DbfFieldDefs);
+    // assume first field is string, 20 wide, make larger to 40
+    NewFieldDefs.Items[0].Size := 40;
+    // rename second field to 'RENAMED'
+    NewFieldDefs.Items[1].FieldName := 'RENAMED';
+    // add a float field
+    NewFieldDef := NewFieldDefs.AddFieldDef;
+    NewFieldDef.FieldName := 'NEW_FLOAT';
+    NewFieldDef.FieldType := ftFloat;
+    NewFieldDef.Size := 10;
+    NewFieldDef.Precision := 3;
+    // restructure table and pack
+    Dbf1.Restructure(NewFieldDefs, true);
+    // restructure table and not pack
+    //Dbf1.Restructure(NewFieldDefs, false);
+    // free mem
+    NewFieldDefs.Free;
+
+
+------------------------
+V5.9
+
+- Master / detail supported!
+  - NOTE: TDbf can only have another TDbf as master!
+  - MasterFields is an expression
+- TableName / FilePath handling changed...bug fixed
+  if FilePath is non-empty then a file assigned to TableName without path
+  will not clear FilePath -> bug fixed reading from DFM
+- expression with variables: 'function/operand has too many arguments' fixed
+- memory leaks fixed
+- index repaging fixed
+- index cursor move next fixed (possible problem at EOF)
+
+
+------------------------
+V5.8.2
+
+- SetTableName simplified, extract full path
+- IsDeleted fixed
+- PackTable fixed
+- Grouping of files in TDbfDatabase removed
+  -> each TDbf has it's own TDbfFile, no sharing -> some bugs fixed
+- Renamed global DbfDefaultDatabase to DbfGlobals
+- Renamed files to Dbf_* to distinguish a little from others, note:
+  - FieldDef -> Dbf_Fields
+  - Index* -> Dbf_Idx*
+  - Parse* -> Dbf_Prs*; except Parser -> Dbf_Parser
+- AutoInc field bugs fixed:
+  - generate value at post
+  - multi-user share aware
+- IncludeTrailingBackslash added for D4 and earlier
+
+
+------------------------
+V5.8.1
+
+- field types: size=1..4, prec=0 is always smallint
+
+
+------------------------
+V5.8
+
+- MAJOR COOL: field default values are supported!
+  - you can't create table with default values yet, (dBase 7 only)
+  - if table is made with DB2K, dBase 7, default values are read from header
+- exclusive access is required for PackTable to avoid corruption
+- automatically add last backslash in FilePath, now really works
+- sorry, 5.7.7 didn't compile
+- renamed MSWINDOWS defs to WIN32, which is more standard
+- DBF locking is now BDE compatible, not sure about index & memo
+- Added TDbf.UseFloatFields, when dbffieldtype = 'N', then UseFloatFields
+  will force ftFloat fields, otherwise when precision is zero an integer field
+  will be used, NOTE: UseFloatFields is default true
+- structure change: passing data via constructor to assigning through
+  properties (cleaner)
+
+
+------------------------
+V5.7.7
+
+- Italian message strings in Strings_ITA.pas (thanks delphiguru)
+- D7 project files
+- automatically add last backslash in FilePath
+- deleted records are now checked with (= '*') instead of (<> ' ')
+  -> slightly different runtime behaviour if another character is present
+
+
+------------------------
+V5.7.6
+
+- _DBASELOCK field can now be in any position
+- locking bug fixed
+- ShowDeleted bug fixed
+- Delete method bug fixed
+- Inserting a record will return physical recno: -1
+
+
+------------------------
+V5.7.5
+
+- _DBASELOCK field is hidden from normal view
+- changes from Paul van Helden applied:
+  - assigning Filtered property
+  - default size/precision float field
+- Int64 support enabled for Delphi 4
+- AutoInc fields enabled for Delphi 4
+
+
+------------------------
+V5.7.4
+
+- Delphi 4 date field bug, worked on, untested, I hope it works now
+- Delphi 7: dbf_reg needs ExptIntf as unit
+- constructing field list bug fixed...more dbase 7 compatible
+  now reads until field termination character found
+- various memory leaks fixed
+- when last field is named _DBASELOCK it will update it when start edit:
+  - first 2 bytes: change count is incremented
+  - next  3 bytes: current time hour,minute,second
+  - next  3 bytes: current date year,month,day
+  - next  0..16 bytes: name of user who locked the record
+
+
+------------------------
+V5.7.3
+
+- unique indexes supported
+- descending indexes supported
+- parser bugs fixed:
+  - clearing expression
+  - resulting length from simple field
+
+
+------------------------
+V5.7.2
+
+- striving for delphi 4 and older compatibility.... (thanks don)
+  - TDbf.GetFieldData/SetFieldData seems D5 only
+
+
+------------------------
+V5.7.1
+
+- parser core bugs fixed:
+  - multiple arguments
+  - integer arguments
+- float fields bug fixed: storing data
+- index bugs fixed:
+  - auto detecting float result from expression
+  - updating index when record edited
+- parser will now only accept a dot as decimal separator whatever your
+  DecimalSeparator character is. A comma will always be the argument separator.
+
+
+------------------------
+V5.7.0
+
+- Dbf.dcr added
+- Packages added
+  - all named tdbf_..., see package.txt
+  - I hope they all work...I haven't been able to test them
+- GetFieldData method: boolean field type widened to Word length
+- Index Expression Support !!!
+  - used FWS expression parser from torry.net
+  - still adding functions but basic STR() and DTOS() and '+' are implemented
+- Languages replaced by own LCID list so that it can compile under D4/C4 and older
+
+
+------------------------
+V5.6.5
+
+- fixed indexing bugs
+  - locale mismatch
+  - opening ndx files corrupted them
+- demo works again!
+- some help on new events:
+  - OnLanguageWarning: when a specified codepage in dbf file is not present
+    on computer, then this event is fired, you can force a different codepage
+    or just OEM or ANSI
+  - OnLocaleError: when locale used in index is not present on computer this
+    event is fired. When using wrong locale, you can mess up the index!!!
+    Again, you can force to use the index, default is to close.
+  - OnIndexMissing: when dbf file has flag that there is a MDX index attached
+    to this dbf file, then when this MDX file is not present, this event is fired.
+    You need to override it if you want to copy another MDX index to this database,
+    default is to break link to MDX file.
+
+
+------------------------
+V5.6.4
+
+- fixed 'CloseDbf' bug (thanks Paul, Eugeny) when opening / closing tables many times
+- Delphi 3 supported again (removed Int64 reference & recoding) (test compile D3, anyone?)
+
+
+------------------------
+V5.6.3
+
+- fixed CreateTable bug (thanks Eugeny)
+  - there seemed heavy need for this fix :-)
+- fixed Memo bug (thanks Christian)
+
+
+------------------------
+V5.6.2
+
+- fixed stupid Undelete bug (thanks Gvido)
+- fixed NDX index list bugs
+- fixed indexing bugs
+- included dbflang.inc in package
+
+
+------------------------
+V5.6.1
+
+- language support...continued (locale support added). index sorting is now
+  done using locale-dependent CompareString from Windows. However, it seems
+  to be always case insensitive.
+- FIndexes bug fixed, indexfile always created as NDX index, now it is created
+  based only as NDX if .NDX added, otherwise in MDX file. (thanks thiaux for pointing it out)
+- new FOnIndexMissing event, when an MDX index is missing, it will notify you asking to delete
+  the link or close file
+- new ExactRecordCount property, it will give #records you are viewing:
+    RecordCount - #deleted records - #records not in filter
+  warning: this will visit the whole dataset each time you request the property,
+  so it will be very slow on larger tables
+
+
+------------------------
+V5.6
+
+- language support (codepages)
+  - NOTE: this is Win32 compatible only, whole project is now Win32 compatible only for sure
+    can anyone translate the codepages to linux? to make it linux compatible again
+- TTranslateEvent changed, you have to return an Integer with length of Dest, or -1 to let it be calculated automatically
+
+
+------------------------
+V5.5
+
+- Parser now in separate class: potential to parse more complex expressions, including multi-field indexes and such
+- Linux compatible support...test anyone...I don't have Kylix...
+- Bugfixes in InternalDelete and PackTable, thanks jimcampbel
+
+
+------------------------
+V5.4
+
+- Multi-user support
+- Some indexing bugs resolved
+
+
+------------------------
+V5.3.1
+
+- TIndexPage.FindNearest uses binary search instead of linear
+
+
+------------------------
+V5.3
+
+- SearchKey method searches on index for a given key
+    SearchKeyType: stEqual, stGreaterEqual, stGreater
+- MDX index support: index names with no extension now create a MDX index
+    belonging to dbf file
+- SetRange method instead of BracketLow/BracketHigh, rewritten range support
+- Index.SetPhysicalRecNo much faster, using Find instead of searching recno
+
+
+------------------------
+V5.002 and older
+
+- see original TDbf website?

fcl/db/dbase/package.txt

@@ -0,0 +1,11 @@
+Help on packages:
+
+TDbf_<< (D)elphi | (C)++Builder | (K)ylix | (L)azarus >> << Version >> << (D)esign | <R>untime >>
+
+eg:
+
+TDbf_c5d    = C++ Builder 5 design time package
+TDbf_d6r    = Delphi 6 runtime package
+TDbf_l      = Lazarus design/runtime package
+
+NOTE: Version 4 and earlier don't have designtime/runtime separated packages

fcl/db/dbase/readme.txt

@@ -0,0 +1 @@
+See History.txt.

fcl/db/dbase/testdbf.pp

@@ -2,7 +2,7 @@ program dumpdb;
 
 {$i+}
 
-uses db,dbf,sysutils;
+uses DB,Dbf,SysUtils;
 
 Procedure DumpTable (Const TN,FN : String);