--- Merging r23789 into '.':

U    packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
--- Merging r23921 into '.':
U    packages/fcl-db/src/sqldb/postgres/pqconnection.pp
U    packages/fcl-db/src/sqldb/odbc/odbcconn.pas
U    packages/fcl-db/src/sqldb/sqldb.pp
G    packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
--- Merging r23927 into '.':
U    packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
--- Merging r23940 into '.':
U    packages/fcl-db/src/sqldb/interbase/ibconnection.pp
--- Merging r23941 into '.':
G    packages/fcl-db/src/sqldb/interbase/ibconnection.pp
--- Merging r23952 into '.':
U    packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Merging r24050 into '.':
U    packages/fcl-db/src/dbase/dbf.pas
--- Merging r24069 into '.':
U    packages/fcl-db/src/dbase/dbf_dbffile.pas
--- Merging r24090 into '.':
U    packages/fcl-db/tests/README.txt
U    packages/fcl-db/tests/bufdatasettoolsunit.pas
U    packages/fcl-db/tests/dbftoolsunit.pas
U    packages/fcl-db/tests/testdatasources.pas
U    packages/fcl-db/tests/database.ini.txt
U    packages/fcl-db/tests/dbtestframework_gui.lpr
U    packages/fcl-db/tests/toolsunit.pas
--- Merging r24104 into '.':
U    packages/fcl-db/tests/dbtestframework.pas
U    packages/fcl-db/tests/dbtestframework_gui.lpi
G    packages/fcl-db/tests/dbftoolsunit.pas
G    packages/fcl-db/tests/database.ini.txt
G    packages/fcl-db/tests/dbtestframework_gui.lpr
A    packages/fcl-db/tests/testspecifictdbf.pas
--- Merging r24106 into '.':
U    packages/fcl-db/src/dbase/readme.txt
U    packages/fcl-db/src/dbase/history.txt
--- Merging r24107 into '.':
G    packages/fcl-db/src/dbase/dbf.pas
G    packages/fcl-db/src/dbase/history.txt
G    packages/fcl-db/src/dbase/readme.txt
--- Merging r24108 into '.':
G    packages/fcl-db/src/dbase/history.txt
--- Merging r24109 into '.':
U    packages/fcl-db/src/dbase/dbf_memo.pas
G    packages/fcl-db/src/dbase/dbf.pas
G    packages/fcl-db/src/dbase/dbf_dbffile.pas
U    packages/fcl-db/src/dbase/dbf_fields.pas
U    packages/fcl-db/src/dbase/dbf_common.pas
--- Merging r24110 into '.':
G    packages/fcl-db/src/dbase/history.txt
--- Merging r24111 into '.':
G    packages/fcl-db/tests/dbftoolsunit.pas
G    packages/fcl-db/tests/database.ini.txt
U    packages/fcl-db/tests/testspecifictdbf.pas
--- Merging r24112 into '.':
G    packages/fcl-db/src/dbase/dbf_dbffile.pas
--- Merging r24121 into '.':
G    packages/fcl-db/tests/dbftoolsunit.pas
G    packages/fcl-db/tests/testspecifictdbf.pas
--- Merging r24122 into '.':
G    packages/fcl-db/src/dbase/dbf.pas

# revisions: 23789,23921,23927,23940,23941,23952,24050,24069,24090,24104,24106,24107,24108,24109,24110,24111,24112,24121,24122
r23789 | lacak | 2013-03-11 10:48:42 +0100 (Mon, 11 Mar 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/mssql/mssqlconn.pp

fcl-db: mssql: small extending (like in others sqldb/sonnections) schema information returned using SetSchemaInfo call. System tables and functions used should be compatible with MS SQL and also with Sybase.
r23921 | lacak | 2013-03-18 10:58:50 +0100 (Mon, 18 Mar 2013) | 3 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
   M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas
   M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp
   M /trunk/packages/fcl-db/src/sqldb/sqldb.pp

fcl-db: sqldb: implemented TSQLConnection.GetSchemaNames
Added stSchemata to TSchemaType (Delphi has strange stUserNames instead)
At TSQLConnection level stSchemata defaults to 'select *  from INFORMATION_SCHEMA.SCHEMATA', which can be overriden in descendants.
r23927 | lacak | 2013-03-19 08:51:29 +0100 (Tue, 19 Mar 2013) | 3 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

fcl-db: sqlite: starting from SQLite 3.7.16, there is changed output of PRAGMA table_info. Now column "pk" shows order of given column in PK (or zero if column is not a part of PK).
Patch keeps backward compatibility.
Test TestMultipleFieldPKIndexDefs
r23940 | michael | 2013-03-20 09:07:03 +0100 (Wed, 20 Mar 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/interbase/ibconnection.pp

* Patch from Jos?\195?\169 Mejuto to fix handling of firebird string params in case Pascal parameter type differs (Bug ID 24080)
r23941 | michael | 2013-03-20 11:15:36 +0100 (Wed, 20 Mar 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/interbase/ibconnection.pp

* Better way of handling date/time conversion in params
r23952 | lacak | 2013-03-22 10:14:59 +0100 (Fri, 22 Mar 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

fcl-db: mysql: add support for other BLOB types (tiny, medium, large). Bug #24112
r24050 | reiniero | 2013-03-29 10:07:40 +0100 (Fri, 29 Mar 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf.pas

* sqldb/dbf: remove deprecated status as it is maintained by FPC devs
r24069 | reiniero | 2013-03-30 12:43:41 +0100 (Sat, 30 Mar 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf_dbffile.pas

* sqldb/dbase: explicit cast to pchar to avoid writing widestrings in dbf header. Fixes mantis #14473
r24090 | reiniero | 2013-03-31 17:09:47 +0200 (Sun, 31 Mar 2013) | 4 lines
Changed paths:
   M /trunk/packages/fcl-db/tests/README.txt
   M /trunk/packages/fcl-db/tests/bufdatasettoolsunit.pas
   M /trunk/packages/fcl-db/tests/database.ini.txt
   M /trunk/packages/fcl-db/tests/dbftoolsunit.pas
   M /trunk/packages/fcl-db/tests/dbtestframework_gui.lpr
   M /trunk/packages/fcl-db/tests/testdatasources.pas
   M /trunk/packages/fcl-db/tests/toolsunit.pas

sqldb/dbtestframework fixes:
* slight cleanup dbftoolsunit
* Fix gui framework selecting old connector after selecting another.
* Cosmetic, spelling fixes.
r24104 | reiniero | 2013-04-01 12:38:23 +0200 (Mon, 01 Apr 2013) | 10 lines
Changed paths:
   M /trunk/packages/fcl-db/tests/database.ini.txt
   M /trunk/packages/fcl-db/tests/dbftoolsunit.pas
   M /trunk/packages/fcl-db/tests/dbtestframework.pas
   M /trunk/packages/fcl-db/tests/dbtestframework_gui.lpi
   M /trunk/packages/fcl-db/tests/dbtestframework_gui.lpr
   A /trunk/packages/fcl-db/tests/testspecifictdbf.pas

sqldb/tests improvements:
* fix memory leak in gui runner
sqldb/tests for dbf/tdbf/dbase/foxpro unit:
* added dbf specific tests
* specify desired tablelevel by connectorparams=<tablelevel> (e.g. 4 for DBase IV)
* dbftoolsunit set up similar to bufdataset tools unit including autocleaning files
- dbname= field in database.ini no longer used for dbf files; always write to temp directory
To do: go through other tests and add ignores if necessary for non-relevant tests
r24106 | reiniero | 2013-04-01 15:05:57 +0200 (Mon, 01 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/history.txt
   M /trunk/packages/fcl-db/src/dbase/readme.txt

* fcl-db/dbase: updated maintenance notice
r24107 | reiniero | 2013-04-01 16:21:04 +0200 (Mon, 01 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf.pas
   M /trunk/packages/fcl-db/src/dbase/history.txt
   M /trunk/packages/fcl-db/src/dbase/readme.txt

+ fcl-db/dbase: implemented FindFirst,FindNext,FindPrior,FindLast and associated tests
r24108 | reiniero | 2013-04-01 16:22:09 +0200 (Mon, 01 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/history.txt

+ fcl-db/dbase: cosmetic; r24107 fixes Mantis #13017
r24109 | reiniero | 2013-04-01 18:47:22 +0200 (Mon, 01 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf.pas
   M /trunk/packages/fcl-db/src/dbase/dbf_common.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_memo.pas

* fcl-db/dbase: start splitting out FoxPro and Visual FoxPro support
r24110 | reiniero | 2013-04-01 18:49:02 +0200 (Mon, 01 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/history.txt

* fcl-db/dbase: cosmetic
r24111 | reiniero | 2013-04-01 18:52:23 +0200 (Mon, 01 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/tests/database.ini.txt
   M /trunk/packages/fcl-db/tests/dbftoolsunit.pas
   M /trunk/packages/fcl-db/tests/testspecifictdbf.pas

fcl-db/dbase: tests for findfirst etc, and visual foxpro
r24112 | reiniero | 2013-04-01 19:06:04 +0200 (Mon, 01 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf_dbffile.pas

* fcl-db/dbase: fix for r24109
r24121 | reiniero | 2013-04-02 04:48:10 +0200 (Tue, 02 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/tests/dbftoolsunit.pas
   M /trunk/packages/fcl-db/tests/testspecifictdbf.pas

* fcl-db/dbase tests: cosmetic/formatting
r24122 | reiniero | 2013-04-02 05:11:01 +0200 (Tue, 02 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf.pas

+ fcl-db/dbase: allow creation of Visual Foxpro tablelevel 30 files

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

.gitattributes

@@ -2031,6 +2031,7 @@ packages/fcl-db/tests/testdddiff.pp svneol=native#text/plain
 packages/fcl-db/tests/testfieldtypes.pas svneol=native#text/plain
 packages/fcl-db/tests/testjsondataset.pp svneol=native#text/plain
 packages/fcl-db/tests/testspecifictbufdataset.pas svneol=native#text/plain
+packages/fcl-db/tests/testspecifictdbf.pas svneol=native#text/plain
 packages/fcl-db/tests/testsqlfiles.lpi svneol=native#text/plain
 packages/fcl-db/tests/testsqlfiles.lpr svneol=native#text/plain
 packages/fcl-db/tests/testsqlscanner.lpi svneol=native#text/plain

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

@@ -1,4 +1,4 @@
-unit dbf deprecated 'Abandoned by maintainer, no longer supported by FPC team. Help may be available at http://tdbf.sourceforge.net and http://sourceforge.net/projects/tdbf/forums/forum/107245';
+unit dbf;
 
 { design info in dbf_reg.pas }
 
@@ -260,7 +260,11 @@ type
     procedure SetFieldData(Field: TField; Buffer: Pointer);
       {$ifdef SUPPORT_OVERLOAD} overload; {$endif} override; {virtual abstract}
 
-    { virtual methods (mostly optionnal) }
+    { 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}
@@ -492,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;
@@ -753,6 +758,30 @@ begin
   SetFieldData(Field, Buffer, true);
 end;
 
+function TDbf.FindFirst: Boolean;
+begin
+  // Use inherited function; if failed use FindRecord
+  Result:=inherited FindFirst or FindRecord(True, True);
+end;
+
+function TDbf.FindLast: Boolean;
+begin
+  // Use inherited function; if failed use FindRecord
+  Result:=inherited FindLast or FindRecord(True, False);
+end;
+
+function TDbf.FindNext: Boolean;
+begin
+  // Use inherited function; if failed use FindRecord
+  Result:=inherited FindNext or FindRecord(False, True);
+end;
+
+function TDbf.FindPrior: Boolean;
+begin
+  // Use inherited function; if failed use FindRecord
+  Result:=inherited FindPrior or FindRecord(False, False);
+end;
+
 procedure TDbf.SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); {overload; override;}
 {$else}
 const
@@ -1043,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;
 
@@ -1192,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;
 
@@ -1299,7 +1329,7 @@ begin
     Result := 0;
 end;
 
-function TDbf.GetLanguageStr: String;
+function TDbf.GetLanguageStr: string;
 begin
   if FDbfFile <> nil then
     Result := FDbfFile.LanguageStr;
@@ -2293,7 +2323,7 @@ begin
   end;
 end;
 
-procedure TDbf.SetTableName(const s: string);
+procedure TDbf.SetTableName(const S: string);
 var
   lPath: string;
 begin
@@ -2326,7 +2356,7 @@ begin
   if NewLevel <> FTableLevel then
   begin
     // check validity
-    if not ((NewLevel = 3) or (NewLevel = 4) or (NewLevel = 7) or (NewLevel = 25)) then
+    if not (NewLevel in [3,4,7,TDBF_TABLELEVEL_FOXPRO,TDBF_TABLELEVEL_VISUALFOXPRO]) then
       exit;
 
     // can only assign tablelevel if table is closed

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');
@@ -595,10 +606,10 @@ begin
       RecordSize := SizeOf(rFieldDescVII);
       FillChar(Header^, HeaderSize, #0);
       PDbfHdr(Header)^.VerDBF := $04;
-      // write language string
+      // write language string. FPC needs an explicit cast to pchar to avoid calling widestring version of StrPLCopy
       StrPLCopy(
-        @PAfterHdrVII(PChar(Header)+SizeOf(rDbfHdr))^.LanguageDriverName[32],
-        ConstructLangName(FFileCodePage, lLocaleID, false), 
+        PChar(@PAfterHdrVII(PChar(Header)+SizeOf(rDbfHdr))^.LanguageDriverName[32]),
+        PChar(ConstructLangName(FFileCodePage, lLocaleID, false)),
         63-32);
       lFieldDescPtr := @lFieldDescVII;
     end else begin
@@ -606,11 +617,11 @@ 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!?}
+      end;
       // standard language WE, dBase III no language support
       if FDbfVersion = xBaseIII then
         PDbfHdr(Header)^.Language := 0
@@ -646,9 +657,9 @@ begin
       lPrec := lFieldDef.Precision;
       if (lFieldDef.NativeFieldType = 'C')
 {$ifndef USE_LONG_CHAR_FIELDS}
-          and (FDbfVersion = xFoxPro)
+        and (FDbfVersion in [xFoxPro,xVisualFoxPro])
 {$endif}
-                then
+        then
       begin
         lPrec := lSize shr 8;
         lSize := lSize and $FF;
@@ -670,12 +681,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 +707,25 @@ 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
+    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);

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

@@ -31,6 +31,11 @@ BUGS & WARNINGS
     - storedefs is not updated automatically when fielddefs are changed
 
 
+FreePascal trunk:
+- 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)
+- compile fix for FPC 2.6.2 (r24069), possibly useful for Delphi
 
 ------------------------
 V6.9.2

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

@@ -1,6 +1,7 @@
-The maintainers of this package have abandoned it, so it has been deprecated.
-It will no longer be supported by the FPC team in the future, unless someone
-else volunteers to do so.
+This package provides support for DBase files.
+It is derived from the upstream package at
+http://sourceforge.net/projects/tdbf/
+It is supported by FPC developers and the upstream maintainers.
 
 Support from other tdbf users may be available on the tdbf forum on
 SourceForge: http://sourceforge.net/projects/tdbf/forums/forum/107245
@@ -12,3 +13,9 @@ See history.txt for changelog.
 See history.txt for version number, latest version is at the top.
 See INSTALL for installation procedure.
 License is LGPL (Library General Public License); see COPYING.LIB for details.
+
+Development notes/additions to end user documentation
+
+property RecNo: approximate record number. Does not take deleted records into account. Used mainly in grids.
+
+

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

@@ -972,11 +972,18 @@ var ParNr,SQLVarNr : integer;
 {$R+}
   end;
 
+Const
+  DateF = 'yyyy-mm-dd';
+  TimeF = 'hh:nn:ss';
+  DateTimeF = DateF+' '+TimeF;
+
 var
   // This should be a pointer, because the ORIGINAL variables must
   // be modified.
   VSQLVar: ^XSQLVAR;
-
+  P: TParam;
+  ft : TFieldType;
+  D : TDateTime;
 begin
 {$R-}
   with cursor as TIBCursor do for SQLVarNr := 0 to High(ParamBinding){AParams.count-1} do
@@ -1011,7 +1018,20 @@ begin
           SetBlobParam;
         SQL_VARYING, SQL_TEXT :
           begin
-          s := AParams[ParNr].AsString;
+          P:=AParams[ParNr];
+          ft:=P.DataType;
+          if Not (ft in [ftDate,ftTime,ftDateTime,ftTimeStamp]) then
+            S:=P.AsString
+          else
+            begin
+            Case ft of
+              ftDate : S:=DateF;
+              ftTime : S:=TimeF;
+              ftDateTime,
+              ftTimeStamp : S:=DateTimeF;
+            end;
+            S:=FormatDateTime(S,P.AsDateTime);
+            end;
           w := length(s); // a word is enough, since the max-length of a string in interbase is 32k
           if ((VSQLVar^.SQLType and not 1) = SQL_VARYING) then
             begin

packages/fcl-db/src/sqldb/mssql/mssqlconn.pp

@@ -931,15 +931,21 @@ begin
 end;
 
 function TMSSQLConnection.GetSchemaInfoSQL(SchemaType: TSchemaType; SchemaObjectName, SchemaObjectPattern: string): string;
-const SCHEMA_QUERY='select name as %s from sysobjects where type=''%s'' order by 1';
+const SCHEMA_QUERY='select id as RECNO, db_name() as CATALOG_NAME, user_name(uid) as SCHEMA_NAME, name as %s '+
+                   'from sysobjects '+
+                   'where type in (%s) '+
+                   'order by name';
 begin
   case SchemaType of
-    stTables     : Result := format(SCHEMA_QUERY, ['table_name','U']);
-    stSysTables  : Result := format(SCHEMA_QUERY, ['table_name','S']);
-    stProcedures : Result := format(SCHEMA_QUERY, ['proc_name','P']);
-    stColumns    : Result := 'select name as column_name from syscolumns where id=object_id(''' + SchemaObjectName + ''') order by colorder';
-  else
-    DatabaseError(SMetadataUnavailable)
+    stTables     : Result := format(SCHEMA_QUERY, ['TABLE_NAME, 1 as TABLE_TYPE', '''U''']);
+    stSysTables  : Result := format(SCHEMA_QUERY, ['TABLE_NAME, 4 as TABLE_TYPE', '''S''']);
+    stProcedures : Result := format(SCHEMA_QUERY, ['PROC_NAME , case type when ''P'' then 1 else 2 end as PROC_TYPE', '''P'',''FN'',''IF'',''TF''']);
+    stColumns    : Result := 'select colid as RECNO, db_name() as CATALOG_NAME, user_name(uid) as SCHEMA_NAME, o.name as TABLE_NAME, c.name as COLUMN_NAME,'+
+                                    'colid as COLUMN_POSITION, prec as COLUMN_PRECISION, scale as COLUMN_SCALE, length as COLUMN_LENGTH, case when c.status&8=8 then 1 else 0 end as COLUMN_NULLABLE '+
+                             'from syscolumns c join sysobjects o on c.id=o.id '+
+                             'where c.id=object_id(''' + SchemaObjectName + ''') '+
+                             'order by colid';
+    else           Result := inherited;
   end;
 end;
 

packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -686,7 +686,7 @@ begin
         NewSize := ASize;
         end;
       end;
-    FIELD_TYPE_BLOB:
+    FIELD_TYPE_TINY_BLOB..FIELD_TYPE_BLOB:
       begin
 {$IFDEF MYSQL50_UP}
       if AField^.charsetnr = 63 then //character set is binary
@@ -1049,7 +1049,7 @@ begin
           end;
       end;
       end;
-    FIELD_TYPE_BLOB:
+    FIELD_TYPE_TINY_BLOB..FIELD_TYPE_BLOB:
       CreateBlob := True;
 {$IFDEF MYSQL50_UP}
     FIELD_TYPE_BIT:

packages/fcl-db/src/sqldb/odbc/odbcconn.pas

@@ -663,14 +663,14 @@ begin
 
   // prepare statement
   ODBCCursor.FQuery:=Buf;
-  if ODBCCursor.FSchemaType=stNoSchema then
+  if not (ODBCCursor.FSchemaType in [stTables, stSysTables, stColumns, stProcedures]) then
     begin
       ODBCCheckResult(
         SQLPrepare(ODBCCursor.FSTMTHandle, PChar(buf), Length(buf)),
         SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not prepare statement.'
       );
-    end
-  else
+    end;
+  if ODBCCursor.FSchemaType <> stNoSchema then
     ODBCCursor.FStatementType:=stSelect;
 end;
 
@@ -757,12 +757,11 @@ begin
     if Assigned(APArams) and (AParams.count > 0) then SetParameters(ODBCCursor, AParams);
     // execute the statement
     case ODBCCursor.FSchemaType of
-      stNoSchema  : Res:=SQLExecute(ODBCCursor.FSTMTHandle); //SQL_NO_DATA returns searched update or delete statement that does not affect any rows
       stTables    : Res:=SQLTables (ODBCCursor.FSTMTHandle, nil, 0, nil, 0, nil, 0, TABLE_TYPE_USER, length(TABLE_TYPE_USER) );
       stSysTables : Res:=SQLTables (ODBCCursor.FSTMTHandle, nil, 0, nil, 0, nil, 0, TABLE_TYPE_SYSTEM, length(TABLE_TYPE_SYSTEM) );
       stColumns   : Res:=SQLColumns(ODBCCursor.FSTMTHandle, nil, 0, nil, 0, @ODBCCursor.FQuery[1], length(ODBCCursor.FQuery), nil, 0 );
       stProcedures: Res:=SQLProcedures(ODBCCursor.FSTMTHandle, nil, 0, nil, 0, nil, 0 );
-      else          Res:=SQL_NO_DATA;
+      else          Res:=SQLExecute(ODBCCursor.FSTMTHandle); //SQL_NO_DATA returns searched update or delete statement that does not affect any rows
     end; {case}
 
     if (Res<>SQL_NO_DATA) then ODBCCheckResult( Res, SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not execute statement.' );
@@ -1450,12 +1449,15 @@ end;
 
 function TODBCConnection.GetSchemaInfoSQL(SchemaType: TSchemaType; SchemaObjectName, SchemaObjectPattern: string): string;
 begin
-  if SchemaObjectName<>'' then
-    Result := SchemaObjectName
+  if SchemaType in [stTables, stSysTables, stColumns, stProcedures] then
+  begin
+    if SchemaObjectName<>'' then
+      Result := SchemaObjectName
+    else
+      Result := ' ';
+  end
   else
-    Result := ' ';
-  if not (SchemaType in [stNoSchema, stTables, stSysTables, stColumns, stProcedures]) then
-    DatabaseError(SMetadataUnavailable);
+    Result := inherited;
 end;
 
 function TODBCConnection.GetConnectionInfo(InfoType: TConnInfoType): string;

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

@@ -1124,7 +1124,7 @@ begin
                         'where (a.attnum>0) and (not a.attisdropped) and (upper(c.relname)=''' + Uppercase(SchemaObjectName) + ''') '+
                         'order by a.attname';
   else
-    DatabaseError(SMetadataUnavailable)
+    s := inherited;
   end; {case}
   result := s;
 end;

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

@@ -22,7 +22,7 @@ interface
 
 uses SysUtils, Classes, DB, bufdataset, sqlscript;
 
-type TSchemaType = (stNoSchema, stTables, stSysTables, stProcedures, stColumns, stProcedureParams, stIndexes, stPackages);
+type TSchemaType = (stNoSchema, stTables, stSysTables, stProcedures, stColumns, stProcedureParams, stIndexes, stPackages, stSchemata);
      TConnOption = (sqSupportParams,sqEscapeSlash,sqEscapeRepeat);
      TConnOptions= set of TConnOption;
      TConnInfoType=(citAll=-1, citServerType, citServerVersion, citServerVersionString, citClientName, citClientVersion);
@@ -149,6 +149,7 @@ type
     procedure GetTableNames(List : TStrings; SystemTables : Boolean = false); virtual;
     procedure GetProcedureNames(List : TStrings); virtual;
     procedure GetFieldNames(const TableName : string; List : TStrings); virtual;
+    procedure GetSchemaNames(List: TStrings); virtual;
     function GetConnectionInfo(InfoType:TConnInfoType): string; virtual;
     procedure CreateDB; virtual;
     procedure DropDB; virtual;
@@ -691,8 +692,10 @@ end;
 
 procedure TSQLConnection.GetTableNames(List: TStrings; SystemTables: Boolean);
 begin
-  if not systemtables then GetDBInfo(stTables,'','table_name',List)
-    else GetDBInfo(stSysTables,'','table_name',List);
+  if not SystemTables then
+    GetDBInfo(stTables,'','table_name',List)
+  else
+    GetDBInfo(stSysTables,'','table_name',List);
 end;
 
 procedure TSQLConnection.GetProcedureNames(List: TStrings);
@@ -705,6 +708,11 @@ begin
   GetDBInfo(stColumns,TableName,'column_name',List);
 end;
 
+procedure TSQLConnection.GetSchemaNames(List: TStrings);
+begin
+  GetDBInfo(stSchemata,'','SCHEMA_NAME',List);
+end;
+
 function TSQLConnection.GetConnectionInfo(InfoType: TConnInfoType): string;
 var i: TConnInfoType;
 begin
@@ -791,7 +799,10 @@ end;
 function TSQLConnection.GetSchemaInfoSQL( SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string;
 
 begin
-  DatabaseError(SMetadataUnavailable);
+  case SchemaType of
+    stSchemata: Result := 'SELECT * FROM INFORMATION_SCHEMA.SCHEMATA';
+    else DatabaseError(SMetadataUnavailable);
+  end;
 end;
 
 procedure TSQLConnection.CreateDB;

packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -885,10 +885,10 @@ begin
   IXFields:=TStringList.Create;
   IXFields.Delimiter:=';';
 
-  //primary key fields
+  //primary key fields; 5th column "pk" is zero for columns that are not part of PK
   artableinfo := stringsquery('PRAGMA table_info('+TableName+');');
   for ii:=low(artableinfo) to high(artableinfo) do
-    if (high(artableinfo[ii]) >= 5) and (artableinfo[ii][5] = '1') then
+    if (high(artableinfo[ii]) >= 5) and (artableinfo[ii][5] >= '1') then
       PKFields.Add(artableinfo[ii][1]);
 
   //list of all table indexes

packages/fcl-db/tests/README.txt

@@ -8,7 +8,8 @@ Simply add the test* units in this directory to the uses statement of the
 test runner and all tests will get registered and executed.
 
 A simple test runner (dbtestframework.pas) which generates XML output is
-included in this directory.
+included in this directory. 
+Additionally, a GUI Lazarus unit (dbtestframework_gui.lpr) is included for convenience.
 
 DBTestframework architecture
 ============================
@@ -31,11 +32,11 @@ They call InternalGetNDataset and InternalGetFieldDataset which should be implem
 Toolsunit.pas defines some variables for use, e.g.
 - testValuesCount is the number of records/test values in the FieldDataset dataset
 - MaxDataset is the same for NDataset.
-See e.g. the SQLDBToolsUnit for the implementation for SQL Databases.
+See e.g. the SQLDBToolsUnit for the implementation for SQL databases.
 
 Tests
 =====
-In your test units, you can specify that you only want to run for certain groups/connectors.
+In your test units, you can specify that you only want it to run for certain groups/connectors.
 E.g. this example to only run for Bufdataset tests:
   TTestSpecificTBufDataset = class(TTestCase)
   ...
@@ -58,9 +59,9 @@ The database can be empty: the test suite will create and delete tables etc. in
 
 Specifying databases, connector names
 =====================================
-Which connector is currently used is dependent on the 'database.ini'
+Which connector is currently used is determined by the 'database.ini'
 configuration file. Also some settings which are connector-dependent can be set
-in that file. See 'database.ini.txt' for an example.
+in that file. See 'database.ini.txt' for a template/example.
 
 The connector names to be used are derived from the connector classes.
 
@@ -68,7 +69,7 @@ For example, the SQL RDBMS connector defined in sqldbtoolsunit:
 - it has this class definition
 TSQLDBConnector = class(TDBConnector)
 - its name in database.ini is sqldb
-- incidentally, in databases.ini, more parameter such as
+- incidentally, in databases.ini, more parameters such as
 connectorparams=postgresql (which specify db type) are needed
 The parameters used depend on the connector type (sql,...)
 

packages/fcl-db/tests/bufdatasettoolsunit.pas

@@ -1,10 +1,11 @@
 unit BufDatasetToolsUnit;
 
 { Sets up bufdataset for testing.
-Tests expect Get*Dataset tho return a dataset with structure and test data, but closed.
+Tests expect Get*Dataset to return a dataset with structure and test data, but closed.
 A closed BufDataset normally has no data, so these tests won't work.
 
-To circumvent this, this unit saves the dataset contents to file and reloads them on opening using BufDataset persistence mechanism.
+To circumvent this, this unit saves the dataset contents to file and reloads them on opening
+using the BufDataset persistence mechanism.
 
 }
 {$mode objfpc}{$H+}
@@ -64,7 +65,7 @@ end;
 
 procedure TbufdatasetDBConnector.CreateNDatasets;
 begin
-// All datasets are created in InternalGet*Dataset
+  // All datasets are created in InternalGet*Dataset
 end;
 
 procedure TbufdatasetDBConnector.CreateFieldDataset;

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

@@ -160,9 +160,13 @@ hostname=127.0.0.1
 ; TDBf: DBase/FoxPro database:
 [dbf]
 connector=dbf
-
-; Give here the path where the *.dbf file can be generated
-name=/tmp
+; Connectorparams specifies table level/compatibility level:
+; 3=DBase III
+; 4=DBase IV
+; 7=Visual DBase 7 for Windows
+; 25=FoxPro
+; 30=Visual FoxPro
+connectorparams=4
 
 ; MemDS in memory dataset:
 [memds]

packages/fcl-db/tests/dbftoolsunit.pas

@@ -1,5 +1,10 @@
 unit DBFToolsUnit;
 
+{ Sets up dbf datasets for testing
+Tests expect Get*Dataset to return a dataset with structure and test data, but closed.
+Because of this, we use file-backed dbfs instead of memory backed dbfs
+}
+
 {$IFDEF FPC}
   {$mode objfpc}{$H+}
 {$ENDIF}
@@ -8,10 +13,10 @@ interface
 
 uses
   Classes, SysUtils, toolsunit,
-  db, Dbf;
+  DB, Dbf, dbf_common;
 
 type
-{ TDBFDBConnector }
+  { TDBFDBConnector }
 
   TDBFDBConnector = class(TDBConnector)
   protected
@@ -19,80 +24,162 @@ type
     procedure CreateFieldDataset; override;
     procedure DropNDatasets; override;
     procedure DropFieldDataset; override;
-    Function InternalGetNDataset(n : integer) : TDataset; override;
-    Function InternalGetFieldDataset : TDataSet; override;
+    function InternalGetNDataset(n: integer): TDataset; override;
+    function InternalGetFieldDataset: TDataSet; override;
   public
-    function GetTraceDataset(AChange : Boolean) : TDataset; override;
+    function GetTraceDataset(AChange: boolean): TDataset; override;
   end;
 
   { TDbfTraceDataset }
 
   TDbfTraceDataset = class(Tdbf)
   protected
-    procedure SetCurrentRecord(Index: Longint); override;
+    procedure SetCurrentRecord(Index: longint); override;
     procedure RefreshInternalCalcFields(Buffer: PChar); override;
     procedure InternalInitFieldDefs; override;
     procedure CalculateFields(Buffer: PChar); override;
     procedure ClearCalcFields(Buffer: PChar); override;
   end;
 
+  { TDBFAutoClean }
+  // DBF descendant that saves to a temp file and removes file when closed
+  TDBFAutoClean = class(TDBF)
+  private
+    function GetUserRequestedTableLevel: integer;
+  public
+    constructor Create;
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+  end;
+
 implementation
 
+
+
+{ TDBFAutoClean }
+
+function TDBFAutoClean.GetUserRequestedTableLevel: integer;
+  // User can specify table level as a connector param, e.g.:
+  // connectorparams=4
+  // If none given, default to DBase IV
+var
+  TableLevelProvided: integer;
+begin
+  TableLevelProvided := StrToIntDef(dbconnectorparams, 4);
+  if not (TableLevelProvided in [3, 4, 5, 7, TDBF_TABLELEVEL_FOXPRO,
+    TDBF_TABLELEVEL_VISUALFOXPRO]) then
+  begin
+    Result := -1; // hope this crashes the tests so user is alerted.
+    //Invalid tablelevel specified in connectorparams= field. Aborting
+    exit;
+  end;
+  Result := TableLevelProvided;
+end;
+
+constructor TDBFAutoClean.Create;
+var
+  DBFFileName: string;
+  TableLevelProvided: integer;
+begin
+  DBFFileName := GetTempFileName;
+  FilePathFull := ExtractFilePath(DBFFileName);
+  TableName := ExtractFileName(DBFFileName);
+  TableLevelProvided := GetUserRequestedTableLevel;
+  TableLevel := TableLevelProvided;
+  CreateTable; //write out header to disk
+end;
+
+constructor TDBFAutoClean.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  Self.Create;
+end;
+
+destructor TDBFAutoClean.Destroy;
+var
+  FileName: string;
+begin
+  FileName := AbsolutePath + TableName;
+  inherited Destroy;
+  deletefile(FileName);
+end;
+
+
 procedure TDBFDBConnector.CreateNDatasets;
-var countID,n : integer;
 begin
-  for n := 0 to MaxDataSet do
-    begin
-    with TDbf.Create(nil) do
+  // All datasets are created in InternalGet*Dataset
+end;
+
+procedure TDBFDBConnector.CreateFieldDataset;
+begin
+  // All datasets are created in InternalGet*Dataset
+end;
+
+procedure TDBFDBConnector.DropNDatasets;
+begin
+  // Nothing to be done here; the dataset is cleaned up in TDBFAutoClean.Destroy
+end;
+
+procedure TDBFDBConnector.DropFieldDataset;
+begin
+  // Nothing to be done here; the dataset is cleaned up in TDBFAutoClean.Destroy
+end;
+
+function TDBFDBConnector.InternalGetNDataset(n: integer): TDataset;
+var
+  countID: integer;
+begin
+  Result := (TDBFAutoClean.Create(nil) as TDataSet);
+  with (Result as TDBFAutoclean) do
+  begin
+    FieldDefs.Add('ID', ftInteger);
+    FieldDefs.Add('NAME', ftString, 50);
+    CreateTable;
+    Open;
+    if n > 0 then
+      for countId := 1 to n do
       begin
-      FilePath := dbname;
-      TableName := 'fpdev_'+inttostr(n)+'.db';
-      FieldDefs.Add('ID',ftInteger);
-      FieldDefs.Add('NAME',ftString,50);
-      CreateTable;
-      Open;
-      if n > 0 then for countId := 1 to n do
-        begin
         Append;
         FieldByName('ID').AsInteger := countID;
-        FieldByName('NAME').AsString := 'TestName'+inttostr(countID);
+        FieldByName('NAME').AsString := 'TestName' + IntToStr(countID);
         // Explicitly call .post, since there could be a bug which disturbs
         // the automatic call to post. (example: when TDataset.DataEvent doesn't
         // work properly)
         Post;
-        end;
-      if state = dsinsert then
-        Post;
-      Close;
-      Free;
       end;
-    end;
+    if state = dsinsert then
+      Post;
+    Close;
+  end;
 end;
 
-procedure TDBFDBConnector.CreateFieldDataset;
-var i : integer;
+function TDBFDBConnector.InternalGetFieldDataset: TDataSet;
+var
+  i: integer;
 begin
-  with TDbf.Create(nil) do
-    begin
-    FilePath := dbname;
-    TableName := 'fpdev_field.db';
-    FieldDefs.Add('ID',ftInteger);
-    FieldDefs.Add('FSTRING',ftString,10);
-    FieldDefs.Add('FSMALLINT',ftSmallint);
-    FieldDefs.Add('FINTEGER',ftInteger);
-//    FieldDefs.Add('FWORD',ftWord);
-    FieldDefs.Add('FBOOLEAN',ftBoolean);
-    FieldDefs.Add('FFLOAT',ftFloat);
-//    FieldDefs.Add('FCURRENCY',ftCurrency);
-//    FieldDefs.Add('FBCD',ftBCD);
-    FieldDefs.Add('FDATE',ftDate);
-//    FieldDefs.Add('FTIME',ftTime);
-    FieldDefs.Add('FDATETIME',ftDateTime);
-    FieldDefs.Add('FLARGEINT',ftLargeint);
+  Result := (TDbfAutoClean.Create(nil) as TDataSet);
+  with (Result as TDBFAutoClean) do
+  begin
+    FieldDefs.Add('ID', ftInteger);
+    FieldDefs.Add('FSTRING', ftString, 10);
+    FieldDefs.Add('FSMALLINT', ftSmallint);
+    FieldDefs.Add('FINTEGER', ftInteger);
+    FieldDefs.Add('FWORD', ftWord);
+    FieldDefs.Add('FBOOLEAN', ftBoolean);
+    FieldDefs.Add('FFLOAT', ftFloat);
+    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);
     CreateTable;
     Open;
-    for i := 0 to testValuesCount-1 do
-      begin
+    for i := 0 to testValuesCount - 1 do
+    begin
       Append;
       FieldByName('ID').AsInteger := i;
       FieldByName('FSTRING').AsString := testStringValues[i];
@@ -103,56 +190,25 @@ begin
       FieldByName('FDATE').AsDateTime := StrToDate(testDateValues[i], 'yyyy/mm/dd', '-');
       FieldByName('FLARGEINT').AsLargeInt := testLargeIntValues[i];
       Post;
-      end;
-    Close;
-    end;
-end;
-
-procedure TDBFDBConnector.DropNDatasets;
-var n : integer;
-begin
-  for n := 0 to MaxDataSet do
-    DeleteFile(ExtractFilePath(dbname)+'fpdev_'+inttostr(n)+'.db');
-end;
-
-procedure TDBFDBConnector.DropFieldDataset;
-begin
-  DeleteFile(ExtractFilePath(dbname)+'fpdev_field.db');
-end;
-
-function TDBFDBConnector.InternalGetNDataset(n: integer): TDataset;
-begin
-  Result := TDbf.Create(nil);
-  with (result as TDbf) do
-    begin
-    FilePath := dbname;
-    TableName := 'fpdev_'+inttostr(n)+'.db';
-    end;
-end;
-
-function TDBFDBConnector.InternalGetFieldDataset: TDataSet;
-begin
-  Result := TDbf.Create(nil);
-  with (result as TDbf) do
-    begin
-    FilePath := dbname;
-    TableName := 'fpdev_field.db';
     end;
+    Close;
+  end;
 end;
 
-function TDBFDBConnector.GetTraceDataset(AChange: Boolean): TDataset;
-var ADS, AResDS : TDbf;
+function TDBFDBConnector.GetTraceDataset(AChange: boolean): TDataset;
+var
+  ADS, AResDS: TDbf;
 begin
-  ADS := GetNDataset(AChange,15) as TDbf;
+  ADS := GetNDataset(AChange, 15) as TDbf;
   AResDS := TDbfTraceDataset.Create(nil);
-  AResDS.FilePath:=ADS.FilePath;
-  AResDs.TableName:=ADS.TableName;
-  Result:=AResDS;
+  AResDS.FilePath := ADS.FilePath;
+  AResDs.TableName := ADS.TableName;
+  Result := AResDS;
 end;
 
 { TDbfTraceDataset }
 
-procedure TDbfTraceDataset.SetCurrentRecord(Index: Longint);
+procedure TDbfTraceDataset.SetCurrentRecord(Index: longint);
 begin
   DataEvents := DataEvents + 'SetCurrentRecord' + ';';
   inherited SetCurrentRecord(Index);
@@ -165,20 +221,23 @@ begin
 end;
 
 procedure TDbfTraceDataset.InternalInitFieldDefs;
-var i : integer;
-    IntCalcFieldName : String;
+var
+  i: integer;
+  IntCalcFieldName: string;
 begin
-  // To fake a internal calculated field, set it's fielddef InternalCalcField
+  // To fake an internal calculated field, set its fielddef InternalCalcField
   // property to true, before the dataset is opened.
   // This procedure takes care of setting the automatically created fielddef's
   // InternalCalcField property to true. (works for only one field)
-  IntCalcFieldName:='';
-  for i := 0 to FieldDefs.Count -1 do
-    if fielddefs[i].InternalCalcField then IntCalcFieldName := FieldDefs[i].Name;
+  IntCalcFieldName := '';
+  for i := 0 to FieldDefs.Count - 1 do
+    if fielddefs[i].InternalCalcField then
+      IntCalcFieldName := FieldDefs[i].Name;
   inherited InternalInitFieldDefs;
-  if IntCalcFieldName<>'' then with FieldDefs.find(IntCalcFieldName) do
+  if IntCalcFieldName <> '' then
+    with FieldDefs.find(IntCalcFieldName) do
     begin
-    InternalCalcField := True;
+      InternalCalcField := True;
     end;
 end;
 
@@ -197,4 +256,3 @@ end;
 initialization
   RegisterClass(TDBFDBConnector);
 end.
-

packages/fcl-db/tests/dbtestframework.pas

@@ -25,6 +25,7 @@ uses
   TestDBBasics,
   TestBufDatasetStreams,
   TestSpecificTBufDataset,
+  TestSpecificTDBF,
   TestDBExport,
   consoletestrunner;
 

packages/fcl-db/tests/dbtestframework_gui.lpi

@@ -83,7 +83,7 @@
     </Other>
   </CompilerOptions>
   <Debugging>
-    <Exceptions Count="4">
+    <Exceptions Count="7">
       <Item1>
         <Name Value="EAbort"/>
       </Item1>
@@ -96,6 +96,15 @@
       <Item4>
         <Name Value="EIBDatabaseError"/>
       </Item4>
+      <Item5>
+        <Name Value="EDatabaseError"/>
+      </Item5>
+      <Item6>
+        <Name Value="EAssertionFailedError"/>
+      </Item6>
+      <Item7>
+        <Name Value="EIgnoredTest"/>
+      </Item7>
     </Exceptions>
   </Debugging>
 </CONFIG>

packages/fcl-db/tests/dbtestframework_gui.lpr

@@ -29,12 +29,14 @@ uses
   TestDatasources,
   TestBufDatasetStreams,
   TestSpecificTBufDataset,
+  TestSpecificTDBF,
   TestDBExport;
 
 {$R *.res}
 
 var
   DBSelectForm: TFormIniEditor;
+  TestRunForm: TGUITestRunner;
 begin
   Application.Initialize;
   DBSelectForm:=TFormIniEditor.Create(nil);
@@ -47,7 +49,14 @@ begin
   finally
     DBSelectForm.Free;
   end;
-  Application.CreateForm(TGuiTestRunner, TestRunner);
-  Application.Run;
+  // Manually run this form because autocreation could have loaded an old
+  // database.ini file (if the user changed it using DBSelectForm)
+  TestRunForm:=TGUITestRunner.Create(nil);
+  try
+    TestRunForm.Show;
+    Application.Run;
+  finally
+    TestRunForm.Free;
+  end;
 end.
 

packages/fcl-db/tests/testdatasources.pas

@@ -365,7 +365,7 @@ begin
     open;
     AssertTrue(THackDataset(ds).InternalCalcFields);
     // If there are InternalCalcFields and 'normal' Calculated fields, only
-    // RefreshIntenralCalcFields is called
+    // RefreshInternalCalcFields is called
     AFld := FieldByName('id');
     DataEvents := '';
     THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
@@ -377,7 +377,7 @@ begin
     THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
     AssertEquals('deFieldChange:NAME;',DataEvents);
 
-    // If the TDataset.State is dsSetKey then IntenralCalcFields shoudn't get called
+    // If the TDataset.State is dsSetKey then InternalCalcFields shoudn't get called
     THackDataset(ds).SetState(dsSetKey);
     AFld := FieldByName('id');
     DataEvents := '';

packages/fcl-db/tests/testspecifictdbf.pas

@@ -0,0 +1,285 @@
+unit testspecifictdbf;
+
+{
+  Unit tests which are specific to the tdbf dbase units.
+}
+
+{$IFDEF FPC}
+{$mode Delphi}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+{$IFDEF FPC}
+  fpcunit, testutils, testregistry, testdecorator,
+{$ELSE FPC}
+  TestFramework,
+{$ENDIF FPC}
+  Classes, SysUtils,
+  db, dbf, dbf_common, ToolsUnit, DBFToolsUnit;
+
+type
+
+  { TTestSpecificTDBF }
+
+  TTestSpecificTDBF = class(TTestCase)
+  private
+    procedure WriteReadbackTest(ADBFDataset: TDbf; AutoInc: boolean = false);
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  published
+    // Create fields using indexdefs:
+    procedure TestCreateDatasetFromFielddefs;
+    // Specifying fields from field objects
+    procedure TestCreateDatasetFromFields;
+    // Tries to open a dbf that has not been activated, which should fail:
+    procedure TestOpenNonExistingDataset_Fails;
+    // Tests creating a new database with calculated/lookup fields
+    procedure TestCreationDatasetWithCalcFields;
+    procedure TestAutoIncField;
+    // Tests findfirst moves to first record
+    procedure TestFindFirst;
+    // Tests findlast moves to last record
+    procedure TestFindLast;
+    // Tests findnext moves to next record
+    procedure TestFindNext;
+    // Tests findprior
+    procedure TestFindPrior;
+  end;
+
+
+implementation
+
+uses
+  variants,
+  FmtBCD;
+
+{ TTestSpecificTDBF }
+
+procedure TTestSpecificTDBF.WriteReadbackTest(ADBFDataset: TDbf;
+  AutoInc: boolean);
+var
+  i  : integer;
+begin
+  for i := 1 to 10 do
+    begin
+    ADBFDataset.Append;
+    if not AutoInc then
+      ADBFDataset.FieldByName('ID').AsInteger := i;
+    ADBFDataset.FieldByName('NAME').AsString := 'TestName' + inttostr(i);
+    ADBFDataset.Post;
+    end;
+  ADBFDataset.first;
+  for i := 1 to 10 do
+    begin
+    CheckEquals(i,ADBFDataset.fieldbyname('ID').asinteger);
+    CheckEquals('TestName' + inttostr(i),ADBFDataset.fieldbyname('NAME').AsString);
+    ADBFDataset.next;
+    end;
+  CheckTrue(ADBFDataset.EOF);
+end;
+
+
+procedure TTestSpecificTDBF.SetUp;
+begin
+  DBConnector.StartTest;
+end;
+
+procedure TTestSpecificTDBF.TearDown;
+begin
+  DBConnector.StopTest;
+end;
+
+procedure TTestSpecificTDBF.TestCreateDatasetFromFielddefs;
+var
+  ds : TDBF;
+begin
+  ds := TDBFAutoClean.Create(nil);
+  DS.FieldDefs.Add('ID',ftInteger);
+  DS.FieldDefs.Add('NAME',ftString,50);
+  DS.CreateTable;
+  DS.Open;
+  WriteReadbackTest(ds);
+  DS.Close;
+  ds.free;
+end;
+
+procedure TTestSpecificTDBF.TestCreateDatasetFromFields;
+var
+  ds : TDBF;
+  f: TField;
+begin
+  ds := TDBFAutoClean.Create(nil);
+  F := TIntegerField.Create(ds);
+  F.FieldName:='ID';
+  F.DataSet:=ds;
+  F := TStringField.Create(ds);
+  F.FieldName:='NAME';
+  F.DataSet:=ds;
+  F.Size:=50;
+  DS.CreateTable;
+  DS.Open;
+  ds.free;
+end;
+
+procedure TTestSpecificTDBF.TestOpenNonExistingDataset_Fails;
+var
+  ds : TDBF;
+  f: TField;
+begin
+  ds := TDBFAutoClean.Create(nil);
+  F := TIntegerField.Create(ds);
+  F.FieldName:='ID';
+  F.DataSet:=ds;
+
+  CheckException(ds.Open,EDbfError);
+  ds.Free;
+
+  ds := TDBFAutoClean.Create(nil);
+  DS.FieldDefs.Add('ID',ftInteger);
+
+  CheckException(ds.Open,EDbfError);
+  ds.Free;
+end;
+
+procedure TTestSpecificTDBF.TestCreationDatasetWithCalcFields;
+var
+  ds : TDBF;
+  f: TField;
+  i: integer;
+begin
+  //todo: find out which tablelevels support calculated/lookup fields
+  ds := TDBFAutoClean.Create(nil);
+  try
+    F := TIntegerField.Create(ds);
+    F.FieldName:='ID';
+    F.DataSet:=ds;
+
+    F := TStringField.Create(ds);
+    F.FieldName:='NAME';
+    F.DataSet:=ds;
+    F.Size:=50;
+
+    F := TStringField.Create(ds);
+    F.FieldKind:=fkCalculated;
+    F.FieldName:='NAME_CALC';
+    F.DataSet:=ds;
+    F.Size:=50;
+
+    F := TStringField.Create(ds);
+    F.FieldKind:=fkLookup;
+    F.FieldName:='NAME_LKP';
+    F.LookupDataSet:=DBConnector.GetNDataset(5);
+    F.KeyFields:='ID';
+    F.LookupKeyFields:='ID';
+    F.LookupResultField:='NAME';
+    F.DataSet:=ds;
+    F.Size:=50;
+
+    DS.CreateTable;
+    DS.Open;
+    WriteReadbackTest(ds);
+
+    for i := 0 to ds.FieldDefs.Count-1 do
+      begin
+      CheckNotEquals(ds.FieldDefs[i].Name,'NAME_CALC');
+      CheckNotEquals(ds.FieldDefs[i].Name,'NAME_LKP');
+      end;
+    DS.Close;
+  finally
+    ds.Free;
+  end;
+end;
+
+procedure TTestSpecificTDBF.TestAutoIncField;
+var
+  ds : TDbf;
+  f: TField;
+begin
+  ds := TDbfAutoClean.Create(nil);
+  if ds.TableLevel<7 then
+  begin
+    Ignore('Autoinc fields are only supported in tablelevel 7 and higher');
+  end;
+
+  F := TAutoIncField.Create(ds);
+  F.FieldName:='ID';
+  F.DataSet:=ds;
+
+  F := TStringField.Create(ds);
+  F.FieldName:='NAME';
+  F.DataSet:=ds;
+  F.Size:=50;
+
+  DS.CreateTable;
+  DS.Open;
+
+  WriteReadbackTest(ds,True);
+  DS.Close;
+  ds.Free;
+end;
+
+procedure TTestSpecificTDBF.TestFindFirst;
+const
+  NumRecs=8;
+var
+  DS: TDataSet;
+begin
+  DS:=DBConnector.GetNDataset(NumRecs);
+  DS.Open;
+  DS.Last;
+  CheckEquals(true,DS.FindFirst,'Findfirst should return true');
+  CheckEquals(1,DS.fieldbyname('ID').asinteger);
+end;
+
+procedure TTestSpecificTDBF.TestFindLast;
+const
+  NumRecs=8;
+var
+  DS: TDataSet;
+begin
+  DS:=DBConnector.GetNDataset(NumRecs);
+  DS.Open;
+  DS.First;
+  CheckEquals(true,DS.FindLast,'Findlast should return true');
+  CheckEquals(NumRecs,DS.fieldbyname('ID').asinteger);
+end;
+
+procedure TTestSpecificTDBF.TestFindNext;
+const
+  NumRecs=8;
+var
+  DS: TDataSet;
+begin
+  DS:=DBConnector.GetNDataset(NumRecs);
+  DS.Open;
+  DS.First;
+  CheckEquals(true,DS.FindNext,'FindNext should return true');
+  CheckEquals(2,DS.fieldbyname('ID').asinteger);
+end;
+
+procedure TTestSpecificTDBF.TestFindPrior;
+const
+  NumRecs=8;
+var
+  DS: TDataSet;
+begin
+  DS:=DBConnector.GetNDataset(NumRecs);
+  DS.Open;
+  DS.Last;
+  CheckEquals(true,DS.FindPrior,'FindPrior should return true');
+  CheckEquals(NumRecs-1,DS.fieldbyname('ID').asinteger);
+end;
+
+
+
+initialization
+{$ifdef fpc}
+  if uppercase(dbconnectorname)='DBF' then
+    begin
+    RegisterTestDecorator(TDBBasicsTestSetup, TTestSpecificTDBF);
+    end;
+{$endif fpc}
+end.

packages/fcl-db/tests/toolsunit.pas

@@ -59,7 +59,8 @@ type
        Function GetNDataset(AChange : Boolean; n : integer) : TDataset;  overload;
        Function GetFieldDataset : TDataSet; overload;
        Function GetFieldDataset(AChange : Boolean) : TDataSet; overload;
-       
+
+       // Gets a dataset that tracks calculation of calculated fields etc.
        Function GetTraceDataset(AChange : Boolean) : TDataset; virtual;
 
        procedure StartTest;