+ Upgraded to version 6.4.1

fcl/db/dbase/dbf.pas

@@ -63,8 +63,11 @@ type
   private
     FBlobField: TBlobField;
     FMode: TBlobStreamMode;
-    FDoWrite: Boolean;
+    FDirty: boolean;            { has possibly modified data, needs to be written }
     FMemoRecNo: Integer;
+        { -1 : invalid contents }
+        {  0 : clear, no contents }
+        { >0 : data from page x }
     FReadSize: Integer;
     FRefCount: Integer;
 
@@ -81,11 +84,11 @@ type
     procedure Cancel;
     procedure Commit;
 
+    property Dirty: boolean read FDirty;
     property Transliterate: Boolean read GetTransliterate;
     property MemoRecNo: Integer read FMemoRecNo write FMemoRecNo;
     property ReadSize: Integer read FReadSize write FReadSize;
     property Mode: TBlobStreamMode write SetMode;
-    property Modified: Boolean read FDoWrite;
     property BlobField: TBlobField read FBlobField;
   end;
 //====================================================================
@@ -241,6 +244,9 @@ type
     procedure InternalOpen; override; {virtual abstract}
     procedure InternalEdit; override; {virtual}
     procedure InternalCancel; override; {virtual}
+{$ifndef FPC}
+    procedure InternalInsert; override; {virtual}
+{$endif}
     procedure InternalPost; override; {virtual abstract}
     procedure InternalSetToRecord(Buffer: PChar); override; {virtual abstract}
     procedure InitFieldDefs; override;
@@ -487,18 +493,20 @@ begin
   FReadSize := 0;
   FMemoRecNo := 0;
   FRefCount := 1;
-  FDoWrite := false;
+  FDirty := false;
 end;
 
 destructor TDbfBlobStream.Destroy;
 begin
   // only continue destroy if all references released
-  Dec(FRefCount);
-  if FRefCount = 0 then
+  if FRefCount = 1 then
   begin
+    // this is the last reference
     inherited
   end else begin
-    if FMode = bmWrite then
+    // fire event when dirty, and the last "user" is freeing it's reference
+    // tdbf always has the last reference
+    if FDirty and (FRefCount = 2) then
     begin
       // a second referer to instance has changed the data, remember modified
 //      TDbf(FBlobField.DataSet).SetModified(true);
@@ -507,6 +515,7 @@ begin
         TDbf(FBlobField.DataSet).DataEvent(deFieldChange, Longint(FBlobField));
     end;
   end;
+  Dec(FRefCount);
 end;
 
 procedure TDbfBlobStream.FreeInstance;
@@ -519,20 +528,20 @@ end;
 procedure TDbfBlobStream.SetMode(NewMode: TBlobStreamMode);
 begin
   FMode := NewMode;
-  FDoWrite := FDoWrite or (NewMode = bmWrite);
+  FDirty := FDirty or (NewMode = bmWrite) or (NewMode = bmReadWrite);
 end;
 
 procedure TDbfBlobStream.Cancel;
 begin
-  FDoWrite := false;
-  FMemoRecNo := 0;
+  FDirty := false;
+  FMemoRecNo := -1;
 end;
 
 procedure TDbfBlobStream.Commit;
 var
   Dbf: TDbf;
 begin
-  if FDoWrite then
+  if FDirty then
   begin
     Size := Position; // Strange but it leave tailing trash bytes if I do not write that.
     Dbf := TDbf(FBlobField.DataSet);
@@ -540,7 +549,7 @@ begin
     Dbf.FDbfFile.MemoFile.WriteMemo(FMemoRecNo, FReadSize, Self);
     Dbf.FDbfFile.SetFieldData(FBlobField.FieldNo-1, ftInteger, @FMemoRecNo,
       @pDbfRecord(TDbf(FBlobField.DataSet).ActiveBuffer).DeletedFlag);
-    FDoWrite := false;
+    FDirty := false;
   end;
 end;
 
@@ -843,13 +852,16 @@ procedure TDbf.InternalAddRecord(Buffer: Pointer; Append: Boolean); {override vi
   // goal: add record with Edit...Set Fields...Post all in one step
 var
   pRecord: pDbfRecord;
+  newRecord: integer;
 begin
   // if InternalAddRecord is called, we know we are active
   pRecord := Buffer;
 
   // we can not insert records in DBF files, only append
   // ignore Append parameter
-  FDbfFile.Insert(@pRecord.DeletedFlag);
+  newRecord := FDbfFile.Insert(@pRecord.DeletedFlag);
+  if newRecord > 0 then
+    FCursor.PhysicalRecNo := newRecord;
 
   // set flag that TDataSet is about to post...so we can disable resync
   FPosting := true;
@@ -1278,10 +1290,19 @@ begin
   // succeeded!
 end;
 
+{$ifndef FPC}
+
+procedure TDbf.InternalInsert; {override virtual from TDataset}
+begin
+  CursorPosChanged;
+end;
+
+{$endif}
+
 procedure TDbf.InternalPost; {override virtual abstract from TDataset}
 var
   pRecord: pDbfRecord;
-  I: Integer;
+  I, newRecord: Integer;
 begin
   // if internalpost is called, we know we are active
   pRecord := pDbfRecord(ActiveBuffer);
@@ -1297,7 +1318,9 @@ begin
     FEditingRecNo := -1;
   end else begin
     // insert
-    FDbfFile.Insert(@pRecord.DeletedFlag);
+    newRecord := FDbfFile.Insert(@pRecord.DeletedFlag);
+    if newRecord > 0 then
+      FCursor.PhysicalRecNo := newRecord;
   end;
   // set flag that TDataSet is about to post...so we can disable resync
   FPosting := true;
@@ -1806,7 +1829,6 @@ begin
   if FBlobStreams[MemoFieldNo] = nil then
     FBlobStreams[MemoFieldNo] := TDbfBlobStream.Create(Field);
   lBlob := FBlobStreams[MemoFieldNo].AddReference;
-  lBlob.Mode := Mode;
   // update pageno of blob <-> location where to read/write in memofile
   if FDbfFile.GetFieldData(Field.FieldNo-1, ftInteger, GetCurrentBuffer, @MemoPageNo) then
   begin
@@ -1823,14 +1845,22 @@ begin
       lBlob.Size := 0;
       lBlob.ReadSize := 0;
     end;
-  end else begin
-    MemoPageNo := 0;
+    lBlob.MemoRecNo := MemoPageNo;
+  end else 
+  if not lBlob.Dirty or (Mode = bmWrite) then
+  begin
+    // reading and memo is empty and not written yet, or rewriting
     lBlob.Size := 0;
     lBlob.ReadSize := 0;
+    lBlob.MemoRecNo := 0;
   end;
-  lBlob.MemoRecNo := MemoPageNo;
+  { this is a hack, we actually need to know per user who's modifying, and who is not }
+  { Mode is more like: the mode of the last "creation" 
+  { if create/free is nested, then everything will be alright, i think ;-) }
+  lBlob.Mode := Mode;
+  { this is a hack: we actually need to know per user what it's position is }
+  lBlob.Position := 0;
   Result := lBlob;
-  Result.Position := 0;
 end;
 
 {$ifdef SUPPORT_NEW_TRANSLATE}
@@ -2107,7 +2137,11 @@ begin
 
   // only refresh if active
   if FCursor <> nil then
+  begin
+    UpdateCursorPos;
+    CursorPosChanged;
     Resync([]);
+  end;
 end;
 
 procedure TDbf.SetFilePath(const Value: string);

fcl/db/dbase/dbf_common.pas

@@ -17,7 +17,7 @@ uses
 
 const
   TDBF_MAJOR_VERSION      = 6;
-  TDBF_MINOR_VERSION      = 40;
+  TDBF_MINOR_VERSION      = 41;
   TDBF_SUB_MINOR_VERSION  = 0;
 
   TDBF_TABLELEVEL_FOXPRO = 25;
@@ -99,6 +99,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;
+{ SwapInt64 NOTE: do not call with same value for Value and Result ! }
 procedure SwapInt64(Value, Result: Pointer); register;
 
 function TranslateString(FromCP, ToCP: Cardinal; Src, Dest: PChar; Length: Integer): Integer;
@@ -409,19 +410,12 @@ 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
+  MOV ECX, dword ptr [EAX] 
+  MOV EAX, dword ptr [EAX + 4] 
+  BSWAP ECX 
+  BSWAP EAX 
+  MOV dword ptr [EDX+4], ECX 
+  MOV dword ptr [EDX], EAX 
 end;
 
 {$else}

fcl/db/dbase/dbf_dbffile.pas

@@ -5,7 +5,7 @@ interface
 {$I Dbf_Common.inc}
 
 uses
-  Classes, SysUtils,
+  Classes, SysUtils, Math,
 {$ifdef WIN32}
   Windows,
 {$else}
@@ -34,6 +34,7 @@ type
 
 //====================================================================
   TDbfIndexMissingEvent = procedure(var DeleteLink: Boolean) of object;
+  TUpdateNullField = (unClear, unSet);
 
 //====================================================================
   TDbfGlobals = class;
@@ -49,8 +50,6 @@ type
     FDbfVersion: TXBaseVersion;
     FPrevBuffer: PChar;
     FRecordBufferSize: Integer;
-    FLockFieldOffset: Integer;
-    FLockFieldLen: DWORD;
     FLockUserLen: DWORD;
     FFileCodePage: Cardinal;
     FUseCodePage: Cardinal;
@@ -58,22 +57,27 @@ type
     FCountUse: Integer;
     FCurIndex: Integer;
     FForceClose: Boolean;
-    FHasLockField: Boolean;
+    FLockField: TDbfFieldDef;
+    FNullField: TDbfFieldDef;
     FAutoIncPresent: Boolean;
     FCopyDateTimeAsString: Boolean;
     FDateTimeHandling: TDateTimeHandling;
     FOnLocaleError: TDbfLocaleErrorEvent;
     FOnIndexMissing: TDbfIndexMissingEvent;
 
-    procedure ConstructFieldDefs;
     function  HasBlob: Boolean;
     function  GetMemoExt: string;
-    procedure WriteLockInfo(Buffer: PChar);
 
     function GetLanguageId: Integer;
     function GetLanguageStr: string;
     function GetUseFloatFields: Boolean;
     procedure SetUseFloatFields(NewUse: Boolean);
+    
+  protected
+    procedure ConstructFieldDefs;
+    procedure UpdateNullField(Buffer: Pointer; AFieldDef: TDbfFieldDef; Action: TUpdateNullField);
+    procedure WriteLockInfo(Buffer: PChar);
+
   public
     constructor Create;
     destructor Destroy; override;
@@ -93,7 +97,7 @@ type
     procedure CloseIndex(AIndexName: string);
     procedure RepageIndex(AIndexFile: string);
     procedure CompactIndex(AIndexFile: string);
-    procedure Insert(Buffer: PChar);
+    function  Insert(Buffer: PChar): integer;
     procedure WriteHeader; override;
     procedure ApplyAutoIncToBuffer(DestBuf: PChar);     // dBase7 support. Writeback last next-autoinc value
     procedure FastPackTable;
@@ -123,7 +127,6 @@ type
     property DbfVersion: TXBaseVersion read FDbfVersion write FDbfVersion;
     property PrevBuffer: PChar read FPrevBuffer;
     property ForceClose: Boolean read FForceClose;
-    property HasLockField: Boolean read FHasLockField;
     property CopyDateTimeAsString: Boolean read FCopyDateTimeAsString write FCopyDateTimeAsString;
     property UseFloatFields: Boolean read GetUseFloatFields write SetUseFloatFields;
     property DateTimeHandling: TDateTimeHandling read FDateTimeHandling write FDateTimeHandling;
@@ -463,9 +466,11 @@ begin
         FMemoFile.DbfVersion := FDbfVersion;
         FMemoFile.Open;
         // set header blob flag corresponding to field list
-        PDbfHdr(Header).VerDBF := PDbfHdr(Header).VerDBF or $80;
+        if FDbfVersion <> xFoxPro then
+          PDbfHdr(Header).VerDBF := PDbfHdr(Header).VerDBF or $80;
       end else
-        PDbfHdr(Header).VerDBF := PDbfHdr(Header).VerDBF and $7F;
+        if FDbfVersion <> xFoxPro then
+          PDbfHdr(Header).VerDBF := PDbfHdr(Header).VerDBF and $7F;
       // check if mdx flagged
       if (FDbfVersion <> xFoxPro) and (PDbfHdr(Header).MDXFlag <> 0) then
       begin
@@ -799,6 +804,8 @@ var
   dataPtr: PChar;
   lNativeFieldType: Char;
   lFieldName: string;
+  lCanHoldNull: boolean;
+  lCurrentNullPosition: integer;
 begin
   FFieldDefs.Clear;
   if DbfVersion >= xBaseVII then
@@ -812,12 +819,15 @@ begin
   HeaderSize := lHeaderSize;
   RecordSize := lFieldSize;
 
-  FHasLockField := false;
+  FLockField := nil;
+  FNullField := nil;
   FAutoIncPresent := false;
   lColumnCount := (PDbfHdr(Header).FullHdrSize - lHeaderSize) div lFieldSize;
   lFieldOffset := 1;
   lAutoInc := 0;
   I := 1;
+  lCurrentNullPosition := 0;
+  lCanHoldNull := false;
   try
     // there has to be minimum of one field
     repeat
@@ -839,6 +849,9 @@ begin
         lSize := lFieldDescIII.FieldSize;
         lPrec := lFieldDescIII.FieldPrecision;
         lNativeFieldType := lFieldDescIII.FieldType;
+        lCanHoldNull := (FDbfVersion = xFoxPro) and 
+          ((lFieldDescIII.FoxProFlags and $2) <> 0) and
+          (lFieldName <> '_NULLFLAGS');
       end;
 
       // apply field transformation tricks
@@ -849,7 +862,8 @@ begin
       end;
 
       // add field
-      with FFieldDefs.AddFieldDef do
+      TempFieldDef := FFieldDefs.AddFieldDef;
+      with TempFieldDef do
       begin
         FieldName := lFieldName;
         Offset := lFieldOffset;
@@ -857,28 +871,32 @@ begin
         Precision := lPrec;
         AutoInc := lAutoInc;
         NativeFieldType := lNativeFieldType;
-
-        // check valid field:
-        //  1) non-empty field name
-        //  2) known field type
-        //  {3) no changes have to be made to precision or size}
-        if (Length(lFieldName) = 0) or (FieldType = ftUnknown) then
-          raise EDbfError.Create(STRING_INVALID_DBF_FILE);
-
-        // determine if lock field present
-        IsLockField := lFieldName = '_DBASELOCK';
-        // if present, then store additional info
-        if IsLockField then
+        if lCanHoldNull then
         begin
-          FHasLockField := true;
-          FLockFieldOffset := lFieldOffset;
-          FLockFieldLen := lSize;
-          FLockUserLen := FLockFieldLen - 8;
-          if FLockUserLen > DbfGlobals.UserNameLen then
-            FLockUserLen := DbfGlobals.UserNameLen;
-        end;
+          NullPosition := lCurrentNullPosition;
+          inc(lCurrentNullPosition);
+        end else
+          NullPosition := -1;
       end;
 
+      // check valid field:
+      //  1) non-empty field name
+      //  2) known field type
+      //  {3) no changes have to be made to precision or size}
+      if (Length(lFieldName) = 0) or (TempFieldDef.FieldType = ftUnknown) then
+        raise EDbfError.Create(STRING_INVALID_DBF_FILE);
+
+      // determine if lock field present, if present, then store additional info
+      if lFieldName = '_DBASELOCK' then
+      begin
+        FLockField := TempFieldDef;
+        FLockUserLen := lSize - 8;
+        if FLockUserLen > DbfGlobals.UserNameLen then
+          FLockUserLen := DbfGlobals.UserNameLen;
+      end else
+      if UpperCase(lFieldName) = '_NULLFLAGS' then
+        FNullField := TempFieldDef;
+
       // goto next field
       Inc(lFieldOffset, lSize);
       Inc(I);
@@ -1047,6 +1065,13 @@ begin
   end;
 end;
 
+type
+  TRestructFieldInfo = record
+    SourceOffset: Integer;
+    DestOffset: Integer;
+    Size: Integer;
+  end;
+
 procedure TDbfFile.RestructureTable(DbfFieldDefs: TDbfFieldDefs; Pack: Boolean);
 var
   DestDbfFile: TDbfFile;
@@ -1056,9 +1081,10 @@ var
   TempDstDef, TempSrcDef: TDbfFieldDef;
   OldIndexFiles, NewIndexFiles: TStrings;
   IndexName, NewBaseName, OldBaseName: string;
-  I, lRecNo, lFieldNo, lFieldSize, lBlobRecNo, lWRecNo: Integer;
+  I, lRecNo, lFieldNo, lFieldSize, lBlobRecNo, lWRecNo, srcOffset, dstOffset: Integer;
   pBuff, pDestBuff: PChar;
   pBlobRecNoBuff: array[1..11] of Char;
+  RestructFieldInfo: array of TRestructFieldInfo;
   BlobStream: TMemoryStream;
 begin
   // nothing to do?
@@ -1105,6 +1131,50 @@ begin
   else
     DestDbfFile.FinishCreate(DestFieldDefs, 512);
 
+  // adjust size and offsets of fields
+  SetLength(RestructFieldInfo, DestFieldDefs.Count);
+  for lFieldNo := 0 to DestFieldDefs.Count - 1 do
+  begin
+    TempDstDef := DestFieldDefs.Items[lFieldNo];
+    if TempDstDef.CopyFrom >= 0 then
+    begin
+      TempSrcDef := FFieldDefs.Items[TempDstDef.CopyFrom];
+      if TempDstDef.NativeFieldType in ['F', 'N'] then
+      begin
+        // get minimum field length
+        lFieldSize := Min(TempSrcDef.Precision, TempDstDef.Precision) +
+          Min(TempSrcDef.Size - TempSrcDef.Precision, 
+            TempDstDef.Size - TempDstDef.Precision);
+        // if one has dec separator, but other not, we lose one digit
+        if (TempDstDef.Precision > 0) xor 
+          ((TempSrcDef.NativeFieldType in ['F', 'N']) and (TempSrcDef.Precision > 0)) then
+          Dec(lFieldSize);
+        // should not happen, but check nevertheless (maybe corrupt data)
+        if lFieldSize < 0 then
+          lFieldSize := 0;
+        srcOffset := TempSrcDef.Size - TempSrcDef.Precision - 
+          (TempDstDef.Size - TempDstDef.Precision);
+        if srcOffset < 0 then
+        begin
+          dstOffset := -srcOffset;
+          srcOffset := 0;
+        end else begin
+          dstOffset := 0;
+        end;
+      end else begin
+        lFieldSize := Min(TempSrcDef.Size, TempDstDef.Size);
+        srcOffset := 0;
+        dstOffset := 0;
+      end;
+      with RestructFieldInfo[lFieldNo] do
+      begin
+        Size := lFieldSize;
+        SourceOffset := TempSrcDef.Offset + srcOffset;
+        DestOffset := TempDstDef.Offset + dstOffset;
+      end;
+    end;
+  end;
+
   // add indexes
   TempIndexDef := TDbfIndexDef.Create(nil);
   for I := 0 to FIndexNames.Count - 1 do
@@ -1182,15 +1252,9 @@ begin
               DestDbfFile.SetFieldData(lFieldNo, ftInteger, @lBlobRecNo, pDestBuff);
             end else if (DbfFieldDefs <> nil) and (TempDstDef.CopyFrom >= 0) then
             begin
-              // restructure and copy field, get src fielddef
-              // DbfFieldDefs <> nil -> DestFieldDefs = DbfFieldDefs
-              TempSrcDef := FFieldDefs.Items[TempDstDef.CopyFrom];
-              // get size
-              lFieldSize := TempSrcDef.Size;
-              if lFieldSize > TempDstDef.Size then
-                lFieldSize := TempDstDef.Size;
               // copy content of field
-              Move(pBuff[TempSrcDef.Offset], pDestBuff[TempDstDef.Offset], lFieldSize);
+              with RestructFieldInfo[lFieldNo] do
+                Move(pBuff[SourceOffset], pDestBuff[DestOffset], Size);
             end;
           end;
         end;
@@ -1367,181 +1431,210 @@ var
   end;
 
 begin
-  // test if non-nil source
-  // do not check Dst = nil, called with dst = nil to check empty field
-  if (Src <> nil) then
+  // test if non-nil source (record buffer)
+  if Src = nil then
   begin
-    FieldOffset := AFieldDef.Offset;
-    FieldSize := AFieldDef.Size;
-    Src := PChar(Src) + FieldOffset;
-    // field types that are binary and of which the fieldsize should not be truncated
-    case AFieldDef.NativeFieldType of
-      '+', 'I':
-        begin
-          if FDbfVersion <> xFoxPro then
-          begin
-            Result := PDWord(Src)^ <> 0;
-            if Result and (Dst <> nil) then
-            begin
-              PInteger(Dst)^ := SwapInt(PInteger(Src)^);
-              if Result then
-                PInteger(Dst)^ := Integer(PDWord(Dst)^ - $80000000);
-            end;
-          end else begin
-            Result := true;
-            if Dst <> nil then
-              PInteger(Dst)^ := PInteger(Src)^;
-          end;
-        end;
-      'O':
+    Result := false;
+    exit;
+  end;
+
+  // check Dst = nil, called with dst = nil to check empty field
+  if (FNullField <> nil) and (Dst = nil) and (AFieldDef.NullPosition >= 0) then
+  begin
+    // go to byte with null flag of this field
+    Src := PChar(Src) + FNullField.Offset + (AFieldDef.NullPosition shr 3);
+    Result := (PByte(Src)^ and (1 shl (AFieldDef.NullPosition and $7))) <> 0;
+    exit;
+  end;
+  
+  FieldOffset := AFieldDef.Offset;
+  FieldSize := AFieldDef.Size;
+  Src := PChar(Src) + FieldOffset;
+  // field types that are binary and of which the fieldsize should not be truncated
+  case AFieldDef.NativeFieldType of
+    '+', 'I':
+      begin
+        if FDbfVersion <> xFoxPro then
         begin
-{$ifdef SUPPORT_INT64}
-          Result := (PInt64(Src)^ <> 0);
+          Result := PDWord(Src)^ <> 0;
           if Result and (Dst <> nil) then
           begin
-            SwapInt64(Src, Dst);
-            if PInt64(Dst)^ > 0 then
-              PInt64(Dst)^ := not PInt64(Dst)^
-            else
-              PDouble(Dst)^ := PDouble(Dst)^ * -1;
+            PInteger(Dst)^ := SwapInt(PInteger(Src)^);
+            if Result then
+              PInteger(Dst)^ := Integer(PDWord(Dst)^ xor $80000000);
           end;
-{$endif}
+        end else begin
+          Result := true;
+          if Dst <> nil then
+            PInteger(Dst)^ := PInteger(Src)^;
         end;
-      '@':
+      end;
+    'O':
+      begin
+{$ifdef SUPPORT_INT64}
+        Result := (PInt64(Src)^ <> 0);
+        if Result and (Dst <> nil) then
         begin
-          Result := (PInteger(Src)^ <> 0) and (PInteger(PChar(Src)+4)^ <> 0);
-          if Result and (Dst <> nil) then
-          begin
-            SwapInt64(Src, Dst);
-            if FDateTimeHandling = dtBDETimeStamp then
-              date := BDETimeStampToDateTime(PDouble(Dst)^)
-            else
-              date := PDateTime(Dst)^;
-            SaveDateToDst;
-          end;
+          SwapInt64(Src, Dst);
+          if PInt64(Dst)^ > 0 then
+            PInt64(Dst)^ := not PInt64(Dst)^
+          else
+            PDouble(Dst)^ := PDouble(Dst)^ * -1;
         end;
-      'T':
+{$endif}
+      end;
+    '@':
+      begin
+        Result := (PInteger(Src)^ <> 0) and (PInteger(PChar(Src)+4)^ <> 0);
+        if Result and (Dst <> nil) then
         begin
-          // all binary zeroes -> empty datetime
-          Result := (PInteger(Src)^ <> 0) or (PInteger(PChar(Src)+4)^ <> 0);
-          if Result and (Dst <> nil) then
-          begin
-            timeStamp.Date := PInteger(Src)^ - 1721425;
-            timeStamp.Time := PInteger(PChar(Src)+4)^;
-            date := TimeStampToDateTime(timeStamp);
-            SaveDateToDst;
-          end;
+          SwapInt64(Src, Dst);
+          if FDateTimeHandling = dtBDETimeStamp then
+            date := BDETimeStampToDateTime(PDouble(Dst)^)
+          else
+            date := PDateTime(Dst)^;
+          SaveDateToDst;
         end;
-      'Y':
+      end;
+    'T':
+      begin
+        // all binary zeroes -> empty datetime
+        Result := (PInteger(Src)^ <> 0) or (PInteger(PChar(Src)+4)^ <> 0);
+        if Result and (Dst <> nil) then
         begin
+          timeStamp.Date := PInteger(Src)^ - 1721425;
+          timeStamp.Time := PInteger(PChar(Src)+4)^;
+          date := TimeStampToDateTime(timeStamp);
+          SaveDateToDst;
+        end;
+      end;
+    'Y':
+      begin
 {$ifdef SUPPORT_INT64}
-          Result := true;
-          if Dst <> nil then
-          begin
-            SwapInt64(Src, Dst);
-            case DataType of
-              ftCurrency:
-              begin
-                PDouble(Dst)^ := PInt64(Src)^ / 10000.0;
-              end;
-              ftBCD:
-              begin
-                PCurrency(Dst)^ := PCurrency(Src)^;
-              end;
+        Result := true;
+        if Dst <> nil then
+        begin
+          // TODO: data is little endian;
+          case DataType of
+            ftCurrency:
+            begin
+              PDouble(Dst)^ := PInt64(Src)^ / 10000.0;
+            end;
+            ftBCD:
+            begin
+              PCurrency(Dst)^ := PCurrency(Src)^;
             end;
           end;
-{$endif}
         end;
-    else
-      //    SetString(s, PChar(Src) + FieldOffset, FieldSize );
-      //    s := {TrimStr(s)} TrimRight(s);
-      // truncate spaces at end by shortening fieldsize
-      while (FieldSize > 0) and ((PChar(Src) + FieldSize - 1)^ = ' ') do
+{$endif}
+      end;
+  else
+    //    SetString(s, PChar(Src) + FieldOffset, FieldSize );
+    //    s := {TrimStr(s)} TrimRight(s);
+    // truncate spaces at end by shortening fieldsize
+    while (FieldSize > 0) and ((PChar(Src) + FieldSize - 1)^ = ' ') do
+      dec(FieldSize);
+    // if not string field, truncate spaces at beginning too
+    if DataType <> ftString then
+      while (FieldSize > 0) and (PChar(Src)^ = ' ') do
+      begin
+        inc(PChar(Src));
         dec(FieldSize);
-      // if not string field, truncate spaces at beginning too
-      if DataType <> ftString then
-        while (FieldSize > 0) and (PChar(Src)^ = ' ') do
+      end;
+    // return if field is empty
+    Result := FieldSize > 0;
+    if Result and (Dst <> nil) then     // data not needed if Result= false or Dst=nil
+      case DataType of
+      ftBoolean:
         begin
-          inc(PChar(Src));
-          dec(FieldSize);
+          // in DBase- FileDescription lowercase t is allowed too
+          // with asking for Result= true s must be longer then 0
+          // else it happens an AV, maybe field is NULL
+          if (PChar(Src)^ = 'T') or (PChar(Src)^ = 't') then
+            PWord(Dst)^ := 1
+          else
+            PWord(Dst)^ := 0;
         end;
-      // return if field is empty
-      Result := FieldSize > 0;
-      if Result and (Dst <> nil) then     // data not needed if Result= false or Dst=nil
-        case DataType of
-        ftBoolean:
-          begin
-            // in DBase- FileDescription lowercase t is allowed too
-            // with asking for Result= true s must be longer then 0
-            // else it happens an AV, maybe field is NULL
-            if (PChar(Src)^ = 'T') or (PChar(Src)^ = 't') then
-              PWord(Dst)^ := 1
-            else
-              PWord(Dst)^ := 0;
-          end;
-        ftSmallInt:
-          PSmallInt(Dst)^ := GetIntFromStrLength(Src, FieldSize, 0);
+      ftSmallInt:
+        PSmallInt(Dst)^ := GetIntFromStrLength(Src, FieldSize, 0);
 {$ifdef SUPPORT_INT64}
-        ftLargeInt:
-          PLargeInt(Dst)^ := GetInt64FromStrLength(Src, FieldSize, 0);
+      ftLargeInt:
+        PLargeInt(Dst)^ := GetInt64FromStrLength(Src, FieldSize, 0);
 {$endif}
-        ftInteger:
-          PInteger(Dst)^ := GetIntFromStrLength(Src, FieldSize, 0);
-        ftFloat, ftCurrency:
-          PDouble(Dst)^ := DbfStrToFloat(Src, FieldSize);
-        ftDate, ftDateTime:
+      ftInteger:
+        PInteger(Dst)^ := GetIntFromStrLength(Src, FieldSize, 0);
+      ftFloat, ftCurrency:
+        PDouble(Dst)^ := DbfStrToFloat(Src, FieldSize);
+      ftDate, ftDateTime:
+        begin
+          // get year, month, day
+          ldy := GetIntFromStrLength(PChar(Src) + 0, 4, 1);
+          ldm := GetIntFromStrLength(PChar(Src) + 4, 2, 1);
+          ldd := GetIntFromStrLength(PChar(Src) + 6, 2, 1);
+          //if (ly<1900) or (ly>2100) then ly := 1900;
+          //Year from 0001 to 9999 is possible
+          //everyting else is an error, an empty string too
+          //Do DateCorrection with Delphis possibillities for one or two digits
+          if (ldy < 100) and (PChar(Src)[0] = #32) and (PChar(Src)[1] = #32) then
+            CorrectYear(ldy);
+          try
+            date := EncodeDate(ldy, ldm, ldd);
+          except
+            date := 0;
+          end;
+
+          // time stored too?
+          if (AFieldDef.FieldType = ftDateTime) and (DataType = ftDateTime) then
           begin
-            // get year, month, day
-            ldy := GetIntFromStrLength(PChar(Src) + 0, 4, 1);
-            ldm := GetIntFromStrLength(PChar(Src) + 4, 2, 1);
-            ldd := GetIntFromStrLength(PChar(Src) + 6, 2, 1);
-            //if (ly<1900) or (ly>2100) then ly := 1900;
-            //Year from 0001 to 9999 is possible
-            //everyting else is an error, an empty string too
-            //Do DateCorrection with Delphis possibillities for one or two digits
-            if (ldy < 100) and (PChar(Src)[0] = #32) and (PChar(Src)[1] = #32) then
-              CorrectYear(ldy);
+            // get hour, minute, second
+            lth := GetIntFromStrLength(PChar(Src) + 8,  2, 1);
+            ltm := GetIntFromStrLength(PChar(Src) + 10, 2, 1);
+            lts := GetIntFromStrLength(PChar(Src) + 12, 2, 1);
+            // encode
             try
-              date := EncodeDate(ldy, ldm, ldd);
+              date := date + EncodeTime(lth, ltm, lts, 0);
             except
               date := 0;
             end;
-
-            // time stored too?
-            if (AFieldDef.FieldType = ftDateTime) and (DataType = ftDateTime) then
-            begin
-              // get hour, minute, second
-              lth := GetIntFromStrLength(PChar(Src) + 8,  2, 1);
-              ltm := GetIntFromStrLength(PChar(Src) + 10, 2, 1);
-              lts := GetIntFromStrLength(PChar(Src) + 12, 2, 1);
-              // encode
-              try
-                date := date + EncodeTime(lth, ltm, lts, 0);
-              except
-                date := 0;
-              end;
-            end;
-
-            SaveDateToDst;
           end;
-        ftString:
-          StrLCopy(Dst, Src, FieldSize);
-      end else begin
-        case DataType of
-        ftString:
-          if Dst <> nil then
-            PChar(Dst)[0] := #0;
+
+          SaveDateToDst;
         end;
+      ftString:
+        StrLCopy(Dst, Src, FieldSize);
+    end else begin
+      case DataType of
+      ftString:
+        if Dst <> nil then
+          PChar(Dst)[0] := #0;
       end;
     end;
+  end;
+end;
+
+procedure TDbfFile.UpdateNullField(Buffer: Pointer; AFieldDef: TDbfFieldDef; 
+  Action: TUpdateNullField);
+var
+  NullDst: pbyte;
+  Mask: byte;
+begin
+  // this field has null setting capability
+  NullDst := PByte(PChar(Buffer) + FNullField.Offset + (AFieldDef.NullPosition shr 3));
+  Mask := 1 shl (AFieldDef.NullPosition and $7);
+  if Action = unSet then
+  begin
+    // clear the field, set null flag
+    NullDst^ := NullDst^ or Mask;
   end else begin
-    Result := false;
+    // set field data, clear null flag
+    NullDst^ := NullDst^ and not Mask;
   end;
 end;
 
 procedure TDbfFile.SetFieldData(Column: Integer; DataType: TFieldType; Src, Dst: Pointer);
 const
   IsBlobFieldToPadChar: array[Boolean] of Char = (#32, '0');
+  SrcNilToUpdateNullField: array[boolean] of TUpdateNullField = (unClear, unSet);
 var
   FieldSize,FieldPrec: Integer;
   TempFieldDef: TDbfFieldDef;
@@ -1576,9 +1669,15 @@ begin
   FieldSize := TempFieldDef.Size;
   FieldPrec := TempFieldDef.Precision;
 
-  Dst := PChar(Dst) + TempFieldDef.Offset;
   // if src = nil then write empty field
   // symmetry with above
+
+  // foxpro has special _nullfield for flagging fields as `null'
+  if (FNullField <> nil) and (TempFieldDef.NullPosition >= 0) then
+    UpdateNullField(Dst, TempFieldDef, SrcNilToUpdateNullField[Src = nil]);
+
+  // copy field data to record buffer
+  Dst := PChar(Dst) + TempFieldDef.Offset;
   case TempFieldDef.NativeFieldType of
     '+', 'I':
       begin
@@ -1587,7 +1686,7 @@ begin
           if Src = nil then
             IntValue := 0
           else
-            IntValue := Integer(PDWord(Src)^ + $80000000);
+            IntValue := Integer(PDWord(Src)^ xor $80000000);
           PInteger(Dst)^ := SwapInt(IntValue);
         end else begin
           if Src = nil then
@@ -1607,8 +1706,8 @@ begin
             PLargeInt(Dst)^ := not PLargeInt(Src)^
           else
             PDouble(Dst)^ := (PDouble(Src)^) * -1;
+          SwapInt64(Dst, Dst);
         end;
-        SwapInt64(Dst, Dst);
 {$endif}
       end;
     '@':
@@ -1652,7 +1751,7 @@ begin
               PCurrency(Dst)^ := PCurrency(Src)^;
           end;
         end;
-        SwapInt64(Dst, Dst);
+        // TODO: data is little endian
 {$endif}
       end;
   else
@@ -1718,18 +1817,28 @@ var
   TempFieldDef: TDbfFieldDef;
   I: Integer;
 begin
+  // clear buffer (assume all string, fix specific fields later)
   FillChar(DestBuf^, RecordSize,' ');
+  
+  // set nullflags field so that all fields are null
+  if FNullField <> nil then
+    FillChar(PChar(DestBuf+FNullField.Offset)^, FNullField.Size, $FF);
+    
+  // check binary and default fields
   for I := 0 to FFieldDefs.Count-1 do
   begin
     TempFieldDef := FFieldDefs.Items[I];
-    if TempFieldDef.NativeFieldType in ['I', 'O', '@', '+'] then
-    begin
-      // integer
+    // binary field?
+    if TempFieldDef.NativeFieldType in ['I', 'O', '@', '+', '0', 'Y'] then
       FillChar(PChar(DestBuf+TempFieldDef.Offset)^, TempFieldDef.Size, 0);
-    end;
     // copy default value?
     if TempFieldDef.HasDefault then
+    begin
       Move(TempFieldDef.DefaultBuf[0], DestBuf[TempFieldDef.Offset], TempFieldDef.Size);
+      // clear the null flag, this field has a value
+      if FNullField <> nil then
+        UpdateNullField(DestBuf, TempFieldDef, unClear);
+    end;
   end;
 end;
 
@@ -2123,7 +2232,7 @@ begin
   end;
 end;
 
-procedure TDbfFile.Insert(Buffer: PChar);
+function TDbfFile.Insert(Buffer: PChar): integer;
 var
   newRecord: Integer;
   lIndex: TIndexFile;
@@ -2163,6 +2272,7 @@ var
   I: Integer;
 begin
   // get new record index
+  Result := 0;
   newRecord := RecordCount+1;
   // lock record so we can write data
   while not LockPage(newRecord, false) do
@@ -2223,7 +2333,7 @@ begin
   end;
 
   // write locking info
-  if FHasLockField then
+  if FLockField <> nil then
     WriteLockInfo(Buffer);
   // write buffer to disk
   WriteRecord(newRecord, Buffer);
@@ -2244,7 +2354,8 @@ begin
     UnlockPage(0);
     // roll back indexes too
     RollbackIndexesAndRaise(FIndexFiles.Count-1, False);
-  end;
+  end else
+    Result := newRecord;
 end;
 
 procedure TDbfFile.WriteLockInfo(Buffer: PChar);
@@ -2253,22 +2364,24 @@ procedure TDbfFile.WriteLockInfo(Buffer: PChar);
 //
 var
   year, month, day, hour, minute, sec, msec: Word;
+  lockoffset: integer;
 begin
   // increase change count
-  Inc(PWord(Buffer+FLockFieldOffset)^);
+  lockoffset := FLockField.Offset;
+  Inc(PWord(Buffer+lockoffset)^);
   // set time
   DecodeDate(Now(), year, month, day);
   DecodeTime(Now(), hour, minute, sec, msec);
-  Buffer[FLockFieldOffset+2] := Char(hour);
-  Buffer[FLockFieldOffset+3] := Char(minute);
-  Buffer[FLockFieldOffset+4] := Char(sec);
+  Buffer[lockoffset+2] := Char(hour);
+  Buffer[lockoffset+3] := Char(minute);
+  Buffer[lockoffset+4] := Char(sec);
   // set date
-  Buffer[FLockFieldOffset+5] := Char(year - 1900);
-  Buffer[FLockFieldOffset+6] := Char(month);
-  Buffer[FLockFieldOffset+7] := Char(day);
+  Buffer[lockoffset+5] := Char(year - 1900);
+  Buffer[lockoffset+6] := Char(month);
+  Buffer[lockoffset+7] := Char(day);
   // set name
-  FillChar(Buffer[FLockFieldOffset+8], FLockFieldLen-8, ' ');
-  Move(DbfGlobals.UserName[1], Buffer[FLockFieldOffset+8], FLockUserLen);
+  FillChar(Buffer[lockoffset+8], FLockField.Size-8, ' ');
+  Move(DbfGlobals.UserName[1], Buffer[lockoffset+8], FLockUserLen);
 end;
 
 procedure TDbfFile.LockRecord(RecNo: Integer; Buffer: PChar);
@@ -2280,7 +2393,7 @@ begin
     // store previous data for updating indexes
     Move(Buffer^, FPrevBuffer^, RecordSize);
     // lock succeeded, update lock info, if field present
-    if FHasLockField then
+    if FLockField <> nil then
     begin
       // update buffer
       WriteLockInfo(Buffer);

fcl/db/dbase/dbf_fields.pas

@@ -33,6 +33,7 @@ type
     FAutoInc: Cardinal;
     FRequired: Boolean;
     FIsLockField: Boolean;
+    FNullPosition: integer;
 
     function  GetDbfVersion: TXBaseVersion;
     procedure SetNativeFieldType(lFieldType: TDbfFieldType);
@@ -73,6 +74,7 @@ type
     property FieldName: string     read FFieldName write FFieldName;
     property FieldType: TFieldType read FFieldType write SetFieldType;
     property NativeFieldType: TDbfFieldType read FNativeFieldType write SetNativeFieldType;
+    property NullPosition: integer read FNullPosition write FNullPosition;
     property Size: Integer         read FSize      write SetSize;
     property Precision: Integer    read FPrecision write SetPrecision;
     property Required: Boolean     read FRequired  write FRequired;
@@ -196,6 +198,7 @@ begin
   FHasDefault := false;
   FHasMin := false;
   FHasMax := false;
+  FNullPosition := -1;
 end;
 
 destructor TDbfFieldDef.Destroy; {override}
@@ -220,6 +223,7 @@ begin
     FRequired := DbfSource.Required;
     FCopyFrom := DbfSource.Index;
     FIsLockField := DbfSource.IsLockField;
+    FNullPosition := DbfSource.NullPosition;
     // copy default,min,max
     AllocBuffers;
     if DbfSource.DefaultBuf <> nil then
@@ -474,7 +478,7 @@ begin
     'N','F':
       begin
         // floating point
-        if FSize < 2   then FSize := 2;
+        if FSize < 1   then FSize := 1;
         if FSize >= 20 then FSize := 20;
         if FPrecision > FSize-2 then FPrecision := FSize-2;
         if FPrecision < 0       then FPrecision := 0;

fcl/db/dbase/dbf_idxfile.pas

@@ -3324,6 +3324,10 @@ end;
 
 procedure TIndexFile.SetPhysicalRecNo(RecNo: Integer);
 begin
+  // check if already at specified recno
+  if FLeaf.PhysicalRecNo = RecNo then
+    exit;
+
   // check record actually exists
   if TDbfFile(FDbfFile).IsRecordPresent(RecNo) then
   begin

fcl/db/dbase/history.txt

@@ -32,6 +32,24 @@ BUGS & WARNINGS
 
 
 
+------------------------
+V6.4.1
+
+- fixed: restructure numeric fields correctly, try to preserve data
+- fixed: read and write foxpro currency fieldtype (thx karelrys)
+- fixed: when using TDbf.Insert to add a record, current record indicator does
+    not move to newly added record (rep by rpoverdijk)
+- fixed: req. of numeric field size >= 2, it can be 1 too! (rep by rpoverdijk)
+- fixed: forgot cursor position when disabling filter (rep by bobmitch/luchop)
+- fixed: initialize binary field types '0' (nullflags) and 'Y' (currency)
+    properly (thx to karelrys)
+- added: _nullflags field operation support (thx karelrys)
+- fixed: when editing a record, then moving to another record, memo is not
+    properly cleared if memo is null (rep by versus)
+- fixed: writing to a memo that also has a connected dbcontrol does not work;
+    quite some semantical changes, may have introduced new bugs (rep by mafro)
+
+
 ------------------------
 V6.4.0