Merged revisions 2281,2315,2435,2439-2442 via svnmerge from

http://[email protected]/svn/fpc/trunk

........
r2281 | joost | 2006-01-13 22:27:00 +0100 (Fri, 13 Jan 2006) | 6 lines

+ date/time fields handling compatibility fix
+ implemented BeforeRefresh and AfterRefresh
+ made TFieldDef.Required writeable (delphi compatible)
+ implemented TUpdateAction
+ Fixed web bug #4644

........
r2315 | marco | 2006-01-20 23:38:09 +0100 (Fri, 20 Jan 2006) | 2 lines

 * 64-bit patches from Neli and Andrew

........
r2435 | peter | 2006-02-05 02:49:55 +0100 (Sun, 05 Feb 2006) | 2 lines

  * duplicate names fixed

........
r2439 | florian | 2006-02-05 11:39:59 +0100 (Sun, 05 Feb 2006) | 2 lines

* TMemIniFile speed up from Patrick Chevalley

........
r2440 | joost | 2006-02-05 15:01:20 +0100 (Sun, 05 Feb 2006) | 1 line

 + Fixed applyupdates for empty datasets
........
r2441 | joost | 2006-02-05 16:04:27 +0100 (Sun, 05 Feb 2006) | 2 lines

 + Made TDataset.Setactive virtual
 + if a TSQLQuery is closed, the query is always unprepared (fix bug #4769)
........
r2442 | marco | 2006-02-05 16:51:34 +0100 (Sun, 05 Feb 2006) | 2 lines

 * patch from neli

........

git-svn-id: branches/fixes_2_0@2455 -

fcl/db/bufdataset.inc

@@ -365,6 +365,12 @@ begin
   Result := grOK;
 end;
 
+function TBufDataset.GetFieldData(Field: TField; Buffer: Pointer;
+  NativeFormat: Boolean): Boolean;
+begin
+  Result := GetFieldData(Field, Buffer);
+end;
+
 function TBufDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
 
 var
@@ -413,6 +419,12 @@ begin
     end;
 end;
 
+procedure TBufDataset.SetFieldData(Field: TField; Buffer: Pointer;
+  NativeFormat: Boolean);
+begin
+  SetFieldData(Field,Buffer);
+end;
+
 procedure TBufDataset.SetFieldData(Field: TField; Buffer: Pointer);
 var
   x        : longint;
@@ -593,8 +605,10 @@ var SaveBookmark : Integer;
 
 begin
   CheckBrowseMode;
-  if IsEmpty then exit;
-  SaveBookMark := GetRecNo;
+  
+  // There is no bookmark available if the dataset is empty
+  if not IsEmpty then
+    SaveBookMark := GetRecNo;
 
   r := 0;
   while r < Length(FUpdateBuffer) do
@@ -640,12 +654,13 @@ begin
       end;
     inc(r);
     end;
-  if not GetDeleted(pbyte(FBBuffers[savebookmark])) then
+  if not IsEmpty then
     begin
     InternalGotoBookMark(@SaveBookMark);
     Resync([rmExact,rmCenter]);
-    end;
-
+    end
+  else
+    InternalFirst;
 end;
 
 procedure TBufDataset.InternalPost;

fcl/db/dataset.inc

@@ -298,6 +298,13 @@ begin
    FAfterScroll(Self);
 end;
 
+Procedure TDataset.DoAfterRefresh;
+
+begin
+ If assigned(FAfterRefresh) then
+   FAfterRefresh(Self);
+end;
+
 Procedure TDataset.DoBeforeCancel;
 
 begin
@@ -354,6 +361,13 @@ begin
    FBeforeScroll(Self);
 end;
 
+Procedure TDataset.DoBeforeRefresh;
+
+begin
+ If assigned(FBeforeRefresh) then
+   FBeforeRefresh(Self);
+end;
+
 Procedure TDataset.DoInternalOpen;
 
 begin
@@ -501,26 +515,23 @@ end;
 function TDataSet.GetFieldData(Field: TField; Buffer: Pointer;
   NativeFormat: Boolean): Boolean;
 
-Const
-  TempBufSize = 1024; { Let's not exaggerate.}
-
 Var
-  Buf : Array[1..TempBufSize] of Char;
-  P : PChar;
+  DT : TFieldType;
+  DTRBuffer : TDateTimeRec;
 begin
   If NativeFormat then
     Result:=GetFieldData(Field, Buffer)
   else
     begin
-    If (Field.DataSize<=TempBufSize) then
-      P:=@Buf
+    DT := Field.DataType;
+    case DT of
+      ftDate, ftTime, ftDateTime: begin
+                                  Result := GetfieldData(Field, @DTRBuffer);
+                                  TDateTime(buffer^) := DateTimeRecToDateTime(DT, DTRBuffer);
+                                  end
     else
-      P:=GetMem(Field.DataSize);
-    Result:=GetFieldData(Field,P);
-    If Result then
-      DataConvert(Field,P,Buffer,False);
-    If (P<>@Buf) then
-      FreeMem(P);
+      Result:=GetFieldData(Field, Buffer)
+    end;
     end;
 end;
 
@@ -566,26 +577,6 @@ begin
     end;
 end;
 
-procedure TDataSet.DataConvert(Field: TField; Source, Dest: Pointer; ToNative: Boolean);
-
-Type
-  PDateTime = ^TDateTime;
-  PDateTimeRec = ^TDateTimeRec;
-
-Var
-  DT : TFieldType;
-
-begin
-  DT:=Field.DataType;
-  case DT of
-    ftDate, ftTime, ftDateTime:
-      if ToNative then
-         PDateTimeRec(Dest)^:=DateTimeToDateTimeRec(DT,PDateTime(Source)^)
-       else
-         PDateTime(Dest)^:=DateTimeRecToDateTime(DT,PDateTimeRec(Source)^);
-  end;
-end;
-
 procedure TDataSet.SetFieldData(Field: TField; Buffer: Pointer);
 
 begin
@@ -595,26 +586,25 @@ end;
 procedure TDataSet.SetFieldData(Field: TField; Buffer: Pointer;
   NativeFormat: Boolean);
 
-Const
-  TempBufSize = 1024; { Let's not exaggerate.}
 
 Var
-  Buf : Array[1..TempBufSize] of Char;
-  P : PChar;
+  DT : TFieldType;
+  DTRBuffer : TDateTimeRec;
 
 begin
   if NativeFormat then
     SetFieldData(Field, Buffer)
   else
     begin
-    if Field.DataSize<=dsMaxStringSize then
-      P:=GetMem(Field.DataSize)
+    DT := Field.DataType;
+    case DT of
+      ftDate, ftTime, ftDateTime: begin
+                                  DTRBuffer := DateTimeToDateTimeRec(DT,TDateTime(buffer^));
+                                  SetFieldData(Field,@DTRBuffer);
+                                  end
     else
-      P:=@Buf;
-    DataConvert(Field,Buffer,P,True);
-    SetFieldData(Field,P);
-    If (P<>@Buf) then
-      FreeMem(P);
+      SetFieldData(Field, Buffer);
+    end; {case};
     end;
 end;
 
@@ -1771,12 +1761,14 @@ Procedure TDataset.Refresh;
 
 begin
   CheckbrowseMode;
+  DoBeforeRefresh;
   UpdateCursorPos;
   InternalRefresh;
 { SetCurrentRecord is called by UpdateCursorPos already, so as long as
   InternalRefresh doesn't do strange things this should be ok. }
 //  SetCurrentRecord(FActiverecord);
   Resync([]);
+  DoAfterRefresh;
 end;
 
 Procedure TDataset.RegisterDataSource(ADatasource : TDataSource);

fcl/db/db.pp

@@ -127,6 +127,7 @@ type
     procedure SetDataType(AValue: TFieldType);
     procedure SetPrecision(const AValue: Longint);
     procedure SetSize(const AValue: Word);
+    procedure SetRequired(const AValue: Boolean);
   protected
     function GetDisplayName: string; override;
     procedure SetDisplayName(const AValue: string); override;
@@ -139,7 +140,7 @@ type
     property FieldClass: TFieldClass read GetFieldClass;
     property FieldNo: Longint read FFieldNo;
     property InternalCalcField: Boolean read FInternalCalcField write FInternalCalcField;
-    property Required: Boolean read FRequired;
+    property Required: Boolean read FRequired write SetRequired;
   Published
     property Attributes: TFieldAttributes read FAttributes write SetAttributes default [];
     property Name: string read FName write FName; // Must move to TNamedItem
@@ -884,6 +885,8 @@ type
 
   TDataAction = (daFail, daAbort, daRetry);
 
+  TUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApplied);
+
   TUpdateKind = (ukModify, ukInsert, ukDelete);
 
 
@@ -916,6 +919,7 @@ type
     FAfterInsert: TDataSetNotifyEvent;
     FAfterOpen: TDataSetNotifyEvent;
     FAfterPost: TDataSetNotifyEvent;
+    FAfterRefresh: TDataSetNotifyEvent;
     FAfterScroll: TDataSetNotifyEvent;
     FAutoCalcFields: Boolean;
     FBOF: Boolean;
@@ -926,6 +930,7 @@ type
     FBeforeInsert: TDataSetNotifyEvent;
     FBeforeOpen: TDataSetNotifyEvent;
     FBeforePost: TDataSetNotifyEvent;
+    FBeforeRefresh: TDataSetNotifyEvent;
     FBeforeScroll: TDataSetNotifyEvent;
     FBlobFieldCount: Longint;
     FBookmarkSize: Longint;
@@ -965,7 +970,6 @@ type
     Function  GetField (Index : Longint) : TField;
     Procedure RegisterDataSource(ADatasource : TDataSource);
     Procedure RemoveField (Field : TField);
-    Procedure SetActive (Value : Boolean);
     Procedure SetField (Index : Longint;Value : TField);
     Procedure ShiftBuffersForward;
     Procedure ShiftBuffersBackward;
@@ -997,6 +1001,7 @@ type
     procedure DoAfterOpen; virtual;
     procedure DoAfterPost; virtual;
     procedure DoAfterScroll; virtual;
+    procedure DoAfterRefresh; virtual;
     procedure DoBeforeCancel; virtual;
     procedure DoBeforeClose; virtual;
     procedure DoBeforeDelete; virtual;
@@ -1005,6 +1010,7 @@ type
     procedure DoBeforeOpen; virtual;
     procedure DoBeforePost; virtual;
     procedure DoBeforeScroll; virtual;
+    procedure DoBeforeRefresh; virtual;
     procedure DoOnCalcFields; virtual;
     procedure DoOnNewRecord; virtual;
     function  FieldByNumber(FieldNo: Longint): TField;
@@ -1033,6 +1039,7 @@ type
     procedure OpenCursor(InfoQuery: Boolean); virtual;
     procedure RefreshInternalCalcFields(Buffer: PChar); virtual;
     procedure RestoreState(const Value: TDataSetState);
+    Procedure SetActive (Value : Boolean); virtual;
     procedure SetBookmarkStr(const Value: TBookmarkStr); virtual;
     procedure SetBufListSize(Value: Longint);
     procedure SetChildOrder(Component: TComponent; Order: Longint); override;
@@ -1068,10 +1075,9 @@ type
     function GetDataSource: TDataSource; virtual;
     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; overload; virtual;
     function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload; virtual;
-    procedure DataConvert(Field: TField; Source, Dest: Pointer; ToNative: Boolean);virtual;
     function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; virtual; abstract;
     function GetRecordSize: Word; virtual; abstract;
-    procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); virtual; abstract;
+    procedure InternalAddRecord(Buffer: Pointer; AAppend: Boolean); virtual; abstract;
     procedure InternalClose; virtual; abstract;
     procedure InternalDelete; virtual; abstract;
     procedure InternalFirst; virtual; abstract;
@@ -1179,6 +1185,8 @@ type
     property AfterDelete: TDataSetNotifyEvent read FAfterDelete write FAfterDelete;
     property BeforeScroll: TDataSetNotifyEvent read FBeforeScroll write FBeforeScroll;
     property AfterScroll: TDataSetNotifyEvent read FAfterScroll write FAfterScroll;
+    property BeforeRefresh: TDataSetNotifyEvent read FBeforeRefresh write FBeforeRefresh;
+    property AfterRefresh: TDataSetNotifyEvent read FAfterRefresh write FAfterRefresh;
     property OnCalcFields: TDataSetNotifyEvent read FOnCalcFields write FOnCalcFields;
     property OnDeleteError: TDataSetErrorEvent read FOnDeleteError write FOnDeleteError;
     property OnEditError: TDataSetErrorEvent read FOnEditError write FOnEditError;
@@ -1532,7 +1540,11 @@ type
     procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
     procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
     function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
+    function GetFieldData(Field: TField; Buffer: Pointer;
+      NativeFormat: Boolean): Boolean; override;
     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
+    procedure SetFieldData(Field: TField; Buffer: Pointer;
+      NativeFormat: Boolean); override;
     procedure SetFieldData(Field: TField; Buffer: Pointer); override;
     function IsCursorOpen: Boolean; override;
     function  GetRecordCount: Longint; override;

fcl/db/dbase/Makefile

@@ -286,6 +286,15 @@ endif
 ifeq ($(FULL_TARGET),i386-wince)
 override TARGET_UNITS+=dbf
 endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),x86_64-win64)
+override TARGET_UNITS+=dbf
+endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_EXAMPLES+=testdbf
 endif
@@ -334,6 +343,15 @@ endif
 ifeq ($(FULL_TARGET),i386-wince)
 override TARGET_EXAMPLES+=testdbf
 endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),x86_64-win64)
+override TARGET_EXAMPLES+=testdbf
+endif
 ifeq ($(FULL_TARGET),i386-linux)
 override CLEAN_UNITS+=dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
 endif
@@ -496,6 +514,15 @@ endif
 ifeq ($(FULL_TARGET),i386-wince)
 override INSTALL_UNITS+=dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
 endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override INSTALL_UNITS+=dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override INSTALL_UNITS+=dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),x86_64-win64)
+override INSTALL_UNITS+=dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
 override INSTALL_FPCPACKAGE=y
 ifeq ($(FULL_TARGET),i386-linux)
 override COMPILER_OPTIONS+=-S2 -Sh

fcl/db/dbase/Makefile.fpc

@@ -9,6 +9,9 @@ main=fcl
 units_i386=dbf
 examples_i386=testdbf
 
+units_x86_64=dbf
+examples_x86_64=testdbf
+
 [compiler]
 options=-S2 -Sh
 
@@ -21,6 +24,11 @@ units_i386=dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur \
       dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile \
       dbf_prscore dbf_prsdef dbf_prssupp dbf_str
 
+
+units_x86_64=dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur \
+      dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile \
+      dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+
 [clean]
 units=dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur \
       dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile \

fcl/db/dbase/dbf.pas

@@ -299,7 +299,7 @@ type
 {$endif}
 
     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
-    procedure CheckDbfFieldDefs(DbfFieldDefs: TDbfFieldDefs);
+    procedure CheckDbfFieldDefs(ADbfFieldDefs: TDbfFieldDefs);
 
 {$ifdef VER1_0}
     procedure DataEvent(Event: TDataEvent; Info: Longint); override;
@@ -348,9 +348,7 @@ type
     procedure CompactIndexFile(const AIndexFile: string);
 
 {$ifdef SUPPORT_VARIANTS}
-{$ifdef USE_BUGGY_LOOKUP}
     function  Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; override;
-{$endif}
     function  Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; {$ifndef FPC_VERSION}override;{$endif}
 {$endif}
 
@@ -358,9 +356,9 @@ type
     procedure Undelete;
 
     procedure CreateTable;
-    procedure CreateTableEx(DbfFieldDefs: TDbfFieldDefs);
+    procedure CreateTableEx(ADbfFieldDefs: TDbfFieldDefs);
     procedure CopyFrom(DataSet: TDataSet; FileName: string; DateTimeAsString: Boolean; Level: Integer);
-    procedure RestructureTable(DbfFieldDefs: TDbfFieldDefs; Pack: Boolean);
+    procedure RestructureTable(ADbfFieldDefs: TDbfFieldDefs; Pack: Boolean);
     procedure PackTable;
     procedure EmptyTable;
     procedure Zap;
@@ -515,7 +513,7 @@ begin
 //      TDbf(FBlobField.DataSet).SetModified(true);
       // is following better? seems to provide notification for user (from VCL)
       if not (FBlobField.DataSet.State in [dsCalcFields, dsFilter, dsNewValue]) then
-        TDbf(FBlobField.DataSet).DataEvent(deFieldChange, Longint(FBlobField));
+        TDbf(FBlobField.DataSet).DataEvent(deFieldChange, PtrInt(FBlobField));
     end;
   end;
   Dec(FRefCount);
@@ -680,16 +678,18 @@ function TDbf.GetCurrentBuffer: PChar;
 begin
   case State of
     dsFilter:     Result := FFilterBuffer;
-    dsCalcFields: Result := @(pDbfRecord(CalcBuffer)^.DeletedFlag);
+    dsCalcFields: Result := CalcBuffer;
 //    dsSetKey:     Result := FKeyBuffer;     // TO BE Implemented
   else
     if IsEmpty then
     begin
       Result := nil;
     end else begin
-      Result := @(pDbfRecord(ActiveBuffer)^.DeletedFlag);
+      Result := ActiveBuffer;
     end;
   end;
+  if Result <> nil then
+    Result := @PDbfRecord(Result)^.DeletedFlag;
 end;
 
 function TDbf.GetFieldData(Field: TField; Buffer: Pointer): Boolean; {override virtual abstract from TDataset}
@@ -824,7 +824,7 @@ begin
     begin
       if Filtered or FFindRecordFilter then
       begin
-        FFilterBuffer := @pRecord^.DeletedFlag;
+        FFilterBuffer := Buffer;
         SaveState := SetTempState(dsFilter);
         DoFilterRecord(acceptable);
         RestoreState(SaveState);
@@ -901,9 +901,8 @@ begin
   // free blobs
   if FBlobStreams <> nil then
   begin
-    for I := 0 to Pred(FieldCount) do
-      if FBlobStreams^[I] <> nil then
-        FBlobStreams^[I].Free;
+    for I := 0 to Pred(FieldDefs.Count) do
+      FBlobStreams^[I].Free;
     FreeMemAndNil(Pointer(FBlobStreams));
   end;
   FreeRecordBuffer(FTempBuffer);
@@ -915,8 +914,6 @@ begin
 
   if FParser <> nil then
     FreeAndNil(FParser);
-  if (FDbfFile <> nil) and not FReadOnly then
-    FDbfFile.WriteHeader;
   FreeAndNil(FCursor);
   if FDbfFile <> nil then
     FreeAndNil(FDbfFile);
@@ -927,7 +924,7 @@ var
   I: Integer;
 begin
   // cancel blobs
-  for I := 0 to Pred(FieldCount) do
+  for I := 0 to Pred(FieldDefs.Count) do
     if Assigned(FBlobStreams^[I]) then
       FBlobStreams^[I].Cancel;
   // if we have locked a record, unlock it
@@ -1193,9 +1190,7 @@ begin
   BindFields(true);
 
   // create array of blobstreams to store memo's in. each field is a possible blob
-  GetMem(FBlobStreams, FieldCount * SizeOf(TDbfBlobStream));
-  for I := 0 to Pred(FieldCount) do
-    FBlobStreams^[I] := nil;
+  FBlobStreams := AllocMem(FieldDefs.Count * SizeOf(TDbfBlobStream));
 
   // check codepage settings
   DetermineTranslationMode;
@@ -1290,7 +1285,7 @@ begin
   FEditingRecNo := FCursor.PhysicalRecNo;
   // reread blobs, execute cancel -> clears remembered memo pageno,
   // causing it to reread the memo contents
-  for I := 0 to Pred(FieldCount) do
+  for I := 0 to Pred(FieldDefs.Count) do
     if Assigned(FBlobStreams^[I]) then
       FBlobStreams^[I].Cancel;
   // try to lock this record
@@ -1317,7 +1312,7 @@ begin
   // if internalpost is called, we know we are active
   pRecord := pDbfRecord(ActiveBuffer);
   // commit blobs
-  for I := 0 to Pred(FieldCount) do
+  for I := 0 to Pred(FieldDefs.Count) do
     if Assigned(FBlobStreams^[I]) then
       FBlobStreams^[I].Commit;
   if State = dsEdit then
@@ -1371,7 +1366,7 @@ begin
   CreateTableEx(nil);
 end;
 
-procedure TDbf.CheckDbfFieldDefs(DbfFieldDefs: TDbfFieldDefs);
+procedure TDbf.CheckDbfFieldDefs(ADbfFieldDefs: TDbfFieldDefs);
 var
   I: Integer;
   TempDef: TDbfFieldDef;
@@ -1388,12 +1383,12 @@ var
     end;
 
 begin
-  if DbfFieldDefs = nil then exit;
+  if ADbfFieldDefs = nil then exit;
 
-  for I := 0 to DbfFieldDefs.Count - 1 do
+  for I := 0 to ADbfFieldDefs.Count - 1 do
   begin
     // check dbffielddefs for errors
-    TempDef := DbfFieldDefs.Items[I];
+    TempDef := ADbfFieldDefs.Items[I];
     if FTableLevel < 7 then
       if not (TempDef.NativeFieldType in ['C', 'F', 'N', 'D', 'L', 'M']) then
         raise EDbfError.CreateFmt(STRING_INVALID_FIELD_TYPE,
@@ -1401,7 +1396,7 @@ begin
   end;
 end;
 
-procedure TDbf.CreateTableEx(DbfFieldDefs: TDbfFieldDefs);
+procedure TDbf.CreateTableEx(ADbfFieldDefs: TDbfFieldDefs);
 var
   I: Integer;
   lIndex: TDbfIndexDef;
@@ -1409,14 +1404,14 @@ var
   tempFieldDefs: Boolean;
 begin
   CheckInactive;
-  tempFieldDefs := DbfFieldDefs = nil;
+  tempFieldDefs := ADbfFieldDefs = nil;
   try
     try
       if tempFieldDefs then
       begin
-        DbfFieldDefs := TDbfFieldDefs.Create(Self);
-        DbfFieldDefs.DbfVersion := TableLevelToDbfVersion(FTableLevel);
-        DbfFieldDefs.UseFloatFields := FUseFloatFields;
+        ADbfFieldDefs := TDbfFieldDefs.Create(Self);
+        ADbfFieldDefs.DbfVersion := TableLevelToDbfVersion(FTableLevel);
+        ADbfFieldDefs.UseFloatFields := FUseFloatFields;
 
         // get fields -> fielddefs if no fielddefs
 {$ifndef FPC_VERSION}
@@ -1427,7 +1422,7 @@ begin
         // fielddefs -> dbffielddefs
         for I := 0 to FieldDefs.Count - 1 do
         begin
-          with DbfFieldDefs.AddFieldDef do
+          with ADbfFieldDefs.AddFieldDef do
           begin
             FieldName := FieldDefs.Items[I].Name;
             FieldType := FieldDefs.Items[I].DataType;
@@ -1447,7 +1442,7 @@ begin
       FDbfFile.DbfVersion := TableLevelToDbfVersion(FTableLevel);
       FDbfFile.FileLangID := FLanguageID;
       FDbfFile.Open;
-      FDbfFile.FinishCreate(DbfFieldDefs, 512);
+      FDbfFile.FinishCreate(ADbfFieldDefs, 512);
 
       // if creating memory table, copy stream pointer
       if FStorage = stoMemory then
@@ -1471,8 +1466,8 @@ begin
     end;
   finally
     // free temporary fielddefs
-    if tempFieldDefs and Assigned(DbfFieldDefs) then
-      DbfFieldDefs.Free;
+    if tempFieldDefs and Assigned(ADbfFieldDefs) then
+      ADbfFieldDefs.Free;
     FreeAndNil(FDbfFile);
   end;
 end;
@@ -1489,12 +1484,12 @@ begin
   FDbfFile.Zap;
 end;
 
-procedure TDbf.RestructureTable(DbfFieldDefs: TDbfFieldDefs; Pack: Boolean);
+procedure TDbf.RestructureTable(ADbfFieldDefs: TDbfFieldDefs; Pack: Boolean);
 begin
   CheckInactive;
 
   // check field defs for errors
-  CheckDbfFieldDefs(DbfFieldDefs);
+  CheckDbfFieldDefs(ADbfFieldDefs);
 
   // open dbf file
   InitDbfFile(pfExclusiveOpen);
@@ -1502,7 +1497,7 @@ begin
 
   // do restructure
   try
-    FDbfFile.RestructureTable(DbfFieldDefs, Pack);
+    FDbfFile.RestructureTable(ADbfFieldDefs, Pack);
   finally
     // close file
     FreeAndNil(FDbfFile);
@@ -1525,9 +1520,13 @@ end;
 
 procedure TDbf.CopyFrom(DataSet: TDataSet; FileName: string; DateTimeAsString: Boolean; Level: Integer);
 var
+  lPhysFieldDefs, lFieldDefs: TDbfFieldDefs;
+  lSrcField, lDestField: TField;
   I: integer;
 begin
   FInCopyFrom := true;
+  lFieldDefs := TDbfFieldDefs.Create(nil);
+  lPhysFieldDefs := TDbfFieldDefs.Create(nil);
   try
     if Active then
       Close;
@@ -1538,29 +1537,61 @@ begin
     if not DataSet.Active then
       DataSet.Open;
     DataSet.FieldDefs.Update;
-    FieldDefs.Assign(DataSet.FieldDefs);
-    IndexDefs.Clear;
-    CreateTable;
+    // first get a list of physical field defintions
+    // we need it for numeric precision in case source is tdbf
+    if DataSet is TDbf then
+    begin
+      lPhysFieldDefs.Assign(TDbf(DataSet).DbfFieldDefs);
+      IndexDefs.Assign(TDbf(DataSet).IndexDefs);
+    end else begin
+      lPhysFieldDefs.Assign(DataSet.FieldDefs);
+      IndexDefs.Clear;
+    end;
+    // convert list of tfields into a list of tdbffielddefs
+    // so that our tfields will correspond to the source tfields
+    for I := 0 to Pred(DataSet.FieldCount) do
+    begin
+      lSrcField := DataSet.Fields[I];
+      with lFieldDefs.AddFieldDef do
+      begin
+        FieldName := lSrcField.Name;
+        FieldType := lSrcField.DataType;
+        Required := lSrcField.Required;
+        Size := lSrcField.Size;
+        if (0 <= lSrcField.FieldNo) 
+            and (lSrcField.FieldNo < lPhysFieldDefs.Count) then
+          Precision := lPhysFieldDefs.Items[lSrcField.FieldNo].Precision;
+      end;
+    end;
+
+    CreateTableEx(lFieldDefs);
     Open;
     DataSet.First;
+{$ifdef USE_CACHE}
+    FDbfFile.BufferAhead := true;
+    if DataSet is TDbf then
+      TDbf(DataSet).DbfFile.BufferAhead := true;
+{$endif}      
     while not DataSet.EOF do
     begin
       Append;
       for I := 0 to Pred(FieldCount) do
       begin
-        if not DataSet.Fields[I].IsNull then
+        lSrcField := DataSet.Fields[I];
+        lDestField := Fields[I];
+        if not lSrcField.IsNull then
         begin
-          if DataSet.Fields[I].DataType = ftDateTime then
+          if lSrcField.DataType = ftDateTime then
           begin
             if FCopyDateTimeAsString then
             begin
-              Fields[I].AsString := DataSet.Fields[I].AsString;
+              lDestField.AsString := lSrcField.AsString;
               if Assigned(FOnCopyDateTimeAsString) then
-                FOnCopyDateTimeAsString(Self, Fields[I], DataSet.Fields[I])
+                FOnCopyDateTimeAsString(Self, lDestField, lSrcField)
             end else
-              Fields[I].AsDateTime := DataSet.Fields[I].AsDateTime;
+              lDestField.AsDateTime := lSrcField.AsDateTime;
           end else
-            Fields[I].Assign(DataSet.Fields[I]);
+            lDestField.Assign(lSrcField);
         end;
       end;
       Post;
@@ -1568,7 +1599,13 @@ begin
     end;
     Close;
   finally
+{$ifdef USE_CACHE}
+    if (DataSet is TDbf) and (TDbf(DataSet).DbfFile <> nil) then
+      TDbf(DataSet).DbfFile.BufferAhead := false;
+{$endif}      
     FInCopyFrom := false;
+    lFieldDefs.Free;
+    lPhysFieldDefs.Free;
   end;
 end;
 
@@ -1605,64 +1642,56 @@ begin
 end;
 
 {$ifdef SUPPORT_VARIANTS}
-{$ifdef USE_BUGGY_LOOKUP}
 
 function TDbf.Lookup(const KeyFields: string; const KeyValues: Variant;
   const ResultFields: string): Variant;
 var
 //  OldState:  TDataSetState;
-  retBookmark: TBookmarkStr;
+  saveRecNo: integer;
+  saveState: TDataSetState;
 begin
   Result := Null;
-  if VarIsNull(KeyValues) then exit;
+  if (FCursor = nil) or VarIsNull(KeyValues) then exit;
 
-  retBookmark := Bookmark;
-  DisableControls;
+  saveRecNo := FCursor.SequentialRecNo;
   try
     if LocateRecord(KeyFields, KeyValues, []) then
     begin
-{
-      OldState := SetTempState(dsCalcFields);
-//      OldState := SetTempState(dsInternalCalc);
-        // disable Calculated fields - otherwise were heavy AVs
-        // and buffer troubles below
+      // FFilterBuffer contains record buffer
+      saveState := SetTempState(dsCalcFields);
       try
-//        CalculateFields(PChar(@FDbfCalcBuffer));
-        CalculateFields(TempBuffer);
-//        CalculateFields(GetCurrentBuffer);
-        if KeyValues = FieldValues[KeyFields] then // there was bug in TDbf.SearchKey
-}
-           Result := FieldValues[ResultFields]; // also there may be buffer troubles from above
-{
+        CalculateFields(FFilterBuffer);
+        if KeyValues = FieldValues[KeyFields] then
+           Result := FieldValues[ResultFields];
       finally
-          (* else *) RestoreState(OldState);
+        RestoreState(saveState);
       end;
-}
     end;
   finally
-    Bookmark := retBookmark;
-    EnableControls;
+    FCursor.SequentialRecNo := saveRecNo;
   end;
 end;
 
-{$endif}
-
 function TDbf.Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean;
 var
-  retBookmark: TBookmarkStr;
+  saveRecNo: integer;
 begin
-  DoBeforeScroll;
-  try
-    DisableControls;
-    retBookmark := Bookmark;
-    Result := LocateRecord(KeyFields, KeyValues, Options);
-    if Result then
-      DoAfterScroll
-    else
-      Bookmark := retBookmark;
-  finally
-    EnableControls;
+  if FCursor = nil then
+  begin
+    Result := false;
+    exit;
   end;
+
+  DoBeforeScroll;
+  saveRecNo := FCursor.SequentialRecNo;
+  Result := LocateRecord(KeyFields, KeyValues, Options);
+  CursorPosChanged;
+  if Result then
+  begin
+    Resync([]);
+    DoAfterScroll;
+  end else
+    FCursor.SequentialRecNo := saveRecNo;
 end;
 
 function TDbf.LocateRecord(const KeyFields: String; const KeyValues: Variant;
@@ -1675,7 +1704,6 @@ var
   bVarIsArray          : Boolean;
   varCompare           : Variant;
   doLinSearch          : Boolean;
-  pIndexValue          : PChar;
 
   function CompareValues: Boolean;
   var
@@ -1713,13 +1741,12 @@ var
 
 var
   searchFlag: TSearchKeyType;
-  searchString: string;
-  strLength: Integer;
+  lPhysRecNo, matchRes: Integer;
+  SaveState: TDataSetState;
+  lTempBuffer: array [0..100] of Char;
 
 begin
   Result := false;
-  CheckBrowseMode;
-
   doLinSearch := true;
   // index active?
   if FCursor is TIndexCursor then
@@ -1733,18 +1760,24 @@ begin
         searchFlag := stGreaterEqual
       else
         searchFlag := stEqual;
-      Result := SearchKey(KeyValues, searchFlag);
-      if Result and (loPartialKey in Options) then
+      TIndexCursor(FCursor).VariantToBuffer(KeyValues, @lTempBuffer[0]);
+      Result := FIndexFile.SearchKey(@lTempBuffer[0], searchFlag);
+      if Result then
       begin
-        searchString := VarToStr(KeyValues);
-        strLength := Length(searchString);
-        pIndexValue := TIndexCursor(FCursor).IndexFile.ExtractKeyFromBuffer(GetCurrentBuffer);
-        if loCaseInsensitive in Options then
+        Result := GetRecord(TempBuffer, gmCurrent, false) = grOK;
+        if not Result then
         begin
-          Result := AnsiStrLIComp(pIndexValue, PChar(searchString), strLength) = 0;
-        end else begin
-          Result := StrLComp(pIndexValue, PChar(searchString), strLength) = 0;
+          Result := GetRecord(TempBuffer, gmNext, false) = grOK;
+          if Result then
+          begin
+            matchRes := TIndexCursor(FCursor).IndexFile.MatchKey(@lTempBuffer[0]);
+            if loPartialKey in Options then
+              Result := matchRes <= 0
+            else
+              Result := matchRes =  0;
+          end;
         end;
+        FFilterBuffer := TempBuffer;
       end;
     end;
   end;
@@ -1752,8 +1785,9 @@ begin
   if doLinSearch then
   begin
     bVarIsArray := false;
-    CursorPosChanged;
     lstKeys := TList.Create;
+    FFilterBuffer := TempBuffer;
+    SaveState := SetTempState(dsFilter);
     try
       GetFieldList(lstKeys, KeyFields);
       if VarArrayDimCount(KeyValues) = 0 then
@@ -1766,10 +1800,18 @@ begin
         bMatchedData := false;
       if bMatchedData then
       begin
-        First;
-        while not Eof and not Result Do
+        FCursor.First;
+        while not Result and FCursor.Next do
         begin
-          Result := true;
+          lPhysRecNo := FCursor.PhysicalRecNo;
+          if (lPhysRecNo = 0) or not FDbfFile.IsRecordPresent(lPhysRecNo) then
+            break;
+          
+          FDbfFile.ReadRecord(lPhysRecNo, @PDbfRecord(FFilterBuffer)^.DeletedFlag);
+          Result := FShowDeleted or (PDbfRecord(FFilterBuffer)^.DeletedFlag <> '*');
+          if Result and Filtered then
+            DoFilterRecord(Result);
+          
           iIndex := 0;
           while Result and (iIndex < lstKeys.Count) Do
           begin
@@ -1779,14 +1821,13 @@ begin
             else
               varCompare := KeyValues;
             Result := CompareValues;
-            iIndex := iIndex + 1;
+            Inc(iIndex);
           end;
-          if not Result then
-            Next;
         end;
       end;
     finally
       lstKeys.Free;
+      RestoreState(SaveState);
     end;
   end;
 end;
@@ -1834,11 +1875,11 @@ 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
-{$ifdef DELPHI_3}    
+{$ifdef DELPHI_3}
       DatabaseError(SNotEditing);
-{$else}    
+{$else}
       DatabaseError(SNotEditing, Self);
-{$endif}      
+{$endif}
   // already created a `placeholder' blob for this field?
   MemoFieldNo := Field.FieldNo - 1;
   if FBlobStreams^[MemoFieldNo] = nil then
@@ -1861,7 +1902,7 @@ begin
       lBlob.ReadSize := 0;
     end;
     lBlob.MemoRecNo := MemoPageNo;
-  end else 
+  end else
   if not lBlob.Dirty or (Mode = bmWrite) then
   begin
     // reading and memo is empty and not written yet, or rewriting
@@ -2011,7 +2052,7 @@ begin
 //    end;
   end;     { end of ***** fkCalculated, fkLookup ***** }
   if not (State in [dsCalcFields, dsFilter, dsNewValue]) then begin
-    DataEvent(deFieldChange, Longint(Field));
+    DataEvent(deFieldChange, PtrInt(Field));
   end;
 end;
 
@@ -2331,7 +2372,7 @@ begin
     Result := lIndexDef.SortField;
 end;
 
-procedure tdbf.SetIndexFieldNames(const Value: string);
+procedure TDbf.SetIndexFieldNames(const Value: string);
 var
   lIndexDef: TDbfIndexDef;
 begin

fcl/db/dbase/dbf_avl.pas

@@ -2,6 +2,11 @@ unit dbf_avl;
 
 interface
 
+{$I dbf_common.inc}
+
+uses
+  Dbf_Common;
+
 type
   TBal = -1..1;
 

fcl/db/dbase/dbf_common.inc

@@ -3,6 +3,12 @@
 
 {.$define USE_CACHE}
 
+// define the following if you want support for 65535 length character
+// fields for all dbase files (and not only foxpro); if you define this, 
+// you will not be able to read MS Excel generated .dbf files!
+
+{.$define USE_LONG_CHAR_FIELDS}
+
 // modifies unix unit dbf_wtil to use hungarian encodings (hack)
 
 {.$define HUNGARIAN}
@@ -15,10 +21,6 @@
 
 {.$define TDBF_UPDATE_FIRSTLAST_NODE}
 
-// use this to enable the lookup function which is still buggy
-
-{.$define USE_BUGGY_LOOKUP}
-
 // use this directive to suppress math exceptions,
 // instead NAN is returned.
 // Using this directive is slightly less efficient
@@ -131,6 +133,29 @@
   {$define DELPHI_3}
 {$endif}
 
+{$ifdef VER180} // Delphi 2006
+  {$define DELPHI_2006}
+  {$define DELPHI_2005}
+  {$define DELPHI_8}
+  {$define DELPHI_7}
+  {$define DELPHI_6}
+  {$define DELPHI_5}
+  {$define DELPHI_4}
+  {$define DELPHI_3}
+{$endif}
+
+{$ifdef VER190} // Delphi 2007
+  {$define DELPHI_2007}
+  {$define DELPHI_2006}
+  {$define DELPHI_2005}
+  {$define DELPHI_8}
+  {$define DELPHI_7}
+  {$define DELPHI_6}
+  {$define DELPHI_5}
+  {$define DELPHI_4}
+  {$define DELPHI_3}
+{$endif}
+
 //-------------------------------------------------------
 //--- Conclude supported features from delphi version ---
 //-------------------------------------------------------
@@ -202,6 +227,13 @@
   {$define SUPPORT_REINTRODUCE}
   {$define SUPPORT_MATH_UNIT}
 
+  // FPC 2.0.x improvements
+  {$ifdef VER2}
+    {$ifndef VER2_0_0}
+      {$define SUPPORT_BACKWARD_FIELDDATA}
+    {$endif}
+  {$endif}
+
   // FPC 1.0.x exceptions: no 0/0 support
   {$ifdef VER1_0}
     {$undef NAN}

fcl/db/dbase/dbf_common.pas

@@ -17,7 +17,7 @@ uses
 
 const
   TDBF_MAJOR_VERSION      = 6;
-  TDBF_MINOR_VERSION      = 45;
+  TDBF_MINOR_VERSION      = 48;
   TDBF_SUB_MINOR_VERSION  = 0;
 
   TDBF_TABLELEVEL_FOXPRO = 25;
@@ -44,6 +44,8 @@ type
       ftTime: (Time: Longint);
       ftDateTime: (DateTime: TDateTimeAlias);
   end;
+{$else}
+  PtrInt = Longint;
 {$endif}
 
   PSmallInt = ^SmallInt;
@@ -56,6 +58,10 @@ type
   PLargeInt = ^Int64;
 {$endif}
 
+{$ifdef DELPHI_3}
+  dword = cardinal;
+{$endif}
+
 //-------------------------------------
 
 {$ifndef SUPPORT_FREEANDNIL}
@@ -98,7 +104,8 @@ function GetFreeMemory: Integer;
 {$endif}
 
 // OH 2000-11-15 dBase7 support. Swap Byte order for 4 and 8 Byte Integer
-function SwapInt(const Value: Cardinal): Cardinal;
+function SwapWord(const Value: word): word;
+function SwapInt(const Value: dword): dword;
 { SwapInt64 NOTE: do not call with same value for Value and Result ! }
 procedure SwapInt64(Value, Result: Pointer); register;
 
@@ -112,6 +119,7 @@ function MemScan(const Buffer: Pointer; Chr: Byte; Length: Integer): Pointer;
 {$ifdef DELPHI_3}
 {$ifndef DELPHI_4}
 function Min(x, y: integer): integer;
+function Max(x, y: integer): integer;
 {$endif}
 {$endif}
 
@@ -340,9 +348,14 @@ end;
 // Utility routines
 //====================================================================
 
+function SwapWord(const Value: word): word;
+begin
+  Result := ((Value and $FF) shl 8) or ((Value shr 8) and $FF);
+end;
+
 {$ifdef USE_ASSEMBLER_486_UP}
 
-function SwapInt(const Value: Cardinal): Cardinal; register; assembler;
+function SwapInt(const Value: dword): dword; register; assembler;
 asm
   BSWAP EAX;
 end;
@@ -466,6 +479,14 @@ begin
     result := y;
 end;
 
+function Max(x, y: integer): integer;
+begin
+  if x < y then
+    result := y
+  else
+    result := x;
+end;
+
 {$endif}
 {$endif}
 

fcl/db/dbase/dbf_dbffile.pas

@@ -52,6 +52,7 @@ type
     FIndexFiles: TList;
     FDbfVersion: TXBaseVersion;
     FPrevBuffer: PChar;
+    FDefaultBuffer: PChar;
     FRecordBufferSize: Integer;
     FLockUserLen: DWORD;
     FFileCodePage: Cardinal;
@@ -78,6 +79,7 @@ type
     
   protected
     procedure ConstructFieldDefs;
+    procedure InitDefaultBuffer;
     procedure UpdateNullField(Buffer: Pointer; AFieldDef: TDbfFieldDef; Action: TUpdateNullField);
     procedure WriteLockInfo(Buffer: PChar);
 
@@ -89,7 +91,7 @@ type
     procedure Close;
     procedure Zap;
 
-    procedure FinishCreate(FieldDefs: TDbfFieldDefs; MemoSize: Integer);
+    procedure FinishCreate(AFieldDefs: TDbfFieldDefs; MemoSize: Integer);
     function GetIndexByName(AIndexName: string): TIndexFile;
     procedure SetRecordSize(NewSize: Integer); override;
 
@@ -293,11 +295,6 @@ begin
   FFieldDefs := TDbfFieldDefs.Create(nil);
   FIndexNames := TStringList.Create;
   FIndexFiles := TList.Create;
-  FOnLocaleError := nil;
-  FOnIndexMissing := nil;
-  FMdxFile := nil;
-  FForceClose := false;
-  FCopyDateTimeAsString := false;
 
   // now initialize inherited
   inherited;
@@ -340,6 +337,7 @@ var
   MemoFileClass: TMemoFileClass;
   I: Integer;
   deleteLink: Boolean;
+  lModified: boolean;
   LangStr: PChar;
   version: byte;
 begin
@@ -350,6 +348,7 @@ begin
     OpenFile;
 
     // check if we opened an already existing file
+    lModified := false;
     if not FileCreated then
     begin
       HeaderSize := sizeof(rDbfHdr); // temporary
@@ -406,7 +405,7 @@ begin
         //             'RecordCount in Hdr : '+IntToStr(PDbfHdr(Header).RecordCount)+^M+
         //             'expected : '+IntToStr(RecordCount));
         PDbfHdr(Header)^.RecordCount := RecordCount;
-        WriteHeader;        // Correct it
+        lModified := true;
       end;
       // determine codepage
       if FDbfVersion >= xBaseVII then
@@ -474,10 +473,16 @@ begin
         FMemoFile.Open;
         // set header blob flag corresponding to field list
         if FDbfVersion <> xFoxPro then
+        begin
           PDbfHdr(Header)^.VerDBF := PDbfHdr(Header)^.VerDBF or $80;
+          lModified := true;
+        end;
       end else
         if FDbfVersion <> xFoxPro then
+        begin
           PDbfHdr(Header)^.VerDBF := PDbfHdr(Header)^.VerDBF and $7F;
+          lModified := true;
+        end;
       // check if mdx flagged
       if (FDbfVersion <> xFoxPro) and (PDbfHdr(Header)^.MDXFlag <> 0) then
       begin
@@ -510,13 +515,19 @@ begin
             FOnIndexMissing(deleteLink);
           // correct flag
           if deleteLink then
-            PDbfHdr(Header)^.MDXFlag := 0
-          else
+          begin
+            PDbfHdr(Header)^.MDXFlag := 0;
+            lModified := true;
+          end else
             FForceClose := true;
         end;
       end;
     end;
 
+    // record changes
+    if lModified then
+      WriteHeader;
+    
     // open indexes
     for I := 0 to FIndexFiles.Count - 1 do
       TIndexFile(FIndexFiles.Items[I]).Open;
@@ -557,15 +568,15 @@ begin
       end;
     end;
     FreeAndNil(FMdxFile);
-    if FPrevBuffer <> nil then
-      FreeMemAndNil(Pointer(FPrevBuffer));
+    FreeMemAndNil(Pointer(FPrevBuffer));
+    FreeMemAndNil(Pointer(FDefaultBuffer));
 
     // reset variables
     FFileLangId := 0;
   end;
 end;
 
-procedure TDbfFile.FinishCreate(FieldDefs: TDbfFieldDefs; MemoSize: Integer);
+procedure TDbfFile.FinishCreate(AFieldDefs: TDbfFieldDefs; MemoSize: Integer);
 var
   lFieldDescIII: rFieldDescIII;
   lFieldDescVII: rFieldDescVII;
@@ -623,9 +634,9 @@ begin
     FFieldDefs.Clear;
     // deleted mark 1 byte
     lFieldOffset := 1;
-    for I := 1 to FieldDefs.Count do
+    for I := 1 to AFieldDefs.Count do
     begin
-      lFieldDef := FieldDefs.Items[I-1];
+      lFieldDef := AFieldDefs.Items[I-1];
 
       // check if datetime conversion
       if FCopyDateTimeAsString then
@@ -644,7 +655,11 @@ begin
       // apply field transformation tricks
       lSize := lFieldDef.Size;
       lPrec := lFieldDef.Precision;
-      if (FDbfVersion = xFoxPro) and (lFieldDef.NativeFieldType = 'C') then
+      if (lFieldDef.NativeFieldType = 'C')
+{$ifndef USE_LONG_CHAR_FIELDS}
+          and (FDbfVersion = xFoxPro)
+{$endif}
+                then
       begin
         lPrec := lSize shr 8;
         lSize := lSize and $FF;
@@ -707,7 +722,7 @@ begin
 
     // update header
     PDbfHdr(Header)^.RecordSize := lFieldOffset;
-    PDbfHdr(Header)^.FullHdrSize := HeaderSize + RecordSize * FieldDefs.Count + 1;
+    PDbfHdr(Header)^.FullHdrSize := HeaderSize + RecordSize * AFieldDefs.Count + 1;
     // add empty "back-link" info, whatever it is: 
     { A 263-byte range that contains the backlink, which is the relative path of 
       an associated database (.dbc) file, information. If the first byte is 0x00, 
@@ -859,7 +874,11 @@ begin
       end;
 
       // apply field transformation tricks
-      if (lNativeFieldType = 'C') and (FDbfVersion = xFoxPro) then
+      if (lNativeFieldType = 'C') 
+{$ifdef USE_LONG_CHAR_FIELDS}
+          and (FDbfVersion = xFoxPro) 
+{$endif}
+                then
       begin
         lSize := lSize + lPrec shl 8;
         lPrec := 0;
@@ -913,17 +932,8 @@ begin
     if FFieldDefs.Count >= 4096 then
       raise EDbfError.CreateFmt(STRING_INVALID_FIELD_COUNT, [FFieldDefs.Count]);
 
-{
-    // removed check because additional data could be present in record
-
-    if (lFieldOffset <> PDbfHdr(Header).RecordSize) then
-    begin
-      // I removed the message because it confuses end-users.
-      // Though there is a major problem if the value is wrong...
-      // I try to fix it but it is likely to crash
-      PDbfHdr(Header).RecordSize := lFieldOffset;
-    end;
-}
+    // do not check FieldOffset = PDbfHdr(Header).RecordSize because additional 
+    // data could be present in record
 
     // get current position
     lPropHdrOffset := Stream.Position;
@@ -978,7 +988,6 @@ begin
       // read custom properties...not implemented
       // read RI properties...not implemented
     end;
-
   finally
     HeaderSize := PDbfHdr(Header)^.FullHdrSize;
     RecordSize := PDbfHdr(Header)^.RecordSize;
@@ -1410,6 +1419,7 @@ var
   ldd, ldm, ldy, lth, ltm, lts: Integer;
   date: TDateTime;
   timeStamp: TTimeStamp;
+  asciiContents: boolean;
 
 {$ifdef SUPPORT_INT64}
   function GetInt64FromStrLength(Src: Pointer; Size: Integer; Default: Int64): Int64;
@@ -1486,6 +1496,7 @@ begin
   FieldOffset := AFieldDef.Offset;
   FieldSize := AFieldDef.Size;
   Src := PChar(Src) + FieldOffset;
+  asciiContents := false;
   // field types that are binary and of which the fieldsize should not be truncated
   case AFieldDef.NativeFieldType of
     '+', 'I':
@@ -1495,7 +1506,7 @@ begin
           Result := PDWord(Src)^ <> 0;
           if Result and (Dst <> nil) then
           begin
-            PInteger(Dst)^ := SwapInt(PInteger(Src)^);
+            PDWord(Dst)^ := SwapInt(PDWord(Src)^);
             if Result then
               PInteger(Dst)^ := Integer(PDWord(Dst)^ xor $80000000);
           end;
@@ -1564,7 +1575,27 @@ begin
         end;
 {$endif}
       end;
+    'B':    // foxpro double
+      begin
+        Result := true;
+        if Dst <> nil then
+          PDouble(Dst)^ := PDouble(Src)^;
+      end;
+    'M':
+      begin
+        if FieldSize = 4 then
+        begin
+          Result := PInteger(Src)^ <> 0;
+          if Dst <> nil then
+            PInteger(Dst)^ := PInteger(Src)^;
+        end else
+          asciiContents := true;
+      end;
   else
+    asciiContents := true;
+  end;
+  if asciiContents then
+  begin
     //    SetString(s, PChar(Src) + FieldOffset, FieldSize );
     //    s := {TrimStr(s)} TrimRight(s);
     // truncate spaces at end by shortening fieldsize
@@ -1674,11 +1705,13 @@ const
 var
   FieldSize,FieldPrec: Integer;
   TempFieldDef: TDbfFieldDef;
-  Len, IntValue: Integer;
+  Len: Integer;
+  IntValue: dword;
   year, month, day: Word;
   hour, minute, sec, msec: Word;
   date: TDateTime;
   timeStamp: TTimeStamp;
+  asciiContents: boolean;
 
   procedure LoadDateFromSrc;
   begin
@@ -1714,6 +1747,7 @@ begin
 
   // copy field data to record buffer
   Dst := PChar(Dst) + TempFieldDef.Offset;
+  asciiContents := false;
   case TempFieldDef.NativeFieldType of
     '+', 'I':
       begin
@@ -1722,13 +1756,13 @@ begin
           if Src = nil then
             IntValue := 0
           else
-            IntValue := Integer(PDWord(Src)^ xor $80000000);
-          PInteger(Dst)^ := SwapInt(IntValue);
+            IntValue := PDWord(Src)^ xor $80000000;
+          PDWord(Dst)^ := SwapInt(IntValue);
         end else begin
           if Src = nil then
-            PInteger(Dst)^ := 0
+            PDWord(Dst)^ := 0
           else
-            PInteger(Dst)^ := PInteger(Src)^;
+            PDWord(Dst)^ := PDWord(Src)^;
         end;
       end;
     'O':
@@ -1790,7 +1824,29 @@ begin
         // TODO: data is little endian
 {$endif}
       end;
+    'B':
+      begin
+        if Src = nil then
+          PDouble(Dst)^ := 0
+        else
+          PDouble(Dst)^ := PDouble(Src)^;
+      end;
+    'M':
+      begin
+        if FieldSize = 4 then
+        begin
+          if Src = nil then
+            PInteger(Dst)^ := 0
+          else
+            PInteger(Dst)^ := PInteger(Src)^;
+        end else
+          asciiContents := true;
+      end;
   else
+    asciiContents := true;
+  end;
+  if asciiContents then
+  begin
     if Src = nil then
     begin
       FillChar(Dst^, FieldSize, ' ');
@@ -1848,36 +1904,48 @@ begin
   end;
 end;
 
-procedure TDbfFile.InitRecord(DestBuf: PChar);
+procedure TDbfFile.InitDefaultBuffer;
 var
+  lRecordSize: integer;
   TempFieldDef: TDbfFieldDef;
   I: Integer;
 begin
+  lRecordSize := PDbfHdr(Header)^.RecordSize;
   // clear buffer (assume all string, fix specific fields later)
-  FillChar(DestBuf^, RecordSize,' ');
+  //   note: Self.RecordSize is used for reading fielddefs too
+  GetMem(FDefaultBuffer, lRecordSize+1);
+  FillChar(FDefaultBuffer^, lRecordSize, ' ');
   
   // set nullflags field so that all fields are null
   if FNullField <> nil then
-    FillChar(PChar(DestBuf+FNullField.Offset)^, FNullField.Size, $FF);
-    
+    FillChar(PChar(FDefaultBuffer+FNullField.Offset)^, FNullField.Size, $FF);
+
   // check binary and default fields
   for I := 0 to FFieldDefs.Count-1 do
   begin
     TempFieldDef := FFieldDefs.Items[I];
-    // binary field?
-    if TempFieldDef.NativeFieldType in ['I', 'O', '@', '+', '0', 'Y'] then
-      FillChar(PChar(DestBuf+TempFieldDef.Offset)^, TempFieldDef.Size, 0);
+    // binary field? (foxpro memo fields are binary, but dbase not)
+    if (TempFieldDef.NativeFieldType in ['I', 'O', '@', '+', '0', 'Y'])
+        or ((TempFieldDef.NativeFieldType = 'M') and (TempFieldDef.Size = 4)) then
+      FillChar(PChar(FDefaultBuffer+TempFieldDef.Offset)^, TempFieldDef.Size, 0);
     // copy default value?
     if TempFieldDef.HasDefault then
     begin
-      Move(TempFieldDef.DefaultBuf[0], DestBuf[TempFieldDef.Offset], TempFieldDef.Size);
+      Move(TempFieldDef.DefaultBuf[0], FDefaultBuffer[TempFieldDef.Offset], TempFieldDef.Size);
       // clear the null flag, this field has a value
       if FNullField <> nil then
-        UpdateNullField(DestBuf, TempFieldDef, unClear);
+        UpdateNullField(FDefaultBuffer, TempFieldDef, unClear);
     end;
   end;
 end;
 
+procedure TDbfFile.InitRecord(DestBuf: PChar);
+begin
+  if FDefaultBuffer = nil then
+    InitDefaultBuffer;
+  Move(FDefaultBuffer^, DestBuf^, RecordSize);
+end;
+
 procedure TDbfFile.ApplyAutoIncToBuffer(DestBuf: PChar);
 var
   TempFieldDef: TDbfFieldDef;

fcl/db/dbase/dbf_fields.pas

@@ -178,7 +178,8 @@ begin
   FieldDef := AddFieldDef;
   FieldDef.FieldName := Name;
   FieldDef.FieldType := DataType;
-  FieldDef.Size := size;
+  if Size <> 0 then
+    FieldDef.Size := Size;
   FieldDef.Required := Required;
 end;
 
@@ -257,7 +258,7 @@ begin
   // convert VCL fieldtypes to native DBF fieldtypes
   VCLToNative;
   // for integer / float fields try fill in size/precision
-  SetDefaultSize;
+  CheckSizePrecision;
   // VCL does not have default value support
   AllocBuffers;
   FHasDefault := false;
@@ -363,7 +364,11 @@ begin
       end;
     'D' : FFieldType := ftDate;
     'M' : FFieldType := ftMemo;
-    'B' : FFieldType := ftBlob;
+    'B' : 
+      if DbfVersion = xFoxPro then
+        FFieldType := ftFloat
+      else
+        FFieldType := ftBlob;
     'G' : FFieldType := ftDBaseOle;
     'Y' :
       if DbfGlobals.CurrencyAsBCD then
@@ -387,7 +392,9 @@ begin
         FNativeFieldType := '@'
       else
       if DbfVersion = xFoxPro then
-        FNativeFieldType := 'T';
+        FNativeFieldType := 'T'
+      else
+        FNativeFieldType := 'D';
 {$ifdef SUPPORT_FIELDTYPES_V4}
     ftFixedChar,
     ftWideString,
@@ -466,8 +473,16 @@ begin
   case FNativeFieldType of
     'C':
       begin
-        if FSize < 0      then FSize := 0;
-        if FSize >= 65534 then FSize := 65534;
+        if FSize < 0 then 
+          FSize := 0;
+        if DbfVersion = xFoxPro then
+        begin
+          if FSize >= $FFFF then 
+            FSize := $FFFF;
+        end else begin
+          if FSize >= $FF then 
+            FSize := $FF;
+        end;
         FPrecision := 0;
       end;
     'L':
@@ -490,7 +505,10 @@ begin
       end;
     'M','G','B':
       begin
-        FSize := 10;
+        if DbfVersion = xFoxPro then
+          FSize := 4
+        else
+          FSize := 10;
         FPrecision := 0;
       end;
     '+','I':

fcl/db/dbase/dbf_idxfile.pas

@@ -117,7 +117,7 @@ type
     procedure RecurFirst;
     procedure RecurLast;
 
-    procedure SetEntry(RecNo: Integer; key: PChar; LowerPageNo: Integer);
+    procedure SetEntry(RecNo: Integer; AKey: PChar; LowerPageNo: Integer);
     procedure SetEntryNo(value: Integer);
     procedure SetPageNo(NewPageNo: Integer);
     procedure SetLowPage(NewPage: Integer);
@@ -271,7 +271,7 @@ type
     procedure ClearRoots;
     function  CalcTagOffset(AIndex: Integer): Pointer;
 
-    function  FindKey(Insert: boolean): Integer;
+    function  FindKey(AInsert: boolean): Integer;
     procedure InsertKey(Buffer: PChar);
     procedure DeleteKey(Buffer: PChar);
     procedure InsertCurrent;
@@ -924,7 +924,7 @@ begin
     FEntry := GetEntry(FEntryNo);
 end;
 
-procedure TIndexPage.SetEntry(RecNo: Integer; Key: PChar; LowerPageNo: Integer);
+procedure TIndexPage.SetEntry(RecNo: Integer; AKey: PChar; LowerPageNo: Integer);
 var
   keyData: PChar;
 {$ifdef TDBF_INDEX_CHECK}
@@ -936,16 +936,16 @@ begin
   // check valid entryno: we should be able to insert entries!
   assert((EntryNo >= 0) and (EntryNo <= FHighIndex));
   if (UpperPage <> nil) and (FEntryNo = FHighIndex) then
-    UpperPage.SetEntry(0, Key, FPageNo);
+    UpperPage.SetEntry(0, AKey, FPageNo);
 {  if PIndexHdr(FIndexFile.IndexHeader).KeyType = 'C' then  }
-    if Key <> nil then
-      Move(Key^, keyData^, PIndexHdr(FIndexFile.IndexHeader)^.KeyLen)
+    if AKey <> nil then
+      Move(AKey^, keyData^, PIndexHdr(FIndexFile.IndexHeader)^.KeyLen)
     else
       PChar(keyData)^ := #0;
 {
   else
-    if Key <> nil then
-      PDouble(keyData)^ := PDouble(Key)^
+    if AKey <> nil then
+      PDouble(keyData)^ := PDouble(AKey)^
     else
       PDouble(keyData)^ := 0.0;
 }
@@ -3063,6 +3063,9 @@ begin
   end else begin
     UpdateCurrent(PrevBuffer, NewBuffer);
   end;
+  // check range, disabled by delete/insert
+  if (FRoot.LowPage = 0) and (FRoot.HighPage = 0) then
+    ResyncRange(true);
 end;
 
 procedure TIndexFile.UpdateCurrent(PrevBuffer, NewBuffer: PChar);
@@ -3086,8 +3089,6 @@ begin
       // now set userkey to key to insert
       FUserKey := @TempBuffer[0];
       InsertCurrent;
-      // check range, disabled by delete/insert
-      ResyncRange(true);
     end;
   end;
 end;
@@ -3198,7 +3199,7 @@ begin
   Result := FindKey(false);
 end;
 
-function TIndexFile.FindKey(Insert: boolean): Integer;
+function TIndexFile.FindKey(AInsert: boolean): Integer;
 //
 // if you set Insert = true, you need to re-enable range after insert!!
 //
@@ -3215,7 +3216,7 @@ begin
   if (FUniqueMode = iuNormal) then
   begin
     // if inserting, search last entry matching key
-    if Insert then
+    if AInsert then
       searchRecNo := -3
     else
       searchRecNo := FUserRecNo
@@ -3266,7 +3267,7 @@ begin
 
     // check if we need to split page
     // done = 1 -> not found entry on insert path yet
-    if Insert and (done <> 1) then
+    if AInsert and (done <> 1) then
     begin
       // now we are on our path to destination where entry is to be inserted
       // check if this page is full, then split it

fcl/db/dbase/dbf_memo.pas

@@ -104,7 +104,7 @@ type
 
   PDbtHdr = ^rDbtHdr;
   rDbtHdr = record
-    NextBlock : Longint;
+    NextBlock : dword;
     Dummy     : array [4..7] of Byte;
     DbfFile   : array [0..7] of Byte;   // 8..15
     bVer      : Byte;                   // 16
@@ -115,7 +115,7 @@ type
 
   PFptHdr = ^rFptHdr;
   rFptHdr = record
-    NextBlock : Longint;
+    NextBlock : dword;
     Dummy     : array [4..5] of Byte;
     BlockLen  : Word;                   // 20..21
     Dummy3    : array [8..511] of Byte;
@@ -183,15 +183,12 @@ begin
 
     RecordSize := GetBlockLen;
     // checking for right blocksize not needed for foxpro?
-    if FDbfVersion <> xFoxPro then
+    // mod 128 <> 0 <-> and 0x7F <> 0
+    if (RecordSize = 0) and ((FDbfVersion = xFoxPro) or ((RecordSize and $7F) <> 0)) then
     begin
-      // mod 128 <> 0 <-> and 0x7F <> 0
-      if (RecordSize = 0) or ((RecordSize and $7F) <> 0) then
-      begin
-        SetBlockLen(512);
-        RecordSize := 512;
-        WriteHeader;
-      end;
+      SetBlockLen(512);
+      RecordSize := 512;
+      WriteHeader;
     end;
 
     // get memory for temporary buffer
@@ -234,11 +231,15 @@ begin
   if (BlockNo<=0) or (RecordSize=0) then
     exit;
   // read first block
-  if ReadRecord(BlockNo, @FBuffer[0]) = 0 then
+  numBytes := ReadRecord(BlockNo, @FBuffer[0]);
+  if numBytes = 0 then
   begin
     // EOF reached?
     exit;
-  end;
+  end else
+  if numBytes < RecordSize then
+    FillChar(FBuffer[RecordSize-numBytes], numBytes, #0);
+
   bytesLeft := GetMemoSize;
   // bytesLeft <> -1 -> memo size is known (FoxPro, dBase4)
   // bytesLeft =  -1 -> memo size unknown (dBase3)
@@ -455,7 +456,7 @@ end;
 
 function  TFoxProMemoFile.GetBlockLen: Integer;
 begin
-  Result := Swap(PFptHdr(Header)^.BlockLen);
+  Result := SwapWord(PFptHdr(Header)^.BlockLen);
 end;
 
 function  TFoxProMemoFile.GetMemoSize: Integer;
@@ -470,12 +471,12 @@ end;
 
 procedure TFoxProMemoFile.SetNextFreeBlock(BlockNo: Integer);
 begin
-  PFptHdr(Header)^.NextBlock := SwapInt(BlockNo);
+  PFptHdr(Header)^.NextBlock := SwapInt(dword(BlockNo));
 end;
 
 procedure TFoxProMemoFile.SetBlockLen(BlockLen: Integer);
 begin
-  PFptHdr(Header)^.BlockLen := Swap(BlockLen);
+  PFptHdr(Header)^.BlockLen := SwapWord(dword(BlockLen));
 end;
 
 // ------------------------------------------------------------------

fcl/db/dbase/dbf_parser.pas

@@ -51,7 +51,7 @@ type
 
     procedure ClearExpressions; override;
 
-    procedure ParseExpression(Expression: string); virtual;
+    procedure ParseExpression(AExpression: string); virtual;
     function ExtractFromBuffer(Buffer: PChar): PChar; virtual;
 
     property DbfFile: Pointer read FDbfFile write FDbfFile;
@@ -233,8 +233,6 @@ type
 
   TRawStringFieldVar = class(TStringFieldVar)
   public
-    constructor Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
-
     procedure Refresh(Buffer: PChar); override;
   end;
 
@@ -253,8 +251,6 @@ type
     function GetFieldVal: Pointer; override;
     function GetFieldType: TExpressionType; override;
   public
-    constructor Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
-
     procedure Refresh(Buffer: PChar); override;
   end;
 
@@ -265,8 +261,6 @@ type
     function GetFieldVal: Pointer; override;
     function GetFieldType: TExpressionType; override;
   public
-    constructor Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
-
     procedure Refresh(Buffer: PChar); override;
   end;
 
@@ -278,8 +272,6 @@ type
     function GetFieldVal: Pointer; override;
     function GetFieldType: TExpressionType; override;
   public
-    constructor Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
-
     procedure Refresh(Buffer: PChar); override;
   end;
 {$endif}
@@ -291,8 +283,16 @@ type
   protected
     function GetFieldVal: Pointer; override;
   public
-    constructor Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
+    procedure Refresh(Buffer: PChar); override;
+  end;
 
+  TBooleanFieldVar = class(TFieldVar)
+  private
+    FFieldVal: boolean;
+    function GetFieldType: TExpressionType; override;
+  protected
+    function GetFieldVal: Pointer; override;
+  public
     procedure Refresh(Buffer: PChar); override;
   end;
 
@@ -319,11 +319,6 @@ begin
 end;
 
 //--TRawStringFieldVar----------------------------------------------------------
-constructor TRawStringFieldVar.Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
-begin
-  inherited;
-end;
-
 procedure TRawStringFieldVar.Refresh(Buffer: PChar);
 begin
   FFieldVal := Buffer + FieldDef.Offset;
@@ -359,11 +354,6 @@ begin
 end;
 
 //--TFloatFieldVar-----------------------------------------------------------
-constructor TFloatFieldVar.Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
-begin
-  inherited;
-end;
-
 function TFloatFieldVar.GetFieldVal: Pointer;
 begin
   Result := @FFieldVal;
@@ -382,11 +372,6 @@ begin
 end;
 
 //--TIntegerFieldVar----------------------------------------------------------
-constructor TIntegerFieldVar.Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
-begin
-  inherited;
-end;
-
 function TIntegerFieldVar.GetFieldVal: Pointer;
 begin
   Result := @FFieldVal;
@@ -406,11 +391,6 @@ end;
 {$ifdef SUPPORT_INT64}
 
 //--TLargeIntFieldVar----------------------------------------------------------
-constructor TLargeIntFieldVar.Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
-begin
-  inherited;
-end;
-
 function TLargeIntFieldVar.GetFieldVal: Pointer;
 begin
   Result := @FFieldVal;
@@ -430,11 +410,6 @@ end;
 {$endif}
 
 //--TDateTimeFieldVar---------------------------------------------------------
-constructor TDateTimeFieldVar.Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
-begin
-  inherited;
-end;
-
 function TDateTimeFieldVar.GetFieldVal: Pointer;
 begin
   Result := @FFieldVal;
@@ -451,6 +426,27 @@ begin
     FFieldVal.DateTime := 0.0;
 end;
 
+//--TBooleanFieldVar---------------------------------------------------------
+function TBooleanFieldVar.GetFieldVal: Pointer;
+begin
+  Result := @FFieldVal;
+end;
+
+function TBooleanFieldVar.GetFieldType: TExpressionType;
+begin
+  Result := etBoolean;
+end;
+
+procedure TBooleanFieldVar.Refresh(Buffer: PChar);
+var
+  lFieldVal: word;
+begin
+  if FDbfFile.GetFieldDataFromDef(FieldDef, ftBoolean, Buffer, @lFieldVal) then
+    FFieldVal := lFieldVal <> 0
+  else
+    FFieldVal := false;
+end;
+
 //--Expression functions-----------------------------------------------------
 
 procedure FuncFloatToStr(Param: PExpressionRec);
@@ -1428,7 +1424,7 @@ begin
 
   // define field in parser
   case FieldInfo.FieldType of
-    ftString, ftBoolean:
+    ftString:
       begin
         if RawStringFields then
         begin
@@ -1441,6 +1437,11 @@ begin
           DefineStringVariable(VarName, TempFieldVar.FieldVal);
         end;
       end;
+    ftBoolean:
+      begin
+        TempFieldVar := TBooleanFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
+        DefineBooleanVariable(VarName, TempFieldVar.FieldVal);
+      end;
     ftFloat:
       begin
         TempFieldVar := TFloatFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
@@ -1506,7 +1507,7 @@ begin
   FCurrentExpression := EmptyStr;
 end;
 
-procedure TDbfParser.ParseExpression(Expression: string);
+procedure TDbfParser.ParseExpression(AExpression: string);
 var
   TempBuffer: array[0..4000] of Char;
 begin
@@ -1514,11 +1515,11 @@ begin
   ClearExpressions;
 
   // is this a simple field or complex expression?
-  FIsExpression := GetVariableInfo(Expression) = nil;
+  FIsExpression := GetVariableInfo(AExpression) = nil;
   if FIsExpression then
   begin
     // parse requested
-    CompileExpression(Expression);
+    CompileExpression(AExpression);
 
     // determine length of string length expressions
     if ResultType = etString then
@@ -1529,7 +1530,7 @@ begin
     end;
   end else begin
     // simple field, create field variable for it
-    HandleUnknownVariable(Expression);
+    HandleUnknownVariable(AExpression);
     FFieldType := TFieldVar(FFieldVarList.Objects[0]).FieldType;
     // set result len of variable length fields
     if FFieldType = etString then
@@ -1546,10 +1547,10 @@ begin
 
   // check if expression not too long
   if FResultLen > 100 then
-    raise EDbfError.CreateFmt(STRING_INDEX_EXPRESSION_TOO_LONG, [Expression, FResultLen]);
+    raise EDbfError.CreateFmt(STRING_INDEX_EXPRESSION_TOO_LONG, [AExpression, FResultLen]);
 
   // if no errors, assign current expression
-  FCurrentExpression := Expression;
+  FCurrentExpression := AExpression;
 end;
 
 function TDbfParser.ExtractFromBuffer(Buffer: PChar): PChar;

fcl/db/dbase/dbf_pgcfile.pas

@@ -42,7 +42,7 @@ type
     procedure SetRecordSize(NewValue: Integer); override;
     procedure SetCacheSize(NewSize: Integer);
   public
-    constructor Create(AFileName: string);
+    constructor Create;
     destructor Destroy; override;
 
     procedure CloseFile; override;
@@ -60,7 +60,7 @@ implementation
 
 {$ifdef USE_CACHE}
 
-constructor TCachedFile.Create(AFileName: string);
+constructor TCachedFile.Create;
 begin
   inherited;
 

fcl/db/dbase/dbf_prsdef.pas

@@ -38,7 +38,7 @@ type
     FMemoryPos: PPChar;
     FSize: PInteger;
   public
-    constructor Create(DestMem, DestPos: PPChar; Size: PInteger);
+    constructor Create(DestMem, DestPos: PPChar; ASize: PInteger);
 
     procedure AssureSpace(ASize: Integer);
     procedure Resize(NewSize: Integer; Exact: Boolean);
@@ -974,13 +974,13 @@ end;
 
 { TDynamicType }
 
-constructor TDynamicType.Create(DestMem, DestPos: PPChar; Size: PInteger);
+constructor TDynamicType.Create(DestMem, DestPos: PPChar; ASize: PInteger);
 begin
   inherited Create;
 
   FMemory := DestMem;
   FMemoryPos := DestPos;
-  FSize := Size;
+  FSize := ASize;
 end;
 
 procedure TDynamicType.Rewind;

fcl/db/dbase/history.txt

@@ -32,6 +32,51 @@ BUGS & WARNINGS
 
 
 
+------------------------
+V6.4.8
+
+- remove duplicate names, may cause ambiguity
+
+
+------------------------
+V6.4.7
+
+- fixed: 64bit compatibility
+- fixed: Field.FieldNo is relative to number of FieldDefs, may be larger
+- added: function Max for Delphi 3, needed by dbf_avl unit
+- added: BCB3 package files (thx to pzelotti)
+- fixed: add special case for copying from source TDbf in CopyFrom to retain
+    more precise field types
+- fixed: TDbf.CopyFrom to keep Fields and FieldDefs seperate
+- fixed: TDbfFieldDefs.Add to ignore size when it is zero
+- added: TDbf.Lookup and as such, lookup fields, should work now
+- added: defines for delphi 2006 and 2007
+- fixed: some range checking errors when swapping data
+- added: packages for delphi 2005 and 2006, c++ 2006 (from stan and others)
+- fixed: modifying records with active range
+- added: packages for kylix 3, fix casing (from jvargas)
+
+
+------------------------
+V6.4.6
+
+- fixed: FPC 2.0.1 implements "backward-compatible" fielddata 
+    for datetime fields in particular (from alexandrov)
+- fixed: only allow >255 field length for creating foxpro files; prevents
+    range check error (rep by miguel)
+- fixed: memo read: check number of bytes read, clear rest for safety
+- added: support for foxpro double, fieldtype 'B'
+- fixed: foxpro memo pageno is binary 4 byte integer, not ascii
+- added: default values are buffered, better/faster record insert
+- added: support for long character fields compiletime definable
+    (USE_LONG_CHAR_FIELDS)
+- fixed: added boolean field support in expressions (note: breaks existing)
+- fixed: compilation with USE_CACHE directive
+- fixed: add my own SwapWord function, because Swap seems buggy in fpc
+- fixed: VCL fieldtype ftDateTime was not translated to any native type
+    for non dBase VII and non FoxPro (hint by paul van helden)
+
+
 ------------------------
 V6.4.5
 

fcl/db/fields.inc

@@ -132,6 +132,12 @@ begin
   Changed(False);
 end;
 
+procedure TFieldDef.SetRequired(const AValue: Boolean);
+begin
+  FRequired := AValue;
+  Changed(False);
+end;
+
 function TFieldDef.GetDisplayName: string;
 begin
   Result := FDisplayName;

fcl/db/sqldb/sqldb.pp

@@ -88,6 +88,7 @@ type
     function Fetch(cursor : TSQLCursor) : boolean; virtual; abstract;
     procedure AddFieldDefs(cursor: TSQLCursor; FieldDefs : TfieldDefs); virtual; abstract;
     procedure UnPrepareStatement(cursor : TSQLCursor); virtual; abstract;
+
     procedure FreeFldBuffers(cursor : TSQLCursor); virtual; abstract;
     function LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer) : boolean; virtual; abstract;
     function GetTransactionHandle(trans : TSQLHandle): pointer; virtual; abstract;
@@ -195,7 +196,6 @@ type
     function Fetch : boolean; override;
     function LoadField(FieldDef : TFieldDef;buffer : pointer) : boolean; override;
     // abstract & virtual methods of TDataset
-    procedure DataConvert(Field: TField; Source, Dest: Pointer; ToNative: Boolean); override;
     procedure UpdateIndexDefs; override;
     procedure SetDatabase(Value : TDatabase); override;
     Procedure SetTransaction(Value : TDBTransaction); override;
@@ -206,6 +206,7 @@ type
     function  GetCanModify: Boolean; override;
     function ApplyRecUpdate(UpdateKind : TUpdateKind) : boolean; override;
     Function IsPrepared : Boolean; virtual;
+    Procedure SetActive (Value : Boolean); override;
     procedure SetFiltered(Value: Boolean); override;
     procedure SetFilterText(const Value: string); override;
   public
@@ -584,6 +585,16 @@ begin
   First;
 end;
 
+Procedure TSQLQuery.SetActive (Value : Boolean);
+
+begin
+  inherited SetActive(Value);
+// The query is UnPrepared, so that if a transaction closes all datasets
+// they also get unprepared
+  if not Value and IsPrepared then UnPrepare;
+end;
+
+
 procedure TSQLQuery.SetFiltered(Value: Boolean);
 
 begin
@@ -679,16 +690,6 @@ begin
   result := (Database as tSQLConnection).LoadField(FCursor,FieldDef,buffer)
 end;
 
-procedure TSQLQuery.DataConvert(Field: TField; Source, Dest: Pointer; ToNative: Boolean);
-
-begin
-  {
-    all data is in native format for these types, so no conversion is needed.
-  }
-  If not (Field.DataType in [ftDate,ftTime,ftDateTime]) then
-    Inherited DataConvert(Field,Source,Dest,ToNative);
-end;
-
 procedure TSQLQuery.InternalAddRecord(Buffer: Pointer; AAppend: Boolean);
 begin
   // not implemented - sql dataset

fcl/inc/inifiles.pp

@@ -133,6 +133,8 @@ override;
     FStream: TStream;
   private
     procedure FillSectionList(AStrings: TStrings);
+  protected
+    procedure WriteStringInMemory(const Section, Ident, Value: String);
   public
     constructor Create(const AFileName: string);
     constructor Create(AStream: TStream);
@@ -154,6 +156,7 @@ override;
     procedure GetStrings(List: TStrings);
     procedure Rename(const AFileName: string; Reload: Boolean);
     procedure SetStrings(List: TStrings);
+    procedure WriteString(const Section, Ident, Value: String); override;
   end;
 
 implementation
@@ -559,7 +562,7 @@ begin
   end;
 end;
 
-procedure TIniFile.WriteString(const Section, Ident, Value: String);
+procedure TIniFile.WriteStringInMemory(const Section, Ident, Value: String);
 var
   oSection: TIniFileSection;
   oKey: TIniFileKey;
@@ -586,6 +589,13 @@ begin
         oSection.KeyList.Remove(oKey);
       end;
     end;
+  end;
+end;
+
+procedure TIniFile.WriteString(const Section, Ident, Value: String);
+begin
+  if (Section > '') and (Ident > '') then begin
+    WriteStringInMemory(Section, Ident, Value);
     UpdateFile;
   end;
 end;
@@ -788,4 +798,11 @@ begin
   FillSectionList(List);
 end;
 
+procedure TMemIniFile.WriteString(const Section, Ident, Value: String);
+begin
+  if (Section > '') and (Ident > '') then begin
+    WriteStringInMemory(Section, Ident, Value);
+  end;
+end;
+
 end.