Browse Source

+ fcl-db/dbase: (Visual) FoxPro fixes:
+ initial read support for Visual FoxPro
* annotated file structures, constants etc
* better error reporting:
different message for valid header but
invalid field definitions
* refactored some procedures for readability

git-svn-id: trunk@24139 -

reiniero 12 years ago
parent
commit
e74474ec73

+ 110 - 95
packages/fcl-db/src/dbase/dbf_dbffile.pas

@@ -328,89 +328,63 @@ var
   I: Integer;
   deleteLink: Boolean;
   lModified: boolean;
-  LangStr: PChar;
-  version: byte;
-begin
-  // check if not already opened
-  if not Active then
-  begin
-    // open requested file
-    OpenFile;
 
-    // check if we opened an already existing file
-    lModified := false;
-    if not FileCreated then
-    begin
-      HeaderSize := sizeof(rDbfHdr); // temporary
-      // OH 2000-11-15 dBase7 support. I build dBase Tables with different
-      // BDE dBase Level (1. without Memo, 2. with Memo)
-      //                          Header Byte ($1d hex) (29 dec) -> Language driver ID.
-      //  $03,$83 xBaseIII        Header Byte $1d=$00, Float -> N($13.$04) DateTime C($1E)
-      //  $03,$8B xBaseIV/V       Header Byte $1d=$58, Float -> N($14.$04)
-      //  $04,$8C xBaseVII        Header Byte $1d=$00  Float -> O($08)     DateTime @($08)
-      //  $03,$F5 FoxPro Level 25 Header Byte $1d=$03, Float -> N($14.$04)
-      // Access 97
-      //  $03,$83 dBaseIII        Header Byte $1d=$00, Float -> N($13.$05) DateTime D($08)
-      //  $03,$8B dBaseIV/V       Header Byte $1d=$00, Float -> N($14.$05) DateTime D($08)
-      //  $03,$F5 FoxPro Level 25 Header Byte $1d=$09, Float -> N($14.$05) DateTime D($08)
-
-      version := PDbfHdr(Header)^.VerDBF;
-      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;
+  procedure GetVersion;
+  var
+    version: byte;
+  begin
+    // OH 2000-11-15 dBase7 support. I build dBase Tables with different
+    // BDE dBase Level (1. without Memo, 2. with Memo)
+    //                          Header Byte ($1d hex) (29 dec) -> Language driver ID.
+    //  $03,$83 xBaseIII        Header Byte $1d=$00, Float -> N($13.$04) DateTime C($1E)
+    //  $03,$8B xBaseIV/V       Header Byte $1d=$58, Float -> N($14.$04)
+    //  $04,$8C xBaseVII        Header Byte $1d=$00  Float -> O($08)     DateTime @($08)
+    //  $03,$F5 FoxPro Level 25 Header Byte $1d=$03, Float -> N($14.$04)
+    // Access 97
+    //  $03,$83 dBaseIII        Header Byte $1d=$00, Float -> N($13.$05) DateTime D($08)
+    //  $03,$8B dBaseIV/V       Header Byte $1d=$00, Float -> N($14.$05) DateTime D($08)
+    //  $03,$F5 FoxPro Level 25 Header Byte $1d=$09, Float -> N($14.$05) DateTime D($08)
+
+    version := PDbfHdr(Header)^.VerDBF;
+    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
+      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;
-      FFieldDefs.DbfVersion := FDbfVersion;
-      RecordSize := PDbfHdr(Header)^.RecordSize;
-      HeaderSize := PDbfHdr(Header)^.FullHdrSize;
-      if (HeaderSize = 0) or (RecordSize = 0) then
-      begin
-        HeaderSize := 0;
-        RecordSize := 0;
-        RecordCount := 0;
-        FForceClose := true;
-        exit;
-      end;
-      // check if specified recordcount correct
-      if PDbfHdr(Header)^.RecordCount <> RecordCount then
-      begin
-        // This message was annoying
-        // and was not understood by most people
-        // ShowMessage('Invalid Record Count,'+^M+
-        //             'RecordCount in Hdr : '+IntToStr(PDbfHdr(Header).RecordCount)+^M+
-        //             'expected : '+IntToStr(RecordCount));
-        // instead, fix up record count without complaint:
-        PDbfHdr(Header)^.RecordCount := RecordCount;
-        lModified := true;
-      end;
-      // determine codepage
-      if FDbfVersion >= xBaseVII then
+    FFieldDefs.DbfVersion := FDbfVersion;
+  end;
+
+  procedure GetCodePage;
+  var
+    LangStr: PChar;
+  begin
+    // determine codepage
+    case FDbfVersion of
+      xBaseVII:
       begin
         // cache language str
         LangStr := @PAfterHdrVII(PChar(Header) + SizeOf(rDbfHdr))^.LanguageDriverName;
@@ -444,15 +418,53 @@ begin
           FFileCodePage := 0;
         end;
         FFileLangId := GetLangId_From_LangName(LanguageStr);
-      end else begin
-        // FDbfVersion <= xBaseV
+      end;
+    else
+      begin
+        // DBase II..V, FoxPro, Visual FoxPro
         FFileLangId := PDbfHdr(Header)^.Language;
         FFileCodePage := LangId_To_CodePage[FFileLangId];
       end;
-      // determine used codepage, if no codepage, then use default codepage
-      FUseCodePage := FFileCodePage;
-      if FUseCodePage = 0 then
-        FUseCodePage := DbfGlobals.DefaultOpenCodePage;
+    end;
+    // determine used codepage, if no codepage, then use default codepage
+    FUseCodePage := FFileCodePage;
+    if FUseCodePage = 0 then
+      FUseCodePage := DbfGlobals.DefaultOpenCodePage;
+  end;
+
+begin
+  // check if not already opened
+  if not Active then
+  begin
+    // open requested file
+    OpenFile;
+
+    // check if we opened an already existing file
+    lModified := false;
+    if not FileCreated then
+    begin
+      HeaderSize := sizeof(rDbfHdr); // temporary, required for getting version
+      GetVersion;
+
+      RecordSize := PDbfHdr(Header)^.RecordSize;
+      HeaderSize := PDbfHdr(Header)^.FullHdrSize;
+      if (HeaderSize = 0) or (RecordSize = 0) then
+      begin
+        HeaderSize := 0;
+        RecordSize := 0;
+        RecordCount := 0;
+        FForceClose := true;
+        exit;
+      end;
+
+      // check if specified recordcount is right; correct if not
+      if PDbfHdr(Header)^.RecordCount <> RecordCount then
+      begin
+        PDbfHdr(Header)^.RecordCount := RecordCount;
+        lModified := true;
+      end;
+
+      GetCodePage;
       // get list of fields
       ConstructFieldDefs;
       // open blob file if present
@@ -604,7 +616,6 @@ begin
     if FDbfVersion = xBaseVII then
     begin
       // version xBaseVII without memo
-      // todo: add support for foxpro writing codepage to codepage slot; use FoxLangId_Intl_850 etc
       HeaderSize := SizeOf(rDbfHdr) + SizeOf(rAfterHdrVII);
       RecordSize := SizeOf(rFieldDescVII);
       FillChar(Header^, HeaderSize, #0);
@@ -616,7 +627,7 @@ begin
         63-32);
       lFieldDescPtr := @lFieldDescVII;
     end else begin
-      // version xBaseIII/IV/V without memo
+      // DBase III..V, (Visual) FoxPro without memo
       HeaderSize := SizeOf(rDbfHdr) + SizeOf(rAfterHdrIII);
       RecordSize := SizeOf(rFieldDescIII);
       FillChar(Header^, HeaderSize, #0);
@@ -627,7 +638,7 @@ begin
         xVisualFoxPro: PDbfHdr(Header)^.VerDBF := $30; {Visual FoxPro no autoincrement,no varchar}
         else PDbfHdr(Header)^.VerDBF := $03; {FoxBASE+/dBASE III PLUS, no memo!?}
       end;
-      // standard language WE, dBase III no language support
+      // standard language WE/Western Europe, dBase III no language support
       if FDbfVersion = xBaseIII then
         PDbfHdr(Header)^.Language := 0
       else
@@ -832,11 +843,12 @@ var
   lCurrentNullPosition: integer;
 begin
   FFieldDefs.Clear;
-  if DbfVersion >= xBaseVII then
+  if DbfVersion = xBaseVII then
   begin
     lHeaderSize := SizeOf(rAfterHdrVII) + SizeOf(rDbfHdr);
     lFieldSize := SizeOf(rFieldDescVII);
   end else begin
+    // DBase III..V, (Visual) FoxPro
     lHeaderSize := SizeOf(rAfterHdrIII) + SizeOf(rDbfHdr);
     lFieldSize := SizeOf(rFieldDescIII);
   end;
@@ -853,10 +865,10 @@ begin
   lCurrentNullPosition := 0;
   lCanHoldNull := false;
   try
-    // there has to be minimum of one field
+    // Specs say there has to be at least one field, so use repeat:
     repeat
       // version field info?
-      if FDbfVersion >= xBaseVII then
+      if FDbfVersion = xBaseVII then
       begin
         ReadRecord(I, @lFieldDescVII);
         lFieldName := AnsiUpperCase(PChar(@lFieldDescVII.FieldName[0]));
@@ -867,6 +879,7 @@ begin
         if lNativeFieldType = '+' then
           FAutoIncPresent := true;
       end else begin
+        // DBase III..V, FoxPro, Visual FoxPro
         ReadRecord(I, @lFieldDescIII);
         lFieldName := AnsiUpperCase(PChar(@lFieldDescIII.FieldName[0]));
         lSize := lFieldDescIII.FieldSize;
@@ -881,10 +894,12 @@ begin
       // apply field transformation tricks
       if (lNativeFieldType = 'C') 
 {$ifndef USE_LONG_CHAR_FIELDS}
-          and (FDbfVersion in [xFoxPro,xVisualFoxPro])
+        and (FDbfVersion in [xFoxPro,xVisualFoxPro])
 {$endif}
-                then
+        then
       begin
+        // (V)FP uses the byte where precision is normally stored
+        // for the high byte of the field size
         lSize := lSize + lPrec shl 8;
         lPrec := 0;
       end;
@@ -912,7 +927,7 @@ begin
       //  2) known field type
       //  {3) no changes have to be made to precision or size}
       if (Length(lFieldName) = 0) or (TempFieldDef.FieldType = ftUnknown) then
-        raise EDbfError.Create(STRING_INVALID_DBF_FILE);
+        raise EDbfError.Create(STRING_INVALID_DBF_FILE_FIELDERROR);
 
       // determine if lock field present, if present, then store additional info
       if lFieldName = '_DBASELOCK' then

+ 34 - 30
packages/fcl-db/src/dbase/dbf_lang.pas

@@ -21,10 +21,10 @@ const
 //*************************************************************************//
 
 // ...
-  FoxLangId_ENU_437       = $01;
-  FoxLangId_Intl_850      = $02;
-  FoxLangId_Windows_1252  = $03;
-  FoxLangId_Mac_10000     = $04;
+  FoxLangId_ENU_437       = $01; // DOS USA
+  FoxLangId_Intl_850      = $02; // DOS multilingual
+  FoxLangId_Windows_1252  = $03; // Windows ANSI
+  FoxLangId_Mac_10000     = $04; // Standard Macintosh
 // ...
   DbfLangId_DAN_865       = $08;
   DbfLangId_NLD_437       = $09;
@@ -70,58 +70,62 @@ const
   DbfLangId_WEurope_1252  = $58;
   DbfLangId_Spanish_1252  = $59;
 // ...
+// Additional FoxPro references:
+// http://msdn.microsoft.com/en-us/library/8t45x02s%28v=VS.80%29.aspx
+// http://www.clicketyclick.dk/databases/xbase/format/dbf.html#DBF_STRUCT
   FoxLangId_German_437    = $5E;
   FoxLangId_Nordic_437    = $5F;
   FoxLangId_Nordic_850    = $60;
   FoxLangId_German_1252   = $61;
   FoxLangId_Nordic_1252   = $62;
 // ...
-  FoxLangId_EEurope_852   = $64;
-  FoxLangId_Russia_866    = $65;
-  FoxLangId_Nordic_865    = $66;
-  FoxLangId_Iceland_861   = $67;
-  FoxLangId_Czech_895     = $68;
+  FoxLangId_EEurope_852   = $64; // DOS
+  FoxLangId_Russia_866    = $65; // DOS //todo: verify, MS docs say this is $66
+  FoxLangId_Nordic_865    = $66; // DOS //todo: verify, MS docs say this is $65
+  FoxLangId_Iceland_861   = $67; // DOS
+  FoxLangId_Czech_895     = $68; // DOS Kamenicky
 // ...
-  DbfLangId_POL_620       = $69;
+  DbfLangId_POL_620       = $69; // DOS Mazovia
 // ...
-  FoxLangId_Greek_737     = $6A;
-  FoxLangId_Turkish_857   = $6B;
+  FoxLangId_Greek_737     = $6A; // DOS (437G)
+  FoxLangId_Turkish_857   = $6B; // DOS
 // ...
-  FoxLangId_Taiwan_950    = $78;
-  FoxLangId_Korean_949    = $79;
-  FoxLangId_Chinese_936   = $7A;
-  FoxLangId_Japan_932     = $7B;
-  FoxLangId_Thai_874      = $7C;
-  FoxLangId_Hebrew_1255   = $7D;
-  FoxLangId_Arabic_1256   = $7E;
+  FoxLangId_Taiwan_950    = $78; // Windows
+  FoxLangId_Korean_949    = $79; // Windows
+  FoxLangId_Chinese_936   = $7A; // Windows Chinese simplified
+  FoxLangId_Japan_932     = $7B; // Windows
+  FoxLangId_Thai_874      = $7C; // Windows
+  FoxLangId_Hebrew_1255   = $7D; // Windows
+  FoxLangId_Arabic_1256   = $7E; // Windows
 // ...
   DbfLangId_Hebrew        = $85;
-  DbfLangId_ELL_437       = $86;    // greek, code page 737 (?)
+  DbfLangId_ELL_437       = $86; // greek, code page 737 (?)
   DbfLangId_SLO_852       = $87;
   DbfLangId_TRK_857       = $88;
 // ...
   DbfLangId_BUL_868       = $8E;
 // ...
-  FoxLangId_Russia_10007  = $96;
-  FoxLangId_EEurope_10029 = $97;
-  FoxLangId_Greek_10006   = $98;
+  FoxLangId_Russia_10007  = $96; // Macintosh
+  FoxLangId_EEurope_10029 = $97; // Macintosh
+  FoxLangId_Greek_10006   = $98; // Macintosh
 // ...
   FoxLangId_Czech_1250    = $9B;
-  FoxLangId_Czech_850     = $9C;    // DOS
+  FoxLangId_Czech_850     = $9C; // DOS
 // ...
-  FoxLangId_EEurope_1250  = $C8;
-  FoxLangId_Russia_1251   = $C9;
-  FoxLangId_Turkish_1254  = $CA;
-  FoxLangId_Greek_1253    = $CB;
+  FoxLangId_EEurope_1250  = $C8; // Windows
+  FoxLangId_Russia_1251   = $C9; // Windows
+  FoxLangId_Turkish_1254  = $CA; // Windows
+  FoxLangId_Greek_1253    = $CB; // Windows
 
 
 // special constants
-
   DbfLocale_NotFound   = $010000;
   DbfLocale_Bul868     = $020000;
 
 //*************************************************************************//
-// DB3/DB4/FoxPro Language ID to CodePage convert table
+// DB3/DB4/FoxPro/Visual Foxpro Language ID to CodePage convert table
+// Visual FoxPro docs call language ID "code page mark"
+// or "code page identifier"
 //*************************************************************************//
 
   LangId_To_CodePage: array[Byte] of Word =

+ 1 - 0
packages/fcl-db/src/dbase/dbf_str.inc

@@ -8,6 +8,7 @@ var
   STRING_KEY_VIOLATION: string;
 
   STRING_INVALID_DBF_FILE: string;
+  STRING_INVALID_DBF_FILE_FIELDERROR: string;
   STRING_FIELD_TOO_LONG: string;
   STRING_INVALID_FIELD_COUNT: string;
   STRING_INVALID_FIELD_TYPE: string;

+ 1 - 0
packages/fcl-db/src/dbase/dbf_str.pas

@@ -19,6 +19,7 @@ initialization
                                          'Index: %s'+#13+#10+'Record=%d Key=''%s''.';
 
   STRING_INVALID_DBF_FILE             := 'Invalid DBF file.';
+  STRING_INVALID_DBF_FILE_FIELDERROR  := 'Invalid DBF file. Invalid field definition.';
   STRING_FIELD_TOO_LONG               := 'Value is too long: %d characters (it can''t be more than %d).';
   STRING_INVALID_FIELD_COUNT          := 'Invalid field count: %d (must be between 1 and 4095).';
   STRING_INVALID_FIELD_TYPE           := 'Invalid field type ''%s'' for field ''%s''.';

+ 1 - 0
packages/fcl-db/src/dbase/dbf_str_es.pas

@@ -19,6 +19,7 @@ initialization
                                          'Indice: %s'+#13+#10+'Registro=%d Clave=''%s''.';
 
   STRING_INVALID_DBF_FILE             := 'Archivo DBF inválido.';
+  STRING_INVALID_DBF_FILE_FIELDERROR  := 'Archivo DBF inválido. Tipo de campo inválido.'; //todo: check for correctness
   STRING_FIELD_TOO_LONG               := 'Valor demasiado largo: %d caracteres (no puede ser mayor de %d).';
   STRING_INVALID_FIELD_COUNT          := 'Cantidad de campos inválida: %d (debe estar entre 1 y 4095).';
   STRING_INVALID_FIELD_TYPE           := 'Tipo de campo inválido ''%s'' para el campo ''%s''.';

+ 2 - 0
packages/fcl-db/src/dbase/dbf_str_fr.pas

@@ -12,6 +12,7 @@ var
   STRING_KEY_VIOLATION: string;
 
   STRING_INVALID_DBF_FILE: string;
+  STRING_INVALID_DBF_FILE_FIELDERROR: string;
   STRING_FIELD_TOO_LONG: string;
   STRING_INVALID_FIELD_COUNT: string;
   STRING_INVALID_FIELD_TYPE: string;
@@ -37,6 +38,7 @@ initialization
                                          'Index: %s'+#13+#10+'Enregistrement=%d Cle=''%s''';
 
   STRING_INVALID_DBF_FILE             := 'Fichier DBF invalide.';
+  STRING_INVALID_DBF_FILE_FIELDERROR  := 'Fichier DBF invalide. Definition de champ invalide.'; //todo: verify field part
   STRING_FIELD_TOO_LONG               := 'Valeur trop longue: %d caractères (ne peut dépasser %d).';
   STRING_INVALID_FIELD_COUNT          := 'Nombre de champs non valide: %d (doit être entre 1 et 4095).';
   STRING_INVALID_FIELD_TYPE           := 'Type de champ ''%s'' invalide pour le champ %s.';

+ 2 - 0
packages/fcl-db/src/dbase/dbf_str_ita.pas

@@ -16,6 +16,8 @@ initialization
   STRING_RECORD_LOCKED                := 'Record già in uso.';
 
   STRING_INVALID_DBF_FILE             := 'File DBF non valido.';
+  STRING_INVALID_DBF_FILE_FIELDERROR  := 'File DBF non valido. Definizione de campo non valido'; //todo: check field part
+
   STRING_FIELD_TOO_LONG               := 'Valore troppo elevato: %d caratteri (esso non può essere più di %d).';
   STRING_INVALID_FIELD_COUNT          := 'Campo non valido (count): %d (deve essere tra 1 e 4095).';
 

+ 1 - 0
packages/fcl-db/src/dbase/dbf_str_nl.pas

@@ -18,6 +18,7 @@ initialization
                                          'Index: %s'+#13+#10+'Record=%d Sleutel=''%s''';
 
   STRING_INVALID_DBF_FILE             := 'Ongeldig DBF bestand.';
+  STRING_INVALID_DBF_FILE_FIELDERROR  := 'Ongeldig DBF bestand. Ongeldige velddefinitie.';
   STRING_FIELD_TOO_LONG               := 'Waarde is te lang: %d karakters (maximum is %d).';
   STRING_INVALID_FIELD_COUNT          := 'Ongeldig aantal velden: %d (moet tussen 1 en 4095).';
   STRING_INVALID_FIELD_TYPE           := 'Veldtype ''%s'' is ongeldig voor veld ''%s''.';

+ 1 - 0
packages/fcl-db/src/dbase/dbf_str_pl.pas

@@ -18,6 +18,7 @@ initialization
                                          'Indeks: %s'+#13+#10+'Rekord=%d Klucz=''%s''';
 
   STRING_INVALID_DBF_FILE             := 'Uszkodzony plik bazy.';
+  STRING_INVALID_DBF_FILE_FIELDERROR  := 'Uszkodzony plik bazy. Uszkodzony pol.'; //todo: definitely check field part
   STRING_FIELD_TOO_LONG               := 'Dana za d³uga : %d znaków (dopuszczalne do %d).';
   STRING_INVALID_FIELD_COUNT          := 'Z³a liczba pól: %d (dozwolone 1 do 4095).';
   STRING_INVALID_FIELD_TYPE           := 'B³êdny typ pola ''%c'' dla pola ''%s''.';

+ 1 - 0
packages/fcl-db/src/dbase/dbf_str_pt.pas

@@ -21,6 +21,7 @@ initialization
                                          'Índice: %s'+#13+#10+'Registro=%d Chave=''%s''.';
 
   STRING_INVALID_DBF_FILE             := 'Arquivo DBF inválido.';
+  STRING_INVALID_DBF_FILE_FIELDERROR  := 'Arquivo DBF inválido. Tipo de campo inválido.'; //todo: check field part
   STRING_FIELD_TOO_LONG               := 'Valor muito grande: %d caracteres (não pode ser maior que %d).';
   STRING_INVALID_FIELD_COUNT          := 'Quantidade de campos inválida: %d (deve estar entre 1 e 4095).';
   STRING_INVALID_FIELD_TYPE           := 'Tipo de campo inválido ''%s'' para o campo ''%s''.';

+ 1 - 0
packages/fcl-db/src/dbase/dbf_str_ru.pas

@@ -23,6 +23,7 @@ initialization
                                          'Индекс: %s'+#13+#10+'Запись (строка)=%d  Ключ="%s".';
 
   STRING_INVALID_DBF_FILE             := 'Файл DBF поврежден или его структура не DBF.';
+  STRING_INVALID_DBF_FILE_FIELDERROR  := 'Файл DBF поврежден или его структура не DBF.'; //todo: add field error info
   STRING_FIELD_TOO_LONG               := 'Длина значения - %d символов, это больше максимума - %d.';
   STRING_INVALID_FIELD_COUNT          := 'Количество полей в таблице (%d) невозможно. Допустимо от 1 до 4095.';
   STRING_INVALID_FIELD_TYPE           := 'Тип значения "%s", затребованный полем "%s" невозможен.';

+ 16 - 8
packages/fcl-db/src/dbase/dbf_struct.inc

@@ -46,17 +46,25 @@ type
     Dummy               : array[64..67] of Byte;
   end;
 //====================================================================
+// DBase III,IV,FoxPro,VisualFoxPro field description
   PFieldDescIII = ^rFieldDescIII;
   rFieldDescIII = packed record
     FieldName       : array[0..10] of Char;
-    FieldType       : Char;     // 11
-    FieldOffset     : Integer;  // 12..15
-    //FieldOffset only applicable to foxpro databases
-    //DBase III: address in memory
-    FieldSize       : Byte;     // 16
-    FieldPrecision  : Byte;     // 17
-    FoxProFlags	    : Byte;	// 18
-    Dummy2          : array[19..31] of Byte;
+    FieldType       : Char;    // 11
+    FieldOffset     : Integer; // 12..15
+    // FieldOffset only applicable to (visual) foxpro databases
+    // DBase III uses it for address in memory
+    FieldSize       : Byte;    // 16
+    FieldPrecision  : Byte;    // 17, also known as decimal count
+    FoxProFlags	    : Byte;	   // 18
+    Reserved1       : Byte;    // 19
+    WorkAreaID      : Byte;    // 20
+    // WorkAreaID only for DBase III, is always $01
+    Reserved2       : array[21..30] of Byte;
+    MDXIndexField   : Byte; //31
+    // DBase IV:
+    // $00: no key for this field;
+    // $01: key exists for this field in MDX index file
   end;
 //====================================================================
 // OH 2000-11-15 dBase7 support. Header Update (add fields like Next AutoInc Value)

+ 3 - 0
packages/fcl-db/src/dbase/history.txt

@@ -32,6 +32,9 @@ BUGS & WARNINGS
 
 
 FreePascal trunk:
+- initial read support for (Visual) FoxPro files
+- annotated constants/file structure
+- factored out get version/get codepage subprocedure for readability
 - split out existing support for Visual FoxPro and Foxpro (r24109) 
   so future Visual FoxPro only features can be implemented
 - implemented FindFirst,FindNext,FindPrior,FindLast (r24107)

+ 20 - 1
packages/fcl-db/src/dbase/readme.txt

@@ -18,4 +18,23 @@ 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:
+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, 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