fcl-base/dbase:

* Version: 6.9.2=>7.0.0 because of FoxPro/Visual Foxpro support (needs more testing though)
* Visibility of FindNext etc matches ancestor now
* Fix for BCD field size; fix for missing FPC .SetAsBCD in tests (thanks, Ludo!)
* Fix for Foxpro 'B' double field: size & incorrectly treated as blob fields
* Link to more specs; clarification of FoxPro memo structure
* Added descriptive names for dbase tests in database template

git-svn-id: trunk@24169 -

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

@@ -261,10 +261,6 @@ type
       {$ifdef SUPPORT_OVERLOAD} overload; {$endif} override; {virtual abstract}
 
     { virtual methods (mostly optional) }
-    function  FindFirst: Boolean; override;
-    function  FindLast: Boolean; override;
-    function  FindNext: Boolean; override;
-    function  FindPrior: Boolean; override;
     function  GetDataSource: TDataSource; {$ifndef VER1_0}override;{$endif}
     function  GetRecordCount: Integer; override; {virtual}
     function  GetRecNo: Integer; override; {virtual}
@@ -294,7 +290,7 @@ type
     { abstract methods }
     function GetFieldData(Field: TField; Buffer: Pointer): Boolean;
       {$ifdef SUPPORT_OVERLOAD} overload; {$endif} override; {virtual abstract}
-    { virtual methods (mostly optionnal) }
+    { virtual methods (mostly optional) }
     procedure Resync(Mode: TResyncMode); override;
     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override; {virtual}
 {$ifdef SUPPORT_NEW_TRANSLATE}
@@ -313,6 +309,11 @@ type
     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
     procedure CheckDbfFieldDefs(ADbfFieldDefs: TDbfFieldDefs);
 
+    function  FindFirst: Boolean; override;
+    function  FindLast: Boolean; override;
+    function  FindNext: Boolean; override;
+    function  FindPrior: Boolean; override;
+
 {$ifdef VER1_0}
     procedure DataEvent(Event: TDataEvent; Info: Longint); override;
 {$endif}
@@ -1065,17 +1066,21 @@ begin
       TempFieldDef.FieldName:=BaseName+IntToStr(N);
     end;
     // add field, passing dbase native size if relevant
-    // todo: add ftWideString, perhaps more fields?
-    if TempFieldDef.FieldType in [ftString, ftBytes] then
-      FieldDefs.Add(TempFieldDef.FieldName, TempFieldDef.FieldType, TempFieldDef.Size, false)
+    // 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);
+      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;
+
+    FieldDefs[I].Precision := TempFieldDef.Precision;
 
-    if TempFieldDef.FieldType = ftFloat then
-      begin
-      FieldDefs[I].Size := 0; // Size is not defined for float fields
-      FieldDefs[I].Precision := TempFieldDef.Size;
-      end;
 
 {$ifdef SUPPORT_FIELDDEF_ATTRIBUTES}
     // AutoInc fields are readonly
@@ -1632,6 +1637,8 @@ begin
           FieldName := lSrcField.FieldName;
         FieldType := lSrcField.DataType;
         Required := lSrcField.Required;
+
+        // Set up size/precision for all physical fields:
         if (1 <= lSrcField.FieldNo) 
             and (lSrcField.FieldNo <= lPhysFieldDefs.Count) then
         begin

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

@@ -16,9 +16,9 @@ uses
 
 
 const
-  TDBF_MAJOR_VERSION      = 6;
-  TDBF_MINOR_VERSION      = 9;
-  TDBF_SUB_MINOR_VERSION  = 2;
+  TDBF_MAJOR_VERSION      = 7;
+  TDBF_MINOR_VERSION      = 0;
+  TDBF_SUB_MINOR_VERSION  = 0;
 
   TDBF_TABLELEVEL_FOXPRO = 25;
   TDBF_TABLELEVEL_VISUALFOXPRO = 30; {Source: http://www.codebase.com/support/kb/?article=C01059}
@@ -87,15 +87,22 @@ procedure FindNextName(BaseName: string; var OutName: string; var Modifier: Inte
 function GetFreeMemory: Integer;
 {$endif}
 
+// Convert word to big endian
 function SwapWordBE(const Value: word): word;
+// Convert word to little endian
 function SwapWordLE(const Value: word): word;
+// Convert integer to big endian
 function SwapIntBE(const Value: dword): dword;
+// Convert integer to little endian
 function SwapIntLE(const Value: dword): dword;
 {$ifdef SUPPORT_INT64}
+// Convert int64 to big endian
 procedure SwapInt64BE(Value, Result: Pointer); register;
+// Convert int64 to little endian
 procedure SwapInt64LE(Value, Result: Pointer); register;
 {$endif}
 
+// Translate string between codepages
 function TranslateString(FromCP, ToCP: Cardinal; Src, Dest: PChar; Length: Integer): Integer;
 
 // Returns a pointer to the first occurence of Chr in Str within the first Length characters

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

@@ -1224,7 +1224,7 @@ begin
       begin
         // get minimum field length
         lFieldSize := Min(TempSrcDef.Precision, TempDstDef.Precision) +
-          Min(TempSrcDef.Size - TempSrcDef.Precision, 
+          Min(TempSrcDef.Size - TempSrcDef.Precision,
             TempDstDef.Size - TempDstDef.Precision);
         // if one has dec separator, but other not, we lose one digit
         if (TempDstDef.Precision > 0) xor 
@@ -1233,7 +1233,7 @@ begin
         // should not happen, but check nevertheless (maybe corrupt data)
         if lFieldSize < 0 then
           lFieldSize := 0;
-        srcOffset := TempSrcDef.Size - TempSrcDef.Precision - 
+        srcOffset := TempSrcDef.Size - TempSrcDef.Precision -
           (TempDstDef.Size - TempDstDef.Precision);
         if srcOffset < 0 then
         begin
@@ -1461,7 +1461,7 @@ var
   var wD, wM, wY, CenturyBase: Word;
 
 {$ifndef DELPHI_5}
-  // Delphi 3 standard-behavior no change possible
+  // Delphi 3 standard behavior, no change possible
   const TwoDigitYearCenturyWindow= 0;
 {$endif}
 

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

@@ -79,10 +79,10 @@ type
     property FieldType: TFieldType read FFieldType write SetFieldType;
     // 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;
     property NullPosition: integer read FNullPosition write FNullPosition;
-    // Size in memory
-    property Size: Integer         read FSize      write SetSize;
-    // Precision in dbase file
     property Precision: Integer    read FPrecision write SetPrecision;
     property Required: Boolean     read FRequired  write FRequired;
   end;
@@ -91,7 +91,6 @@ type
   private
     FOwner: TPersistent;
     FDbfVersion: TXBaseVersion;
-
     function GetItem(Idx: Integer): TDbfFieldDef;
   protected
     function GetOwner: TPersistent; override;
@@ -250,7 +249,9 @@ begin
   // copy from Db.TFieldDef
   FFieldName := DbSource.Name;
   FFieldType := DbSource.DataType;
-  FSize := DbSource.Size;
+  // We do NOT copy over size if TFieldDef size is different from our native size
+  if not(DBSource.DataType in [ftBCD,ftCurrency]) then
+    FSize := DbSource.Size;
   FPrecision := DbSource.Precision;
   FRequired := DbSource.Required;
 {$ifdef SUPPORT_FIELDDEF_INDEX}
@@ -259,7 +260,7 @@ begin
   FIsLockField := false;
   // convert VCL fieldtypes to native DBF fieldtypes
   VCLToNative;
-  // for integer / float fields try to fill in size/precision
+  // for integer / float fields try to fill in Size/precision
   if FSize = 0 then
     SetDefaultSize
   else
@@ -334,9 +335,7 @@ end;
 procedure TDbfFieldDef.NativeToVCL;
 begin
   case FNativeFieldType of
-// OH 2000-11-15 dBase7 support.
-// Add the new fieldtypes
-    '+' : 
+    '+' :
       if DbfVersion = xBaseVII then
         FFieldType := ftAutoInc;
     'I' : FFieldType := ftInteger;
@@ -437,7 +436,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
@@ -446,8 +445,9 @@ begin
       end;
     ftCurrency, ftBCD:
       begin
-        FSize := 8;
-        FPrecision := 4;
+        FSize := 8; // Stored in dbase as 8 bytes; up to 18 (or 20) characters including .-
+        // FPC ftBCD/ftCurrency TFieldDef.Size has max 4 which is 4 bytes after decimal
+        FPrecision := 4; //Total number of digits
       end;
     ftSmallInt, ftWord:
       begin
@@ -476,7 +476,7 @@ begin
       end;
   end; // case fieldtype
 
-  // set sizes for fields that are restricted to single size/precision
+  // set sizes for fields that are restricted to single Size/precision
   CheckSizePrecision;
 end;
 
@@ -485,14 +485,14 @@ begin
   case FNativeFieldType of
     'C': // Character
       begin
-        if FSize < 0 then 
+        if FSize < 0 then
           FSize := 0;
         if (DbfVersion = xFoxPro) or (DbfVersion = xVisualFoxPro) then
         begin
-          if FSize >= $FFFF then 
+          if FSize >= $FFFF then
             FSize := $FFFF;
         end else begin
-          if FSize >= $FF then 
+          if FSize >= $FF then
             FSize := $FF;
         end;
         FPrecision := 0;
@@ -504,9 +504,12 @@ begin
       end;
     'N','F': // Binary code decimal numeric, floating point binary numeric
       begin
+        // ftBCD: precision=total number of digits; Delphi supports max 32
+        // Note: this field can be stored as BCD or integer, depending on FPrecision;
+        // that's why we allow 0 precision
         if FSize < 1   then FSize := 1;
         if FSize >= 20 then FSize := 20;
-        if FPrecision > FSize-2 then FPrecision := FSize-2;
+        if FPrecision > FSize-2 then FPrecision := FSize-2; //Leave space for . and -
         if FPrecision < 0       then FPrecision := 0;
       end;
     'D': // Date
@@ -514,12 +517,17 @@ begin
         FSize := 8;
         FPrecision := 0;
       end;
-    'B': // Double
+    'B': // (Visual)Foxpro double, DBase binary
       begin
-        if (DbfVersion <> xFoxPro) and (DbfVersion <> xVisualFoxPro) then
+        if not(DbfVersion in [xFoxPro,xVisualFoxPro]) then
         begin
           FSize := 10;
           FPrecision := 0;
+        end
+        else
+        begin
+          FSize := 8; //Foxpro double
+          FPrecision := 0;
         end;
       end;
     'M','G': // Memo, general
@@ -574,7 +582,11 @@ end;
 
 function TDbfFieldDef.IsBlob: Boolean; {override;}
 begin
-  Result := FNativeFieldType in ['M','G','B'];
+  // 'B' is float in (V)FP
+  if (DbfVersion in [xFoxPro,xVisualFoxPro]) then
+    Result := FNativeFieldType in ['M','G']
+  else
+    Result := FNativeFieldType in ['M','G','B'];
 end;
 
 procedure TDbfFieldDef.FreeBuffers;
@@ -591,7 +603,7 @@ end;
 
 procedure TDbfFieldDef.AllocBuffers;
 begin
-  // size changed?
+  // Size changed?
   if FAllocSize <> FSize then
   begin
     // free old buffers
@@ -600,7 +612,7 @@ begin
     GetMem(FDefaultBuf, FSize*3);
     FMinBuf := FDefaultBuf + FSize;
     FMaxBuf := FMinBuf + FSize;
-    // store allocated size
+    // store allocated Size
     FAllocSize := FSize;
   end;
 end;

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

@@ -102,10 +102,13 @@ uses
 //====================================================================
 type
   // DBase III+ dbt memo file
+  // (Visual) FoxPro note: integers are in Big Endian: high byte first
+  // http://msdn.microsoft.com/en-us/library/aa975374%28VS.71%29.aspx
   PDbtHdr = ^rDbtHdr;
   rDbtHdr = record
     NextBlock : dword;                  // 0..3
     // Dummy in DBaseIII; size of blocks in memo file; default 512 bytes
+    // (Visual) FoxPro: 4..5 unused; use only bytes 6..7
     BlockSize : dword;                  // 4..7
     // DBF file name without extension
     DbfFile   : array [0..7] of Byte;   // 8..15
@@ -126,11 +129,15 @@ type
   end;
 
   // Header of a memo data block:
+  // (Visual) FoxPro note: integers are in Big Endian: high byte first
   PBlockHdr = ^rBlockHdr;
   rBlockHdr = record
     // DBase IV(+) identifier: $FF $FF $08 $00
-    MemoType  : Cardinal; // 0..4
-    MemoSize  : Cardinal; // 5..7
+    // (Visual) FoxPro: $00 picture, $01 text/memo, $02 object
+    MemoType  : Cardinal; // 0..3
+    // Length of memo field
+    MemoSize  : Cardinal; // 4..7
+    // memo data             8..N
   end;
 
 

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

@@ -25,16 +25,7 @@ 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, and these values match other sources:
-FoxBASE/dBase II: 0x02
-FoxBASE+/FoxPro/Dbase III plus, no memo: 0x03
-Visual FoxPro: 0x30
-Visual FoxPro, autoincrement enabled: 0x31
-Visual FoxPro, Varchar, Varbinary, or Blob-enabled: 0x32
-dBASE IV SQL table files, no memo: 0x43
-dBASE IV SQL system files, no memo: 0x63
-FoxBASE+/dBASE III PLUS, with memo: 0x83
-dBASE IV with memo: 0x8B
-dBASE IV SQL table files, with memo: 0xCB
-FoxPro 2.x (or earlier) with memo: 0xF5
-FoxBASE: 0xFB
+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

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

@@ -168,6 +168,24 @@ connector=dbf
 ; 30=Visual FoxPro
 connectorparams=4
 
+; TDBf: DBase/FoxPro database:
+[dbase7]
+connector=dbf
+; 7=Visual DBase 7 for Windows
+connectorparams=7
+
+; TDBf: DBase/FoxPro database:
+[foxpro]
+connector=dbf
+; 25=FoxPro
+connectorparams=25
+
+; TDBf: DBase/FoxPro database:
+[visualfoxpro]
+connector=dbf
+; 30=Visual FoxPro
+connectorparams=25
+
 ; MemDS in memory dataset:
 [memds]
 connector=memds

packages/fcl-db/tests/dbftoolsunit.pas

@@ -162,12 +162,12 @@ begin
     FieldDefs.Add('FWORD', ftWord);
     FieldDefs.Add('FBOOLEAN', ftBoolean);
     FieldDefs.Add('FFLOAT', ftFloat);
+    // Field types only available in newer versions
     if (Result as TDBF).TableLevel >= 25 then
       FieldDefs.Add('FCURRENCY', ftCurrency);
     if (Result as TDBF).TableLevel >= 25 then
       FieldDefs.Add('FBCD', ftBCD);
     FieldDefs.Add('FDATE', ftDate);
-    //    FieldDefs.Add('FTIME',ftTime);
     FieldDefs.Add('FDATETIME', ftDateTime);
     FieldDefs.Add('FLARGEINT', ftLargeint);
     FieldDefs.Add('FMEMO', ftMemo);
@@ -184,8 +184,9 @@ begin
       FieldByName('FFLOAT').AsFloat := testFloatValues[i];
       if (Result as TDBF).TableLevel >= 25 then
         FieldByName('FCURRENCY').AsCurrency := testCurrencyValues[i];
+      // work around missing TBCDField.AsBCD:
       if (Result as TDBF).TableLevel >= 25 then
-        FieldByName('FBCD').AsBCD := StrToBCD(testFmtBCDValues[i], Self.FormatSettings);
+        FieldByName('FBCD').AsFloat := StrToFLoat(testFmtBCDValues[i],Self.FormatSettings);
       FieldByName('FDATE').AsDateTime := StrToDate(testDateValues[i], 'yyyy/mm/dd', '-');
       FieldByName('FLARGEINT').AsLargeInt := testLargeIntValues[i];
       Post;
@@ -227,8 +228,6 @@ begin
 end;
 
 function TDBFDBConnector.GetTraceDataset(AChange: boolean): TDataset;
-var
-  ADS: TDataSet;
 begin
   // Mimic TDBConnector.GetNDataset
   if AChange then FChangedDatasets[NForTraceDataset] := True;