fcl-db/dbase:

// Visual Foxpro support
+ Varchar ("V" field type), varbinary ("Q" field type) fields
+ Nullable fields
+ Autoincrement fields
* Store ftinteger in native integer instead of Numeric fields
To do for VFP:
hide _NULLFLAGS field/system fields in output and field count
// Other
* initial ftBytes/bytes ("0" field type) field support
* Minor documentation fixes

Thanks to Ludo for the var*/null help!

git-svn-id: trunk@24245 -

packages/fcl-db/src/dbase/dbf.pas

@@ -1071,7 +1071,7 @@ begin
     // TDbfFieldDef.Size indicates the number of bytes in the physical dbase file
     // TFieldDef.Size is only meant to store size indicator for variable length fields
     case TempFieldDef.FieldType of
-      ftString, ftBytes: FieldDefs.Add(TempFieldDef.FieldName, TempFieldDef.FieldType, TempFieldDef.Size, false);
+      ftString, ftBytes, ftVarBytes: FieldDefs.Add(TempFieldDef.FieldName, TempFieldDef.FieldType, TempFieldDef.Size, false);
       ftBCD:
         begin
           FieldDefs.Add(TempFieldDef.FieldName, TempFieldDef.FieldType, 0, false);;;
@@ -1082,7 +1082,6 @@ begin
 
     FieldDefs[I].Precision := TempFieldDef.Precision;
 
-
 {$ifdef SUPPORT_FIELDDEF_ATTRIBUTES}
     // AutoInc fields are readonly
     if TempFieldDef.FieldType = ftAutoInc then
@@ -1091,6 +1090,10 @@ begin
     // if table has dbase lock field, then hide it
     if TempFieldDef.IsLockField then
       FieldDefs[I].Attributes := [Db.faHiddenCol];
+
+    // Hide system/hidden fields (e.g. VFP's _NULLFLAGS)
+    if TempFieldDef.IsSystemField then
+      FieldDefs[I].Attributes := [Db.faHiddenCol];
 {$endif}
   end;
 

packages/fcl-db/src/dbase/dbf_common.inc

@@ -224,6 +224,7 @@
   {$define SUPPORT_REFRESHEVENTS}
 
   // FPC 2.0.x improvements
+  // todo: add a $IF FPC_FULLVERSION>=20000 for support for future FPC 3+
   {$ifdef VER2}
     {$ifndef VER2_0_0}
       {$define SUPPORT_BACKWARD_FIELDDATA}

packages/fcl-db/src/dbase/dbf_dbffile.pas

@@ -34,12 +34,15 @@ type
 
 //====================================================================
   TDbfIndexMissingEvent = procedure(var DeleteLink: Boolean) of object;
-  TUpdateNullField = (unClear, unSet);
+  TUpdateNullField = (unfClear, unfSet);
+  TNullFieldFlag = (nfNullFlag, nfVarlengthFlag); //the field that the nullflags bit applies to
 
 //====================================================================
   TDbfGlobals = class;
 //====================================================================
 
+  { TDbfFile }
+
   TDbfFile = class(TPagedFile)
   protected
     FMdxFile: TIndexFile;
@@ -71,11 +74,15 @@ type
 
     function GetLanguageId: Integer;
     function GetLanguageStr: string;
-    
+
   protected
+    // Reads the field's properties from the field header(s)
     procedure ConstructFieldDefs;
     procedure InitDefaultBuffer;
-    procedure UpdateNullField(Buffer: Pointer; AFieldDef: TDbfFieldDef; Action: TUpdateNullField);
+    // Shows if the (null or varlength) flag for AFieldDef is set.
+    function IsNullFlagSet(const Src: Pointer; var AFieldDef: TDbfFieldDef; WhichField: TNullFieldFlag): boolean;
+    // Updates _NULLFLAGS field with null or varlength flag for field
+    procedure UpdateNullField(Buffer: Pointer; AFieldDef: TDbfFieldDef; Action: TUpdateNullField; WhichField: TNullFieldFlag);
     procedure WriteLockInfo(Buffer: TRecordBuffer);
 
   public
@@ -86,6 +93,7 @@ type
     procedure Close;
     procedure Zap;
 
+    // Write out field definitions to header etc.
     procedure FinishCreate(AFieldDefs: TDbfFieldDefs; MemoSize: Integer);
     function GetIndexByName(AIndexName: string): TIndexFile;
     procedure SetRecordSize(NewSize: Integer); override;
@@ -97,19 +105,27 @@ type
     procedure CloseIndex(AIndexName: string);
     procedure RepageIndex(AIndexFile: string);
     procedure CompactIndex(AIndexFile: string);
+    // Inserts new record
     function  Insert(Buffer: TRecordBuffer): integer;
-    // Write relevant dbf header as well as EOF marker at end of file if necessary
+    // Write dbf header as well as EOF marker at end of file if necessary
     procedure WriteHeader; override;
-    procedure ApplyAutoIncToBuffer(DestBuf: TRecordBuffer);     // dBase7 support. Writeback last next-autoinc value
+    // Writes autoinc value to record buffer and updates autoinc value in field header
+    procedure ApplyAutoIncToBuffer(DestBuf: TRecordBuffer);
     procedure FastPackTable;
     procedure RestructureTable(DbfFieldDefs: TDbfFieldDefs; Pack: Boolean);
     procedure Rename(DestFileName: string; NewIndexFileNames: TStrings; DeleteFiles: boolean);
     function  GetFieldInfo(FieldName: string): TDbfFieldDef;
+    // Copies record buffer to field buffer
+    // Returns true if not null & data succesfully copied; false if field is null
     function  GetFieldData(Column: Integer; DataType: TFieldType; Src,Dst: Pointer; 
       NativeFormat: boolean): Boolean;
+    // Copies record buffer to field buffer
+    // Returns true if not null & data succesfully copied; false if field is null
     function  GetFieldDataFromDef(AFieldDef: TDbfFieldDef; DataType: TFieldType; 
       Src, Dst: Pointer; NativeFormat: boolean): Boolean;
+    // Copies field buffer to record buffer for this field
     procedure SetFieldData(Column: Integer; DataType: TFieldType; Src,Dst: Pointer; NativeFormat: boolean);
+    // Fill DestBuf with default field data
     procedure InitRecord(DestBuf: TRecordBuffer);
     procedure PackIndex(lIndexFile: TIndexFile; AIndexName: string);
     procedure RegenerateIndexes;
@@ -128,6 +144,7 @@ type
     property FileCodePage: Cardinal read FFileCodePage;
     property UseCodePage: Cardinal read FUseCodePage write FUseCodePage;
     property FileLangId: Byte read FFileLangId write FFileLangId;
+    // Dbase (clone) version that this format emulates. Related to tablelevel.
     property DbfVersion: TXBaseVersion read FDbfVersion write FDbfVersion;
     property PrevBuffer: TRecordBuffer read FPrevBuffer;
     property ForceClose: Boolean read FForceClose;
@@ -205,6 +222,7 @@ uses
 const
   sDBF_DEC_SEP = '.';
   FIELD_DESCRIPTOR_ARRAY_TERMINATOR = $0D; // Marker at end of list of fields within header
+  NULLFLAGSFIELD = '_NULLFLAGS'; //Visual Foxpro system field with flags for field=null and field has varlength byte
 
 {$I dbf_struct.inc}
 
@@ -597,12 +615,14 @@ var
   I, lFieldOffset, lSize, lPrec: Integer;
   lHasBlob: Boolean;
   lLocaleID: LCID;
+  lNullVarFlagCount:integer; //(VFP only) Keeps track of number null/varlength flags needed for _NULLFLAGS size calculation
 
 begin
   try
     // first reset file
     RecordCount := 0;
     lHasBlob := false;
+    lNullVarFlagCount := 0;
     // determine codepage & locale
     if FFileLangId = 0 then
       FFileLangId := DbfGlobals.DefaultCreateLangId;
@@ -666,6 +686,16 @@ begin
       lFieldDef.FieldName := AnsiUpperCase(lFieldDef.FieldName);
       lFieldDef.Offset := lFieldOffset;
       lHasBlob := lHasBlob or lFieldDef.IsBlob;
+      // Check for foxpro, too, as it can get auto-upgraded to vfp:
+      if (FDbfVersion in [xFoxPro,xVisualFoxPro]) then
+        begin
+        if (lFieldDef.NativeFieldType='Q') or (lFieldDef.NativeFieldType='V') then
+          begin
+          lNullVarFlagCount:=lNullVarFlagCount+1;
+          end;
+        if (lFieldDef.NullPosition>=0) then
+          lNullVarFlagCount:=lNullVarFlagCount+1;
+        end;
 
       // apply field transformation tricks
       lSize := lFieldDef.Size;
@@ -700,20 +730,38 @@ begin
         lFieldDescIII.FieldPrecision := lPrec;
         if (FDbfVersion in [xFoxPro,xVisualFoxPro]) then
           lFieldDescIII.FieldOffset := SwapIntLE(lFieldOffset);
-        // Adjust the version info if needed for supporting field types used:
-        // VerDBF=$03 also includes dbase formats, so we perform an extra check
-        // todo: reconsider this shifting foxpro=>vfoxpro: if the user requested
-        // a certain tablelevel, we're now silently changing that without notification.
-        // This may be an interoperability problem.
-        if (FDBFVersion in [xUnknown,xFoxPro,xVisualFoxPro]) and
-          (PDbfHdr(Header)^.VerDBF in [$02,$03]) and
-          (lFieldDef.NativeFieldType in ['0', 'Y', 'T', 'O', '+']) then
+
+        // Upgrade the version info if needed for supporting field types used.
+        // This is also what Visual FoxPro does with FoxPro tables to which you
+        // add new VFP features.
+        if (FDBFVersion in [xUnknown,xFoxPro,xVisualFoxPro]) then
+        begin
+          // VerDBF=$03 also includes dbase formats, so we perform an extra check
+          if (PDbfHdr(Header)^.VerDBF in [$02,$03]) and
+           ((lFieldDef.NativeFieldType in ['0', 'Y', 'T', 'O', '+', 'Q', 'V']) or (lNullVarFlagCount>0))
+           then
+           begin
+             PDbfHdr(Header)^.VerDBF := $30; {Visual FoxPro}
+             FDBFVersion:=xVisualFoxPro; //needed to write the backlink info
+           end;
+          //AutoInc only support in Visual Foxpro; another upgrade
+          //Note: .AutoIncrementNext is really a cardinal (see the definition)
+          lFieldDescIII.AutoIncrementNext:=SwapIntLE(lFieldDef.AutoInc);
+          lFieldDescIII.AutoIncrementStep:=lFieldDef.AutoIncStep;
+          // Set autoincrement flag using AutoIncStep as a marker
+          if (lFieldDef.AutoIncStep<>0) then
+            lFieldDescIII.VisualFoxProFlags:=(lFieldDescIII.VisualFoxProFlags or $0C);
+          if (PDbfHdr(Header)^.VerDBF = $30) and (lFieldDef.AutoIncStep<>0) then
           begin
-            PDbfHdr(Header)^.VerDBF := $30; {Visual FoxPro}
-            FDBFVersion:=xVisualFoxPro; //needed to write the backlink info
+            PDbfHdr(Header)^.VerDBF := $31; {Visual FoxPro, autoincrement enabled}
+            FDBFVersion:=xVisualFoxPro;
           end;
-        if (PDbfHdr(Header)^.VerDBF = $30) and (lFieldDef.NativeFieldType = '+') then
-          PDbfHdr(Header)^.VerDBF := $31; {Visual FoxPro, autoincrement enabled}
+
+          // Only supported in Visual FoxPro but let's not upgrade format as
+          // IsSystemField is a minor property
+          if (lFieldDef.IsSystemField) then
+            lFieldDescIII.VisualFoxProFlags:=(lFieldDescIII.VisualFoxProFlags or $01);
+        end;
       end;
 
       // update our field list
@@ -728,6 +776,22 @@ begin
       WriteRecord(I, lFieldDescPtr);
       Inc(lFieldOffset, lFieldDef.Size);
     end;
+
+    // Visual Foxpro: write _NULLFLAGS field if required
+    if (FDBFVersion=xVisualFoxPro) and (lNullVarFlagCount>0) then
+    begin
+      FillChar(lFieldDescIII, SizeOf(lFieldDescIII), #0);
+      StrPLCopy(lFieldDescIII.FieldName, NULLFLAGSFIELD, 10);
+      lFieldDescIII.FieldType := '0'; //bytes
+      lFieldDescIII.FieldSize := 1+(lNullVarFlagCount-1) div 8; //Number of bytes needed for all bit flags
+      lFieldDescIII.FieldPrecision := 0;
+      lFieldDescIII.FieldOffset := SwapIntLE(lFieldOffset);
+      lFieldDescIII.VisualFoxProFlags:=$01+$04 ; //System column (hidden)+Column can store null values (which is a bit of a paradox)
+      // save field props
+      WriteRecord(AFieldDefs.Count+1, @lFieldDescIII);
+      Inc(lFieldOffset, lFieldDescIII.FieldSize);
+    end;
+
     // end of field descriptor; ussually end of header -
     // Visual Foxpro backlink info is part of the header but comes after the
     // terminator
@@ -748,7 +812,10 @@ begin
 
     // update header
     PDbfHdr(Header)^.RecordSize := lFieldOffset;
-    PDbfHdr(Header)^.FullHdrSize := HeaderSize + RecordSize * AFieldDefs.Count + 1;
+    if lNullVarFlagCount>0 then
+      PDbfHdr(Header)^.FullHdrSize := HeaderSize + RecordSize * (AFieldDefs.Count+1) + 1
+    else
+      PDbfHdr(Header)^.FullHdrSize := HeaderSize + RecordSize * AFieldDefs.Count + 1;
     { For Visual FoxPro only, add empty "back-link" info:
       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, 
@@ -851,7 +918,10 @@ var
   dataPtr: PChar;
   lNativeFieldType: Char;
   lFieldName: string;
-  lCanHoldNull: boolean;
+  lCanHoldNull: boolean; //Can the field store nulls, i.e. is it nullable?
+  lIsVFPSystemField: boolean; //Is this a Visual FoxPro system/hidden field?
+  lIsVFPVarLength: boolean; //Is this a Visual FoxPro varbinary/varchar field,
+  // where varlength bit is maintained in _NULLFLAGS
   lCurrentNullPosition: integer;
 begin
   FFieldDefs.Clear;
@@ -874,8 +944,10 @@ begin
   lFieldOffset := 1;
   lAutoInc := 0;
   I := 1;
-  lCurrentNullPosition := 0;
+  lCurrentNullPosition := 0; // Contains the next value for the _NULLFLAGS bit position
   lCanHoldNull := false;
+  lIsVFPSystemField := false;
+  lIsVFPVarLength := false;
   try
     // Specs say there has to be at least one field, so use repeat:
     repeat
@@ -897,10 +969,25 @@ begin
         lSize := lFieldDescIII.FieldSize;
         lPrec := lFieldDescIII.FieldPrecision;
         lNativeFieldType := lFieldDescIII.FieldType;
-        // todo: verify but AFAIU only Visual FoxPro supports null fields.
+        if (FDBFVersion=xVisualFoxPro) and ((lFieldDescIII.VisualFoxProFlags and $0C)<>0) then
+        begin
+          // We do not test for an I field - we could implement our own N autoincrement this way...
+          lAutoInc:=lFieldDescIII.AutoIncrementNext;
+          FAutoIncPresent:=true;
+        end;
+
+        // Only Visual FoxPro supports null fields, if the nullable field flag is on
         lCanHoldNull := (FDbfVersion in [xVisualFoxPro]) and
-          ((lFieldDescIII.FoxProFlags and $2) <> 0) and
-          (lFieldName <> '_NULLFLAGS');
+          ((lFieldDescIII.VisualFoxProFlags and $2) <> 0) and
+          (lFieldName <> NULLFLAGSFIELD {the field where null status is stored can never be null itself});
+        // System/hidden flag (VFP only):
+        lIsVFPSystemField := (FDbfVersion in [xVisualFoxPro]) and
+          ((lFieldDescIII.VisualFoxProFlags and $01)=$01);
+        // Only Visual Foxpro supports varbinary/varchar fields where a flag indicates
+        // if the actual size is stored in the last data byte.
+        lIsVFPVarLength := (FDbfVersion in [xVisualFoxPro]) and
+          (lNativeFieldType in ['Q','V']) and
+          (lFieldName <> NULLFLAGSFIELD);
       end;
 
       // apply field transformation tricks
@@ -926,6 +1013,15 @@ begin
         Precision := lPrec;
         AutoInc := lAutoInc;
         NativeFieldType := lNativeFieldType;
+        IsSystemField := lIsVFPSystemField;
+        if lIsVFPVarLength then
+        begin
+          // The varlength flag uses the same _NULLFLAGS field as the null flags.
+          // It comes before the null bit for that field, if any.
+          VarLengthPosition := lCurrentNullPosition;
+          inc(lCurrentNullPosition);
+        end else
+          VarLengthPosition := -1;
         if lCanHoldNull then
         begin
           NullPosition := lCurrentNullPosition;
@@ -949,7 +1045,7 @@ begin
         if FLockUserLen > DbfGlobals.UserNameLen then
           FLockUserLen := DbfGlobals.UserNameLen;
       end else
-      if UpperCase(lFieldName) = '_NULLFLAGS' then
+      if (FDbfVersion=xVisualFoxPro) and (uppercase(lFieldName) = NULLFLAGSFIELD) then
         FNullField := TempFieldDef;
 
       // goto next field
@@ -1017,8 +1113,8 @@ begin
             ReadBlock(dataPtr, lStdProp.DataSize, lPropHdrOffset + lStdProp.DataOffset);
         end;
       end;
-      // read custom properties...not implemented
-      // read RI/referential integrity properties...not implemented
+      // todo: read custom properties...not implemented
+      // todo: read RI/referential integrity properties...not implemented
     end;
   finally
     HeaderSize := PDbfHdr(Header)^.FullHdrSize;
@@ -1031,12 +1127,46 @@ begin
   Result := PDbfHdr(Header)^.Language;
 end;
 
-function TDbfFile.GetLanguageStr: String;
+function TDbfFile.GetLanguageStr: string;
 begin
   if FDbfVersion >= xBaseVII then
     Result := PAfterHdrVII(PChar(Header) + SizeOf(rDbfHdr))^.LanguageDriverName;
 end;
 
+function TDbfFile.IsNullFlagSet(const Src: Pointer; var AFieldDef: TDbfFieldDef; WhichField: TNullFieldFlag): boolean;
+var
+  NullFlagByte: Pointer;
+begin
+  case WhichField of
+  nfNullFlag:
+    begin
+      if (AFieldDef.NullPosition<0) or (FNullField=nil) then
+        result:=false //field is not even nullable
+      else
+      begin
+        // go to _NULLFLAGS byte that has this field's null flag
+        // Find out the byte where the null bit for the field is stored by doing
+        // NullPosition shr3 (= NullPosition div 8)...
+        NullFlagByte := PChar(Src) + FNullField.Offset + (AFieldDef.NullPosition shr 3);
+        // ... get the correct bit in the byte by the equivalent of getting the bit number in that byte:
+        // NullPosition and $7 (=mod 8)... and going to the bit value in the byte (by shl)
+        // The result is true if the field is null.
+        Result := (PByte(NullFlagByte)^ and (1 shl (AFieldDef.NullPosition and $7))) <> 0;
+      end;
+    end;
+  nfVarlengthFlag:
+    begin
+      if (AFieldDef.VarLengthPosition<0) or (FNullField=nil) then
+        result:=false //field *never* has a varlength byte
+      else
+      begin
+        NullFlagByte := PChar(Src) + FNullField.Offset + (AFieldDef.VarLengthPosition shr 3);
+        Result := (PByte(NullFlagByte)^ and (1 shl (AFieldDef.VarLengthPosition and $7))) <> 0
+      end;
+    end;
+  end;
+end;
+
 {
   I fill the holes with the last records.
   now we can do an 'in-place' pack
@@ -1451,6 +1581,7 @@ var
   date: TDateTime;
   timeStamp: TTimeStamp;
   asciiContents: boolean;
+  SrcRecord: Pointer;
 
 {$ifdef SUPPORT_INT64}
   function GetInt64FromStrLength(Src: Pointer; Size: Integer; Default: Int64): Int64;
@@ -1519,14 +1650,13 @@ begin
   // 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;
+    result:= not(IsNullFlagSet(Src, AFieldDef, nfNullFlag));
     exit;
   end;
-  
+
   FieldOffset := AFieldDef.Offset;
   FieldSize := AFieldDef.Size;
+  SrcRecord := Src;
   Src := PChar(Src) + FieldOffset;
   asciiContents := false;
   Result := true;
@@ -1604,7 +1734,7 @@ begin
         end;
 {$endif}
       end;
-    'B':    // Foxpro double
+    'B':  // Foxpro double
       begin
         if (FDbfVersion in [xFoxPro,xVisualFoxPro]) then
         begin
@@ -1624,6 +1754,44 @@ begin
         end else
           asciiContents := true;
       end;
+    'Q', 'V':  // Visual Foxpro varbinary, varchar
+      //todo: check if codepage conversion/translation for varchar is needed
+      begin
+        if (FDbfVersion in [xVisualFoxPro]) then
+        begin
+          Result := true;
+          // The length byte is only stored if the field is not full
+          if (Dst <> nil) then
+          begin
+            //clear the destination, just in case
+            Fillchar(pbyte(Dst)^,Fieldsize,0);
+            if IsNullFlagSet(SrcRecord, AFieldDef, nfVarlengthFlag) then
+            // so we decrease the fieldsize and let the rest of the code handle it
+              FieldSize:=(PByte(Src)+FieldSize-1)^;
+            // If field is not null:
+            if not(IsNullFlagSet(SrcRecord, AFieldDef, nfNullFlag)) then
+              if Afielddef.FieldType=ftVarBytes then
+              begin
+                PWord(Dst)^:=Fieldsize; //Store size in destination
+                move(Src^, pbyte(Dst+sizeof(Word))^, FieldSize)
+              end
+              else
+                move(Src^, pbyte(Dst)^, FieldSize)
+            else
+              result:=false;
+          end;
+        end;
+      end;
+    '0':  // Zero not letter 0: bytes
+      begin
+        if (Dst <> nil) then
+        begin
+          //clear the destination, just in case
+          Fillchar(pbyte(Dst)^,Fieldsize,0);
+          move(Src^, pbyte(Dst)^, FieldSize);
+          Result := true;
+        end;
+      end;
   else
     asciiContents := true;
   end;
@@ -1649,7 +1817,7 @@ begin
         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
+          // else an AV occurs, maybe field is NULL
           if (PChar(Src)^ = 'T') or (PChar(Src)^ = 't') then
             PWord(Dst)^ := 1
           else
@@ -1713,20 +1881,38 @@ begin
 end;
 
 procedure TDbfFile.UpdateNullField(Buffer: Pointer; AFieldDef: TDbfFieldDef; 
-  Action: TUpdateNullField);
+  Action: TUpdateNullField; WhichField: TNullFieldFlag);
 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
+  // this field has null setting capability...
+  // ... but no Super Cow Powers.
+  case WhichField of
+  nfNullFlag:
+    begin
+      // Find out the byte where the length bit for the field is stored by doing
+      // NullPosition shr3 (= NullPosition div 8)...
+      NullDst := PByte(PChar(Buffer) + FNullField.Offset + (AFieldDef.NullPosition shr 3));
+      // ... get the correct bit in the byte by the equivalent of
+      // getting the bit number in that byte:
+      // NullPosition and $7 (=mod 8)...
+      // and going to the bit value in the byte (shl)
+      Mask := 1 shl (AFieldDef.NullPosition and $7);
+    end;
+  nfVarlengthFlag:
+    begin
+      NullDst := PByte(PChar(Buffer) + FNullField.Offset + (AFieldDef.VarLengthPosition shr 3));
+      Mask := 1 shl (AFieldDef.VarLengthPosition and $7);
+    end;
+  end;
+
+  if Action = unfSet then
   begin
-    // clear the field, set null flag
+    // set flag
     NullDst^ := NullDst^ or Mask;
-  end else begin
-    // set field data, clear null flag
+  end else begin //unfClear
+    // clear flag
     NullDst^ := NullDst^ and not Mask;
   end;
 end;
@@ -1735,8 +1921,9 @@ procedure TDbfFile.SetFieldData(Column: Integer; DataType: TFieldType;
   Src, Dst: Pointer; NativeFormat: boolean);
 const
   IsBlobFieldToPadChar: array[Boolean] of Char = (#32, '0');
-  SrcNilToUpdateNullField: array[boolean] of TUpdateNullField = (unClear, unSet);
+  SrcNilToUpdateNullField: array[boolean] of TUpdateNullField = (unfClear, unfSet);
 var
+  DstRecord: Pointer;
   FieldSize,FieldPrec: Integer;
   TempFieldDef: TDbfFieldDef;
   Len: Integer;
@@ -1773,18 +1960,18 @@ begin
   FieldSize := TempFieldDef.Size;
   FieldPrec := TempFieldDef.Precision;
 
+  DstRecord:=Dst; //beginning of record
+  Dst := PChar(Dst) + TempFieldDef.Offset; //beginning of field
+
   // if src = nil then write empty field
-  // symmetry with above
+  // symmetry with above loading code
 
-  // foxpro has special _nullfield for flagging fields as `null'
+  // Visual Foxpro has special _nullfield for flagging fields as `null'
   if (FNullField <> nil) and (TempFieldDef.NullPosition >= 0) then
-    UpdateNullField(Dst, TempFieldDef, SrcNilToUpdateNullField[Src = nil]);
+    UpdateNullField(DstRecord, TempFieldDef, SrcNilToUpdateNullField[Src = nil],nfNullFlag);
 
   // copy field data to record buffer
-  Dst := PChar(Dst) + TempFieldDef.Offset;
   asciiContents := false;
-  // todo: check/add visualfoxpro autoincrement capability, null values, DateTime, Currency, and Double data types
-  // see comments in dbf_fields for details
   case TempFieldDef.NativeFieldType of
     '+', 'I' {autoincrement, integer}:
       begin
@@ -1891,6 +2078,54 @@ begin
         end else
           asciiContents := true;
       end;
+    'Q': //Visual FoxPro varbinary
+      begin
+        // copy data, and update varlength flag/varlength byte in field data
+        Len := PWord(Src)^;
+        if Len > FieldSize then
+          Len := FieldSize;
+        if Len < FieldSize then
+        begin
+          // Clear flag and store actual size byte in last data byte
+          PByte(PChar(Dst)+TempFieldDef.Size-1)^:=Len;
+          UpdateNullField(DstRecord, TempFieldDef, unfSet, nfVarlengthFlag);
+        end
+        else
+        begin
+          UpdateNullField(DstRecord, TempFieldDef, unfClear, nfVarlengthFlag);
+        end;
+
+        Move((Src+sizeof(word))^, Dst^, Len);
+        // fill remaining data area with spaces, keeping room for size indicator if needed
+        if Len=FieldSize then
+          FillChar((PChar(Dst)+Len)^, FieldSize - Len, ' ')
+        else
+          FillChar((PChar(Dst)+Len)^, FieldSize - Len - 1, ' ');
+      end;
+    'V': //Visual FoxPro varchar
+      begin
+        // copy data, and update varlength flag/varlength byte in field data
+        Len := StrLen(Src);
+        if Len > FieldSize then
+          Len := FieldSize;
+        if Len < FieldSize then
+        begin
+          // Clear flag and store actual size byte in last data byte
+          PByte(PChar(Dst)+TempFieldDef.Size-1)^:=Len;
+          UpdateNullField(DstRecord, TempFieldDef, unfSet, nfVarlengthFlag);
+        end
+        else
+        begin
+          UpdateNullField(DstRecord, TempFieldDef, unfClear, nfVarlengthFlag);
+        end;
+
+        Move(Src^, Dst^, Len);
+        // fill remaining data area with spaces, keeping room for size indicator if needed
+        if Len=FieldSize then
+          FillChar((PChar(Dst)+Len)^, FieldSize - Len, ' ')
+        else
+          FillChar((PChar(Dst)+Len)^, FieldSize - Len - 1, ' ');
+      end
   else
     asciiContents := true;
   end;
@@ -1965,7 +2200,7 @@ begin
   GetMem(FDefaultBuffer, lRecordSize+1);
   FillChar(FDefaultBuffer^, lRecordSize, ' ');
   
-  // set nullflags field so that all fields are null
+  // set nullflags field so that all fields are null (and var* fields marked as full)
   if FNullField <> nil then
     FillChar(PChar(FDefaultBuffer+FNullField.Offset)^, FNullField.Size, $FF);
 
@@ -1973,9 +2208,9 @@ begin
   for I := 0 to FFieldDefs.Count-1 do
   begin
     TempFieldDef := FFieldDefs.Items[I];
-    // 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
+    // binary (non-text) field? (foxpro memo fields are binary, but dbase not)
+    if (TempFieldDef.NativeFieldType in ['I', 'O', '@', '+', '0', 'W', 'Y'])
+        or ((TempFieldDef.NativeFieldType = 'M') and (TempFieldDef.Size = 4) {Visual FoxPro?}) then
       FillChar(PChar(FDefaultBuffer+TempFieldDef.Offset)^, TempFieldDef.Size, 0);
     // copy default value?
     if TempFieldDef.HasDefault then
@@ -1983,7 +2218,18 @@ begin
       Move(TempFieldDef.DefaultBuf[0], FDefaultBuffer[TempFieldDef.Offset], TempFieldDef.Size);
       // clear the null flag, this field has a value
       if FNullField <> nil then
-        UpdateNullField(FDefaultBuffer, TempFieldDef, unClear);
+        UpdateNullField(FDefaultBuffer, TempFieldDef, unfClear, nfNullFlag);
+      // Check for varbinary/varchar and if default matches it, then mark field as full
+      if (TempFieldDef.VarLengthPosition>=0) then
+        if (strlen(FDefaultBuffer)>=TempFieldDef.Size) then
+          UpdateNullField(FDefaultBuffer, TempFieldDef, unfClear, nfVarlengthFlag)
+        else
+          begin
+            // Set flag and store actual size byte in last data byte
+            UpdateNullField(FDefaultBuffer, TempFieldDef, unfSet, nfVarlengthFlag);
+            //todo: verify pointer use
+            PByte(PChar(FDefaultBuffer)+TempFieldDef.Size)^:=strlen(FDefaultBuffer);
+          end;
     end;
   end;
 end;
@@ -2013,7 +2259,8 @@ begin
     for I := 0 to FFieldDefs.Count-1 do
     begin
       TempFieldDef := FFieldDefs.Items[I];
-      if (TempFieldDef.NativeFieldType = '+') then
+      if (DbfVersion=xBaseVII) and
+        (TempFieldDef.NativeFieldType = '+') then
       begin
         // read current auto inc, from header or field, depending on sharing
         lAutoIncOffset := sizeof(rDbfHdr) + sizeof(rAfterHdrVII) + 
@@ -2031,6 +2278,18 @@ begin
         TempFieldDef.AutoInc := NextVal;
         // write new value to header buffer
         PCardinal(FHeader+lAutoIncOffset)^ := SwapIntLE(NextVal);
+      end
+      else
+      if (DbfVersion=xVisualFoxPro) and
+        (TempFieldDef.AutoIncStep<>0) then
+      begin
+        // read current auto inc from field header
+        NextVal:=TempFieldDef.AutoInc; //todo: is this correc
+        PCardinal(DestBuf+TempFieldDef.Offset)^ := SwapIntBE(NextVal); //todo: is swapintbe correct?
+        // Increase with step size
+        NextVal:=NextVal+TempFieldDef.AutoIncStep;
+        // write new value back
+        TempFieldDef.AutoInc:=NextVal;
       end;
     end;
 

packages/fcl-db/src/dbase/dbf_fields.pas

@@ -14,10 +14,15 @@ uses
 type
   PDbfFieldDef = ^TDbfFieldDef;
 
+  { TDbfFieldDef }
+
   TDbfFieldDef = class(TCollectionItem)
   private
+    FAutoIncStep: Integer;
     FFieldName: string;
     FFieldType: TFieldType;
+    FIsSystemField: Boolean;
+    FVarLengthPosition: integer;
     FNativeFieldType: TDbfFieldType;
     FDefaultBuf: PChar;
     FMinBuf: PChar;
@@ -69,19 +74,39 @@ type
     property HasDefault: Boolean read FHasDefault write FHasDefault;
     property HasMin: Boolean read FHasMin write FHasMin;
     property HasMax: Boolean read FHasMax write FHasMax;
+    // Distance of field from beginning of record
     property Offset: Integer read FOffset write FOffset;
+    // Value for autoinc
     property AutoInc: Cardinal read FAutoInc write FAutoInc;
+    // Step size for autoinc (Visual FoxPro only)
+    property AutoIncStep: Integer read FAutoIncStep write FAutoIncStep;
+    // Field contains lock data (not a normal field)
     property IsLockField: Boolean read FIsLockField write FIsLockField;
+    // Field is a system, hidden field (Visual FoxPro supported only)
+    property IsSystemField: Boolean read FIsSystemField write FIsSystemField;
     property CopyFrom: Integer read FCopyFrom write FCopyFrom;
   published
     property FieldName: string     read FFieldName write FFieldName;
     // VCL/LCL field type mapped to this field
     property FieldType: TFieldType read FFieldType write SetFieldType;
+    // If using varchar/varbinary/var...:
+    // VFP uses a varlength bit in _NullFields in physical order (bit number corresponds to physical order)
+    // If flag=1, the actually used length/size is stored in the last data byte of the field
+    // If the var* field is nullable, 2 bits are used:
+    // lower bit number is varlength, next is null flag.
+    // Note: VarLengthPosition property is 0 based
+    // http://msdn.microsoft.com/en-us/library/st4a0s68%28v=VS.80%29.aspx
+    property VarLengthPosition: integer read FVarLengthPosition write FVarLengthPosition;
     // Native dbf field type
     property NativeFieldType: TDbfFieldType read FNativeFieldType write SetNativeFieldType;
     // Size in physical dbase file.
     // Note: this often differs from the VCL field sizes
     property Size: Integer         read FSize write SetSize;
+    // Visual FoxPro: position of field null flag in _NullFields field
+    // Reflects the physical field order, except if varchar/varbinary/var* fields
+    // are used (see VarLengthPosition property for details)
+    // Note: NullPosition property is 0 based
+    // http://msdn.microsoft.com/en-us/library/st4a0s68%28v=VS.80%29.aspx
     property NullPosition: integer read FNullPosition write FNullPosition;
     property Precision: Integer    read FPrecision write SetPrecision;
     property Required: Boolean     read FRequired  write FRequired;
@@ -201,6 +226,7 @@ begin
   FHasMin := false;
   FHasMax := false;
   FNullPosition := -1;
+  FVarLengthPosition := -1;
 end;
 
 destructor TDbfFieldDef.Destroy; {override}
@@ -225,7 +251,9 @@ begin
     FRequired := DbfSource.Required;
     FCopyFrom := DbfSource.Index;
     FIsLockField := DbfSource.IsLockField;
+    FIsSystemField := DbfSource.IsSystemField;
     FNullPosition := DbfSource.NullPosition;
+    FVarLengthPosition:=DbfSource.VarLengthPosition;
     // copy default,min,max
     AllocBuffers;
     if DbfSource.DefaultBuf <> nil then
@@ -236,6 +264,7 @@ begin
     // do we need offsets?
     FOffset := DbfSource.Offset;
     FAutoInc := DbfSource.AutoInc;
+    FAutoIncStep := DbfSource.AutoIncStep;
 {$ifdef SUPPORT_FIELDDEF_TPERSISTENT}
   end else if Source is TFieldDef then begin
     AssignDb(TFieldDef(Source));
@@ -258,6 +287,7 @@ begin
   FCopyFrom := DbSource.Index;
 {$endif}
   FIsLockField := false;
+  FIsSystemField := false;
   // convert VCL fieldtypes to native DBF fieldtypes
   VCLToNative;
   // for integer / float fields try to fill in Size/precision
@@ -272,6 +302,7 @@ begin
   FHasMax := false;
   FOffset := 0;
   FAutoInc := 0;
+  FAutoIncStep := 0;
 end;
 
 procedure TDbfFieldDef.AssignTo(Dest: TPersistent);
@@ -303,14 +334,14 @@ begin
   Result := TDbfFieldDefs(Collection).DbfVersion;
 end;
 
-procedure TDbfFieldDef.SetFieldType(lFieldType: tFieldType);
+procedure TDbfFieldDef.SetFieldType(lFieldType: TFieldType);
 begin
   FFieldType := lFieldType;
   VCLToNative;
   SetDefaultSize;
 end;
 
-procedure TDbfFieldDef.SetNativeFieldType(lFieldType: tDbfFieldType);
+procedure TDbfFieldDef.SetNativeFieldType(lFieldType: TDbfFieldType);
 begin
   // convert lowercase to uppercase
   if (lFieldType >= 'a') and (lFieldType <= 'z') then
@@ -338,8 +369,12 @@ begin
     '+' : //dbase7+ autoinc
       if DbfVersion = xBaseVII then
         FFieldType := ftAutoInc;
-    'I' : //integer
-      FFieldType := ftInteger;
+    'I' : //visual foxpro integer
+      // todo: is this the right property to check for? Can't we check flags directly
+      if FAutoIncStep=0 then
+        FFieldType := ftInteger
+      else
+        FFieldType := ftAutoInc;
     'O' : //double, 8 bytes?
       FFieldType := ftFloat;
     '@', 'T' {Foxpro? datetime}:
@@ -398,7 +433,7 @@ begin
         FFieldType := ftBlob;
     'Q' : //varbinary
       if (DBFVersion = xVisualFoxPro) then
-        FFieldType := ftBytes;
+        FFieldType := ftVarBytes;
   else
     FNativeFieldType := #0;
     FFieldType := ftUnknown;
@@ -410,7 +445,11 @@ begin
   FNativeFieldType := #0;
   case FFieldType of
     ftAutoInc  :
-      FNativeFieldType  := '+'; //todo: verify: xbasev/7 only? also (V)foxpro?
+      if DbfVersion=xVisualFoxPro then
+        FNativeFieldType  := 'I'
+        //todo: set autoincrement fields: offset 18: add flag $0c; 19-22: value of next autoincrement; 23 value of autoincrement step value
+      else
+        FNativeFieldType  := '+'; //Apparently xbaseV/7+ only; not (Visual) Foxpro
     ftDateTime :
       if DbfVersion = xBaseVII then
         FNativeFieldType := '@'
@@ -439,7 +478,7 @@ begin
     ftBlob     :
       case DBFVersion of
         xFoxPro:
-          FNativeFieldType := 'P'; //picture
+          FNativeFieldType := 'P'; //picture; best we can do
         xVisualFoxPro:
           FNativeFieldType := 'W'; //blob
         xBaseIII,xBaseIV:
@@ -449,6 +488,12 @@ begin
       else
         FNativeFieldType := 'M'; //fallback
       end;
+    ftVarBytes :
+      //todo: figure out if we can use the same fallbacks as ftBlob
+      case DBFVersion of
+        xVisualFoxPro:
+          FNativeFieldType := 'Q'; //variant bytes
+      end;
     ftDBaseOle :
       FNativeFieldType := 'G'; //general
       //todo: verify if this is dbaseV/7 specific
@@ -457,8 +502,7 @@ begin
       // P is apparently not recommended
       FNativeFieldType := 'B'; //BLOB
     ftInteger  :
-      //todo: verify FoxPro I=4 byte little endian integer
-      if DbfVersion = xBaseVII then
+      if (DbfVersion in [xBaseVII,xVisualFoxPro]) then
         FNativeFieldType := 'I' //integer
       else
         FNativeFieldType := 'N'; //numeric
@@ -472,7 +516,7 @@ end;
 
 procedure TDbfFieldDef.SetDefaultSize;
 begin
-  // choose default values for variable Size fields
+  // choose default values for variable size fields
   case FFieldType of
     ftFloat:
       begin
@@ -492,8 +536,8 @@ begin
       end;
     ftInteger, ftAutoInc:
       begin
-        if DbfVersion = xBaseVII then
-          FSize := 4
+        if DbfVersion in [xBaseVII,xVisualFoxPro] then
+          FSize := 4 //I, @ field
         else
           FSize := DIGITS_INTEGER;
         FPrecision := 0;
@@ -601,31 +645,8 @@ begin
         FPrecision := 4;
       end;
   else
-    {
-    No check, includes:
-    http://msdn.microsoft.com/en-US/library/ww305zh2%28v=vs.80%29.aspx
-    P Picture (in at least Visual FoxPro)
-    V Varchar/varchar binary (in Visual FoxPro 9) 1 byte up to 254 bytes.
-      Same storage as char (padded spaces) but padding is removed on display
-      http://foxcentral.net/microsoft/WhatsNewInVFP9_Chapter09.htm
-    W Blob (Visual FoxPro 9), 4 bytes in a table; stored in .fpt
-      http://foxcentral.net/microsoft/WhatsNewInVFP9_Chapter09.htm
-    Q Varchar (binary) (in Visual Foxpro 9):
-      accepts null, up to 254 characters (stored as padded with spaces), no code page translations
-      note varchar (binary)<>varbinary
-      http://foxcentral.net/microsoft/WhatsNewInVFP9_Chapter09.htm
-    Varchar/varbinary storage:
-      Uses _NullFlags:
-      bit n=1: nullable field number n is null (as in previous versions)
-      bit n=0: varchar/varbinary field is full/fills space
-      bit n=1: varchar/varbinary is not full; last byte of field data contains size
-      If varchar/varbinary field AND nullable field, 2 bits are used:
-      - lower bit=full status
-      - higher bit=null status
-
-
-    }
-  end; // case
+    // no idea/unimportant, let other code sort it out
+  end;
 end;
 
 function TDbfFieldDef.GetDisplayName: string; {override;}
@@ -635,9 +656,9 @@ end;
 
 function TDbfFieldDef.IsBlob: Boolean; {override;}
 begin
-  // 'B' is float in (V)FP
+  // 'B' is float in (V)FP; W is Blob (VFP9)
   if (DbfVersion in [xFoxPro,xVisualFoxPro]) then
-    Result := FNativeFieldType in ['M','G']
+    Result := FNativeFieldType in ['M','G','W']
   else
     Result := FNativeFieldType in ['M','G','B'];
 end;

packages/fcl-db/src/dbase/dbf_struct.inc

@@ -31,7 +31,10 @@ type
     MultiUse    : Integer;  // 16-19
     LastUserID  : Integer;  // 20-23
     Dummy2      : array[24..27] of Byte;
-    MDXFlag     : Byte;     // 28
+    MDXFlag     : Byte;     // 28 Flags:
+    // $01: mdx (or cdx for VFP) index file present
+    // $02: (Visual FoxPro): associated memo file?
+    // $04: (Visual FoxPro): is this a dbc/database container
     Language    : Byte;     // 29 code page mark
     Dummy3      : Word;     // 30-31
   end;
@@ -49,22 +52,32 @@ type
 // DBase III,IV,FoxPro,VisualFoxPro field description
   PFieldDescIII = ^rFieldDescIII;
   rFieldDescIII = packed record
-    FieldName       : array[0..10] of Char;
-    FieldType       : Char;    // 11
-    // FieldOffset only applicable to (visual) foxpro databases
+    FieldName         : array[0..10] of Char;
+    FieldType         : Char;    // 11
+    // FieldOffset: (V)FoxPro only: displacement of field in record
     // DBase III uses it for address in memory
-    FieldOffset     : Integer; // 12..15
-    FieldSize       : Byte;    // 16
-    FieldPrecision  : Byte;    // 17, also known as decimal count
-    FoxProFlags	    : Byte;	   // 18
-    Reserved1       : Byte;    // 19
-    WorkAreaID      : Byte;    // 20
+    FieldOffset       : Integer; // 12..15
+    FieldSize         : Byte;    // 16
+    FieldPrecision    : Byte;    // 17, also known as decimal count
+    VisualFoxProFlags : Byte;    // 18 Field Flags; flags can be combined
+    // $01: system solumn (not user-visible)
+    // $02: column can store null values
+    // $04: binary column, e.g. don't interpret codepage (char/memo fields)
+    // $0C: column is autoincrementing (only integer fields)
+    AutoIncrementNext : Byte;    // 19 VFP only: autoincrement value
+    // (!!not the next value for a new record!!); the next is calculated by
+    // adding AutoIncrementStep first.
+    // Value covers bytes 19..22 (so no WorkAreaID,Reserved1 for VFP)
+    WorkAreaID        : Byte;    // 20
     // WorkAreaID only for DBase III, is always $01
-    Reserved2       : array[21..30] of Byte;
-    MDXIndexField   : Byte;    //31
+    Reserved1         : array[21..22] of Byte;
+    AutoIncrementStep : Byte;    // 23 VFP only: step value for autoincrement
+    Reserved2         : array[24..30] of Byte;
+    MDXIndexField     : Byte;    //31
     // DBase IV:
     // $00: no key for this field;
     // $01: key exists for this field in MDX index file
+    // todo: implement this??
   end;
 //====================================================================
 // OH 2000-11-15 dBase7 support. Header Update (add fields like Next AutoInc Value)

packages/fcl-db/src/dbase/dbf_wtil.pas

@@ -142,7 +142,7 @@ const
   SUBLANG_SPANISH_GUATEMALA            = $04;    { Spanish (Guatemala) }
   SUBLANG_SPANISH_COSTA_RICA           = $05;    { Spanish (Costa Rica) }
   SUBLANG_SPANISH_PANAMA               = $06;    { Spanish (Panama) }
-  SUBLANG_SPANISH_DOMINICAN_REPUBLIC   = $07;  { Spanish (Dominican Republic) }
+  SUBLANG_SPANISH_DOMINICAN_REPUBLIC   = $07;    { Spanish (Dominican Republic) }
   SUBLANG_SPANISH_VENEZUELA            = $08;    { Spanish (Venezuela) }
   SUBLANG_SPANISH_COLOMBIA             = $09;    { Spanish (Colombia) }
   SUBLANG_SPANISH_PERU                 = $0a;    { Spanish (Peru) }

packages/fcl-db/src/dbase/readme.txt

@@ -19,6 +19,14 @@ Development notes/additions to end user documentation
 property RecNo: approximate record number. Does not take deleted records into account. Used mainly in grids.
 
 File format references:
+Flagship/FoxPro/Clipper/DBase III..V .dbf file format description
+ftp://fship.com/pub/multisoft/flagship/docu/dbfspecs.txt
+
+FoxPro 2.x:
+http://support.microsoft.com/kb/98743/en-us
+Data type:
+P Picture (foxpro/vfoxpro specific)
+
 Visual FoxPro:
 http://msdn.microsoft.com/en-us/library/d863bcf2%28v=vs.80%29.aspx
 
@@ -27,14 +35,21 @@ http://msdn.microsoft.com/en-US/library/st4a0s68%28v=vs.80%29.aspx
 note however that the file type/magic number at offset 0 is incorrect.
 A community member amended these with correct numbers. See bottom of page
 
+Visual FoxPro 6 internal structures, _NULLFIELDS etc:
+http://www.dfpug.de/buecher/fundamentals/Hack6/S1C2.HTM
+
+Visual Foxpro 8 info about autoincrement:
+http://msdn.microsoft.com/en-us/library/aa976850%28v=VS.71%29.aspx
+
 Visual FoxPro 9 data types
 http://msdn.microsoft.com/en-US/library/ww305zh2%28v=vs.80%29.aspx
 
 Visual FoxPro 9 specific changes:
 http://foxcentral.net/microsoft/WhatsNewInVFP9_Chapter09.htm
-
-FoxPro 2.x:
-http://support.microsoft.com/kb/98743/en-us
-
-Flagship/FoxPro/Clipper/DBase III..V .dbf file format description
-ftp://fship.com/pub/multisoft/flagship/docu/dbfspecs.txt
+New data types:
+V Varchar/varchar binary (in Visual FoxPro 9) 1 byte up to 254 bytes.
+	Same storage as char (padded spaces) but padding is removed on display
+W Blob (Visual FoxPro 9), 4 bytes in a table; stored in .fpt
+Q Varchar (binary) (in Visual Foxpro 9):
+	accepts null, up to 254 characters (stored as padded with spaces), no code page translations
+	note varchar (binary)<>varbinary