* fcl-db/dbase: start splitting out FoxPro and Visual FoxPro support

git-svn-id: trunk@24109 -

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

@@ -496,9 +496,10 @@ const
 function TableLevelToDbfVersion(TableLevel: integer): TXBaseVersion;
 begin
   case TableLevel of
-    3:                      Result := xBaseIII;
-    7:                      Result := xBaseVII;
-    TDBF_TABLELEVEL_FOXPRO: Result := xFoxPro;
+    3:                            Result := xBaseIII;
+    7:                            Result := xBaseVII;
+    TDBF_TABLELEVEL_FOXPRO:       Result := xFoxPro;
+    TDBF_TABLELEVEL_VISUALFOXPRO: Result := xVisualFoxPro;
   else
     {4:} Result := xBaseIV;
   end;
@@ -1071,7 +1072,7 @@ begin
 
     if TempFieldDef.FieldType = ftFloat then
       begin
-      FieldDefs[I].Size := 0;                      // Size is not defined for float-fields
+      FieldDefs[I].Size := 0; // Size is not defined for float fields
       FieldDefs[I].Precision := TempFieldDef.Size;
       end;
 
@@ -1220,10 +1221,11 @@ begin
 
   // determine dbf version
   case FDbfFile.DbfVersion of
-    xBaseIII: FTableLevel := 3;
-    xBaseIV:  FTableLevel := 4;
-    xBaseVII: FTableLevel := 7;
-    xFoxPro:  FTableLevel := TDBF_TABLELEVEL_FOXPRO;
+    xBaseIII:      FTableLevel := 3;
+    xBaseIV:       FTableLevel := 4;
+    xBaseVII:      FTableLevel := 7;
+    xFoxPro:       FTableLevel := TDBF_TABLELEVEL_FOXPRO;
+    xVisualFoxPro: FTableLevel := TDBF_TABLELEVEL_VISUALFOXPRO;
   end;
   FLanguageID := FDbfFile.LanguageID;
 

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

@@ -21,6 +21,7 @@ const
   TDBF_SUB_MINOR_VERSION  = 2;
 
   TDBF_TABLELEVEL_FOXPRO = 25;
+  TDBF_TABLELEVEL_VISUALFOXPRO = 30; {Source: http://www.codebase.com/support/kb/?article=C01059}
 
   JulianDateDelta = 1721425; { number of days between 1.1.4714 BC and "0" }
 
@@ -30,7 +31,7 @@ type
 
   TDbfFieldType = char;
 
-  TXBaseVersion   = (xUnknown, xClipper, xBaseIII, xBaseIV, xBaseV, xFoxPro, xBaseVII);
+  TXBaseVersion   = (xUnknown, xClipper, xBaseIII, xBaseIV, xBaseV, xFoxPro, xBaseVII, xVisualFoxPro);
   TSearchKeyType = (stEqual, stGreaterEqual, stGreater);
 
   TDateTimeHandling       = (dtDateTime, dtBDETimeStamp);

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

@@ -354,24 +354,35 @@ begin
       //  $03,$F5 FoxPro Level 25 Header Byte $1d=$09, Float -> N($14.$05) DateTime D($08)
 
       version := PDbfHdr(Header)^.VerDBF;
-      case (version and $07) of
-        $03:
-          if LanguageID = 0 then
-            FDbfVersion := xBaseIII
-          else
-            FDbfVersion := xBaseIV;
-        $04:
-          FDbfVersion := xBaseVII;
-        $02, $05:
-          FDbfVersion := xFoxPro;
-      else
-        // check visual foxpro
-        if ((version and $FE) = $30) or (version = $F5) or (version = $FB) then
-        begin
-          FDbfVersion := xFoxPro;
-        end else begin
-          // not a valid DBF file
-          raise EDbfError.Create(STRING_INVALID_DBF_FILE);
+      FDbfVersion := xUnknown;
+      // Some hardcode versions for Visual FoxPro; see MS documentation
+      // (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;
+        $F5: FDbfVersion:=xFoxPro;
+      end;
+      if FDbfVersion = xUnknown then
+      begin
+        case (version and $07) of
+          $03:
+            if LanguageID = 0 then
+              FDbfVersion := xBaseIII
+            else
+              FDbfVersion := xBaseIV;
+          $04:
+            FDbfVersion := xBaseVII;
+          $02, $05:
+            FDbfVersion := xFoxPro;
+        else
+          // todo: check visual foxpro, modify
+          if ((version and $FE) = $30) or (version = $F5) or (version = $FB) then
+          begin
+            FDbfVersion := xFoxPro;
+          end else begin
+            // not a valid DBF file
+            raise EDbfError.Create(STRING_INVALID_DBF_FILE);
+          end;
         end;
       end;
       FFieldDefs.DbfVersion := FDbfVersion;
@@ -449,7 +460,7 @@ begin
         // open blob file
         if not FileExists(lMemoFileName) then
           MemoFileClass := TNullMemoFile
-        else if FDbfVersion = xFoxPro then
+        else if FDbfVersion in [xFoxPro,xVisualFoxPro]  then
           MemoFileClass := TFoxProMemoFile
         else
           MemoFileClass := TDbaseMemoFile;
@@ -461,19 +472,19 @@ begin
         FMemoFile.DbfVersion := FDbfVersion;
         FMemoFile.Open;
         // set header blob flag corresponding to field list
-        if FDbfVersion <> xFoxPro then
+        if not(FDbfVersion in [xFoxPro,xVisualFoxPro]) then
         begin
           PDbfHdr(Header)^.VerDBF := PDbfHdr(Header)^.VerDBF or $80;
           lModified := true;
         end;
       end else
-        if FDbfVersion <> xFoxPro then
+        if not(FDbfVersion in [xFoxPro,xVisualFoxPro]) then
         begin
           PDbfHdr(Header)^.VerDBF := PDbfHdr(Header)^.VerDBF and $7F;
           lModified := true;
         end;
       // check if mdx flagged
-      if (FDbfVersion <> xFoxPro) and (PDbfHdr(Header)^.MDXFlag <> 0) then
+      if not(FDbfVersion in [xFoxPro,xVisualFoxPro]) and (PDbfHdr(Header)^.MDXFlag <> 0) then
       begin
         // open mdx file if present
         lMdxFileName := ChangeFileExt(FileName, '.mdx');
@@ -606,11 +617,10 @@ begin
       HeaderSize := SizeOf(rDbfHdr) + SizeOf(rAfterHdrIII);
       RecordSize := SizeOf(rFieldDescIII);
       FillChar(Header^, HeaderSize, #0);
-      if FDbfVersion = xFoxPro then
-      begin
-        PDbfHdr(Header)^.VerDBF := $02
-      end else
-        PDbfHdr(Header)^.VerDBF := $03;
+      case FDbfVersion of
+        xFoxPro: PDbfHdr(Header)^.VerDBF := $02; {FoxBASE}
+        xVisualFoxPro: PDbfHdr(Header)^.VerDBF := $30; {Visual FoxPro no autoincrement,no varchar} //todo: check autoincrement, Varchar, Varbinary, or Blob-enabled
+        else PDbfHdr(Header)^.VerDBF := $03; {FoxBASE+/dBASE III PLUS, no memo!?}
       // standard language WE, dBase III no language support
       if FDbfVersion = xBaseIII then
         PDbfHdr(Header)^.Language := 0
@@ -646,7 +656,7 @@ begin
       lPrec := lFieldDef.Precision;
       if (lFieldDef.NativeFieldType = 'C')
 {$ifndef USE_LONG_CHAR_FIELDS}
-          and (FDbfVersion = xFoxPro)
+          and (FDbfVersion in [xFoxPro,xVisualFoxPro])
 {$endif}
                 then
       begin
@@ -670,12 +680,12 @@ begin
         lFieldDescIII.FieldType := lFieldDef.NativeFieldType;
         lFieldDescIII.FieldSize := lSize;
         lFieldDescIII.FieldPrecision := lPrec;
-        if FDbfVersion = xFoxPro then
+        if FDbfVersion in [xFoxPro,xVisualFoxPro] then
           lFieldDescIII.FieldOffset := SwapIntLE(lFieldOffset);
         if (PDbfHdr(Header)^.VerDBF = $02) and (lFieldDef.NativeFieldType in ['0', 'Y', 'T', 'O', '+']) then
-          PDbfHdr(Header)^.VerDBF := $30;
+          PDbfHdr(Header)^.VerDBF := $30; {Visual FoxPro}
         if (PDbfHdr(Header)^.VerDBF = $30) and (lFieldDef.NativeFieldType = '+') then
-          PDbfHdr(Header)^.VerDBF := $31;
+          PDbfHdr(Header)^.VerDBF := $31; {Visual FoxPro, autoincrement enabled}
       end;
 
       // update our field list
@@ -696,26 +706,26 @@ begin
     // write memo bit
     if lHasBlob then
     begin
-      if FDbfVersion = xBaseIII then
-        PDbfHdr(Header)^.VerDBF := PDbfHdr(Header)^.VerDBF or $80
-      else
-      if FDbfVersion = xFoxPro then
-      begin
-        if PDbfHdr(Header)^.VerDBF = $02 then
-          PDbfHdr(Header)^.VerDBF := $F5;
-      end else
-        PDbfHdr(Header)^.VerDBF := PDbfHdr(Header)^.VerDBF or $88;
+      case FDbfVersion of
+        xBaseIII: PDbfHdr(Header)^.VerDBF := PDbfHdr(Header)^.VerDBF or $80;
+        xFoxPro: if PDbfHdr(Header)^.VerDBF = $02 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;
+        else PDbfHdr(Header)^.VerDBF := PDbfHdr(Header)^.VerDBF or $88;
+      end;
     end;
 
     // update header
     PDbfHdr(Header)^.RecordSize := lFieldOffset;
     PDbfHdr(Header)^.FullHdrSize := HeaderSize + RecordSize * AFieldDefs.Count + 1;
-    // add empty "back-link" info, whatever it is: 
-    { A 263-byte range that contains the backlink, which is the relative path of 
+    { 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, 
       the file is not associated with a database. Therefore, database files always 
       contain 0x00. }
-    if FDbfVersion = xFoxPro then
+    end;
+    if FDbfVersion = xVisualFoxPro then
       Inc(PDbfHdr(Header)^.FullHdrSize, 263);
 
     // write dbf header to disk
@@ -731,7 +741,7 @@ begin
   if HasBlob and (FMemoFile=nil) then
   begin
     lMemoFileName := ChangeFileExt(FileName, GetMemoExt);
-    if FDbfVersion = xFoxPro then
+    if FDbfVersion in [xFoxPro,xVisualFoxPro] then
       FMemoFile := TFoxProMemoFile.Create(Self)
     else
       FMemoFile := TDbaseMemoFile.Create(Self);
@@ -756,10 +766,10 @@ end;
 
 function TDbfFile.GetMemoExt: string;
 begin
-  if FDbfVersion = xFoxPro then
-    Result := '.fpt'
-  else
-    Result := '.dbt';
+  case FDbfVersion of
+    xFoxPro, xVisualFoxPro: Result := '.fpt'
+    else Result := '.dbt';
+  end;
 end;
 
 procedure TDbfFile.Zap;
@@ -854,7 +864,8 @@ begin
         lSize := lFieldDescIII.FieldSize;
         lPrec := lFieldDescIII.FieldPrecision;
         lNativeFieldType := lFieldDescIII.FieldType;
-        lCanHoldNull := (FDbfVersion = xFoxPro) and 
+        // 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');
       end;
@@ -862,7 +873,7 @@ begin
       // apply field transformation tricks
       if (lNativeFieldType = 'C') 
 {$ifndef USE_LONG_CHAR_FIELDS}
-          and (FDbfVersion = xFoxPro) 
+          and (FDbfVersion in [xFoxPro,xVisualFoxPro])
 {$endif}
                 then
       begin
@@ -1486,9 +1497,9 @@ begin
   Result := true;
   // field types that are binary and of which the fieldsize should not be truncated
   case AFieldDef.NativeFieldType of
-    '+', 'I':
+    '+', 'I': //Autoincrement, integer
       begin
-        if FDbfVersion <> xFoxPro then
+        if not(FDbfVersion in [xFoxPro,xVisualFoxPro]) then
         begin
           Result := PDWord(Src)^ <> 0;
           if Result and (Dst <> nil) then
@@ -1558,9 +1569,9 @@ begin
         end;
 {$endif}
       end;
-    'B':    // foxpro double
+    'B':    // Foxpro double
       begin
-        if FDbfVersion = xFoxPro then
+        if FDbfVersion in [xFoxPro,xVisualFoxPro] then
         begin
           Result := true;
           if Dst <> nil then
@@ -1737,10 +1748,11 @@ begin
   // 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':
+    '+', 'I' {autoincrement, integer}:
       begin
-        if FDbfVersion <> xFoxPro then
+        if not(FDbfVersion in [xFoxPro,xVisualFoxPro]) then
         begin
           if Src = nil then
             IntValue := 0
@@ -1821,9 +1833,9 @@ begin
         end;
 {$endif}
       end;
-    'B':
+    'B' {(Visual) FoxPro Double}:
       begin
-        if DbfVersion = xFoxPro then
+        if DbfVersion in [xFoxPro,xVisualFoxPro] then
         begin
           if Src = nil then
             PDouble(Dst)^ := 0

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

@@ -55,6 +55,7 @@ type
     procedure Assign(Source: TPersistent); override;
     procedure AssignDb(DbSource: TFieldDef);
 
+    // Checks and adjusts field size & precision
     procedure CheckSizePrecision;
     procedure SetDefaultSize;
     procedure AllocBuffers;
@@ -365,7 +366,7 @@ begin
     'D' : FFieldType := ftDate;
     'M' : FFieldType := ftMemo;
     'B' : 
-      if DbfVersion = xFoxPro then
+      if (DbfVersion = xFoxPro) or (DbfVersion=xVisualFoxPro) then
         FFieldType := ftFloat
       else
         FFieldType := ftBlob;
@@ -375,7 +376,15 @@ begin
         FFieldType := ftBCD
       else
         FFieldType := ftCurrency;
-    '0' : FFieldType := ftBytes;	{ Visual FoxPro ``_NullFlags'' }
+    '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 (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)
+    }
   else
     FNativeFieldType := #0;
     FFieldType := ftUnknown;
@@ -391,7 +400,7 @@ begin
       if DbfVersion = xBaseVII then
         FNativeFieldType := '@'
       else
-      if DbfVersion = xFoxPro then
+      if (DbfVersion = xFoxPro) or (DbfVersion = xVisualFoxPro) then
         FNativeFieldType := 'T'
       else
         FNativeFieldType := 'D';
@@ -416,7 +425,7 @@ begin
       else
         FNativeFieldType := 'N';
     ftBCD, ftCurrency: 
-      if DbfVersion = xFoxPro then
+      if (DbfVersion = xFoxPro) or (DBFVersion = xVisualFoxPro) then
         FNativeFieldType := 'Y';
   end;
   if FNativeFieldType = #0 then
@@ -471,11 +480,11 @@ end;
 procedure TDbfFieldDef.CheckSizePrecision;
 begin
   case FNativeFieldType of
-    'C':
+    'C': // Character
       begin
         if FSize < 0 then 
           FSize := 0;
-        if DbfVersion = xFoxPro then
+        if (DbfVersion = xFoxPro) or (DbfVersion = xVisualFoxPro) then
         begin
           if FSize >= $FFFF then 
             FSize := $FFFF;
@@ -485,35 +494,34 @@ begin
         end;
         FPrecision := 0;
       end;
-    'L':
+    'L': // Logical/boolean
       begin
         FSize := 1;
         FPrecision := 0;
       end;
-    'N','F':
+    'N','F': // Binary code decimal numeric, floating point binary numeric
       begin
-        // floating point
         if FSize < 1   then FSize := 1;
         if FSize >= 20 then FSize := 20;
         if FPrecision > FSize-2 then FPrecision := FSize-2;
         if FPrecision < 0       then FPrecision := 0;
       end;
-    'D':
+    'D': // Date
       begin
         FSize := 8;
         FPrecision := 0;
       end;
-    'B':
+    'B': // Double
       begin
-        if DbfVersion <> xFoxPro then
+        if (DbfVersion <> xFoxPro) and (DbfVersion <> xVisualFoxPro) then
         begin
           FSize := 10;
           FPrecision := 0;
         end;
       end;
-    'M','G':
+    'M','G': // Memo, general
       begin
-        if DbfVersion = xFoxPro then
+        if (DbfVersion = xFoxPro) or (DbfVersion = xVisualFoxPro) then
         begin
           if (FSize <> 4) and (FSize <> 10) then
             FSize := 4;
@@ -521,31 +529,38 @@ begin
           FSize := 10;
         FPrecision := 0;
       end;
-    '+','I':
+    '+','I': // Autoincrement, integer
       begin
         FSize := 4;
         FPrecision := 0;
       end;
-    '@', 'O':
+    '@', 'O': //Timestamp, double (both DBase 7)
       begin
         FSize := 8;
         FPrecision := 0;
       end;
-    'T':
+    'T': // DateTime
       begin
-        if DbfVersion = xFoxPro then
+        if (DbfVersion = xFoxPro) or (DbfVersion = xVisualFoxPro) then
           FSize := 8
         else
           FSize := 14;
         FPrecision := 0;
       end;
-    'Y':
+    'Y': // Currency
       begin
         FSize := 8;
         FPrecision := 4;
       end;
   else
-    // Nothing
+    {
+    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
 end;
 

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

@@ -184,7 +184,7 @@ begin
     RecordSize := GetBlockLen;
     // checking for right blocksize not needed for foxpro?
     // mod 128 <> 0 <-> and 0x7F <> 0
-    if (RecordSize = 0) and ((FDbfVersion = xFoxPro) or ((RecordSize and $7F) <> 0)) then
+    if (RecordSize = 0) and ((FDbfVersion in [xFoxPro,xVisualFoxPro]) or ((RecordSize and $7F) <> 0)) then
     begin
       SetBlockLen(512);
       RecordSize := 512;
@@ -371,7 +371,7 @@ begin
     if bytesBefore=8 then
     begin
       totsize := Src.Size + bytesBefore + bytesAfter;
-      if FDbfVersion <> xFoxPro then
+      if not(FDbfVersion in [xFoxPro,xVisualFoxPro]) then
       begin
         PBlockHdr(FBuffer)^.MemoType := SwapIntLE($0008FFFF);
         PBlockHdr(FBuffer)^.MemoSize := SwapIntLE(totsize);