+ version 6.3.7 of Tdbf component

fcl/db/dbase/Dbf.pas

@@ -14,6 +14,7 @@ uses
   Dbf_Parser,
   Dbf_Cursor,
   Dbf_Fields,
+  Dbf_PgFile,
   Dbf_IdxFile;
 // If you got a compilation error here or asking for dsgnintf.pas, then just add
 // this file in your project:
@@ -143,6 +144,7 @@ type
     FMasterLink: TDbfMasterLink;
     FParser: TDbfParser;
     FBlobStreams: PDbfBlobList;
+    FUserStream: TStream;  // user stream to open
     FTableName: string;    // table path and file name
     FRelativePath: string;
     FAbsolutePath: string;
@@ -151,6 +153,7 @@ type
     FFilterBuffer: PChar;
     FTempBuffer: PChar;
     FEditingRecNo: Integer;
+    FLanguageID: Byte;
     FTableLevel: Integer;
     FExclusive: Boolean;
     FShowDeleted: Boolean;
@@ -177,7 +180,6 @@ type
     function GetIndexName: string;
     function GetVersion: string;
     function GetPhysicalRecNo: Integer;
-    function GetLanguageID: Integer;
     function GetLanguageStr: string;
     function GetCodePage: Cardinal;
     function GetExactRecordCount: Integer;
@@ -191,6 +193,7 @@ type
     procedure SetFilePath(const Value: string);
     procedure SetTableName(const S: string);
     procedure SetVersion(const S: string);
+    procedure SetLanguageID(NewID: Byte);
     procedure SetDataSource(Value: TDataSource);
     procedure SetMasterFields(const Value: string);
     procedure SetTableLevel(const NewLevel: Integer);
@@ -203,6 +206,7 @@ type
     procedure UpdateRange;
     procedure SetShowDeleted(Value: Boolean);
     procedure GetFieldDefsFromDbfFieldDefs;
+    procedure InitDbfFile(FileOpenMode: TPagedFileMode);
     function  ParseIndexName(const AIndexName: string): string;
     function  GetDbfFieldDefs: TDbfFieldDefs;
     function  SearchKeyBuffer(Buffer: PChar; SearchType: TSearchKeyType): Boolean;
@@ -351,13 +355,14 @@ type
     property AbsolutePath: string read FAbsolutePath;
     property DbfFieldDefs: TDbfFieldDefs read GetDbfFieldDefs;
     property PhysicalRecNo: Integer read GetPhysicalRecNo write SetPhysicalRecNo;
-    property LanguageID: Integer read GetLanguageID;
+    property LanguageID: Byte read FLanguageID write SetLanguageID;
     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 UserStream: TStream read FUserStream write FUserStream;
     property DisableResyncOnPost: Boolean read FDisableResyncOnPost write FDisableResyncOnPost;
   published
     property DateTimeHandling: TDateTimeHandling
@@ -437,16 +442,21 @@ uses
   Libc,
 {$endif}  
   Types,
-{$endif}
   Dbf_Wtil,
+{$endif}
 {$ifdef DELPHI_6}
   Variants,
 {$endif}
-  Dbf_PgFile,
   Dbf_IdxCur,
   Dbf_Memo,
   Dbf_Str;
 
+{$ifdef FPC}
+const
+  // TODO: move these to DBConsts
+  SNotEditing = 'Dataset not in edit or insert mode';
+  SCircularDataLink = 'Circular datalinks are not allowed';
+{$endif}
 
 //==========================================================
 //============ TDbfBlobStream
@@ -740,11 +750,12 @@ var
   lPhysicalRecNo: Integer;
 //  s: string;
 begin
-  if (FDbfFile.RecordCount<1) or (FCursor=nil) then
+  if FCursor = nil then
   begin
     Result := grEOF;
     exit;
   end;
+
   pRecord := pDBFRecord(Buffer);
   acceptable := false;
   repeat
@@ -762,7 +773,6 @@ begin
           if Acceptable then begin
             Result := grOK;
           end else begin
-            //FCursor.Last;
             Result := grEOF
           end;
         end;
@@ -772,7 +782,6 @@ begin
           if Acceptable then begin
             Result := grOK;
           end else begin
-            //FCursor.First;
             Result := grBOF
           end;
         end;
@@ -781,7 +790,7 @@ begin
     if (Result = grOK) then
     begin
       lPhysicalRecNo := FCursor.PhysicalRecNo;
-      if (lPhysicalRecNo > FDbfFile.RecordCount) or (lPhysicalRecNo <= 0) then
+      if not FDbfFile.IsRecordPresent(lPhysicalRecNo) then
       begin
         Result := grError;
       end else begin
@@ -999,6 +1008,24 @@ begin
   InternalInitFieldDefs;
 end;
 
+procedure TDbf.InitDbfFile(FileOpenMode: TPagedFileMode);
+begin
+  FDbfFile := TDbfFile.Create;
+  if FStorage = stoMemory then
+  begin
+    FDbfFile.Stream := FUserStream;
+    FDbfFile.Mode := pfMemoryOpen;
+  end else begin
+    FDbfFile.FileName := FAbsolutePath + FTableName;
+    FDbfFile.Mode := FileOpenMode;
+  end;
+  FDbfFile.AutoCreate := false;
+  FDbfFile.UseFloatFields := FUseFloatFields;
+  FDbfFile.DateTimeHandling := FDateTimeHandling;
+  FDbfFile.OnLocaleError := FOnLocaleError;
+  FDbfFile.OnIndexMissing := FOnIndexMissing;
+end;
+
 procedure TDbf.InternalInitFieldDefs; {override virtual abstract from TDataset}
 var
   MustReleaseDbfFile: Boolean;
@@ -1009,13 +1036,7 @@ 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;
+      InitDbfFile(pfReadOnly);
       FDbfFile.Open;
       MustReleaseDbfFile := true;
     end;
@@ -1074,7 +1095,10 @@ begin
   FreeAndNil(FDbfFile);
 
   // does file not exist? -> create
-  if not FileExists(FAbsolutePath + FTableName) and (FOpenMode in [omAutoCreate, omTemporary]) then
+  if ((FStorage = stoFile) and 
+        not FileExists(FAbsolutePath + FTableName) and 
+        (FOpenMode in [omAutoCreate, omTemporary])) or
+     ((FStorage = stoMemory) and (FUserStream = nil)) then
   begin
     doCreate := true;
     if Assigned(FBeforeAutoCreate) then
@@ -1086,13 +1110,7 @@ begin
   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;
+  InitDbfFile(DbfOpenMode[FReadOnly, FExclusive]);
   FDbfFile.Open;
 
   // fail open?
@@ -1108,6 +1126,7 @@ begin
     xBaseVII: FTableLevel := 7;
     xFoxPro:  FTableLevel := TDBF_TABLELEVEL_FOXPRO;
   end;
+  FLanguageID := FDbfFile.LanguageID;
 
   // build VCL fielddef list from native DBF FieldDefs
 (*
@@ -1215,14 +1234,6 @@ begin
     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
@@ -1249,8 +1260,7 @@ begin
   // 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;
+      FBlobStreams[I].Cancel;
   // try to lock this record
   FDbfFile.LockRecord(FEditingRecNo, @pDbfRecord(ActiveBuffer).DeletedFlag);
   // succeeded!
@@ -1385,13 +1395,8 @@ begin
         end;
       end;
 
-      FDbfFile := TDbfFile.Create(FAbsolutePath + FTableName);
-      FDbfFile.Mode := pfExclusiveCreate;
-      FDbfFile.AutoCreate := true;
+      InitDbfFile(pfExclusiveCreate);
       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;
@@ -1399,6 +1404,7 @@ begin
       else
         {4:} FDbfFile.DbfVersion := xBaseIV;
       end;
+      FDbfFile.FileLangID := FLanguageID;
       FDbfFile.Open;
       FDbfFile.FinishCreate(DbfFieldDefs, 512);
 
@@ -1446,12 +1452,7 @@ begin
   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;
+  InitDbfFile(pfExclusiveOpen);
   FDbfFile.Open;
 
   // do restructure
@@ -1749,7 +1750,7 @@ begin
     // already in exclusive mode?
     FDbfFile.TryExclusive;
     // update file mode
-    FExclusive := FDbfFile.Mode in [pfMemory..pfExclusiveOpen];
+    FExclusive := not FDbfFile.IsSharedAccess;
     FReadOnly := FDbfFile.Mode = pfReadOnly;
   end else begin
     // just set exclusive to true
@@ -1765,7 +1766,7 @@ begin
     // call file handler
     FDbfFile.EndExclusive;
     // update file mode
-    FExclusive := FDbfFile.Mode in [pfMemory..pfExclusiveOpen];
+    FExclusive := not FDbfFile.IsSharedAccess;
     FReadOnly := FDbfFile.Mode = pfReadOnly;
   end else begin
     // just set exclusive to false
@@ -1779,6 +1780,10 @@ var
   MemoFieldNo: Integer;
   lBlob: TDbfBlobStream;
 begin
+  // check if in editing mode if user wants to write
+  if (Mode = bmWrite) or (Mode = bmReadWrite) then
+    if not (State in [dsEdit, dsInsert]) then
+      DatabaseError(SNotEditing, Self);
   // already created a `placeholder' blob for this field?
   MemoFieldNo := Field.FieldNo - 1;
   if FBlobStreams[MemoFieldNo] = nil then
@@ -1963,6 +1968,11 @@ var
 begin
   // init vars
   Result := 0;
+
+  // check if FCursor open
+  if FCursor = nil then
+    exit; 
+
   // store current position
   prevRecNo := FCursor.SequentialRecNo;
   FCursor.First;
@@ -2101,6 +2111,13 @@ begin
   FIndexDefs.Assign(Value);
 end;
 
+procedure TDbf.SetLanguageID(NewID: Byte);
+begin
+  CheckInactive;
+  
+  FLanguageID := NewID;
+end;
+
 procedure TDbf.SetTableLevel(const NewLevel: Integer);
 begin
   if NewLevel <> FTableLevel then
@@ -2641,7 +2658,7 @@ end;
 
 procedure TDbf.SetDataSource(Value: TDataSource);
 begin
-{$ifndef FPC_VERSION}
+{$ifndef FPC}
   if IsLinkedTo(Value) then
   begin
 {$ifdef DELPHI_4}
@@ -2650,7 +2667,7 @@ begin
     DatabaseError(SCircularDataLink);
 {$endif}
   end;
-{$endif}
+{$endif}  
   FMasterLink.DataSource := Value;
 end;
 

fcl/db/dbase/Dbf_Avl.pas

@@ -1,425 +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.
+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

@@ -5,9 +5,7 @@
 
 // enables assembler routines, 486+ only
 
-{$ifdef cpui386}
-  {$define USE_ASSEMBLER_486_UP}
-{$endif cpui386}  
+{$define USE_ASSEMBLER_486_UP}
 
 // test compatibility
 
@@ -157,6 +155,14 @@
   {$mode delphi}
   {$h+}
 
+{$ifndef CPUI386}
+  {$undef USE_ASSEMBLER_486_UP}
+{$endif}
+
+{$ifdef USE_ASSEMBLER_486_UP}
+  {$asmmode intel}
+{$endif}
+
   {$define SUPPORT_INT64}
   {$define SUPPORT_DEFAULT_PARAMS}
   {$define SUPPORT_NEW_TRANSLATE}

fcl/db/dbase/Dbf_Common.pas

@@ -17,7 +17,7 @@ uses
 
 const
   TDBF_MAJOR_VERSION      = 6;
-  TDBF_MINOR_VERSION      = 35;
+  TDBF_MINOR_VERSION      = 37;
   TDBF_SUB_MINOR_VERSION  = 0;
 
   TDBF_TABLELEVEL_FOXPRO = 25;
@@ -86,13 +86,15 @@ function IncludeTrailingPathDelimiter(const Path: string): string;
 function GetCompletePath(const Base, Path: string): string;
 function GetCompleteFileName(const Base, FileName: string): string;
 function IsFullFilePath(const Path: string): Boolean; // full means not relative
+{$ifndef SUPPORT_NEW_FIELDDATA}
 function DateTimeToBDETimeStamp(aDT: TDateTime): double;
 function BDETimeStampToDateTime(aBT: double): TDateTime;
+{$endif}
 function  GetStrFromInt(Val: Integer; const Dst: PChar): Integer;
-procedure GetStrFromInt_Width(Val: Integer; const Width: Integer; const Dst: PChar);
+procedure GetStrFromInt_Width(Val: Integer; const Width: Integer; const Dst: PChar; const PadChar: Char);
 {$ifdef SUPPORT_INT64}
 function  GetStrFromInt64(Val: Int64; const Dst: PChar): Integer;
-procedure GetStrFromInt64_Width(Val: Int64; const Width: Integer; const Dst: PChar);
+procedure GetStrFromInt64_Width(Val: Int64; const Width: Integer; const Dst: PChar; const PadChar: Char);
 {$endif}
 procedure FindNextName(BaseName: string; var OutName: string; var Modifier: Integer);
 {$ifdef USE_CACHE}
@@ -101,7 +103,7 @@ function GetFreeMemory: Integer;
 
 // 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); {$ifdef USE_ASSEMBLER_486_UP}pascal;{$endif}
+procedure SwapInt64(Value, Result: Pointer); register;
 
 function TranslateString(FromCP, ToCP: Cardinal; Src, Dest: PChar; Length: Integer): Integer;
 
@@ -165,7 +167,7 @@ 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);
+procedure GetStrFromInt_Width(Val: Integer; const Width: Integer; const Dst: PChar; const PadChar: Char);
 var
   Temp: array[0..10] of Char;
   I, J, K, Sign: Integer;
@@ -189,7 +191,7 @@ begin
   // add spaces
   for K := 0 to Width - I - J - 1 do
   begin
-    Dst[J] := '0';
+    Dst[J] := PadChar;
     Inc(J);
   end;
   // if field too long, cut off
@@ -206,7 +208,7 @@ end;
 
 {$ifdef SUPPORT_INT64}
 
-procedure GetStrFromInt64_Width(Val: Int64; const Width: Integer; const Dst: PChar);
+procedure GetStrFromInt64_Width(Val: Int64; const Width: Integer; const Dst: PChar; const PadChar: Char);
 var
   Temp: array[0..19] of Char;
   I, J, K: Integer;
@@ -231,7 +233,7 @@ begin
   // add spaces
   for K := 0 to Width - I - J - 1 do
   begin
-    Dst[J] := '0';
+    Dst[J] := PadChar;
     inc(J);
   end;
   // if field too long, cut off
@@ -303,9 +305,12 @@ begin
   until I = 0;
   // done!
 end;
+
 {$endif}
 
-function DateTimeToBDETimeStamp(aDT: TDateTime): Double;
+{$ifndef SUPPORT_NEW_FIELDDATA}
+
+function DateTimeToBDETimeStamp(aDT: TDateTime): double;
 var
   aTS: TTimeStamp;
 begin
@@ -313,7 +318,7 @@ begin
   Result := TimeStampToMSecs(aTS);
 end;
 
-function BDETimeStampToDateTime(aBT: Double): TDateTime;
+function BDETimeStampToDateTime(aBT: double): TDateTime;
 var
   aTS: TTimeStamp;
 begin
@@ -321,6 +326,8 @@ begin
   Result := TimeStampToDateTime(aTS);
 end;
 
+{$endif}
+
 //====================================================================
 
 {$ifndef SUPPORT_FREEANDNIL}
@@ -400,19 +407,21 @@ 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;
+procedure SwapInt64(Value {EAX}, Result {EDX}: Pointer); register;
+asm
+  XCHG EAX, ECX
+{ 
+        single byte, on Pentium+ is not to be data move, but just renaming
+        registers, so i expect even faster than MOV  :-) 
+}
+
+  MOV EAX, dword ptr [ECX]
+  BSWAP EAX
+  MOV dword ptr [EDX+4], EAX
+
+  MOV EAX, dword ptr [ECX+4]
+  BSWAP EAX
+  MOV dword ptr [EDX], EAX
 end;
 
 {$else}
@@ -425,7 +434,7 @@ begin
   PByteArray(@Result)[3] := PByteArray(@Value)[0];
 end;
 
-procedure SwapInt64(Value, Result: Pointer); 
+procedure SwapInt64(Value, Result: Pointer); register;
 var
   PtrResult: PByteArray;
   PtrSource: PByteArray;

fcl/db/dbase/Dbf_Cursor.pas

@@ -1,71 +1,70 @@
-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.
-
+unit Dbf_Cursor;
+
+interface
+
+{$I Dbf_Common.inc}
+
+uses
+  SysUtils,
+  Classes,
+  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

@@ -16,12 +16,10 @@ uses
 {$endif}
   Db,
   Dbf_Common,
-  Dbf_Parser,
   Dbf_Cursor,
   Dbf_PgFile,
   Dbf_Fields,
   Dbf_Memo,
-  Dbf_IdxCur,
   Dbf_IdxFile;
 
 //====================================================================
@@ -56,12 +54,12 @@ type
     FLockUserLen: DWORD;
     FFileCodePage: Cardinal;
     FUseCodePage: Cardinal;
+    FFileLangId: Byte;
     FCountUse: Integer;
     FCurIndex: Integer;
     FForceClose: Boolean;
     FHasLockField: Boolean;
     FAutoIncPresent: Boolean;
-    FOpened: Boolean;
     FCopyDateTimeAsString: Boolean;
     FDateTimeHandling: TDateTimeHandling;
     FOnLocaleError: TDbfLocaleErrorEvent;
@@ -77,7 +75,7 @@ type
     function GetUseFloatFields: Boolean;
     procedure SetUseFloatFields(NewUse: Boolean);
   public
-    constructor Create(lFileName: string);
+    constructor Create;
     destructor Destroy; override;
 
     procedure Open;
@@ -121,6 +119,7 @@ type
     property LanguageStr: string read GetLanguageStr;
     property FileCodePage: Cardinal read FFileCodePage;
     property UseCodePage: Cardinal read FUseCodePage write FUseCodePage;
+    property FileLangId: Byte read FFileLangId write FFileLangId;
     property DbfVersion: xBaseVersion read FDbfVersion write FDbfVersion;
     property PrevBuffer: PChar read FPrevBuffer;
     property ForceClose: Boolean read FForceClose;
@@ -163,12 +162,12 @@ type
     FCodePages: TList;
     FCurrencyAsBCD: Boolean;
     FDefaultOpenCodePage: Integer;
-    FDefaultCreateCodePage: Integer;
-    FDefaultCreateLocale: LCID;
-//    FDefaultCreateFoxPro: Boolean;
+    FDefaultCreateLangId: Byte;
     FUserName: string;
     FUserNameLen: DWORD;
 	
+    function  GetDefaultCreateCodePage: Integer;
+    procedure SetDefaultCreateCodePage(NewCodePage: Integer);
     procedure InitUserName;
   public
     constructor Create;
@@ -178,9 +177,8 @@ type
 
     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 DefaultCreateCodePage: Integer read GetDefaultCreateCodePage write SetDefaultCreateCodePage;
+    property DefaultCreateLangId: Byte read FDefaultCreateLangId write FDefaultCreateLangId;
     property UserName: string read FUserName;
     property UserNameLen: DWORD read FUserNameLen;
   end;
@@ -284,7 +282,7 @@ end;
 //====================================================================
 // TDbfFile
 //====================================================================
-constructor TDbfFile.Create(lFileName: string);
+constructor TDbfFile.Create;
 begin
   // init variables first
   FFieldDefs := TDbfFieldDefs.Create(nil);
@@ -294,11 +292,10 @@ begin
   FOnIndexMissing := nil;
   FMdxFile := nil;
   FForceClose := false;
-  FOpened := false;
   FCopyDateTimeAsString := false;
 
-  // pass on parameters
-  inherited Create(lFileName);
+  // now initialize inherited
+  inherited;
 end;
 
 destructor TDbfFile.Destroy;
@@ -341,7 +338,7 @@ var
   LangStr: PChar;
 begin
   // check if not already opened
-  if not FOpened then
+  if not Active then
   begin
     // open requested file
     OpenFile;
@@ -438,9 +435,11 @@ begin
         end else begin
           FFileCodePage := 0;
         end;
+        FFileLangId := GetLangId_From_LangName(LanguageStr);
       end else begin
         // FDbfVersion <= xBaseV
-        FFileCodePage := LangId_To_CodePage[PDbfHdr(Header).Language];
+        FFileLangId := PDbfHdr(Header).Language;
+        FFileCodePage := LangId_To_CodePage[FFileLangId];
       end;
       // determine used codepage, if no codepage, then use default codepage
       FUseCodePage := FFileCodePage;
@@ -459,7 +458,8 @@ begin
           MemoFileClass := TFoxProMemoFile
         else
           MemoFileClass := TDbaseMemoFile;
-        FMemoFile := MemoFileClass.Create(lMemoFileName);
+        FMemoFile := MemoFileClass.Create;
+        FMemoFile.FileName := lMemoFileName;
         FMemoFile.Mode := Mode;
         FMemoFile.AutoCreate := false;
         FMemoFile.MemoRecordSize := 0;
@@ -477,7 +477,8 @@ begin
         if FileExists(lMdxFileName) then
         begin
           // open file
-          FMdxFile := TIndexFile.Create(Self, lMdxFileName);
+          FMdxFile := TIndexFile.Create(Self);
+          FMdxFile.FileName := lMdxFileName;
           FMdxFile.Mode := Mode;
           FMdxFile.AutoCreate := false;
           FMdxFile.OnLocaleError := FOnLocaleError;
@@ -510,9 +511,6 @@ begin
     // open indexes
     for I := 0 to FIndexFiles.Count - 1 do
       TIndexFile(FIndexFiles.Items[I]).Open;
-
-    // now opened
-    FOpened := true;
   end;
 end;
 
@@ -520,7 +518,7 @@ procedure TDbfFile.Close;
 var
   MdxIndex, I: Integer;
 begin
-  if FOpened then
+  if Active then
   begin
     // close index files first
     MdxIndex := -1;
@@ -553,8 +551,8 @@ begin
     if FPrevBuffer <> nil then
       FreeMemAndNil(Pointer(FPrevBuffer));
 
-    // flag closed
-    FOpened := false;
+    // reset variables
+    FFileLangId := 0;
   end;
 end;
 
@@ -567,12 +565,19 @@ var
   lMemoFileName: string;
   I, lFieldOffset, lSize, lPrec: Integer;
   lHasBlob: Boolean;
+  lLocaleID: LCID;
 
 begin
   try
     // first reset file
     RecordCount := 0;
     lHasBlob := false;
+    // determine codepage & locale
+    if FFileLangId = 0 then
+      FFileLangId := DbfGlobals.DefaultCreateLangId;
+    FFileCodePage := LangId_To_CodePage[FFileLangId];
+    lLocaleID := LangId_To_Locale[FFileLangId];
+    FUseCodePage := FFileCodePage;
     // prepare header size
     if FDbfVersion = xBaseVII then
     begin
@@ -584,10 +589,7 @@ begin
       // write language string
       StrPLCopy(
         @PAfterHdrVII(PChar(Header)+SizeOf(rDbfHdr)).LanguageDriverName[32],
-        ConstructLangName(
-          DbfGlobals.DefaultCreateCodePage,
-          DbfGlobals.DefaultCreateLocale,
-          FDbfVersion = xFoxPro),
+        ConstructLangName(FFileCodePage, lLocaleID, false), 
         63-32);
       lFieldDescPtr := @lFieldDescVII;
     end else begin
@@ -603,10 +605,7 @@ begin
       if FDbfVersion = xBaseIII then
         PDbfHdr(Header).Language := 0
       else
-        PDbfHdr(Header).Language := ConstructLangId(
-          DbfGlobals.DefaultCreateCodePage,
-          DbfGlobals.DefaultCreateLocale,
-          FDbfVersion = xFoxPro);
+        PDbfHdr(Header).Language := FFileLangId;
       // init field ptr
       lFieldDescPtr := @lFieldDescIII;
     end;
@@ -630,7 +629,6 @@ begin
       // update source
       lFieldDef.FieldName := AnsiUpperCase(lFieldDef.FieldName);
       lFieldDef.Offset := lFieldOffset;
-      lFieldDef.CalcValueOffset;
       lHasBlob := lHasBlob or lFieldDef.IsBlob;
 
       // apply field transformation tricks
@@ -650,6 +648,7 @@ begin
         lFieldDescVII.FieldType := lFieldDef.NativeFieldType;
         lFieldDescVII.FieldSize := lSize;
         lFieldDescVII.FieldPrecision := lPrec;
+        // TODO: bug-endianness
         lFieldDescVII.NextAutoInc := lFieldDef.AutoInc;
         //lFieldDescVII.MDXFlag := ???
       end else begin
@@ -666,7 +665,6 @@ begin
         Assign(lFieldDef);
         Offset := lFieldOffset;
         AutoInc := 0;
-        CalcValueOffset;
       end;
 
       // save field props
@@ -704,9 +702,10 @@ begin
   begin
     lMemoFileName := ChangeFileExt(FileName, GetMemoExt);
     if FDbfVersion = xFoxPro then
-      FMemoFile := TFoxProMemoFile.Create(lMemoFileName)
+      FMemoFile := TFoxProMemoFile.Create
     else
-      FMemoFile := TDbaseMemoFile.Create(lMemoFileName);
+      FMemoFile := TDbaseMemoFile.Create;
+    FMemoFile.FileName := lMemoFileName;
     FMemoFile.Mode := Mode;
     FMemoFile.AutoCreate := AutoCreate;
     FMemoFile.MemoRecordSize := MemoSize;
@@ -814,6 +813,7 @@ begin
         lSize := lFieldDescVII.FieldSize;
         lPrec := lFieldDescVII.FieldPrecision;
         lNativeFieldType := lFieldDescVII.FieldType;
+        // TODO: big-endianness
         lAutoInc := lFieldDescVII.NextAutoInc;
         if lNativeFieldType = '+' then
           FAutoIncPresent := true;
@@ -841,7 +841,6 @@ begin
         Precision := lPrec;
         AutoInc := lAutoInc;
         NativeFieldType := lNativeFieldType;
-        CalcValueOffset;
 
         // check valid field:
         //  1) non-empty field name
@@ -1060,18 +1059,29 @@ begin
 
   // select final field definition list
   if DbfFieldDefs = nil then
-    DestFieldDefs := FFieldDefs
-  else
+  begin
+    DestFieldDefs := FFieldDefs;
+  end else begin
     DestFieldDefs := DbfFieldDefs;
+    // copy autoinc values
+    for I := 0 to DbfFieldDefs.Count - 1 do
+    begin
+      lFieldNo := DbfFieldDefs.Items[I].CopyFrom;
+      if (lFieldNo >= 0) and (lFieldNo < FFieldDefs.Count) then
+        DbfFieldDefs.Items[I].AutoInc := FFieldDefs.Items[lFieldNo].AutoInc;
+    end;
+  end;
 
   // create temporary dbf
-  DestDbfFile := TDbfFile.Create(NewBaseName);
+  DestDbfFile := TDbfFile.Create;
+  DestDbfFile.FileName := NewBaseName;
   DestDbfFile.AutoCreate := true;
   DestDbfFile.Mode := pfExclusiveCreate;
   DestDbfFile.UseFloatFields := UseFloatFields;
   DestDbfFile.OnIndexMissing := FOnIndexMissing;
   DestDbfFile.OnLocaleError := FOnLocaleError;
   DestDbfFile.DbfVersion := FDbfVersion;
+  DestDbfFile.FileLangId := FileLangId;
   DestDbfFile.Open;
   // create dbf header
   if FMemoFile <> nil then
@@ -1116,9 +1126,8 @@ begin
     BufferAhead := true;
     DestDbfFile.BufferAhead := true;
 {$endif}
-    lRecNo := 1;
     lWRecNo := 1;
-    while lRecNo <= RecordCount do
+    for lRecNo := 1 to RecordCount do
     begin
       // read record from original dbf
       ReadRecord(lRecNo, pBuff);
@@ -1179,7 +1188,6 @@ begin
         // go to next record
         Inc(lWRecNo);
       end;
-      Inc(lRecNo);
     end;
 
 {$ifdef USE_CACHE}
@@ -1410,7 +1418,7 @@ begin
           case DataType of
             ftCurrency:
             begin
-              PDouble(Dst)^ := PInt64(Src)^ / 10000;
+              PDouble(Dst)^ := PInt64(Src)^ / 10000.0;
             end;
             ftBCD:
             begin
@@ -1507,6 +1515,8 @@ begin
 end;
 
 procedure TDbfFile.SetFieldData(Column: Integer; DataType: TFieldType; Src, Dst: Pointer);
+const
+  IsBlobFieldToPadChar: array[Boolean] of Char = (#32, '0');
 var
   FieldSize,FieldPrec: Integer;
   TempFieldDef: TDbfFieldDef;
@@ -1622,32 +1632,33 @@ begin
               PChar(Dst)^ := 'F';
           end;
         ftSmallInt:
-          GetStrFromInt_Width(PSmallInt(Src)^, FieldSize, PChar(Dst));
+          GetStrFromInt_Width(PSmallInt(Src)^, FieldSize, PChar(Dst), #32);
 {$ifdef SUPPORT_INT64}
         ftLargeInt:
-          GetStrFromInt64_Width(PLargeInt(Src)^, FieldSize, PChar(Dst));
+          GetStrFromInt64_Width(PLargeInt(Src)^, FieldSize, PChar(Dst), #32);
 {$endif}
         ftFloat, ftCurrency:
           FloatToDbfStr(PDouble(Src)^, FieldSize, FieldPrec, PChar(Dst));
         ftInteger:
-          GetStrFromInt_Width(PInteger(Src)^, FieldSize, PChar(Dst));
+          GetStrFromInt_Width(PInteger(Src)^, FieldSize, PChar(Dst),
+            IsBlobFieldToPadChar[TempFieldDef.IsBlob]);
         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);
+            GetStrFromInt_Width(year,  4, PChar(Dst),   '0');
+            GetStrFromInt_Width(month, 2, PChar(Dst)+4, '0');
+            GetStrFromInt_Width(day,   2, PChar(Dst)+6, '0');
             // 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);
+              GetStrFromInt_Width(hour,   2, PChar(Dst)+8,  '0');
+              GetStrFromInt_Width(minute, 2, PChar(Dst)+10, '0');
+              GetStrFromInt_Width(sec,    2, PChar(Dst)+12, '0');
             end;
           end;
         ftString:
@@ -1688,7 +1699,7 @@ end;
 procedure TDbfFile.ApplyAutoIncToBuffer(DestBuf: PChar);
 var
   TempFieldDef: TDbfFieldDef;
-  I, NextVal: {LongWord} Cardinal;    {Delphi 3 does not know LongWord?}
+  I, NextVal, lAutoIncOffset: {LongWord} Cardinal;    {Delphi 3 does not know LongWord?}
 begin
   if FAutoIncPresent then
   begin
@@ -1706,17 +1717,20 @@ begin
       if (TempFieldDef.NativeFieldType = '+') then
       begin
         // read current auto inc, from header or field, depending on sharing
+        lAutoIncOffset := sizeof(rDbfHdr) + sizeof(rAfterHdrVII) + 
+          FieldDescVII_AutoIncOffset + I * sizeof(rFieldDescVII);
+        // TODO: big-endianness
         if NeedLocks then
-          ReadBlock(@NextVal, 4, TempFieldDef.ValueOffset)
+          ReadBlock(@NextVal, 4, lAutoIncOffset)
         else
           NextVal := TempFieldDef.AutoInc;
         // store to buffer, positive = high bit on, so flip it
-        PCardinal(DestBuf+TempFieldDef.Offset)^ := SwapInt(NextVal xor $80000000);
+        PCardinal(DestBuf+TempFieldDef.Offset)^ := SwapInt(NextVal or $80000000);
         // increase
         Inc(NextVal);
         TempFieldDef.AutoInc := NextVal;
         // write new value to header buffer
-        PCardinal(FHeader+TempFieldDef.ValueOffset)^ := NextVal;
+        PCardinal(FHeader+lAutoIncOffset)^ := NextVal;
       end;
     end;
 
@@ -1736,7 +1750,7 @@ begin
   inherited;
 
   // exclusive succeeded? open index & memo exclusive too
-  if Mode in [pfMemory..pfExclusiveOpen] then
+  if Mode in [pfMemoryCreate..pfExclusiveOpen] then
   begin
     // indexes
     for I := 0 to FIndexFiles.Count - 1 do
@@ -1766,9 +1780,9 @@ procedure TDbfFile.OpenIndex(IndexName, IndexField: string; CreateIndex: Boolean
   // assumes IndexName is not empty
   //
 const
-  // mem, excr, exopen, rwcr, rwopen, rdonly
-  IndexOpenMode: array[pfMemory..pfReadOnly] of TPagedFileMode =
-    (pfMemory, pfExclusiveOpen, pfExclusiveOpen, pfReadWriteOpen, pfReadWriteOpen,
+  // memcr, memop, excr, exopen, rwcr, rwopen, rdonly
+  IndexOpenMode: array[pfMemoryCreate..pfReadOnly] of TPagedFileMode =
+    (pfMemoryCreate, pfMemoryCreate, pfExclusiveOpen, pfExclusiveOpen, pfReadWriteOpen, pfReadWriteOpen,
      pfReadOnly);
 var
   lIndexFile: TIndexFile;
@@ -1812,7 +1826,8 @@ begin
     if lIndexFileName <> EmptyStr then
     begin
       // try to open / create the file
-      lIndexFile := TIndexFile.Create(Self, lIndexFileName);
+      lIndexFile := TIndexFile.Create(Self);
+      lIndexFile.FileName := lIndexFileName;
       lIndexFile.Mode := IndexOpenMode[Mode];
       lIndexFile.AutoCreate := CreateIndex or (Length(IndexField) > 0);
       lIndexFile.CodePage := UseCodePage;
@@ -2315,15 +2330,15 @@ begin
 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);
+  if TDbfFile(PagedFile).IsRecordPresent(FPhysicalRecNo) then
+  begin
+    inc(FPhysicalRecNo);
+    Result := TDbfFile(PagedFile).IsRecordPresent(FPhysicalRecNo);
+  end else begin
+    FPhysicalRecNo := TDbfFile(PagedFile).CachedRecordCount + 1;
+    Result := false;
+  end;
 end;
 
 function TDbfCursor.Prev: Boolean;
@@ -2332,7 +2347,7 @@ begin
     dec(FPhysicalRecNo)
   else
     FPhysicalRecNo := 0;
-  Result := (FPhysicalRecNo > 0);
+  Result := FPhysicalRecNo > 0;
 end;
 
 procedure TDbfCursor.First;
@@ -2417,12 +2432,10 @@ end;
 constructor TDbfGlobals.Create;
 begin
   FCodePages := TList.Create;
-//  FDefaultOpenCodePage := GetOEMCP;
   FDefaultOpenCodePage := GetACP;
-  FDefaultCreateCodePage := GetACP;
-  FDefaultCreateLocale := GetUserDefaultLCID;
+  // the following sets FDefaultCreateLangId
+  DefaultCreateCodePage := GetACP;
   FCurrencyAsBCD := true;
-//  FDefaultCreateFoxPro := false;
   // determine which code pages are installed
   TempCodePageList := FCodePages;
   EnumSystemCodePages(@CodePagesProc, {CP_SUPPORTED} CP_INSTALLED);
@@ -2432,7 +2445,7 @@ end;
 
 procedure TDbfGlobals.InitUserName;
 {$ifdef FPC}
-{$ifndef win32}
+{$ifndef WIN32}
 var
   TempName: UTSName;
 {$endif}
@@ -2458,6 +2471,16 @@ begin
   FCodePages.Free;
 end;
 
+function TDbfGlobals.GetDefaultCreateCodePage: Integer;
+begin
+  Result := LangId_To_CodePage[FDefaultCreateLangId];
+end;
+
+procedure TDbfGlobals.SetDefaultCreateCodePage(NewCodePage: Integer);
+begin
+  FDefaultCreateLangId := ConstructLangId(NewCodePage, GetUserDefaultLCID, false);
+end;
+
 function TDbfGlobals.CodePageInstalled(ACodePage: Integer): Boolean;
 begin
   Result := FCodePages.IndexOf(Pointer(ACodePage)) >= 0;

fcl/db/dbase/Dbf_Fields.pas

@@ -30,7 +30,6 @@ type
     FHasMin: Boolean;
     FHasMax: Boolean;
     FAllocSize: Integer;
-    FValueOffset: Integer;
     FCopyFrom: Integer;
     FOffset: Integer;
     FAutoInc: Cardinal;
@@ -58,7 +57,6 @@ type
     procedure AssignDb(DbSource: TFieldDef);
 
     procedure CheckSizePrecision;
-    procedure CalcValueOffset;
     procedure SetDefaultSize;
     procedure AllocBuffers;
     function  IsBlob: Boolean;
@@ -69,7 +67,6 @@ type
     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;
@@ -233,7 +230,6 @@ begin
     FHasMin := DbfSource.HasMin;
     FHasMax := DbfSource.HasMax;
     // do we need offsets?
-    FValueOffset := DbfSource.ValueOffset;
     FOffset := DbfSource.Offset;
     FAutoInc := DbfSource.AutoInc;
 {$ifdef SUPPORT_FIELDDEF_TPERSISTENT}
@@ -265,7 +261,6 @@ begin
   FHasDefault := false;
   FHasMin := false;
   FHasMax := false;
-  FValueOffset := 0;
   FOffset := 0;
   FAutoInc := 0;
 end;
@@ -294,13 +289,6 @@ begin
     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;
@@ -389,6 +377,7 @@ end;
 
 procedure TDbfFieldDef.VCLToNative;
 begin
+  FNativeFieldType := #0;
   case FFieldType of
     ftAutoInc  : FNativeFieldType  := '+';
     ftDateTime :
@@ -418,13 +407,12 @@ begin
         FNativeFieldType := 'I'
       else
         FNativeFieldType := 'N';
-    ftBCD      : FNativeFieldType := 'Y';
-    ftCurrency : FNativeFieldType := 'Y';
-  else
-//    FFieldType := ftUnknown;
-    FNativeFieldType := #0;
+    ftBCD, ftCurrency: 
+      if DbfVersion = xFoxPro then
+        FNativeFieldType := 'Y';
+  end;
+  if FNativeFieldType = #0 then
     raise EDbfError.CreateFmt(STRING_INVALID_VCL_FIELD_TYPE, [GetDisplayName, Ord(FFieldType)]);
-  end; // Case
 end;
 
 procedure TDbfFieldDef.SetDefaultSize;

fcl/db/dbase/Dbf_IdxCur.pas

@@ -9,9 +9,7 @@ interface
 uses
   SysUtils,
   Classes,
-  Db,
   Dbf_Cursor,
-  Dbf_PgFile,
   Dbf_IdxFile,
   Dbf_PrsDef,
   Dbf_Common;

fcl/db/dbase/Dbf_IdxFile.pas

@@ -261,7 +261,7 @@ type
 
     function  GetNewPageNo: Integer;
     procedure TouchHeader(AHeader: Pointer);
-    function  CreateTempMemFile(BaseName: string): TPagedFile;
+    function  CreateTempFile(BaseName: string): TPagedFile;
     procedure WriteIndexHeader(AIndex: Integer);
     procedure SelectIndexVars(AIndex: Integer);
     procedure CalcKeyProperties;
@@ -306,7 +306,7 @@ type
     property InternalLocaleID: LCID read FLocaleID write SetLocaleID;
 
   public
-    constructor Create(ADbfFile: Pointer; AFileName: string);
+    constructor Create(ADbfFile: Pointer);
     destructor Destroy; override;
 
     procedure Open;
@@ -1696,11 +1696,11 @@ end;
 //==============================================================================
 //============ TIndexFile
 //==============================================================================
-constructor TIndexFile.Create(ADbfFile: Pointer; AFileName: string);
+constructor TIndexFile.Create(ADbfFile: Pointer);
 var
   I: Integer;
 begin
-  inherited Create(AFileName);
+  inherited Create;
 
   // clear variables
   FOpened := false;
@@ -2384,14 +2384,15 @@ begin
   PMdxHdr(AHeader).UpdDay := day;
 end;
 
-function TIndexFile.CreateTempMemFile(BaseName: string): TPagedFile;
+function TIndexFile.CreateTempFile(BaseName: string): TPagedFile;
 var
   lModifier: Integer;
 begin
   // create temporary in-memory index file
   lModifier := 0;
   FindNextName(BaseName, BaseName, lModifier);
-  Result := TPagedFile.Create(BaseName);
+  Result := TPagedFile.Create;
+  Result.FileName := BaseName;
   Result.Mode := pfExclusiveCreate;
   Result.AutoCreate := true;
   Result.OpenFile;
@@ -2484,7 +2485,7 @@ begin
 
   prevIndex := FSelectedIndex;
   newPageNo := HeaderSize div PageSize;
-  TempFile := CreateTempMemFile(FileName);
+  TempFile := CreateTempFile(FileName);
   if FIndexVersion >= xBaseIV then
   begin
     // copy header
@@ -2651,7 +2652,7 @@ begin
 
   prevIndex := FSelectedIndex;
   newPageNo := HeaderSize div PageSize;
-  TempFile := CreateTempMemFile(FileName);
+  TempFile := CreateTempFile(FileName);
   if FIndexVersion >= xBaseIV then
   begin
     // copy header
@@ -2812,22 +2813,20 @@ begin
     end else begin
       // DB4 MDX
       NumDecimals := 0;
-      IntSrc := 0;
       case ResultType of
-        etInteger: IntSrc := PInteger(Result)^;
+        etInteger: 
+          begin
+            IntSrc := PInteger(Result)^;
+            // handle zero differently: no decimals
+            NumDecimals := GetStrFromInt(IntSrc, @FloatRec.Digits[0]);
+            FloatRec.Negative := IntSrc < 0;
+          end;
 {$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;
+            NumDecimals := GetStrFromInt64(Int64Src, @FloatRec.Digits[0]);
             FloatRec.Negative := Int64Src < 0;
-            // null-terminate string
-            FloatRec.Digits[NumDecimals] := #0;
           end;
 {$endif}
         etFloat:
@@ -2841,17 +2840,13 @@ begin
           end;
       end;
 
-      // parse integers to string
       case ResultType of
-        etInteger:
+        etInteger {$ifdef SUPPORT_INT64}, etLargeInt{$endif}:
           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;
+            // MDX-BCD does not count ending zeroes as `data' space length
+            while (NumDecimals > 0) and (FloatRec.Digits[NumDecimals-1] = '0') do
+              Dec(NumDecimals);
             // null-terminate string
             FloatRec.Digits[NumDecimals] := #0;
           end;
@@ -2862,7 +2857,7 @@ begin
       // 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;
+      FUserBCD[1] := (((NumDecimals+1) div 2) * 8) + 1;
       // where to store decimal dot position? now implicitly in first byte
       // store negative sign
       if FloatRec.Negative then
@@ -3284,8 +3279,10 @@ begin
 end;
 
 procedure TIndexFile.SetLocaleID(const NewID: LCID);
+{$ifdef WIN32}
 var
   InfoStr: array[0..7] of Char;
+{$endif}
 begin
   FLocaleID := NewID;
   if NewID = lcidBinary then
@@ -3589,11 +3586,10 @@ begin
       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
+      if (Byte(Key1[0]) = $01) and (Byte(Key1[1]) = $34) then
         Result := -1
       else
-      if PSmallInt(Key2)^ = $0134 then
+      if (Byte(Key2[0]) = $01) and (Byte(Key2[1]) = $34) then
         Result := 1
       else
         Result := Byte(Key1[0]) - Byte(Key2[0]);

fcl/db/dbase/Dbf_Memo.pas

@@ -25,7 +25,7 @@ type
     procedure SetNextFreeBlock(BlockNo: Integer); virtual; abstract;
     procedure SetBlockLen(BlockLen: Integer); virtual; abstract;
   public
-    constructor Create(AFileName: string);
+    constructor Create;
     destructor Destroy; override;
 
     procedure Open;
@@ -79,7 +79,7 @@ type
     procedure SetBlockLen(BlockLen: Integer); override;
 
   public
-    constructor Create(AFileName: string);
+    constructor Create;
 
     procedure CloseFile; override;
     procedure OpenFile; override;
@@ -130,14 +130,14 @@ type
 //==========================================================
 //============ Dbtfile
 //==========================================================
-constructor TMemoFile.Create(AFileName: string);
+constructor TMemoFile.Create;
 begin
   // init vars
   FBuffer := nil;
   FOpened := false;
 
   // call inherited
-  inherited Create(AFileName);
+  inherited;
 end;
 
 destructor TMemoFile.Destroy;
@@ -241,6 +241,7 @@ begin
   if bytesLeft <> -1 then
   begin
     dataStart := 8;
+    DestStream.Size := bytesLeft;
     while bytesLeft > 0 do
     begin
       // get number of bytes to be read
@@ -477,7 +478,7 @@ end;
 // NULL file (no file) specific helper routines
 // ------------------------------------------------------------------
 
-constructor TNullMemoFile.Create(AFileName: string);
+constructor TNullMemoFile.Create;
 begin
   inherited;
 end;

fcl/db/dbase/Dbf_Parser.pas

@@ -316,7 +316,7 @@ begin
   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);
+  while (Len >= 1) and (FFieldVal[Len-1] = ' ') do Dec(Len);
   FFieldVal[Len] := #0;
   // translate to ANSI
   TranslateString(DbfFile.UseCodePage, GetACP, FFieldVal, FFieldVal, Len);
@@ -477,7 +477,7 @@ begin
     begin
       // convert to string
       width := PInteger(Args[1])^;
-      GetStrFromInt_Width(Val, width, Res.MemoryPos^);
+      GetStrFromInt_Width(Val, width, Res.MemoryPos^, #32);
       // advance pointer
       Inc(Res.MemoryPos^, width);
       // need to add decimal?
@@ -1046,7 +1046,7 @@ end;
 
 var
   DbfWordsSensList, DbfWordsInsensList: TExpressList;
-  DbfWordsAllList: TOCollection;
+  DbfWordsAllList: TExpressList;
 
 constructor TDbfParser.Create(ADbfFile: Pointer);
 begin
@@ -1127,10 +1127,15 @@ begin
     ftString, ftBoolean:
       begin
         if RawStringFields then
-          TempFieldVar := TRawStringFieldVar.Create(FieldInfo, TDbfFile(FDbfFile))
-        else
+        begin
+          { raw string fields have fixed length, not null-terminated }
+          TempFieldVar := TRawStringFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
+          DefineStringVariableFixedLen(VarName, TempFieldVar.FieldVal, FieldInfo.Size);
+        end else begin
+          { ansi string field function translates and null-terminates field value }
           TempFieldVar := TAnsiStringFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
-        DefineStringVariableFixedLen(VarName, TempFieldVar.FieldVal, FieldInfo.Size);
+          DefineStringVariable(VarName, TempFieldVar.FieldVal);
+        end;
       end;
     ftFloat:
       begin
@@ -1266,8 +1271,6 @@ begin
   end;
 end;
 
-var
-  GenCount, SensCount, AllCount: Integer;
 initialization
 
   DbfWordsSensList := TExpressList.Create;
@@ -1363,31 +1366,29 @@ initialization
     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, ''));
+  end;
 
-    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;
-
+  with DbfWordsInsensList do
+  begin
+    AddList(DbfWordsAllList, 0, DbfWordsAllList.Count - 1);
     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);
+  with DbfWordsSensList do
+  begin
+    AddList(DbfWordsAllList, 0, DbfWordsAllList.Count - 1);
+    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));
+  end;
 
 finalization
 

fcl/db/dbase/Dbf_PgFile.pas

@@ -15,8 +15,8 @@ uses
 type
   EPagedFile = Exception;
 
-  TPagedFileMode = (pfNone, pfMemory, pfExclusiveCreate, pfExclusiveOpen,
-    pfReadWriteCreate, pfReadWriteOpen, pfReadOnly);
+  TPagedFileMode = (pfNone, pfMemoryCreate, pfMemoryOpen, pfExclusiveCreate, 
+    pfExclusiveOpen, pfReadWriteCreate, pfReadWriteOpen, pfReadOnly);
 
   // access levels:
   //
@@ -42,7 +42,9 @@ type
     FRecordCount: Integer;      { actually FPageCount, but we want to keep existing code }
     FPagesPerRecord: Integer;
     FCachedSize: Integer;
+    FCachedRecordCount: Integer;
     FHeader: PChar;
+    FActive: Boolean;
     FNeedRecalc: Boolean;
     FHeaderModified: Boolean;
     FPageOffsetByHeader: Boolean;   { do pages start after header or just at BOF? }
@@ -71,6 +73,8 @@ type
     procedure SetPageOffsetByHeader(NewValue: Boolean); virtual;
     procedure SetRecordCount(NewValue: Integer);
     procedure SetBufferAhead(NewValue: Boolean);
+    procedure SetFileName(NewName: string);
+    procedure SetStream(NewStream: TStream);
     function  LockSection(const Offset, Length: Cardinal; const Wait: Boolean): Boolean; virtual;
     function  UnlockSection(const Offset, Length: Cardinal): Boolean; virtual;
     procedure UpdateBufferSize;
@@ -88,13 +92,11 @@ type
     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);
+    constructor Create;
     destructor Destroy; override;
 
     procedure CloseFile; virtual;
@@ -105,11 +107,12 @@ type
     procedure CheckExclusiveAccess;
     procedure DisableForceCreate;
     function  CalcPageOffset(const PageNo: Integer): Integer;
+    function  IsRecordPresent(IntRecNum: Integer): boolean;
     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;
+    function  IsSharedAccess: Boolean;
     procedure ResetError;
 
     function  LockPage(const PageNo: Integer; const Wait: Boolean): Boolean;
@@ -119,6 +122,7 @@ type
 
     procedure Flush; virtual;
 
+    property Active: Boolean read FActive;
     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;
@@ -129,10 +133,12 @@ type
     property PageSize: Integer read FPageSize write SetPageSize;
     property PagesPerRecord: Integer read FPagesPerRecord;
     property RecordCount: Integer read GetRecordCount write SetRecordCount;
+    property CachedRecordCount: Integer read FCachedRecordCount;
     property PageOffsetByHeader: Boolean read FPageOffsetbyHeader write SetPageOffsetByHeader;
     property FileLocked: Boolean read FFileLocked;
     property Header: PChar read FHeader;
-    property FileName: string read FFileName;
+    property FileName: string read FFileName write SetFileName;
+    property Stream: TStream read FStream write SetStream;
     property BufferAhead: Boolean read FBufferAhead write SetBufferAhead;
     property WriteError: Boolean read FWriteError;
   end;
@@ -153,15 +159,16 @@ uses
 //====================================================================
 // TPagedFile
 //====================================================================
-constructor TPagedFile.Create(AFileName: string);
+constructor TPagedFile.Create;
 begin
-  FFileName := AFileName;
+  FFileName := EmptyStr;
   FHeaderOffset := 0;
   FHeaderSize := 0;
   FRecordSize := 0;
   FRecordCount := 0;
   FPageSize := 0;
   FPagesPerRecord := 0;
+  FActive := false;
   FHeaderModified := false;
   FPageOffsetByHeader := true;
   FNeedLocks := false;
@@ -178,6 +185,8 @@ begin
   FBufferMaxSize := 0;
   FBufferOffset := 0;
   FWriteError := false;
+
+  inherited;
 end;
 
 destructor TPagedFile.Destroy;
@@ -185,6 +194,7 @@ begin
   // close physical file
   if FFileLocked then UnlockAllPages;
   CloseFile;
+  FFileLocked := false;
 
   // free mem
   if FHeader <> nil then
@@ -197,87 +207,101 @@ procedure TPagedFile.OpenFile;
 var
   fileOpenMode: Word;
 begin
-  if FStream = nil then
+  if FActive then exit;  
+
+  // store user specified mode
+  FUserMode := FMode;
+  if not (FMode in [pfMemoryCreate, pfMemoryOpen]) then
   begin
-    // store user specified mode
-    FUserMode := FMode;
-    if FMode <> pfMemory then
+    // test if file exists
+    if not FileExists(FFileName) 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]);
+      // if auto-creating, adjust mode
+      if FAutoCreate then case FMode of
+        pfExclusiveOpen:             FMode := pfExclusiveCreate;
+        pfReadWriteOpen, pfReadOnly: FMode := pfReadWriteCreate;
       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
+      // 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
-        FStream.Size := 0;
-    end else begin
+        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
+    if FStream = nil then
+    begin
+      FMode := pfMemoryCreate;
       FStream := TMemoryStream.Create;
+    end else begin
+      FMode := pfMemoryOpen;
     end;
-    // init size var
-    FCachedSize := Stream.Size;
-    // update whether we need locking
+  end;
+  // init size var
+  FCachedSize := Stream.Size;
+  // update whether we need locking
 {$ifdef _DEBUG}
-    FNeedLocks := true;
+  FNeedLocks := true;
 {$else}
-    FNeedLocks := IsSharedAccess;
+  FNeedLocks := IsSharedAccess;
 {$endif}
-  end;
+  FActive := true;
 end;
 
 procedure TPagedFile.CloseFile;
 begin
-  if FStream <> nil then
+  if FActive then
   begin
     FlushHeader;
-    FreeAndNil(FStream);
+    // don't free the user's stream
+    if FMode <> pfMemoryOpen then
+      FreeAndNil(FStream);
 
     // mode possibly overriden in case of auto-created file
     FMode := FUserMode;
+    FActive := false;
+    FCachedRecordCount := 0;
   end;
 end;
 
 procedure TPagedFile.DeleteFile;
 begin
   // opened -> we can not delete
-  if FStream = nil then
+  if not FActive 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
+  CreationModes: array [pfNone..pfReadOnly] of Boolean =
+    (false, true, false, true, false, true, false, false);
+//   node, memcr, memop, excr, exopn, rwcr, rwopn, rdonly
 begin
   Result := CreationModes[FMode];
 end;
 
 function TPagedFile.IsSharedAccess: Boolean;
+const
+  SharedAccessModes: array [pfNone..pfReadOnly] of Boolean =
+    (false, false, false, false, false, true, true,  true);
+//   node,  memcr, memop, excr,  exopn, rwcr, rwopn, rdonly
 begin
-  Result := (Mode <> pfExclusiveOpen) and (Mode <> pfExclusiveCreate) and (Mode <> pfMemory);
+  Result := SharedAccessModes[FMode];
 end;
 
 procedure TPagedFile.CheckExclusiveAccess;
@@ -375,6 +399,15 @@ begin
   FBufferReadSize := ReadBlock(FBufferPtr, FBufferReadSize, FBufferOffset);
 end;
 
+function TPagedFile.IsRecordPresent(IntRecNum: Integer): boolean;
+begin
+  // if in shared mode, recordcount can only increase, check if recordno
+  // in range for cached recordcount
+  if not IsSharedAccess or (IntRecNum > FCachedRecordCount) then
+    FCachedRecordCount := RecordCount;
+  Result := (0 <= IntRecNum) and (IntRecNum <= FCachedRecordCount);
+end;
+
 function TPagedFile.ReadRecord(IntRecNum: Integer; Buffer: Pointer): Integer;
 var
   Offset: Integer;
@@ -449,6 +482,18 @@ begin
   end;
 end;
 
+procedure TPagedFile.SetStream(NewStream: TStream);
+begin
+  if not FActive then
+    FStream := NewStream;
+end;
+
+procedure TPagedFile.SetFileName(NewName: string);
+begin
+  if not FActive then
+    FFileName := NewName;
+end;
+
 procedure TPagedFile.UpdateBufferSize;
 begin
   if FBufferAhead then
@@ -495,18 +540,6 @@ begin
   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
@@ -662,7 +695,7 @@ begin
   if FNeedRecalc then
   begin
     // no file? test flags
-    if (FPageSize = 0) or (FStream = nil) then
+    if (FPageSize = 0) or not FActive then
       FRecordCount := 0
     else
     if FPageOffsetByHeader then

fcl/db/dbase/Dbf_PgcFile.pas

@@ -1,234 +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.
+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

@@ -43,18 +43,18 @@ type
     FExpResultPos: PChar;
     FExpResultSize: Integer;
 
-    function ParseString(AnExpression: string): TExprCollection;
-    function MakeTree(var Expr: TExprCollection): PExpressionRec;
-    function MakeRec: PExpressionRec;
-    procedure MakeLinkedList(ExprRec: PExpressionRec; Memory: PPChar;
+    procedure ParseString(AnExpression: string; DestCollection: TExprCollection);
+    function  MakeTree(Expr: TExprCollection; FirstItem, LastItem: Integer): PExpressionRec;
+    procedure MakeLinkedList(var ExprRec: PExpressionRec; Memory: PPChar;
         MemoryPos: PPChar; MemSize: PInteger);
     procedure Check(AnExprList: TExprCollection);
     procedure CheckArguments(ExprRec: PExpressionRec);
-    function RemoveConstants(ExprRec: PExpressionRec): PExpressionRec;
+    procedure RemoveConstants(var ExprRec: PExpressionRec);
     function ResultCanVary(ExprRec: PExpressionRec): Boolean;
   protected
     FWordsList: TSortedCollection;
 
+    function MakeRec: PExpressionRec; virtual;
     procedure FillExpressList; virtual; abstract;
     procedure HandleUnknownVariable(VarName: string); virtual; abstract;
 
@@ -149,19 +149,19 @@ var
   ExpColl: TExprCollection;
   ExprTree: PExpressionRec;
 begin
-  ExprTree := nil;
-  ExpColl := nil;
   if Length(AnExpression) > 0 then
   begin
+    ExprTree := nil;
+    ExpColl := TExprCollection.Create;
     try
       //    FCurrentExpression := anExpression;
-      ExpColl := ParseString(AnExpression);
+      ParseString(AnExpression, ExpColl);
       Check(ExpColl);
-      ExprTree := MakeTree(ExpColl);
+      ExprTree := MakeTree(ExpColl, 0, ExpColl.Count - 1);
       FCurrentRec := nil;
       CheckArguments(ExprTree);
       if Optimize then
-        ExprTree := RemoveConstants(ExprTree);
+        RemoveConstants(ExprTree);
       // all constant expressions are evaluated and replaced by variables
       FCurrentRec := nil;
       FExpResultPos := FExpResult;
@@ -170,9 +170,11 @@ begin
       on E: Exception do
       begin
         DisposeTree(ExprTree);
-	raise;
+        ExpColl.Free;
+        raise;
       end;
     end;
+    ExpColl.Free;
   end;
 end;
 
@@ -255,53 +257,52 @@ begin
   end;
 end;
 
-function TCustomExpressionParser.RemoveConstants(ExprRec: PExpressionRec): PExpressionRec;
+procedure TCustomExpressionParser.RemoveConstants(var ExprRec: PExpressionRec);
 var
   I: Integer;
 begin
-  Result := ExprRec;
-  with ExprRec^ do
+  if not ResultCanVary(ExprRec) then
   begin
-    if not ResultCanVary(ExprRec) then
+    if not ExprRec^.ExprWord.IsVariable 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);
+      // reset current record so that make list generates new
+      FCurrentRec := nil;
+      FExpResultPos := FExpResult;
+      MakeLinkedList(ExprRec, @FExpResult, @FExpResultPos, @FExpResultSize);
 
-        try
-          // compute result
-          EvaluateCurrent;
+      try
+        // compute result
+        EvaluateCurrent;
 
-          // make new record to store constant in
-          Result := MakeRec;
+        // make new record to store constant in
+        ExprRec := MakeRec;
 
-          // check result type
+        // check result type
+        with ExprRec^ do
+        begin
           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);
+            etBoolean: ExprWord := TBooleanConstant.Create(EmptyStr, PBoolean(FExpResult)^);
+            etFloat: ExprWord := TFloatConstant.CreateAsDouble(EmptyStr, PDouble(FExpResult)^);
+            etString: 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;
+          Oper := ExprWord.ExprFunc;
+          Args[0] := ExprWord.AsPointer;
+          FConstantsList.Add(ExprWord);
         end;
+      finally
+        DisposeList(FCurrentRec);
+        FCurrentRec := nil;
       end;
-    end
-    else
+    end;
+  end else
+    with ExprRec^ do
+    begin
       for I := 0 to ExprWord.MaxFunctionArg - 1 do
         if ArgList[I] <> nil then
-          ArgList[I] := RemoveConstants(ArgList[I]);
-  end;
+          RemoveConstants(ArgList[I]);
+    end;
 end;
 
 procedure TCustomExpressionParser.DisposeTree(ExprRec: PExpressionRec);
@@ -343,7 +344,7 @@ begin
     until ARec = nil;
 end;
 
-procedure TCustomExpressionParser.MakeLinkedList(ExprRec: PExpressionRec;
+procedure TCustomExpressionParser.MakeLinkedList(var ExprRec: PExpressionRec;
   Memory: PPChar; MemoryPos: PPChar; MemSize: PInteger);
 var
   I: Integer;
@@ -365,6 +366,7 @@ begin
     end;
     // don't need this record anymore
     Dispose(ExprRec);
+    ExprRec := nil;
   end else begin
     // inc memory pointer so we know if we are first
     ExprRec^.ResetDest := MemoryPos^ = Memory^;
@@ -414,7 +416,8 @@ begin
   end;
 end;
 
-function TCustomExpressionParser.MakeTree(var Expr: TExprCollection): PExpressionRec;
+function TCustomExpressionParser.MakeTree(Expr: TExprCollection; 
+  FirstItem, LastItem: Integer): PExpressionRec;
 
 {
 - This is the most complex routine, it breaks down the expression and makes
@@ -423,138 +426,125 @@ function TCustomExpressionParser.MakeTree(var Expr: TExprCollection): PExpressio
 }
 
 var
-  I, IArg, IStart, IEnd, brCount: Integer;
-  FirstOper: TExprWord;
-  Expr2: TExprCollection;
-  Rec: PExpressionRec;
+  I, IArg, IStart, IEnd, lPrec, brCount: Integer;
+  redundantBrackets: boolean;
+  ExprWord: TExprWord;
 begin
-  FirstOper := nil;
-  IStart := 0;
-  try
+  // remove redundant brackets
+  repeat
+    redundantBrackets := false;
+    if (TExprWord(Expr.Items[FirstItem]).ResultType = etLeftBracket) and
+        (TExprWord(Expr.Items[LastItem]).ResultType = etRightBracket) then
+    begin
+      Inc(FirstItem);
+      Dec(LastItem);
+      redundantBrackets := true;
+    end;
+  until not redundantBrackets;
+
+  // check for empty range
+  if LastItem < FirstItem then
+  begin
     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;
+    exit;
+  end;
+
+  // get new record
+  Result := MakeRec;
 
-      // simple constant, variable or function?
-      if Expr.Count = 1 then
+  // simple constant, variable or function?
+  if LastItem = FirstItem then
+  begin
+    Result.ExprWord := TExprWord(Expr.Items[FirstItem]);
+    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
-        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;
+        // 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');
+  // no...more complex, find operator with lowest precedence
+  brCount := 0;
+  IArg := 0;
+  IEnd := FirstItem-1;
+  lPrec := -1;
+  for I := FirstItem to LastItem do
+  begin
+    ExprWord := TExprWord(Expr.Items[I]);
+    if (brCount = 0) and ExprWord.IsOperator and (TFunction(ExprWord).OperPrec > lPrec) then
+    begin
+      IEnd := I;
+      lPrec := TFunction(ExprWord).OperPrec;
+    end;
+    case ExprWord.ResultType of
+      etLeftBracket: Inc(brCount);
+      etRightBracket: Dec(brCount);
+    end;
+  end;
 
-      if not FirstOper.IsOper then
+  // operator found ?
+  if IEnd >= FirstItem then
+  begin
+    // save operator
+    Result.ExprWord := TExprWord(Expr.Items[IEnd]);
+    Result.Oper := Result.ExprWord.ExprFunc;
+    // recurse into left part if present
+    if IEnd > FirstItem then
+    begin
+      Result.ArgList[IArg] := MakeTree(Expr, FirstItem, IEnd-1);
+      Inc(IArg);
+    end;
+    // recurse into right part if present
+    if IEnd < LastItem then
+      Result.ArgList[IArg] := MakeTree(Expr, IEnd+1, LastItem);
+  end else 
+  if TExprWord(Expr.Items[FirstItem]).IsFunction then 
+  begin
+    // save function
+    Result.ExprWord := TExprWord(Expr.Items[FirstItem]);
+    Result.Oper := Result.ExprWord.ExprFunc;
+    // parse function arguments
+    IEnd := FirstItem + 1;
+    IStart := IEnd;
+    brCount := 0;
+    if TExprWord(Expr.Items[IEnd]).ResultType = etLeftBracket then
+    begin
+      // opening bracket found, first argument expression starts at next index
+      Inc(brCount);
+      Inc(IStart);
+      while (IEnd < LastItem) and (brCount <> 0) do
       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;
+        case TExprWord(Expr.Items[IEnd]).ResultType of
+          etLeftBracket: Inc(brCount);
+          etComma:
+            if brCount = 1 then
+            begin
+              // argument separation found, build tree of argument expression
+              Result.ArgList[IArg] := MakeTree(Expr, IStart, IEnd-1);
+              Inc(IArg);
+              IStart := IEnd + 1;
+            end;
+          etRightBracket: Dec(brCount);
         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;
+      // parse last argument
+      Result.ArgList[IArg] := MakeTree(Expr, IStart, IEnd-1);
+    end;
+  end else
+    raise EParserException.Create('Operator/function missing');
 end;
 
-function TCustomExpressionParser.ParseString(AnExpression: string): TExprCollection;
+procedure TCustomExpressionParser.ParseString(AnExpression: string; DestCollection: TExprCollection);
 var
   isConstant: Boolean;
   I, I1, I2, Len, DecSep: Integer;
@@ -696,64 +686,55 @@ var
   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
+  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
-	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
+        // 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;
+          // 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;
+          TempWord := TFloatConstant.Create(W, W)
+        end else begin
+          TempWord := TIntegerConstant.Create(StrToInt(W));
+        end;
+      end;
+      DestCollection.Add(TempWord);
+      FConstantsList.Add(TempWord);
+    end
+    else if Length(W) > 0 then
+      if FWordsList.Search(PChar(W), I) then
+      begin
+        DestCollection.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
+          DestCollection.Add(FWordsList.Items[I])
+        end else begin
+          raise EParserException.Create('Unknown variable '''+W+''' found.');
+        end;
+      end;
+  until I2 > Len;
 end;
 
 procedure TCustomExpressionParser.Check(AnExprList: TExprCollection);
@@ -772,7 +753,7 @@ begin
         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
+        (TExprWord(Items[I - 1]).IsOperator and (TExprWord(Items[I - 1]).MaxFunctionArg
         = 2))) then
       begin
         {replace e.g. ----1 with +1}
@@ -785,7 +766,7 @@ begin
           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 -
+          (TExprWord(Items[I + L - 1]).IsOperator and (TExprWord(Items[I + L -
           1]).MaxFunctionArg = 2))) do
         begin
           if TExprWord(Items[I + L]).Name = '-' then
@@ -811,7 +792,7 @@ begin
       if (TExprWord(Items[I]).Name = 'not')
         and ((I = 0) or
         (TExprWord(Items[I - 1]).ResultType = etLeftBracket) or
-        TExprWord(Items[I - 1]).IsOper) then
+        TExprWord(Items[I - 1]).IsOperator) then
       begin
         {replace e.g. not not 1 with 1}
         K := -1;
@@ -819,7 +800,7 @@ begin
         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
+          TExprWord(Items[I + L - 1]).IsOperator) do
         begin
           K := -K;
           Inc(L);
@@ -1005,6 +986,7 @@ var
 begin
   New(Result);
   Result.Oper := nil;
+  Result.AuxData := nil;
   for I := 0 to MaxArg - 1 do
   begin
     Result.Args[I] := nil;

fcl/db/dbase/Dbf_PrsDef.pas

@@ -59,6 +59,7 @@ type
     Next: PExpressionRec;
     Res: TDynamicType;
     ExprWord: TExprWord;
+    AuxData: pointer;
     ResetDest: Boolean;
     Args: array[0..MaxArg-1] of PChar;
     ArgsPos: array[0..MaxArg-1] of PChar;
@@ -69,7 +70,6 @@ type
 
   TExprCollection = class(TNoOwnerCollection)
   public
-    function NextOper(IStart: Integer): Integer;
     procedure Check;
     procedure EraseExtraBrackets;
   end;
@@ -77,7 +77,7 @@ type
   TExprWordRec = record
     Name: PChar;
     ShortName: PChar;
-    IsOper: Boolean;
+    IsOperator: Boolean;
     IsVariable: Boolean;
     IsFunction: Boolean;
     NeedsCopy: Boolean;
@@ -98,7 +98,7 @@ type
   protected
     FRefCount: Cardinal;
 
-    function GetIsOper: Boolean; virtual;
+    function GetIsOperator: Boolean; virtual;
     function GetIsVariable: Boolean;
     function GetNeedsCopy: Boolean;
     function GetFixedLen: Integer; virtual;
@@ -117,7 +117,7 @@ type
     function IsFunction: Boolean; virtual;
 
     property ExprFunc: TExprFunc read FExprFunc;
-    property IsOper: Boolean read GetIsOper;
+    property IsOperator: Boolean read GetIsOperator;
     property CanVary: Boolean read GetCanVary;
     property IsVariable: Boolean read GetIsVariable;
     property NeedsCopy: Boolean read GetNeedsCopy;
@@ -302,7 +302,7 @@ type
 
   TFunction = class(TExprWord)
   private
-    FIsOper: Boolean;
+    FIsOperator: Boolean;
     FOperPrec: Integer;
     FMinFunctionArg: Integer;
     FMaxFunctionArg: Integer;
@@ -312,7 +312,7 @@ type
     FResultType: TExpressionType;
   protected
     function GetDescription: string; override;
-    function GetIsOper: Boolean; override;
+    function GetIsOperator: Boolean; override;
     function GetMinFunctionArg: Integer; override;
     function GetMaxFunctionArg: Integer; override;
     function GetResultType: TExpressionType; override;
@@ -320,7 +320,7 @@ type
     function GetShortName: string; override;
 
     procedure InternalCreate(AName, ATypeSpec: string; AMinFuncArg: Integer; AResultType: TExpressionType;
-      AExprFunc: TExprFunc; AIsOper: Boolean; AOperPrec: Integer);
+      AExprFunc: TExprFunc; AIsOperator: 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);
@@ -447,7 +447,7 @@ begin
   Result := EmptyStr;
 end;
 
-function TExprWord.GetIsOper: Boolean;
+function TExprWord.GetIsOperator: Boolean;
 begin
   Result := False;
 end;
@@ -793,7 +793,7 @@ begin
   { also add ShortName as reference }
   if Length(TExprWord(Item).ShortName) > 0 then
   begin
-    FShortList.Search(KeyOf(Item), I);
+    FShortList.Search(FShortList.KeyOf(Item), I);
     FShortList.Insert(I, Item);
   end;
 end;
@@ -889,22 +889,6 @@ begin
   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;
@@ -923,7 +907,7 @@ begin
 end;
 
 procedure TFunction.InternalCreate(AName, ATypeSpec: string; AMinFuncArg: Integer; AResultType: TExpressionType;
-  AExprFunc: TExprFunc; AIsOper: Boolean; AOperPrec: Integer);
+  AExprFunc: TExprFunc; AIsOperator: Boolean; AOperPrec: Integer);
 begin
   inherited Create(AName, AExprFunc);
 
@@ -931,7 +915,7 @@ begin
   FMinFunctionArg := AMinFuncArg;
   if AMinFuncArg = -1 then
     FMinFunctionArg := FMaxFunctionArg;
-  FIsOper := AIsOper;
+  FIsOperator := AIsOperator;
   FOperPrec := AOperPrec;
   FTypeSpec := ATypeSpec;
   FResultType := AResultType;
@@ -946,9 +930,9 @@ begin
   Result := FDescription;
 end;
 
-function TFunction.GetIsOper: Boolean;
+function TFunction.GetIsOperator: Boolean;
 begin
-  Result := FIsOper;
+  Result := FIsOperator;
 end;
 
 function TFunction.GetMinFunctionArg: Integer;

fcl/db/dbase/Dbf_Reg.pas

@@ -1,368 +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.
+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.pas

@@ -1,38 +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.
-
+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

@@ -1,56 +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.
-
+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

@@ -1,47 +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.
+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

@@ -1,57 +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.
-
+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

@@ -1,36 +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.
-
+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

@@ -1,42 +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.
-
+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

@@ -8,7 +8,7 @@ const
   FieldPropType_Default     = $04;
   FieldPropType_Constraint  = $06;
 
-  FieldDescVII_AutoIncOffset = 40;
+  FieldDescVII_AutoIncOffset = 42;
 
 //====================================================================
 // File structures
@@ -65,9 +65,12 @@ type
     FieldPrecision : Byte;  // 34
     Reserved1      : Word;  // 35-36
     MDXFlag        : Byte;  // 37
-    Reserved2      : Cardinal; // 38-39
-    NextAutoInc    : Cardinal; // 40-43
-    Reserved3      : Word;  // 44-47
+    // NOTE: the docs say Reserved2 is 2 bytes, and Reserved3 is 4 bytes
+    //   but testing shows BDE has them the other way around
+    //   be BDE compatible :S
+    Reserved2      : Cardinal; // 38-41
+    NextAutoInc    : Cardinal; // 42-45
+    Reserved3      : Word; // 46-47
   end;
 //====================================================================
   PFieldPropsHdr = ^rFieldPropsHdr;

fcl/db/dbase/Dbf_Wtil.pas

@@ -407,7 +407,6 @@ const
 const
 
 {$IFDEF FPC}
-{$IFNDEF VER1_9_4}
    F_RDLCK = 0;
    F_WRLCK = 1;
    F_UNLCK = 2;
@@ -423,7 +422,6 @@ const
    LOCK_READ = 64;
    LOCK_WRITE = 128;
    LOCK_RW = 192;
-{$ENDIF}
 
    EACCES = ESysEACCES;
    EAGAIN = ESysEAGAIN;

fcl/db/dbase/history.txt

@@ -34,6 +34,37 @@ BUGS & WARNINGS
 
 
 
+------------------------
+V6.3.7
+
+- fixed: numeric index data exponent (rep by rpoverdijk)
+- fixed: big-endian issues in dbf_idxfile
+- added: spanish (thx mauricio) and brazilian portuguese translation (thx adilson)
+- fixed: opening memory streams; more generic implementation
+- fixed: querying ExactRecordCount on open table causes AV (rep by sikorsky)
+- added: smarter Dbf_Parser initialization (thx emled)
+- fixed: copy languageid and autoinc values upon restructure/pack
+- added: TDbf.LanguageID to set language id of new table; set before CreateTable
+- fixed: remember autoinc value after restructure
+- fixed: do not try to create foxpro currency fields if creating dbase table
+- speed: when reading v4 memo field, set size of stream in advance
+- fixed: empty field really returns empty string in parser
+- fixed: rewritten token parser, tree construction to be much simpler
+- speed: reduce number of getrecordcount calls, cache recordcount if possible
+
+
+------------------------
+V6.3.6
+
+- fixed: crash when optimizing expression with constants
+- fixed: expression parser to use variable-length string variables for non-raw
+    fields
+- added: support for opening (memory) streams as file
+- fixed: numeric mdx compatibility bug; bytes instead of decimals (rep by rpoverdijk)
+- fixed: integer fields store numerics padded with zeroes; now it uses spaces
+- added: use new, faster assembler SwapInt64 from arioch
+
+
 ------------------------
 V6.3.5
 

fcl/db/dbase/package.txt

@@ -1,11 +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
+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