--- Merging r24175 into '.':

U    packages/fcl-db/src/base/db.pas
U    packages/fcl-db/src/base/fields.inc
--- Merging r24183 into '.':
U    packages/fcl-db/src/dbase/history.txt
U    packages/fcl-db/tests/dbftoolsunit.pas
--- Merging r24187 into '.':
U    packages/fcl-db/tests/testdbbasics.pas
U    packages/fcl-db/src/dbase/dbf.pas
U    packages/fcl-db/src/dbase/dbf_dbffile.pas
U    packages/fcl-db/src/dbase/dbf_pgfile.pas
--- Merging r24204 into '.':
G    packages/fcl-db/src/dbase/dbf_dbffile.pas
U    packages/fcl-db/src/dbase/dbf_fields.pas
U    packages/fcl-db/src/dbase/readme.txt
U    packages/fcl-db/src/dbase/dbf_lang.pas
G    packages/fcl-db/src/dbase/dbf_pgfile.pas
G    packages/fcl-db/src/dbase/dbf.pas
--- Merging r24206 into '.':
U    packages/fcl-db/tests/testspecifictdbf.pas
G    packages/fcl-db/src/dbase/dbf_dbffile.pas
U    packages/fcl-db/src/dbase/dbf_memo.pas
--- Merging r24210 into '.':
G    packages/fcl-db/src/dbase/dbf.pas
--- Merging r24216 into '.':
G    packages/fcl-db/src/dbase/dbf_fields.pas
G    packages/fcl-db/src/dbase/readme.txt
--- Merging r24219 into '.':
U    packages/fcl-db/tests/dbtestframework_gui.lpi
U    packages/fcl-db/tests/dbtestframework_gui.lpr
--- Merging r24220 into '.':
U    packages/fcl-db/tests/database.ini.txt
--- Merging r24234 into '.':
U    packages/fcl-db/src/sqldb/interbase/ibconnection.pp
--- Merging r24245 into '.':
G    packages/fcl-db/src/dbase/readme.txt
G    packages/fcl-db/src/dbase/dbf.pas
G    packages/fcl-db/src/dbase/dbf_dbffile.pas
U    packages/fcl-db/src/dbase/dbf_struct.inc
U    packages/fcl-db/src/dbase/dbf_common.inc
U    packages/fcl-db/src/dbase/dbf_wtil.pas
G    packages/fcl-db/src/dbase/dbf_fields.pas
--- Merging r24253 into '.':
G    packages/fcl-db/src/dbase/dbf_dbffile.pas
--- Merging r24254 into '.':
G    packages/fcl-db/src/dbase/dbf_dbffile.pas
G    packages/fcl-db/src/dbase/dbf_lang.pas
--- Merging r24256 into '.':
G    packages/fcl-db/src/dbase/dbf_memo.pas
--- Merging r24264 into '.':
U    packages/fcl-db/src/dbase/dbf_common.pas
--- Merging r24265 into '.':
U    packages/fcl-db/src/sqldb/postgres/pqconnection.pp
--- Merging r24266 into '.':
G    packages/fcl-db/src/sqldb/postgres/pqconnection.pp
--- Merging r24267 into '.':
G    packages/fcl-db/src/dbase/dbf_fields.pas
G    packages/fcl-db/src/dbase/dbf.pas
G    packages/fcl-db/src/dbase/dbf_lang.pas
--- Merging r24268 into '.':
G    packages/fcl-db/src/dbase/dbf.pas
--- Merging r24279 into '.':
G    packages/fcl-db/src/dbase/dbf_lang.pas
G    packages/fcl-db/src/dbase/dbf_struct.inc

# revisions: 24175,24183,24187,24204,24206,24210,24216,24219,24220,24234,24245,24253,24254,24256,24264,24265,24266,24267,24268,24279
r24175 | ludob | 2013-04-07 13:16:53 +0200 (Sun, 07 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/base/db.pas
   M /trunk/packages/fcl-db/src/base/fields.inc

fcl-db: added TBCDField.AsBCD support
r24183 | reiniero | 2013-04-07 18:21:34 +0200 (Sun, 07 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/history.txt
   M /trunk/packages/fcl-db/tests/dbftoolsunit.pas

fcl-db/dbase: use new .AsBCD; updaeted history
r24187 | reiniero | 2013-04-07 20:33:39 +0200 (Sun, 07 Apr 2013) | 5 lines
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf.pas
   M /trunk/packages/fcl-db/src/dbase/dbf_dbffile.pas
   M /trunk/packages/fcl-db/src/dbase/dbf_pgfile.pas
   M /trunk/packages/fcl-db/tests/testdbbasics.pas

fcl-db/dbase:
* fix TestRecNo test
* dbtestframework: ignore currency test as tdbf uses bcd fields
* fix writing $1A EOF marker at end of dbf file
* fix: FoxPro does not allow null fields
r24204 | reiniero | 2013-04-08 12:20:18 +0200 (Mon, 08 Apr 2013) | 4 lines
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf.pas
   M /trunk/packages/fcl-db/src/dbase/dbf_dbffile.pas
   M /trunk/packages/fcl-db/src/dbase/dbf_fields.pas
   M /trunk/packages/fcl-db/src/dbase/dbf_lang.pas
   M /trunk/packages/fcl-db/src/dbase/dbf_pgfile.pas
   M /trunk/packages/fcl-db/src/dbase/readme.txt

fcl-base/dbase: 
* fix foxpro (tablelevel 25) files so they are readable by visual foxpro
+ added file specification links for FoxPro 2.x
+ added file specification links for Visual FoxPro 9 specific changes
r24206 | reiniero | 2013-04-08 16:24:54 +0200 (Mon, 08 Apr 2013) | 6 lines
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf_dbffile.pas
   M /trunk/packages/fcl-db/src/dbase/dbf_memo.pas
   M /trunk/packages/fcl-db/tests/testspecifictdbf.pas

fcl-base/dbase: 
* when tdbf "auto upgrades" foxpro to visual foxpro, write the missing backlink info
* updated tablelevel test that deals with FoxPro=>VFP "auto upgrade"
* default block length for (visual) foxpro files is 64, not 512
* match (Visual)FoxPro empty characters in memo field
r24210 | reiniero | 2013-04-09 08:55:08 +0200 (Tue, 09 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf.pas

* fcl-db/dbase: let dbf.pas apply default blocklength=64 (instead of 512) for *foxpro
r24216 | reiniero | 2013-04-09 15:10:15 +0200 (Tue, 09 Apr 2013) | 3 lines
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf_fields.pas
   M /trunk/packages/fcl-db/src/dbase/readme.txt

fcl-db/dbase:
* Foxpro: memo pointer 10 chars=>4 bytes, should make files compatible with (V)FoxPro
* Started support for FoxPro P(picture), Visual FoxPro 9 W(blob),V(varchar),Q(varbinary) field types.
r24219 | reiniero | 2013-04-10 11:47:50 +0200 (Wed, 10 Apr 2013) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/tests/dbtestframework_gui.lpi
   M /trunk/packages/fcl-db/tests/dbtestframework_gui.lpr

* fcl-base: simplify running gui testframework
  without compiling db ppus locally which messes up builds
r24220 | reiniero | 2013-04-10 12:55:20 +0200 (Wed, 10 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/tests/database.ini.txt

fcl-db/tests: cosmetic: add dbase3 & IV to database template
r24234 | reiniero | 2013-04-12 15:52:14 +0200 (Fri, 12 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/interbase/ibconnection.pp

ibconnection:fixed rounding problem in timestamp (complements r24225)
r24245 | reiniero | 2013-04-14 18:56:30 +0200 (Sun, 14 Apr 2013) | 13 lines
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf.pas
   M /trunk/packages/fcl-db/src/dbase/dbf_common.inc
   M /trunk/packages/fcl-db/src/dbase/dbf_dbffile.pas
   M /trunk/packages/fcl-db/src/dbase/dbf_fields.pas
   M /trunk/packages/fcl-db/src/dbase/dbf_struct.inc
   M /trunk/packages/fcl-db/src/dbase/dbf_wtil.pas
   M /trunk/packages/fcl-db/src/dbase/readme.txt

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!
r24253 | reiniero | 2013-04-15 10:58:44 +0200 (Mon, 15 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf_dbffile.pas

fcl-db/dbase: attempt to fix dbase code page marks in (v)foxpro files. Needs more work.
r24254 | reiniero | 2013-04-15 13:18:46 +0200 (Mon, 15 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf_dbffile.pas
   M /trunk/packages/fcl-db/src/dbase/dbf_lang.pas

fcl-db/dbase: further improvement on r24253 though no solution yet.
r24256 | reiniero | 2013-04-16 09:42:04 +0200 (Tue, 16 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf_memo.pas

fcl-db/dbase: DbaseIII memo fix: blocksize=fixed 512; no memo field size header
r24264 | reiniero | 2013-04-18 08:20:28 +0200 (Thu, 18 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf_common.pas

* fcl-db/dbase: fix for dbf_common Memscan fixes DBase3 memo issues. Thanks to J.G. Johansen
r24265 | michael | 2013-04-18 10:56:57 +0200 (Thu, 18 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp

* Enable NULL values in prepared statements
r24266 | michael | 2013-04-18 12:35:56 +0200 (Thu, 18 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp

* Preserve data type for null params if it is set
r24267 | reiniero | 2013-04-19 10:04:12 +0200 (Fri, 19 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf.pas
   M /trunk/packages/fcl-db/src/dbase/dbf_fields.pas
   M /trunk/packages/fcl-db/src/dbase/dbf_lang.pas

fcl
r24268 | reiniero | 2013-04-19 10:14:27 +0200 (Fri, 19 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf.pas

fcl-db/dbase: Hide Visual Foxpro _NULLFLAGS from user.
r24279 | reiniero | 2013-04-21 08:24:13 +0200 (Sun, 21 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf_lang.pas
   M /trunk/packages/fcl-db/src/dbase/dbf_struct.inc

fcl-db/dbase: cosmetic: reorganize struct comments so they show up browsing code

git-svn-id: branches/fixes_2_6@24938 -

packages/fcl-db/src/base/db.pas

@@ -779,6 +779,7 @@ type
     FCurrency   : boolean;
   protected
     class procedure CheckTypeSize(AValue: Longint); override;
+    function GetAsBCD: TBCD; override;
     function GetAsCurrency: Currency; override;
     function GetAsFloat: Double; override;
     function GetAsLongint: Longint; override;
@@ -788,6 +789,7 @@ type
     function GetDataSize: Integer; override;
     function GetDefaultWidth: Longint; override;
     procedure GetText(var TheText: string; ADisplayText: Boolean); override;
+    procedure SetAsBCD(const AValue: TBCD); override;
     procedure SetAsFloat(AValue: Double); override;
     procedure SetAsLongint(AValue: Longint); override;
     procedure SetAsString(const AValue: string); override;

packages/fcl-db/src/base/fields.inc

@@ -2379,6 +2379,17 @@ begin
     DatabaseErrorfmt(SInvalidFieldSize,[Avalue]);
 end;
 
+function TBCDField.GetAsBCD: TBCD;
+Var
+  c:system.Currency;
+
+begin
+  If GetData(@c) then
+    Result:=CurrToBCD(c)
+  else
+    Result:=NullBCD;
+end;
+
 function TBCDField.GetAsCurrency: Currency;
 
 begin
@@ -2464,6 +2475,14 @@ begin
     TheText := '';
 end;
 
+procedure TBCDField.SetAsBCD(const AValue: TBCD);
+var
+  c:system.currency;
+begin
+  if BCDToCurr(AValue,c) then  //always returns true !!
+    SetAsCurrency(c);
+end;
+
 procedure TBCDField.SetAsCurrency(AValue: Currency);
 
 begin

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

@@ -17,9 +17,11 @@ uses
   dbf_fields,
   dbf_pgfile,
   dbf_idxfile;
+{$ifndef fpc}
 // If you got a compilation error here or asking for dsgnintf.pas, then just add
 // this file in your project:
 // dsgnintf.pas in 'C: \Program Files\Borland\Delphi5\Source\Toolsapi\dsgnintf.pas'
+{$endif}
 
 type
 
@@ -372,7 +374,7 @@ type
 
     function  IsDeleted: Boolean;
     procedure Undelete;
-
+    // Call this after setting up fielddefs in order to store the definitions into a table
     procedure CreateTable;
     procedure CreateTableEx(ADbfFieldDefs: TDbfFieldDefs);
     procedure CopyFrom(DataSet: TDataSet; FileName: string; DateTimeAsString: Boolean; Level: Integer);
@@ -565,7 +567,7 @@ var
 begin
   if FDirty then
   begin
-    Size := Position; // Strange but it leave tailing trash bytes if I do not write that.
+    Size := Position; // Strange but it leaves tailing trash bytes if I do not write that.
     Dbf := TDbf(FBlobField.DataSet);
     Translate(true);
     Dbf.FDbfFile.MemoFile.WriteMemo(FMemoRecNo, FReadSize, Self);
@@ -1046,18 +1048,17 @@ end;
 
 procedure TDbf.GetFieldDefsFromDbfFieldDefs;
 var
-  I, N: Integer;
+  I: Integer;
   TempFieldDef: TDbfFieldDef;
   TempMdxFile: TIndexFile;
-  BaseName, lIndexName: string;
-begin
-  FieldDefs.Clear;
+  lIndexName: string;
+  lFieldDefCount: integer; //Counter for destination fielddefs
 
-  // get all fields
-  for I := 0 to FDbfFile.FieldDefs.Count - 1 do
+  procedure FixDuplicateNames;
+  var
+    BaseName: string;
+    N: Integer;
   begin
-    TempFieldDef := FDbfFile.FieldDefs.Items[I];
-    // handle duplicate field names
     N := 1;
     BaseName := TempFieldDef.FieldName;
     while FieldDefs.IndexOf(TempFieldDef.FieldName)>=0 do
@@ -1065,31 +1066,55 @@ begin
       Inc(N);
       TempFieldDef.FieldName:=BaseName+IntToStr(N);
     end;
+  end;
+
+begin
+  FieldDefs.Clear;
+
+  // get all fields
+  lFieldDefCount:=-1; //will be fixed by first addition
+  for I := 0 to FDbfFile.FieldDefs.Count - 1 do
+  begin
+    TempFieldDef := FDbfFile.FieldDefs.Items[I];
+    // handle duplicate field names:
+    FixDuplicateNames;
     // add field, passing dbase native size if relevant
     // 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
-          // todo: we should calculate number of digits after decimal place in some way, but how?
           FieldDefs.Add(TempFieldDef.FieldName, TempFieldDef.FieldType, 0, false);;;
         end;
     else
       FieldDefs.Add(TempFieldDef.FieldName, TempFieldDef.FieldType, 0, false);
     end;
+    lFieldDefCount:=lFieldDefCount+1;
 
-    FieldDefs[I].Precision := TempFieldDef.Precision;
-
+    FieldDefs[lFieldDefCount].Precision := TempFieldDef.Precision;
 
 {$ifdef SUPPORT_FIELDDEF_ATTRIBUTES}
     // AutoInc fields are readonly
     if TempFieldDef.FieldType = ftAutoInc then
-      FieldDefs[I].Attributes := [Db.faReadOnly];
+      FieldDefs[lFieldDefCount].Attributes := [Db.faReadOnly];
 
     // if table has dbase lock field, then hide it
     if TempFieldDef.IsLockField then
-      FieldDefs[I].Attributes := [Db.faHiddenCol];
+      FieldDefs[lFieldDefCount].Attributes := [Db.faHiddenCol];
+
+    // Hide system/hidden fields (e.g. VFP's _NULLFLAGS)
+    if TempFieldDef.IsSystemField then
+      FieldDefs[lFieldDefCount].Attributes := [Db.faHiddenCol];
+{$else}
+    // Poor man's way of hiding fields that shouldn't be shown/modified:
+    // Note: Visual Foxpro seems to allow adding another _NULLFLAGS field.
+    // todo: test this with lockfield, then add this (TempFieldDef.IsLockField)
+    if (TempFieldDef.IsSystemField) then
+    begin
+      FieldDefs.Delete(lFieldDefCount);
+      lFieldDefCount:=lFieldDefCount-1;
+    end;
 {$endif}
   end;
 
@@ -1360,7 +1385,7 @@ begin
   // store recno we are editing
   FEditingRecNo := FCursor.PhysicalRecNo;
   // reread blobs, execute cancel -> clears remembered memo pageno,
-  // causing it to reread the memo contents
+  // causing it to reread the x contents
   for I := 0 to Pred(FieldDefs.Count) do
     if Assigned(FBlobStreams^[I]) then
       FBlobStreams^[I].Cancel;
@@ -1517,7 +1542,11 @@ begin
       FDbfFile.DbfVersion := TableLevelToDbfVersion(FTableLevel);
       FDbfFile.FileLangID := FLanguageID;
       FDbfFile.Open;
-      FDbfFile.FinishCreate(ADbfFieldDefs, 512);
+      // Default memo blocklength for FoxPro/VisualFoxpro is 64 (not 512 as specs say)
+      if FDbfFile.DbfVersion in [xFoxPro,xVisualFoxPro] then
+        FDbfFile.FinishCreate(ADbfFieldDefs, 64)
+      else
+        FDbfFile.FinishCreate(ADbfFieldDefs, 512);
 
       // if creating memory table, copy stream pointer
       if FStorage = stoMemory then

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_common.pas

@@ -408,7 +408,9 @@ function MemScan(const Buffer: Pointer; Chr: Byte; Length: Integer): Pointer;
 var
   I: Integer;
 begin
-  I := System.IndexByte(Buffer, Length, Chr);
+  // Make sure we pass a buffer of bytes instead of a pchar otherwise
+  // the call will always fail
+  I := System.IndexByte(PByte(Buffer)^, Length, Chr);
   if I = -1 then
     Result := nil
   else

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,18 +105,27 @@ type
     procedure CloseIndex(AIndexName: string);
     procedure RepageIndex(AIndexFile: string);
     procedure CompactIndex(AIndexFile: string);
+    // Inserts new record
     function  Insert(Buffer: TRecordBuffer): integer;
+    // 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;
@@ -127,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;
@@ -157,6 +175,9 @@ type
   end;
 
 //====================================================================
+
+  { TDbfGlobals }
+
   TDbfGlobals = class
   protected
     FCodePages: TList;
@@ -204,6 +225,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}
 
@@ -351,19 +373,19 @@ var
     // (including the correction at the bottom):
     // http://msdn.microsoft.com/en-US/library/st4a0s68%28v=vs.80%29.aspx
     case version of
-      $30, $31, $32: FDbfVersion:=xVisualFoxPro;
+      $30, $31, $32 {VFP9 with new data types}: FDbfVersion:=xVisualFoxPro;
       $F5, $FB: FDbfVersion:=xFoxPro;
     end;
     if FDbfVersion = xUnknown then
       case (version and $07) of
-        $03:
+        $03: //dbf without memo. Could be foxpro, too
           if LanguageID = 0 then
             FDbfVersion := xBaseIII
           else
             FDbfVersion := xBaseIV;
         $04:
           FDbfVersion := xBaseVII;
-        $02, $05:
+        $02 {FoxBase, not readable by current Visual FoxPro driver}, $05:
           FDbfVersion := xFoxPro;
       else
         begin
@@ -596,18 +618,31 @@ 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;
+    if FDbfVersion in [xFoxPro, xVisualFoxPro] then
+    begin
+      // Don't use DbfGlobals default language ID as it is dbase-based
+      FFileLangId := ConstructLangId(LangId_To_CodePage[FFileLangId],GetUserDefaultLCID, true);
+    end
+    else
+    begin
+      // DBase
+      if FFileLangId = 0 then
+        FFileLangId := DbfGlobals.DefaultCreateLangId;
+    end;
     FFileCodePage := LangId_To_CodePage[FFileLangId];
     lLocaleID := LangId_To_Locale[FFileLangId];
     FUseCodePage := FFileCodePage;
+
+
     // prepare header size
     if FDbfVersion = xBaseVII then
     begin
@@ -630,15 +665,19 @@ begin
       // Note: VerDBF may be changed later on depending on what features/fields are used
       // (autoincrement etc)
       case FDbfVersion of
-        xFoxPro: PDbfHdr(Header)^.VerDBF := $02; {FoxBASE}
+        xFoxPro: PDbfHdr(Header)^.VerDBF := $03; {FoxBASE+/FoxPro/dBASE III PLUS/dBASE IV, no memo
+        alternative $02 FoxBASE is not readable by current Visual FoxPro drivers.
+        }
         xVisualFoxPro: PDbfHdr(Header)^.VerDBF := $30; {Visual FoxPro no autoincrement,no varchar}
-        else PDbfHdr(Header)^.VerDBF := $03; {FoxBASE+/dBASE III PLUS, no memo!?}
+        else PDbfHdr(Header)^.VerDBF := $03; {FoxBASE+/FoxPro/dBASE III PLUS/dBASE IV, no memo}
       end;
-      // standard language WE/Western Europe, dBase III no language support
-      if FDbfVersion = xBaseIII then
-        PDbfHdr(Header)^.Language := 0
+
+      // standard language WE/Western Europe
+      if FDbfVersion=xBaseIII then
+        PDbfHdr(Header)^.Language := 0 //no language support
       else
         PDbfHdr(Header)^.Language := FFileLangId;
+
       // init field ptr
       lFieldDescPtr := @lFieldDescIII;
     end;
@@ -663,6 +702,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;
@@ -697,11 +746,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:
-        if (PDbfHdr(Header)^.VerDBF = $02) and (lFieldDef.NativeFieldType in ['0', 'Y', 'T', 'O', '+']) then
-          PDbfHdr(Header)^.VerDBF := $30; {Visual FoxPro}
-        if (PDbfHdr(Header)^.VerDBF = $30) and (lFieldDef.NativeFieldType = '+') then
-          PDbfHdr(Header)^.VerDBF := $31; {Visual FoxPro, autoincrement enabled}
+
+        // 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 := $31; {Visual FoxPro, autoincrement enabled}
+            FDBFVersion:=xVisualFoxPro;
+          end;
+
+          // 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
@@ -716,6 +792,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
@@ -726,7 +818,7 @@ begin
     begin
       case FDbfVersion of
         xBaseIII: PDbfHdr(Header)^.VerDBF := PDbfHdr(Header)^.VerDBF or $80;
-        xFoxPro: if PDbfHdr(Header)^.VerDBF = $02 then {change from FoxBASE to...}
+        xFoxPro: if (PDbfHdr(Header)^.VerDBF in [$02,$03]) then {change from FoxBASE to...}
           PDbfHdr(Header)^.VerDBF := $F5; {...FoxPro 2.x (or earlier) with memo}
         xVisualFoxPro: //MSDN says field 28 or $02 to set memo flag
           PDbfHdr(Header)^.MDXFlag := PDbfHdr(Header)^.MDXFlag or $02;
@@ -736,7 +828,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, 
@@ -821,7 +916,8 @@ begin
 
   // Write terminator at the end of the file, after the records:
   EofTerminator := $1A;
-  WriteBlock(@EofTerminator, 1, CalcPageOffset(RecordCount+1));
+  // We're using lDataHdr to make sure we have the latest/correct version
+  WriteBlock(@EofTerminator, 1, CalcPageOffset(lDataHdr.RecordCount+1));
 end;
 
 procedure TDbfFile.ConstructFieldDefs;
@@ -838,7 +934,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;
@@ -861,8 +960,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
@@ -884,10 +985,25 @@ begin
         lSize := lFieldDescIII.FieldSize;
         lPrec := lFieldDescIII.FieldPrecision;
         lNativeFieldType := lFieldDescIII.FieldType;
-        // todo: verify but AFAIU only Visual FoxPro supports null fields. Leave in FoxPro for now
-        lCanHoldNull := (FDbfVersion in [xFoxPro,xVisualFoxPro]) and
-          ((lFieldDescIII.FoxProFlags and $2) <> 0) and
-          (lFieldName <> '_NULLFLAGS');
+        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.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
@@ -913,6 +1029,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;
@@ -936,7 +1061,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
@@ -1004,8 +1129,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;
@@ -1018,12 +1143,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
@@ -1438,6 +1597,7 @@ var
   date: TDateTime;
   timeStamp: TTimeStamp;
   asciiContents: boolean;
+  SrcRecord: Pointer;
 
 {$ifdef SUPPORT_INT64}
   function GetInt64FromStrLength(Src: Pointer; Size: Integer; Default: Int64): Int64;
@@ -1506,14 +1666,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;
@@ -1591,7 +1750,7 @@ begin
         end;
 {$endif}
       end;
-    'B':    // Foxpro double
+    'B':  // Foxpro double
       begin
         if (FDbfVersion in [xFoxPro,xVisualFoxPro]) then
         begin
@@ -1611,6 +1770,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;
@@ -1636,7 +1833,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
@@ -1700,20 +1897,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;
@@ -1722,8 +1937,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;
@@ -1760,17 +1976,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 xvisualfoxpro autoincrement capability, null values, DateTime, Currency, and Double data types
   case TempFieldDef.NativeFieldType of
     '+', 'I' {autoincrement, integer}:
       begin
@@ -1877,6 +2094,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;
@@ -1951,7 +2216,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);
 
@@ -1959,9 +2224,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
@@ -1969,7 +2234,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;
@@ -1999,7 +2275,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) + 
@@ -2017,6 +2294,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;
 
@@ -2802,7 +3091,8 @@ finalization
 
 
 (*
-  Stuffs non implemented yet
+  Not implemented yet (encrypted cdx is undocumented;
+  unencrypted cdx could be implemented)
   TFoxCDXHeader         = Record
     PointerRootNode     : Integer;
     PointerFreeList     : Integer;

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;
@@ -48,7 +53,7 @@ type
   protected
     function  GetDisplayName: string; override;
     procedure AssignTo(Dest: TPersistent); override;
-
+    // File is compatible with this database product
     property DbfVersion: TXBaseVersion read GetDbfVersion;
   public
     constructor Create(ACollection: TCollection); override;
@@ -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;
-    // Native dbf field type
+    // 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 (C character etc)
     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
@@ -335,18 +366,25 @@ end;
 procedure TDbfFieldDef.NativeToVCL;
 begin
   case FNativeFieldType of
-    '+' :
+    '+' : //dbase7+ autoinc
       if DbfVersion = xBaseVII then
         FFieldType := ftAutoInc;
-    'I' : FFieldType := ftInteger;
-    'O' : FFieldType := ftFloat;
-    '@', 'T':
-          FFieldType := ftDateTime;
-    'C',
-    #$91  {Russian 'C'}
-        : FFieldType := ftString;
-    'L' : FFieldType := ftBoolean;
-    'F', 'N':
+    '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}:
+      FFieldType := ftDateTime;
+    'C', //character
+    #$91  {Russian 'C'}:
+      FFieldType := ftString;
+    'L' : //logical
+      FFieldType := ftBoolean;
+    'F', 'N': //float/numeric
       begin
         if (FPrecision = 0) then
         begin
@@ -365,28 +403,37 @@ begin
           FFieldType := ftFloat;
         end;
       end;
-    'D' : FFieldType := ftDate;
-    'M' : FFieldType := ftMemo;
-    'B' : 
+    'D' : //date
+      FFieldType := ftDate;
+    'M' : //memo
+      FFieldType := ftMemo;
+    'B' : //binary or float
       if (DbfVersion = xFoxPro) or (DbfVersion=xVisualFoxPro) then
         FFieldType := ftFloat
       else
         FFieldType := ftBlob;
-    'G' : FFieldType := ftDBaseOle;
-    'Y' :
+    'G' : //general
+      FFieldType := ftDBaseOle;
+    'Y' : //currency
       if DbfGlobals.CurrencyAsBCD then
         FFieldType := ftBCD
       else
         FFieldType := ftCurrency;
-    '0' : FFieldType := ftBytes; { Visual FoxPro ``_NullFlags'' }
-    {
-    To do: add support for Visual Foxpro types
-    http://msdn.microsoft.com/en-US/library/ww305zh2%28v=vs.80%29.aspx
-    P Picture (perhaps also in FoxPro)
-    V Varchar/varchar binary (perhaps also in FoxPro) 1 byte up to 255 bytes (or perhaps 254)
-    W Blob (perhaps also in FoxPro), 4 bytes in a table; stored in .fpt
-    Q Varbinary (perhaps also in Foxpro)
-    }
+    '0' : //zero, not the letter O
+      FFieldType := ftBytes;
+    'P' : //picture
+      if (DBFversion in [xFoxPro,xVisualFoxPro]) then
+        FFieldType := ftBlob; {Picture, but probably not compatible with ftGraphic storage}
+    'V' : //VFP 9 Varchar; character with length indication
+      if (DbfVersion = xVisualFoxPro) then
+        FFieldType := ftString;
+      //todo: verify if 'V' for other systems exists. DBF "Varifields"?
+    'W' : //BLOB
+      if (DBFVersion = xVisualFoxPro) then
+        FFieldType := ftBlob;
+    'Q' : //varbinary
+      if (DBFVersion = xVisualFoxPro) then
+        FFieldType := ftVarBytes;
   else
     FNativeFieldType := #0;
     FFieldType := ftUnknown;
@@ -397,7 +444,12 @@ procedure TDbfFieldDef.VCLToNative;
 begin
   FNativeFieldType := #0;
   case FFieldType of
-    ftAutoInc  : FNativeFieldType  := '+';
+    ftAutoInc  :
+      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 := '@'
@@ -410,23 +462,51 @@ begin
     ftFixedChar,
     ftWideString,
 {$endif}
-    ftString   : FNativeFieldType  := 'C';
-    ftBoolean  : FNativeFieldType  := 'L';
+    ftString   :
+      FNativeFieldType := 'C'; // VFP9: could have used V but this works, too.
+    ftBoolean  :
+      FNativeFieldType := 'L'; //logical
     ftFloat, ftSmallInt, ftWord
 {$ifdef SUPPORT_INT64}
       , ftLargeInt
 {$endif}
                : FNativeFieldType := 'N';
-    ftDate     : FNativeFieldType := 'D';
-    ftMemo     : FNativeFieldType := 'M';
-    ftBlob     : FNativeFieldType := 'B';
-    ftDBaseOle : FNativeFieldType := 'G';
+    ftDate     :
+      FNativeFieldType := 'D'; //date
+    ftMemo     :
+      FNativeFieldType := 'M'; //memo
+    ftBlob     :
+      case DBFVersion of
+        xFoxPro:
+          FNativeFieldType := 'P'; //picture; best we can do
+        xVisualFoxPro:
+          FNativeFieldType := 'W'; //blob
+        xBaseIII,xBaseIV:
+          FNativeFieldType := 'M'; //memo; best we can do
+        xBaseV,xBaseVII:
+          FNativeFieldType := 'B'; //binary
+      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
+    ftGraphic  :
+      // Let's store this as a BLOB even though FoxPro has P(icture).
+      // P is apparently not recommended
+      FNativeFieldType := 'B'; //BLOB
     ftInteger  :
-      if DbfVersion = xBaseVII then
-        FNativeFieldType := 'I'
+      if (DbfVersion in [xBaseVII,xVisualFoxPro]) then
+        FNativeFieldType := 'I' //integer
       else
-        FNativeFieldType := 'N';
-    ftBCD, ftCurrency: 
+        FNativeFieldType := 'N'; //numeric
+    ftBCD, ftCurrency:
       if (DbfVersion = xFoxPro) or (DBFVersion = xVisualFoxPro) then
         FNativeFieldType := 'Y';
   end;
@@ -436,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
@@ -456,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;
@@ -481,9 +561,10 @@ begin
 end;
 
 procedure TDbfFieldDef.CheckSizePrecision;
+// FSize means size in the database, not any VCL field size
 begin
   case FNativeFieldType of
-    'C': // Character
+    'C','V','Q': // Character, Visual FoxPro varchar,Visual FoxPro varbinary
       begin
         if FSize < 0 then
           FSize := 0;
@@ -530,14 +611,14 @@ begin
           FPrecision := 0;
         end;
       end;
-    'M','G': // Memo, general
+    'M','G','P','W': // Memo, general, FoxPro picture, Visual FoxPro blob
       begin
-        if (DbfVersion = xFoxPro) or (DbfVersion = xVisualFoxPro) then
+        if (DbfVersion = xVisualFoxPro) then
         begin
           if (FSize <> 4) and (FSize <> 10) then
             FSize := 4;
         end else
-          FSize := 10;
+          FSize := 10; //Dbase, includes FoxPro
         FPrecision := 0;
       end;
     '+','I': // Autoincrement, integer
@@ -564,15 +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 at least Visual FoxPro) 1 byte up to 255 bytes (or perhaps 254)
-    W Blob (in at least Visual FoxPro), 4 bytes in a table; stored in .fpt
-    Q Varbinary (in at least Visual Foxpro)
-    }
-  end; // case
+    // no idea/unimportant, let other code sort it out
+  end;
 end;
 
 function TDbfFieldDef.GetDisplayName: string; {override;}
@@ -582,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_lang.pas

@@ -85,7 +85,7 @@ const
   FoxLangId_Iceland_861   = $67; // DOS
   FoxLangId_Czech_895     = $68; // DOS Kamenicky
 // ...
-  DbfLangId_POL_620       = $69; // DOS Mazovia
+  DbfLangId_POL_620       = $69; // DOS Polish Mazovia
 // ...
   FoxLangId_Greek_737     = $6A; // DOS (437G)
   FoxLangId_Turkish_857   = $6B; // DOS
@@ -123,7 +123,7 @@ const
   DbfLocale_Bul868     = $020000;
 
 //*************************************************************************//
-// DB3/DB4/FoxPro/Visual Foxpro Language ID to CodePage convert table
+// DB3/DB4/FoxPro Language ID to CodePage conversion table
 // Visual FoxPro docs call language ID "code page mark"
 // or "code page identifier"
 //*************************************************************************//
@@ -165,6 +165,7 @@ const
 {F0}       0,    0,    0,    0,    0,    0,    0,    0,
 {F8}       0,    0,    0,    0,    0,    0,    0,    0);
 
+
 {$ifdef FPC_VERSION}
 {$ifdef VER1_0}
   LANG_ARABIC                          = $01;
@@ -469,6 +470,7 @@ const
 // reverse convert routines
 //*************************************************************************//
 
+// Visual DBaseVII specific; the IsFoxPro means a FoxPro codepage, which DB7 supports
 function ConstructLangName(CodePage: Integer; Locale: LCID; IsFoxPro: Boolean): string;
 
 function ConstructLangId(CodePage: Integer; Locale: LCID; IsFoxPro: Boolean): Byte;
@@ -521,8 +523,7 @@ begin
 end;
 
 const
-  // range of Dbase / FoxPro locale; these are INCLUSIVE
-
+  // range of Dbase locales; these are INCLUSIVE (the rest are FoxPro)
   dBase_RegionCount = 4;
   dBase_Regions: array[0..dBase_RegionCount*2-1] of Byte =
    ($00, $00,
@@ -530,31 +531,34 @@ const
     $69, $69, // a lonely dbf entry :-)
     $80, $90);
 
-function FindLangId(CodePage, Info2: Cardinal; Info2Table: PCardinal; IsFoxPro: Boolean): Byte;
+function FindLangId(CodePage, DesiredLocale: Cardinal; LanguageIDToLocaleTable: PCardinal; IsFoxPro: Boolean): Byte;
+// DesiredLocale: pointer to lookup array: language ID=>locale
 var
-  I, Region, FoxRes, DbfRes: Integer;
+  LangID, Region, FoxRes, DbfRes: Integer;
 begin
   Region := 0;
   DbfRes := 0;
   FoxRes := 0;
-  // scan
-  for I := 0 to $FF do
+  // scan for a language ID matching the given codepage
+  for LangID := 0 to $FF do
   begin
     // check if need to advance to next region
     if Region + 2 < dBase_RegionCount then
-      if I >= dBase_Regions[Region + 2] then
+      if LangID >= dBase_Regions[Region + 2] then
         Inc(Region, 2);
     // it seems delphi does not properly understand pointers?
     // what a mess :-(
-    if ((LangId_To_CodePage[I] = CodePage) or (CodePage = 0)) and (PCardinal(PChar(Info2Table)+(I*4))^ = Info2) then
-      if I <= dBase_Regions[Region+1] then
-        DbfRes := Byte(I)
+    //todo: verify this for visual foxpro; we never seem to get a result
+    if ((LangId_To_CodePage[LangID] = CodePage) or (CodePage = 0)) and
+      (PCardinal(PChar(LanguageIDToLocaleTable)+(LangID*4))^ = DesiredLocale) then
+      if LangID <= dBase_Regions[Region+1] then
+        DbfRes := Byte(LangID)
       else
-        FoxRes := Byte(I);
+        FoxRes := Byte(LangID);
   end;
   // if we can find langid in other set, use it
   if (DbfRes <> 0) and (not IsFoxPro or (FoxRes = 0)) then
-    Result := DbfRes
+    Result := DbfRes //... not using foxpro
   else  {(DbfRes = 0) or (IsFoxPro and (FoxRes <> 0)}
   if (FoxRes <> 0) {and (IsFoxPro or (DbfRes = 0)} then
     Result := FoxRes
@@ -562,48 +566,9 @@ begin
     Result := 0;
 end;
 
-{
-function FindLangId(CodePage, Info2: Cardinal; Info2Table: PCardinal; IsFoxPro: Boolean): Byte;
-var
-  I, Region, lEnd: Integer;
-  EndReached: Boolean;
-begin
-  Region := 0;
-  Result := 0;
-  repeat
-    // determine region to scan
-    if IsFoxPro then
-    begin
-      // foxpro, in between dbase regions
-      I := dBase_Regions[Region+1] + 1;
-      lEnd := dBase_Regions[Region+2] - 1;
-      EndReached := Region = dBase_RegionCount*2-4;
-    end else begin
-      // dBase, select regions
-      I := dBase_Regions[Region];
-      lEnd := dBase_Regions[Region+1];
-      EndReached := Region = dBase_RegionCount*2-2;
-    end;
-    // scan
-    repeat
-      // it seems delphi does not properly understand pointers?
-      // what a mess :-(
-      if (LangId_To_CodePage[I] = CodePage) and (PCardinal(PChar(Info2Table)+(I*4))^ = Info2) then
-        Result := Byte(I);
-      Inc(I);
-      // lEnd is included in range
-    until (Result <> 0) or (I > lEnd);
-    // goto next region
-    if (Result = 0) then
-      Inc(Region, 2);
-    // found or end?
-  until (Result <> 0) or EndReached;
-end;
-}
-
 function ConstructLangId(CodePage: Integer; Locale: LCID; IsFoxPro: Boolean): Byte;
 begin
-  // locale: lower 16bits only
+  // locale: lower 16bits only, with default sorting
   Locale := (Locale and $FFFF) or (SORT_DEFAULT shl 16);
   Result := FindLangId(CodePage, Locale, @LangId_To_Locale[0], IsFoxPro);
   // not found? try any codepage
@@ -636,6 +601,12 @@ begin
   else
     CodePage := StrToInt(CodePageStr);
   // find lang id
+  //todo: debug, remove
+  writeln('');
+  writeln('getlangid_fromLangName');
+  writeln('codepagestr ',codepagestr);
+  writeln('subtype: ',subtype);
+  writeln('codepage: ',codepage);
   Result := FindLangId(CodePage, SubType, @LangId_To_LocaleStr[0], IsFoxPro);
 end;
 

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

@@ -12,10 +12,16 @@ uses
 type
 
 //====================================================================
+
+  { TMemoFile }
+
   TMemoFile = class(TPagedFile)
+  private
+    procedure SetDBFVersion(AValue: TXBaseVersion);
   protected
     FDbfFile: pointer;
     FDbfVersion: TXBaseVersion;
+    FEmptySpaceFiller: Char; //filler for unused header and memo data
     FMemoRecordSize: Integer;
     FOpened: Boolean;
     FBuffer: PChar;
@@ -35,10 +41,12 @@ type
     procedure ReadMemo(BlockNo: Integer; DestStream: TStream);
     procedure WriteMemo(var BlockNo: Integer; ReadSize: Integer; Src: TStream);
 
-    property DbfVersion: TXBaseVersion read FDbfVersion write FDbfVersion;
+    property DbfVersion: TXBaseVersion read FDbfVersion write SetDBFVersion;
     property MemoRecordSize: Integer read FMemoRecordSize write FMemoRecordSize;
   end;
 
+  { TFoxProMemoFile }
+  // (Visual) Foxpro memo file support
   TFoxProMemoFile = class(TMemoFile)
   protected
     function  GetBlockLen: Integer; override;
@@ -48,6 +56,7 @@ type
     procedure SetBlockLen(BlockLen: Integer); override;
   end;
 
+  // DBaseIII+ memo file support:
   TDbaseMemoFile = class(TMemoFile)
   protected
     function  GetBlockLen: Integer; override;
@@ -141,6 +150,17 @@ type
   end;
 
 
+procedure TMemoFile.SetDBFVersion(AValue: TXBaseVersion);
+begin
+  if FDbfVersion=AValue then Exit;
+  FDbfVersion:=AValue;
+  if AValue in [xFoxPro, xVisualFoxPro] then
+    // Visual Foxpro writes 0s itself, so mimic it
+    FEmptySpaceFiller:=#0
+  else
+    FEmptySpaceFiller:=' ';
+end;
+
 //==========================================================
 //============ Dbtfile
 //==========================================================
@@ -150,6 +170,8 @@ begin
   FBuffer := nil;
   FOpened := false;
 
+  FEmptySpaceFiller:=' '; //default
+
   // call inherited
   inherited Create;
 
@@ -200,8 +222,9 @@ begin
     if (RecordSize = 0) and
       ((FDbfVersion in [xFoxPro,xVisualFoxPro]) or ((RecordSize and $7F) <> 0)) then
     begin
-      SetBlockLen(512);
-      RecordSize := 512;
+      SetBlockLen(64); //(Visual) FoxPro docs suggest 512 is default; however it is 64: see
+      //http://technet.microsoft.com/en-us/subscriptions/d6e1ah7y%28v=vs.90%29.aspx
+      RecordSize := 64;
       WriteHeader;
     end;
 
@@ -282,10 +305,10 @@ begin
       end;
     end;
   end else begin
-    // dbase III memo
+    // e.g. dbase III memo
     done := false;
     repeat
-      // scan for EOF marker
+      // scan for EOF marker/field terminator
       endMemo := MemScan(FBuffer, $1A, RecordSize);
       // EOF found?
       if endMemo <> nil then
@@ -294,10 +317,10 @@ begin
         if (endMemo-FBuffer < RecordSize - 1) and
           ((endMemo[1] = #$1A) or (endMemo[1] = #0)) then
         begin
-          done := true;
+          done := true; //found the end
           numBytes := endMemo - FBuffer;
         end else begin
-          // no, fake
+          // no, fake ending
           numBytes := RecordSize;
         end;
       end else begin
@@ -381,8 +404,9 @@ begin
     end;
     tmpRecNo := BlockNo;
     Src.Position := 0;
-    FillChar(FBuffer[0], RecordSize, ' ');
-    if bytesBefore=8 then
+    FillChar(FBuffer[0], RecordSize, FEmptySpaceFiller);
+
+    if bytesBefore=8 then //Field header
     begin
       totsize := Src.Size + bytesBefore + bytesAfter;
       if not(FDbfVersion in [xFoxPro,xVisualFoxPro]) then
@@ -400,15 +424,16 @@ begin
       // end of input data reached? check if we need to write block terminators
       while (readBytes < RecordSize - bytesBefore) and (bytesAfter > 0) do
       begin
-        FBuffer[readBytes] := #$1A;
+        FBuffer[readBytes] := #$1A; //block terminator
         Inc(readBytes);
         Dec(bytesAfter);
       end;
-      // have we read anything that is to be written?
+      // have we read anything that needs to be written?
       if readBytes > 0 then
       begin
         // clear any unused space
-        FillChar(FBuffer[bytesBefore+readBytes], RecordSize-readBytes-bytesBefore, ' ');
+        FillChar(FBuffer[bytesBefore+readBytes], RecordSize-readBytes-bytesBefore, FEmptySpaceFiller);
+
         // write to disk
         WriteRecord(tmpRecNo, @FBuffer[0]);
         Inc(tmpRecNo);
@@ -433,7 +458,7 @@ end;
 function  TDbaseMemoFile.GetBlockLen: Integer;
 begin
   // Can you tell me why the header of dbase3 memo contains 1024 and is 512 ?
-  // answer: it is not a valid field in memo db3 header
+  // answer: BlockLen is not a valid field in memo db3 header
   if FDbfVersion = xBaseIII then
     Result := 512
   else
@@ -443,7 +468,7 @@ end;
 function  TDbaseMemoFile.GetMemoSize: Integer;
 begin
   // dBase4 memofiles contain a small 'header'
-  if PInteger(@FBuffer[0])^ = Integer(SwapIntLE($0008FFFF)) then
+  if (FDbfVersion<>xBaseIII) and (PInteger(@FBuffer[0])^ = Integer(SwapIntLE($0008FFFF))) then
     Result := SwapIntLE(PBlockHdr(FBuffer)^.MemoSize)-8
   else
     Result := -1;
@@ -461,7 +486,9 @@ end;
 
 procedure TDbaseMemoFile.SetBlockLen(BlockLen: Integer);
 begin
-  PDbtHdr(Header)^.BlockLen := SwapWordLE(BlockLen);
+  // DBase III does not support block sizes<>512 bytes
+  if (FDbfVersion<>xBaseIII) then
+    PDbtHdr(Header)^.BlockLen := SwapWordLE(BlockLen);
 end;
 
 // ------------------------------------------------------------------

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

@@ -80,10 +80,12 @@ type
     procedure UpdateBufferSize;
     procedure RecalcPagesPerRecord;
     procedure ReadHeader;
+    // Write header to stream
     procedure FlushHeader;
     procedure FlushBuffer;
     function  ReadChar: Byte;
     procedure WriteChar(c: Byte);
+    // Check if position in cache. If not, enlarge cache.
     procedure CheckCachedSize(const APosition: Integer);
     procedure SynchronizeBuffer(IntRecNum: Integer);
     function  Read(Buffer: Pointer; ASize: Integer): Integer;
@@ -316,6 +318,9 @@ end;
 
 function TPagedFile.CalcPageOffset(const PageNo: Integer): Integer;
 begin
+  //todo: verify: this looks suspicious: check if we should uniformly use
+  // either FPageSize*PageNo as in the case without header offset
+  // or (FPageSize*(PageNo-1))
   if not FPageOffsetByHeader then
     Result := FPageSize * PageNo
   else if PageNo = 0 then
@@ -555,7 +560,7 @@ begin
   begin
     // get size left in file for header
     size := FStream.Size - FHeaderOffset;
-    // header start before EOF?
+    // does header start before EOF?
     if size >= 0 then
     begin
       // go to header start
@@ -571,7 +576,7 @@ begin
         Read(FHeader, size);
       end;
     end else begin
-      // header start before EOF, clear header
+      // clear header
       size := 0;
     end;
     FillChar(FHeader[size], FHeaderSize-size, 0);

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
+    // $01: mdx (or cdx for VFP) index file present
+    // $02: (Visual FoxPro): associated memo file?
+    // $04: (Visual FoxPro): is this a dbc/database container
+    MDXFlag     : Byte;     // 28 Flags:
     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
+    // $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)
+    VisualFoxProFlags : Byte;    // 18 Field Flags; flags can be combined
+    // (!!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)
+    AutoIncrementNext : Byte;    // 19 VFP only: autoincrement value
     // WorkAreaID only for DBase III, is always $01
-    Reserved2       : array[21..30] of Byte;
-    MDXIndexField   : Byte;    //31
+    WorkAreaID        : Byte;    // 20
+    Reserved1         : array[21..22] of Byte;
+    AutoIncrementStep : Byte;    // 23 VFP only: step value for autoincrement
+    Reserved2         : array[24..30] of Byte;
     // DBase IV:
     // $00: no key for this field;
     // $01: key exists for this field in MDX index file
+    // todo: implement this??
+    MDXIndexField     : Byte;    //31
   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/history.txt

@@ -31,8 +31,9 @@ BUGS & WARNINGS
     - storedefs is not updated automatically when fielddefs are changed
 
 
-FreePascal trunk:
-- initial read support for (Visual) FoxPro files (r24139)
+FreePascal trunk (future V7.0.0):
+- clarification on field types; remove some workarounds (r24169) todo: reinstate depending on test set
+- initial support for (Visual) FoxPro files (r24139)
 - annotated constants/file structure (r24139)
 - factored out get version/get codepage subprocedure for readability (r24139)
 - split out existing support for Visual FoxPro and Foxpro (r24109) 

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

@@ -19,13 +19,37 @@ 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
 
 especially this for table structure:
 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. See bottom of page
-
-ftp://fship.com/pub/multisoft/flagship/docu/dbfspecs.txt
-Flagship/FoxPro/Clipper/DBase III..V .dbf file format description
+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
+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

packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -1286,7 +1286,7 @@ begin
       {$IFNDEF SUPPORT_MSECS}
       isc_encode_sql_time(@CTime, PISC_TIME(CurrBuff));
       {$ELSE}
-      PISC_TIME(CurrBuff)^ := Trunc(abs(Frac(PTime)) * IBTimeFractionsPerDay);
+      PISC_TIME(CurrBuff)^ := Round(abs(Frac(PTime)) * IBTimeFractionsPerDay);
       {$ENDIF}
     SQL_TIMESTAMP :
       begin

packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -632,19 +632,27 @@ begin
       if Assigned(AParams) and (AParams.Count > 0) then
         begin
         s := s + '(';
-        for i := 0 to AParams.Count-1 do if TypeStrings[AParams[i].DataType] <> 'Unknown' then
-          s := s + TypeStrings[AParams[i].DataType] + ','
-        else
-          begin
-          if AParams[i].DataType = ftUnknown then 
-            DatabaseErrorFmt(SUnknownParamFieldType,[AParams[i].Name],self)
-          else 
-            DatabaseErrorFmt(SUnsupportedParameter,[Fieldtypenames[AParams[i].DataType]],self);
-          end;
+        for i := 0 to AParams.Count-1 do
+          if TypeStrings[AParams[i].DataType] <> 'Unknown' then
+            s := s + TypeStrings[AParams[i].DataType] + ','
+          else
+            begin
+            if AParams[i].DataType = ftUnknown then
+              begin
+              if AParams[i].IsNull then
+                s:=s+' unknown ,'
+              else
+                DatabaseErrorFmt(SUnknownParamFieldType,[AParams[i].Name],self)
+              end
+            else
+              DatabaseErrorFmt(SUnsupportedParameter,[Fieldtypenames[AParams[i].DataType]],self);
+            end;
         s[length(s)] := ')';
         buf := AParams.ParseSQL(buf,false,sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions,psPostgreSQL);
         end;
       s := s + ' as ' + buf;
+      if LogEvent(detPrepare) then
+        Log(detPrepare,S);
       res := PQexec(tr.PGConn,pchar(s));
       CheckResultError(res,nil,SErrPrepareFailed);
       // if statement is INSERT, UPDATE, DELETE with RETURNING clause, then

packages/fcl-db/tests/database.ini.txt

@@ -168,6 +168,16 @@ connector=dbf
 ; 30=Visual FoxPro
 connectorparams=4
 
+; TDBf: DBase/FoxPro database:
+[dbase3]
+connector=dbf
+connectorparams=3
+
+; TDBf: DBase/FoxPro database:
+[dbase4]
+connector=dbf
+connectorparams=4
+
 ; TDBf: DBase/FoxPro database:
 [dbase7]
 connector=dbf

packages/fcl-db/tests/dbftoolsunit.pas

@@ -186,7 +186,7 @@ begin
         FieldByName('FCURRENCY').AsCurrency := testCurrencyValues[i];
       // work around missing TBCDField.AsBCD:
       if (Result as TDBF).TableLevel >= 25 then
-        FieldByName('FBCD').AsFloat := StrToFLoat(testFmtBCDValues[i],Self.FormatSettings);
+        FieldByName('FBCD').AsBCD := StrToBCD(testFmtBCDValues[i],Self.FormatSettings);
       FieldByName('FDATE').AsDateTime := StrToDate(testDateValues[i], 'yyyy/mm/dd', '-');
       FieldByName('FLARGEINT').AsLargeInt := testLargeIntValues[i];
       Post;

packages/fcl-db/tests/dbtestframework_gui.lpi

@@ -14,7 +14,7 @@
     <VersionInfo>
       <StringTable ProductVersion=""/>
     </VersionInfo>
-    <BuildModes Count="2">
+    <BuildModes Count="3">
       <Item1 Name="Default" Default="True"/>
       <Item2 Name="debug">
         <CompilerOptions>
@@ -31,6 +31,25 @@
           </Other>
         </CompilerOptions>
       </Item2>
+      <Item3 Name="Default_no_local_ppus">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+          </SearchPaths>
+          <Linking>
+            <Debugging>
+              <GenerateDebugInfo Value="False"/>
+            </Debugging>
+          </Linking>
+          <Other>
+            <CompilerMessages>
+              <UseMsgFile Value="True"/>
+            </CompilerMessages>
+            <CompilerPath Value="$(CompPath)"/>
+          </Other>
+        </CompilerOptions>
+      </Item3>
     </BuildModes>
     <PublishOptions>
       <Version Value="2"/>

packages/fcl-db/tests/dbtestframework_gui.lpr

@@ -2,13 +2,15 @@ program dbtestframework_gui;
 
 {$mode objfpc}{$H+}
 
-// Note that this Lazarus project by default re-compiles all DB-units! This eases
-// developing, but asks some attention from the developer.
-// If you want to use the default, installed db-units, simply clear the search path
-// in the compiler-options.
-// It could also be that after compiling this project, you have to manually clean
+// Note that this Lazarus project by default re-compiles all DB units! This eases
+// developing, but requires some attention from the developer.
+// It could very well be that after compiling this project, you have to manually clean
 // the .ppu files before you can build fcl-db in the regular way. (Using fpmake)
 
+// If you want to use the default installed db units, use the
+// Default_no_local_ppus build mode which clears the search path in the compiler
+// options.
+
 uses
   Interfaces, Forms,
   // GUI:

packages/fcl-db/tests/testdbbasics.pas

@@ -2434,6 +2434,8 @@ var i          : byte;
     Fld        : TField;
 
 begin
+  if (uppercase(dbconnectorname)='DBF') then
+    Ignore('This test does not apply to TDDBF as they store currency in BCD fields.');
   TestfieldDefinition(ftCurrency,8,ds,Fld);
 
   for i := 0 to testValuesCount-1 do

packages/fcl-db/tests/testspecifictdbf.pas

@@ -106,6 +106,8 @@ procedure TTestSpecificTDBF.TestTableLevel;
 var
   ds : TDBF;
 begin
+  if ((DS as TDBFAutoClean).UserRequestedTableLevel=25) then
+    ignore('Foxpro (tablelevel 25) may write data out in dBase IV (tablelevel 4) format.');
   ds := TDBFAutoClean.Create(nil);
   DS.FieldDefs.Add('ID',ftInteger);
   DS.CreateTable;