--- Merging r25106 into '.':

A    packages/fcl-db/examples/dbftool.lpr
A    packages/fcl-db/examples/dbftool.lpi
--- Merging r25124 into '.':
U    packages/fcl-db/src/dbase/readme.txt
--- Merging r25125 into '.':
U    packages/fcl-db/src/dbase/dbf_lang.pas
--- Merging r25163 into '.':
U    packages/fcl-db/tests/testfieldtypes.pas
--- Merging r25165 into '.':
U    packages/fcl-db/src/sqldb/sqldb.pp
--- Merging r25166 into '.':
G    packages/fcl-db/src/sqldb/sqldb.pp
--- Merging r25173 into '.':
U    packages/fcl-db/src/base/dataset.inc
--- Merging r25174 into '.':
U    packages/fcl-db/tests/testdbbasics.pas
G    packages/fcl-db/src/base/dataset.inc
--- Merging r25215 into '.':
G    packages/fcl-db/tests/testfieldtypes.pas
--- Merging r25216 into '.':
G    packages/fcl-db/tests/testfieldtypes.pas
--- Merging r25233 into '.':
U    packages/fcl-db/src/base/dsparams.inc

# revisions: 25106,25124,25125,25163,25165,25166,25173,25174,25215,25216,25233
r25106 | reiniero | 2013-07-15 13:49:36 +0200 (Mon, 15 Jul 2013) | 2 lines
Changed paths:
   A /trunk/packages/fcl-db/examples/dbftool.lpi
   A /trunk/packages/fcl-db/examples/dbftool.lpr

fcl-db: example program that shows creating, using dbf as well as exporting using dbexport
r25124 | reiniero | 2013-07-17 13:48:03 +0200 (Wed, 17 Jul 2013) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/readme.txt

fcl-db: cosmetic: dbase: add reference to language IDs/codepages for DBaseIV
r25125 | reiniero | 2013-07-17 13:57:20 +0200 (Wed, 17 Jul 2013) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf_lang.pas

fcl-db: dbase: Remove erroneous language ID $20 Czech as it does not appear in references. Fixes issue #0024730: Incorrect dbf Language ID to Locale convert table for Czech locale Windows
r25163 | lacak | 2013-07-23 13:11:24 +0200 (Tue, 23 Jul 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/tests/testfieldtypes.pas

fcl-db: tests: formatting (reorder methods, so related tests are together)
r25165 | lacak | 2013-07-24 12:40:08 +0200 (Wed, 24 Jul 2013) | 3 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/sqldb.pp

fcl-db: sqldb: - Move private method "GetStatementInfo" to protected and make it virtual to allow TSQLConnection descendants override it
- Rename new property "CheckParams" to "ParamCheck" to align with other components such as Zeos, IBObjects, IBX, ADODB, ElevateDB, SQLMemTable and many others.
r25166 | lacak | 2013-07-24 13:02:02 +0200 (Wed, 24 Jul 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/sqldb.pp

fcl-db: sqldb: formatting
r25173 | lacak | 2013-07-26 09:14:12 +0200 (Fri, 26 Jul 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/base/dataset.inc

fcl-db: base: formatting (unification char-case)
r25174 | lacak | 2013-07-26 09:34:07 +0200 (Fri, 26 Jul 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/base/dataset.inc
   M /trunk/packages/fcl-db/tests/testdbbasics.pas

fcl-db: base: for UniDirectional DataSet initialize  BufferCount=1; + adapt also test (checked with Delphi, where for UniDirectional sql dataset (f.e.TSQLTable) on Next is also generated deDataSetScroll:-1 not deDataSetScroll:0)
r25215 | reiniero | 2013-08-05 10:41:54 +0200 (Mon, 05 Aug 2013) | 3 lines
Changed paths:
   M /trunk/packages/fcl-db/tests/testfieldtypes.pas

* fcl-db: dbtestframework: add test for parameter .AsFloat; bug #24728
  Memory Leak in DataSet Parameter Binding
r25216 | reiniero | 2013-08-05 11:13:46 +0200 (Mon, 05 Aug 2013) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/tests/testfieldtypes.pas

* revert previous commit - was due to a misunderstanding: TestFloatParamQuery already covers the bug.
r25233 | reiniero | 2013-08-11 12:14:04 +0200 (Sun, 11 Aug 2013) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/base/dsparams.inc

* fcl-db: TParam.SetAs***: set variant datatype before value assignment. Mantis #24728. Patch by Andrew Brunner.

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

.gitattributes

@@ -1799,6 +1799,8 @@ packages/fcl-base/tests/tests_fptemplate.pp svneol=native#text/plain
 packages/fcl-base/texts/fptemplate.txt svneol=native#text/plain
 packages/fcl-db/Makefile svneol=native#text/plain
 packages/fcl-db/Makefile.fpc svneol=native#text/plain
+packages/fcl-db/examples/dbftool.lpi svneol=native#text/plain
+packages/fcl-db/examples/dbftool.lpr svneol=native#text/plain
 packages/fcl-db/examples/fbadmindemo.pp svneol=native#text/plain
 packages/fcl-db/examples/fbeventstest.pp svneol=native#text/plain
 packages/fcl-db/examples/loadlibdemo.lpi svneol=native#text/plain

packages/fcl-db/examples/dbftool.lpi

@@ -0,0 +1,72 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="DBFTool"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <CommandLineParams Value="--createdemo"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="dbftool.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="dbftool"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="dbftool"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Other>
+      <CompilerMessages>
+        <MsgFileName Value=""/>
+      </CompilerMessages>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-db/examples/dbftool.lpr

@@ -0,0 +1,574 @@
+program dbftool;
+
+{ Reads and exports DBF files. Can create a demo DBF file to test with.
+
+Demonstrates creating DBF tables, filling it with data,
+and exporting datasets.
+}
+
+{$mode objfpc}{$H+}
+
+uses {$IFDEF UNIX} {$IFDEF UseCThreads}
+  cthreads, {$ENDIF} {$ENDIF}
+  Classes,
+  SysUtils,
+  CustApp,
+  DB,
+  dbf,
+  dbf_fields,
+  dbf_common,
+  dateutils,
+  fpdbexport,
+  fpcsvexport,
+  fpdbfexport,
+  fpfixedexport,
+  fprtfexport,
+  fpsimplejsonexport,
+  fpsimplexmlexport,
+  fpsqlexport,
+  fptexexport,
+  fpxmlxsdexport;
+
+
+type
+
+  { TDBFTool }
+
+  TDBFTool = class(TCustomApplication)
+  private
+    procedure ExportDBF(var MyDbf: TDbf);
+  protected
+    procedure DoRun; override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure WriteHelp; virtual;
+  end;
+
+  procedure CreateDemoDBFs(Directory: string; TableLevel: integer);
+  // Creates 2 demonstration DBFs in Directory with dbase compatibility level
+  // TableLevel
+  // and specified codepage (if not CODEPAGE_NOT_SPECIFIED)
+  var
+    NewDBF: TDBF;
+    i: integer;
+  begin
+
+    NewDBF := TDBF.Create(nil);
+    try
+      if Directory = '' then
+        NewDBF.FilePath := '' { application directory}
+      else
+        NewDBF.FilePathFull := ExpandFileName(Directory) {full absolute path};
+      if TableLevel <= 0 then
+        NewDBF.TableLevel := 4 {default to DBase IV}
+      else
+        NewDBF.TableLevel := TableLevel;
+
+      NewDBF.TableName := 'CUSTOMER.DBF';
+      writeln('Creating ', NewDBF.TableName, ' with table level ', NewDBF.TableLevel);
+      if TableLevel >= 30 then
+      begin
+        NewDBF.FieldDefs.Add('CUST_NO', ftAutoInc);
+      end
+      else
+        NewDBF.FieldDefs.Add('CUST_NO', ftInteger);
+      NewDBF.FieldDefs.Add('CUSTOMER', ftString, 25);
+      NewDBF.FieldDefs.Add('CITY', ftString, 25);
+      NewDBF.FieldDefs.Add('COUNTRY', ftString, 15);
+      NewDBF.CreateTable;
+      NewDBF.Open;
+
+      for i := 1 to 5 do //keep size manageable until we have working files
+      begin
+        NewDBF.Append;
+        if (NewDBF.FieldDefs.Find('CUST_NO').DataType <> ftAutoInc) then
+          NewDBF.FieldByName('CUST_NO').AsInteger := i;
+        case i of
+          1:
+          begin
+            NewDBF.FieldByName('CUSTOMER').AsString := 'Michael Design';
+            NewDBF.FieldByName('CITY').AsString := 'San Diego';
+            NewDBF.FieldByName('COUNTRY').AsString := 'USA';
+          end;
+          2:
+          begin
+            NewDBF.FieldByName('CUSTOMER').AsString := 'Michael Design';
+            NewDBF.FieldByName('CITY').AsString := 'San Diego';
+            NewDBF.FieldByName('COUNTRY').AsString := 'USA';
+          end;
+          3:
+          begin
+            NewDBF.FieldByName('CUSTOMER').AsString := 'VC Technologies';
+            NewDBF.FieldByName('CITY').AsString := 'Dallas';
+            NewDBF.FieldByName('COUNTRY').AsString := 'USA';
+          end;
+          4:
+          begin
+            NewDBF.FieldByName('CUSTOMER').AsString := 'Klämpfl, Van Canneyt';
+            NewDBF.FieldByName('CITY').AsString := 'Boston';
+            NewDBF.FieldByName('COUNTRY').AsString := 'USA';
+          end;
+          5:
+          begin
+            NewDBF.FieldByName('CUSTOMER').AsString := 'Felipe Bank';
+            NewDBF.FieldByName('CITY').AsString := 'Manchester';
+            NewDBF.FieldByName('COUNTRY').AsString := 'England';
+          end;
+        end;
+        NewDBF.Post;
+      end;
+      NewDBF.Close;
+    finally
+      NewDBF.Free;
+    end;
+
+    NewDBF := TDBF.Create(nil);
+    try
+      if Directory = '' then
+        NewDBF.FilePath := '' { application directory}
+      else
+        NewDBF.FilePathFull := ExpandFileName(Directory) {full absolute path};
+      if TableLevel <= 0 then
+        NewDBF.TableLevel := 4 {default to DBase IV}
+      else
+        NewDBF.TableLevel := TableLevel;
+
+      NewDBF.TableName := 'EMPLOYEE.DBF';
+      writeln('Creating ', NewDBF.TableName, ' with table level ', NewDBF.TableLevel);
+      if TableLevel >= 30 then
+      begin
+        NewDBF.FieldDefs.Add('EMP_NO', ftAutoInc);
+      end
+      else
+        NewDBF.FieldDefs.Add('EMP_NO', ftInteger);
+      NewDBF.FieldDefs.Add('FIRST_NAME', ftString, 15);
+      NewDBF.FieldDefs.Add('LAST_NAME', ftString, 20);
+      NewDBF.FieldDefs.Add('PHONE_EXT', ftString, 4);
+      NewDBF.FieldDefs.Add('JOB_CODE', ftString, 5);
+      NewDBF.FieldDefs.Add('JOB_GRADE', ftInteger);
+      NewDBF.FieldDefs.Add('JOB_COUNTR', ftString, 15); //Note 10 character limit for table/field names in most DBases
+      NewDBF.FieldDefs.Add('SALARY', ftFloat);
+      NewDBF.CreateTable;
+      NewDBF.Open;
+
+      for i := 1 to 5 do //keep size manageable until we have working files
+      begin
+        NewDBF.Append;
+        if (NewDBF.FieldDefs.Find('EMP_NO').DataType <> ftAutoInc) then
+          NewDBF.FieldByName('EMP_NO').AsInteger := i;
+        case i of
+          1:
+          begin
+            NewDBF.FieldByName('FIRST_NAME').AsString := 'William';
+            NewDBF.FieldByName('LAST_NAME').AsString := 'Shatner';
+            NewDBF.FieldByName('PHONE_EXT').AsString := '1702';
+            NewDBF.FieldByName('JOB_CODE').AsString := 'CEO';
+            NewDBF.FieldByName('JOB_GRADE').AsInteger := 1;
+            NewDBF.FieldByName('JOB_COUNTR').AsString := 'USA';
+            NewDBF.FieldByName('SALARY').AsFloat := 48000;
+          end;
+          2:
+          begin
+            NewDBF.FieldByName('FIRST_NAME').AsString := 'Ivan';
+            NewDBF.FieldByName('LAST_NAME').AsString := 'Ishenin';
+            NewDBF.FieldByName('PHONE_EXT').AsString := '9802';
+            NewDBF.FieldByName('JOB_CODE').AsString := 'Eng';
+            NewDBF.FieldByName('JOB_GRADE').AsInteger := 2;
+            NewDBF.FieldByName('JOB_COUNTR').AsString := 'Russia';
+            NewDBF.FieldByName('SALARY').AsFloat := 38000;
+          end;
+          3:
+          begin
+            NewDBF.FieldByName('FIRST_NAME').AsString := 'Erin';
+            NewDBF.FieldByName('LAST_NAME').AsString := 'Powell';
+            NewDBF.FieldByName('PHONE_EXT').AsString := '1703';
+            NewDBF.FieldByName('JOB_CODE').AsString := 'Admin';
+            NewDBF.FieldByName('JOB_GRADE').AsInteger := 2;
+            NewDBF.FieldByName('JOB_COUNTR').AsString := 'USA';
+            NewDBF.FieldByName('SALARY').AsFloat := 45368;
+          end;
+          4:
+          begin
+            NewDBF.FieldByName('FIRST_NAME').AsString := 'Margaret';
+            NewDBF.FieldByName('LAST_NAME').AsString := 'Tetchy';
+            NewDBF.FieldByName('PHONE_EXT').AsString := '3804';
+            NewDBF.FieldByName('JOB_CODE').AsString := 'Eng';
+            NewDBF.FieldByName('JOB_GRADE').AsInteger := 3;
+            NewDBF.FieldByName('JOB_COUNTR').AsString := 'England';
+            NewDBF.FieldByName('SALARY').AsFloat := 28045;
+          end;
+          5:
+          begin
+            NewDBF.FieldByName('FIRST_NAME').AsString := 'Sergey';
+            NewDBF.FieldByName('LAST_NAME').AsString := 'Bron';
+            NewDBF.FieldByName('PHONE_EXT').AsString := '3807';
+            NewDBF.FieldByName('JOB_CODE').AsString := 'Admin';
+            NewDBF.FieldByName('JOB_GRADE').AsInteger := 3;
+            NewDBF.FieldByName('JOB_COUNTR').AsString := 'England';
+            NewDBF.FieldByName('SALARY').AsFloat := 24468;
+          end;
+        end;
+        NewDBF.Post;
+      end;
+      NewDBF.Close;
+    finally
+      NewDBF.Free;
+    end;
+  end;
+
+  procedure GetDBFList(Results: TStringList);
+  // Gets list of all .dbf files in a directory and its subdirectories.
+  var
+    r: TSearchRec;
+  begin
+    results.Clear;
+    if FindFirst('*.dbf', faAnyFile -
+{$WARNINGS OFF}
+      faVolumeID - faSymLink
+{$WARNINGS ON}
+      , r) = 0 then
+    begin
+      repeat
+        if (r.Attr and faDirectory) <> faDirectory then
+        begin
+          results.add(expandfilename(r.Name));
+        end;
+      until (FindNext(r) <> 0);
+      findclose(r);
+    end;
+  end;
+
+  function BinFieldToHex(BinarySource: TField): string;
+    // Convert binary field contents to strings with hexadecimal representation.
+    // Useful for displaying binary field contents.
+  var
+    HexValue: PChar;
+  begin
+    Result := '';
+    HexValue := StrAlloc(Length(BinarySource.AsBytes));
+    try
+      try
+        BinToHex(PChar(BinarySource.AsBytes), HexValue, Length(BinarySource.AsBytes));
+        Result := 'size: ' + IntToStr(Length(BinarySource.AsBytes)) + '; hex: ' + HexValue;
+      except
+        on E: Exception do
+        begin
+          Result := 'exception: ' + E.ClassName + '/' + E.Message;
+        end;
+      end;
+    finally
+      StrDispose(HexValue);
+    end;
+  end;
+
+  procedure PrintRecord(DBf: TDBf; RecordNumber: integer);
+  // Prints contents of a record to screen
+  var
+    i: integer;
+  begin
+    writeln('Record ' + IntToStr(RecordNumber));
+    for i := 0 to DBf.Fields.Count - 1 do
+    begin
+      if DBF.fields[i].IsNull then
+        writeln('Field ', DBf.Fields[i].FieldName, ' is          ***NULL***')
+      else
+      if DBF.Fields[i].DataType in [ftVarBytes, ftBytes] then
+        writeln('Field ', DBF.Fields[i].FieldName, ' has value: binary ' + BinFieldToHex(DBF.Fields[i]))
+      else
+        writeln('Field ', DBf.Fields[i].FieldName, ' has value: ' + DBf.fields[i].AsString);
+    end;
+  end;
+
+  { TDBFTool }
+
+  procedure TDBFTool.ExportDBF(var MyDbf: TDbf);
+  // Exports recordset to another format depending on user selection
+  var
+    ExportFormatText: string;
+    ExportSettings: TCustomExportFormatSettings;
+    Exporter: TCustomFileExporter;
+  begin
+    ExportFormatText := UpperCase(GetOptionValue('exportformat'));
+    try
+      case ExportFormatText of
+        'ACCESS', 'MSACCESS':
+        begin
+          Exporter := TXMLXSDExporter.Create(nil);
+          ExportSettings := TXMLXSDFormatSettings.Create(true);
+          (ExportSettings as TXMLXSDFormatSettings).CreateXSD := true;
+          (ExportSettings as TXMLXSDFormatSettings).ExportFormat :=
+            AccessCompatible;
+          (ExportSettings as TXMLXSDFormatSettings).DecimalSeparator := '.';
+          Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.xml');
+        end;
+        'ADO', 'ADONET', 'ADO.NET':
+        begin
+          Exporter := TXMLXSDExporter.Create(nil);
+          ExportSettings := TXMLXSDFormatSettings.Create(true);
+          (ExportSettings as TXMLXSDFormatSettings).CreateXSD := true;
+          (ExportSettings as TXMLXSDFormatSettings).ExportFormat :=
+            ADONETCompatible;
+          (ExportSettings as TXMLXSDFormatSettings).DecimalSeparator := '.';
+          Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.xml');
+        end;
+        'CSVEXCEL', 'EXCELCSV', 'CREATIVYST':
+        begin
+          Exporter := TCSVExporter.Create(nil);
+          ExportSettings := TCSVFormatSettings.Create(true);
+          (ExportSettings as TCSVFormatSettings).RowDelimiter:=LineEnding;
+          //todo: delimiter?
+          Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.csv');
+        end;
+        'CSV', 'CSVRFC4180', 'CSVLIBRE', 'CSVLIBREOFFICE':
+        begin
+          Exporter := TCSVExporter.Create(nil);
+          ExportSettings := TCSVFormatSettings.Create(true);
+          (ExportSettings as TCSVFormatSettings).DecimalSeparator := '.';
+          (ExportSettings as TCSVFormatSettings).StringQuoteChar := '"';
+          Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.csv');
+        end;
+        'DATASET', 'DELPHI':
+        begin
+          Exporter := TXMLXSDExporter.Create(nil);
+          ExportSettings := TXMLXSDFormatSettings.Create(true);
+          (ExportSettings as TXMLXSDFormatSettings).ExportFormat :=
+            DelphiClientDataset;
+          (ExportSettings as TXMLXSDFormatSettings).DecimalSeparator := '.';
+          Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.xml');
+        end;
+        'EXCEL', 'EXCELXML':
+        begin
+          Exporter := TXMLXSDExporter.Create(nil);
+          ExportSettings := TXMLXSDFormatSettings.Create(true);
+          (ExportSettings as TXMLXSDFormatSettings).ExportFormat := ExcelCompatible;
+          (ExportSettings as TXMLXSDFormatSettings).DecimalSeparator := '.';
+          Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.xml');
+        end;
+        'JSON':
+        begin
+          Exporter := TSimpleJSONExporter.Create(nil);
+          ExportSettings := TSimpleJSONFormatSettings.Create(true);
+          Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.json');
+        end;
+        'SIMPLEXML', 'XML':
+        begin
+          Exporter := TSimpleXMLExporter.Create(nil);
+          ExportSettings := TSimpleXMLFormatSettings.Create(true);
+          Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.xml');
+        end;
+        'RTF':
+        begin
+          Exporter := TRTFExporter.Create(nil);
+          ExportSettings := TSimpleXMLFormatSettings.Create(true);
+          Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.rtf');
+        end;
+        'SQL':
+        begin
+          Exporter := TSQLExporter.Create(nil);
+          ExportSettings := TSQLFormatSettings.Create(true);
+          (ExportSettings as TSQLFormatSettings).QuoteChar := '"';
+          (ExportSettings as TSQLFormatSettings).DecimalSeparator := '.';
+          (ExportSettings as TSQLFormatSettings).TableName := ChangeFileExt(MyDBF.TableName,'');
+          (ExportSettings as TSQLFormatSettings).DateFormat := 'yyyy"-"mm"-"dd'; //ISO 8601, yyyy-mm-dd
+          (ExportSettings as TSQLFormatSettings).TimeFormat := 'hh":"nn":"ss';   //ISO 8601, hh:mm:ss;
+          (ExportSettings as TSQLFormatSettings).DateTimeFormat :=
+            (ExportSettings as TSQLFormatSettings).DateFormat + '"T"' + (ExportSettings as TSQLFormatSettings).TimeFormat; //ISO 8601
+          Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.sql');
+        end;
+        'TEX', 'LATEX':
+        begin
+          Exporter := TTeXExporter.Create(nil);
+          ExportSettings := TTeXExportFormatSettings.Create(true);
+          Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.tex');
+        end;
+        'TEXT', 'FIXED', 'FIXEDTEXT':
+        begin
+          Exporter := TFixedLengthExporter.Create(nil);
+          ExportSettings := nil;
+          Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.txt');
+        end
+        else
+        begin
+          writeln('***Error: Unknown export format ' + ExportFormatText + ' specified' + '. Aborting');
+          Exporter := nil;
+          ExportSettings := nil;
+          Terminate;
+          Exit;
+        end;
+      end;
+      if assigned(ExportSettings) then
+        Exporter.FormatSettings := ExportSettings;
+      Exporter.Dataset := MyDBF;
+      MyDBF.First; // we've just read the last record - make sure export starts at beginning
+      Exporter.Execute;
+      writeln('Completed export to ' + Exporter.FileName);
+    finally
+      if assigned(Exporter) then
+        Exporter.Free;
+      if assigned(ExportSettings) then
+        ExportSettings.Free;
+    end;
+  end;
+
+  procedure TDBFTool.DoRun;
+  var
+    DBFs: TStringList;
+    Demo: boolean;
+    ErrorMsg: string;
+    FileNo: integer;
+    MyDbf: TDbf;
+    RecCount: integer;
+    TableLevel: integer; //todo: use it
+  begin
+    // quick check parameters
+    ErrorMsg := CheckOptions('h', 'codepage: createdemo exportformat: help tablelevel:');
+    if ErrorMsg <> '' then
+    begin
+      ShowException(Exception.Create(ErrorMsg));
+      Terminate;
+      Exit;
+    end;
+
+    // parse parameters
+    if HasOption('h', 'help') then
+    begin
+      WriteHelp;
+      Terminate;
+      Exit;
+    end;
+
+    DBFs := TStringList.Create;
+    try
+      Demo := false;
+      if HasOption('createdemo') then
+        Demo := true;
+
+      TableLevel := 4; //DBF
+      if HasOption('tablelevel') then
+        TableLevel := StrToIntDef(GetOptionValue('tablelevel'), 4);
+
+      if Demo then
+      begin
+        try
+          CreateDemoDBFs('', TableLevel);
+        except
+          on E: Exception do
+          begin
+            writeln('*** Error creating demo databases: ' + E.Message);
+            Terminate;
+            Exit;
+          end;
+        end;
+      end;
+
+      // Process all dbfs if no files specified
+      if DBFs.Count = 0 then
+        GetDBFList(DBFs);
+
+      if DBFs.Count = 0 then
+        writeln('Could not find any dbf files');
+
+      for FileNo := 0 to DBFs.Count - 1 do
+      begin
+        if not (fileexists(DBFs[FileNo])) then
+        begin
+          // for some reason, fpc trunk suddenly returns the directory as well...
+          //writeln('Sorry, file ',DBFs[FileNo],' does not exist.');
+          break;
+        end;
+        MyDbf := TDbf.Create(nil);
+        try
+          try
+            MyDbf.FilePath := ExtractFilePath(DBFs[FileNo]);
+            MyDbf.TableName := ExtractFileName(DBFs[FileNo]);
+            MyDbf.ReadOnly := true;
+            writeln('*** Opening: ' + DBFs[FileNo]);
+            MyDbf.Open;
+            writeln('Database tablelevel: ' + IntToStr(MyDbf.TableLevel));
+            writeln('Database codepage:   ' + IntToStr(MyDBF.CodePage));
+
+            RecCount := 1;
+            while not (MyDbf.EOF) do
+            begin
+              PrintRecord(MyDBF, RecCount);
+              MyDBF.Next;
+              RecCount := RecCount + 1;
+              writeln('');
+            end;
+
+            if HasOption('exportformat') then
+            begin
+              try
+                ExportDBF(MyDbf);
+              except
+                on E: Exception do
+                begin
+                  writeln('*** Problem exporting file ', FileNo, ': ', E.Message);
+                end;
+              end;
+            end;
+
+            MyDbf.Close;
+          except
+            on E: Exception do
+            begin
+              writeln('*** Error reading file ', FileNo, ': ', E.Message);
+            end;
+          end;
+        finally
+          MyDbf.Free;
+        end;
+      end;
+    finally
+      DBFs.Free;
+    end;
+
+    // stop program loop
+    Terminate;
+  end;
+
+  constructor TDBFTool.Create(TheOwner: TComponent);
+  begin
+    inherited Create(TheOwner);
+    StopOnException := true;
+  end;
+
+  destructor TDBFTool.Destroy;
+  begin
+    inherited Destroy;
+  end;
+
+  procedure TDBFTool.WriteHelp;
+  begin
+    writeln('Usage: ', ExeName, ' -h');
+    writeln(' --createdemo          create demo database');
+    writeln(' --tablelevel=<n>      optional: desired tablelevel for demo db');
+    writeln('  3                    DBase III');
+    writeln('  4                    DBase IV');
+    writeln('  7                    Visual DBase 7');
+    writeln(' 25                    FoxPro 2.x');
+    writeln(' 30                    Visual FoxPro');
+    writeln(' --exportformat=<text> export dbfs to format. Format can be:');
+    writeln(' access                Microsoft Access XML');
+    writeln(' adonet                ADO.Net dataset');
+    writeln(' csvexcel              Excel/Creativyst format CSV text file (with locale dependent output)');
+    writeln(' csvRFC4180            LibreOffice/RFC4180 format CSV text file');
+    writeln(' dataset               Delphi dataset XML');
+    writeln(' excel                 Microsoft Excel XML');
+    writeln(' fixedtext             Fixed length text file');
+    writeln(' json                  JSON file');
+    writeln(' rtf                   Rich Text Format');
+    writeln(' simplexml             Simple XML');
+    writeln(' sql                   SQL insert statements');
+    writeln(' tex                   LaTeX file');
+  end;
+
+var
+  Application: TDBFTool;
+begin
+  Application := TDBFTool.Create(nil);
+  Application.Title := 'DBFTool';
+  Application.Run;
+  Application.Free;
+end.

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

@@ -52,10 +52,10 @@ begin
   Active:=False;
   FFieldDefs.Free;
   FFieldList.Free;
-  With FDatasources do
+  With FDataSources do
     begin
     While Count>0 do
-      TDatasource(Items[Count - 1]).DataSet:=Nil;
+      TDataSource(Items[Count - 1]).DataSet:=Nil;
     Free;
     end;
   for i := 0 to FBufferCount do
@@ -174,7 +174,7 @@ Procedure TDataset.ClearBuffers;
 
 begin
   FRecordCount:=0;
-  FactiveRecord:=0;
+  FActiveRecord:=0;
   FCurrentRecord:=-1;
   FBOF:=True;
   FEOF:=True;
@@ -408,10 +408,10 @@ begin
 {$ifdef dsdebug}
   Writeln ('Calling RecalcBufListSize');
 {$endif}
-  FRecordcount := 0;
+  FRecordCount := 0;
   RecalcBufListSize;
-  FBOF:=True;
-  FEOF := (FRecordcount = 0);
+  FBOF := True;
+  FEOF := (FRecordCount = 0);
 end;
 
 Procedure TDataset.DoOnCalcFields;
@@ -759,18 +759,18 @@ begin
   Writeln ('Getting next record. Internal RecordCount : ',FRecordCount);
 {$endif}
   If FRecordCount>0 Then SetCurrentRecord(FRecordCount-1);
-  Result:=GetRecord(FBuffers[FBuffercount],gmNext,True)=grOK;
+  Result:=GetRecord(FBuffers[FBufferCount],gmNext,True)=grOK;
 
   if result then
     begin
       If FRecordCount=0 then ActivateBuffers;
-      if FRecordcount=FBuffercount then
-        shiftbuffersbackward
+      if FRecordCount=FBufferCount then
+        ShiftBuffersBackward
       else
         begin
           inc(FRecordCount);
           FCurrentRecord:=FRecordCount - 1;
-          ExchangeBuffers(Fbuffers[FCurrentRecord],FBuffers[FBuffercount]);
+          ExchangeBuffers(FBuffers[FCurrentRecord],FBuffers[FBufferCount]);
         end;
     end
   else
@@ -802,13 +802,13 @@ begin
 {$endif}
   CheckBiDirectional;
   If FRecordCount>0 Then SetCurrentRecord(0);
-  Result:=GetRecord(FBuffers[FBuffercount],gmPrior,True)=grOK;
+  Result:=GetRecord(FBuffers[FBufferCount],gmPrior,True)=grOK;
   if result then
     begin
       If FRecordCount=0 then ActivateBuffers;
-      shiftbuffersforward;
+      ShiftBuffersForward;
 
-      if FRecordcount<FBuffercount then
+      if FRecordCount<FBufferCount then
         inc(FRecordCount);
     end
   else
@@ -825,7 +825,7 @@ begin
 {$ifdef dsdebug}
   Writeln ('Getting previous record(s), need :',FBufferCount);
 {$endif}
-  While (FRecordCount<FbufferCount) and GetPriorRecord do
+  While (FRecordCount<FBufferCount) and GetPriorRecord do
     Inc(Result);
 end;
 
@@ -1124,7 +1124,11 @@ begin
 {$ifdef dsdebug}
   Writeln('Recalculating buffer list size');
 {$endif}
-  ABufferCount := DefaultBufferCount;
+  if IsUniDirectional then
+    ABufferCount := 1
+  else
+    ABufferCount := DefaultBufferCount;
+
   for i := 0 to FDataSources.Count - 1 do
     for j := 0 to TDataSource(FDataSources[i]).DataLinks.Count - 1 do
       begin
@@ -1217,8 +1221,8 @@ begin
     if (value > -1) and (FActiveRecord>Value-1) then
       begin
       for i := 0 to (FActiveRecord-Value) do
-        shiftbuffersbackward;
-      FActiverecord := Value -1;
+        ShiftBuffersBackward;
+      FActiveRecord := Value -1;
       end;
 
     If Assigned(FBuffers) then
@@ -1238,7 +1242,7 @@ begin
   FBufferCount:=Value;
   If Value=-1 then
     Value:=0;
-  if FRecordcount > Value then FRecordcount := Value;
+  if FRecordCount > Value then FRecordCount := Value;
 {$ifdef dsdebug}
   Writeln ('   SetBufListSize: Final FBufferCount=',FBufferCount);
 {$endif}
@@ -1457,11 +1461,11 @@ begin
     UpdateCursorPos;
     InternalCancel;
     FreeFieldBuffers;
-    if (state = dsInsert) and (FRecordcount = 1) then
+    if (State = dsInsert) and (FRecordCount = 1) then
       begin
       FEOF := true;
       FBOF := true;
-      FRecordcount := 0;
+      FRecordCount := 0;
       InitRecord(ActiveBuffer);
       SetState(dsBrowse);
       DataEvent(deDatasetChange,0);
@@ -1469,7 +1473,7 @@ begin
     else
       begin
       SetState(dsBrowse);
-      SetCurrentRecord(FActiverecord);
+      SetCurrentRecord(FActiveRecord);
       resync([]);
       end;
     DoAfterCancel;
@@ -1482,7 +1486,7 @@ begin
   CheckActive;
   DataEvent(deCheckBrowseMode,0);
   Case State of
-    dsedit,dsinsert: begin
+    dsEdit,dsInsert: begin
       UpdateRecord;
       If Modified then Post else Cancel;
     end;
@@ -1553,7 +1557,7 @@ begin
 {$ifdef dsdebug}
     writeln ('Delete: Browse mode set');
 {$endif}
-    SetCurrentRecord(FActiverecord);
+    SetCurrentRecord(FActiveRecord);
     Resync([]);
     DoAfterDelete;
     DoAfterScroll;
@@ -1586,20 +1590,20 @@ Procedure TDataset.DoInsertAppend(DoAppend : Boolean);
   begin
   // need to scroll up al buffers after current one,
   // but copy current bookmark to insert buffer.
-  If FRecordcount > 0 then
+  If FRecordCount > 0 then
     BookBeforeInsert:=Bookmark;
 
   if not DoAppend then
     begin
     if FRecordCount > 0 then
       begin
-      TempBuf := FBuffers[FBuffercount];
-      move(FBuffers[FActiveRecord],FBuffers[FActiveRecord+1],(Fbuffercount-FActiveRecord)*sizeof(FBuffers[0]));
+      TempBuf := FBuffers[FBufferCount];
+      move(FBuffers[FActiveRecord],FBuffers[FActiveRecord+1],(FBufferCount-FActiveRecord)*sizeof(FBuffers[0]));
       FBuffers[FActiveRecord]:=TempBuf;
       end;
     end
-  else if FRecordcount=FBuffercount then
-    shiftbuffersbackward
+  else if FRecordCount=FBufferCount then
+    ShiftBuffersBackward
   else
     begin
     if FRecordCount>0 then
@@ -1621,7 +1625,7 @@ Procedure TDataset.DoInsertAppend(DoAppend : Boolean);
 
     // 1-apr-06, JvdS: It just sets the bookmark of the newly inserted record to the place
     // where the record should be inserted. So it is ok.
-    if FRecordcount > 0 then
+    if FRecordCount > 0 then
       SetBookMarkData(ActiveBuffer,pointer(BookBeforeInsert));
     end;
 
@@ -1664,7 +1668,7 @@ begin
   try
     DoOnNewRecord;
   except
-    SetCurrentRecord(FActiverecord);
+    SetCurrentRecord(FActiveRecord);
     resync([]);
     raise;
   end;
@@ -1682,7 +1686,7 @@ end;
 Procedure TDataset.Edit;
 
 begin
-  If State in [dsedit,dsinsert] then exit;
+  If State in [dsEdit,dsInsert] then exit;
   CheckBrowseMode;
   If Not CanModify then
     DatabaseError(SDatasetReadOnly,Self);
@@ -1694,7 +1698,7 @@ begin
   DoBeforeEdit;
   If Not TryDoing(@InternalEdit,OnEditError) then exit;
   GetCalcFields(ActiveBuffer);
-  SetState(dsedit);
+  SetState(dsEdit);
   DataEvent(deRecordChange,0);
   DoAfterEdit;
 end;
@@ -1864,7 +1868,7 @@ Function TDataset.IsEmpty: Boolean;
 
 begin
   Result:=(fBof and fEof) and
-          (not (state = dsinsert)); // After an insert on an empty dataset, both fBof and fEof are true
+          (not (State = dsInsert)); // After an insert on an empty dataset, both fBof and fEof are true
 end;
 
 Function TDataset.IsLinkedTo(ADataSource: TDataSource): Boolean;
@@ -1910,8 +1914,7 @@ Function TDataset.MoveBy(Distance: Longint): Longint;
 Var
   TheResult: Integer;
 
-  Function Scrollforward : Integer;
-
+  Function ScrollForward : Integer;
   begin
     Result:=0;
 {$ifdef dsdebug}
@@ -1945,8 +1948,8 @@ Var
         end;
       end
   end;
-  Function ScrollBackward : Integer;
 
+  Function ScrollBackward : Integer;
   begin
     CheckBiDirectional;
     Result:=0;
@@ -2074,15 +2077,15 @@ begin
   InternalRefresh;
 { SetCurrentRecord is called by UpdateCursorPos already, so as long as
   InternalRefresh doesn't do strange things this should be ok. }
-//  SetCurrentRecord(FActiverecord);
+//  SetCurrentRecord(FActiveRecord);
   Resync([]);
   DoAfterRefresh;
 end;
 
-Procedure TDataset.RegisterDataSource(ADatasource : TDataSource);
+Procedure TDataset.RegisterDataSource(ADataSource : TDataSource);
 
 begin
-  FDatasources.Add(ADataSource);
+  FDataSources.Add(ADataSource);
   RecalcBufListSize;
 end;
 
@@ -2098,16 +2101,16 @@ begin
 {$endif}
   if FIsUnidirectional then Exit;
 // place the cursor of the underlying dataset to the active record
-//  SetCurrentRecord(FActiverecord);
+//  SetCurrentRecord(FActiveRecord);
 
 // Now look if the data on the current cursor of the underlying dataset is still available
-  If GetRecord(Fbuffers[0],gmcurrent,False)<>grOk Then
+  If GetRecord(FBuffers[0],gmCurrent,False)<>grOk Then
 // If that fails and rmExact is set, then raise an exception
     If rmExact in Mode then
       DatabaseError(SNoSuchRecord,Self)
 // else, if rmexact is not set, try to fetch the next  or prior record in the underlying dataset
-    else if (GetRecord(Fbuffers[0],gmnext,True)<>grOk) and
-            (GetRecord(Fbuffers[0],gmprior,True)<>grOk) then
+    else if (GetRecord(FBuffers[0],gmNext,True)<>grOk) and
+            (GetRecord(FBuffers[0],gmPrior,True)<>grOk) then
       begin
 {$ifdef dsdebug}
       Writeln ('Resync: fuzzy resync');
@@ -2129,7 +2132,7 @@ begin
   else
     count := FActiveRecord;
   i := 0;
-  FRecordcount := 1;
+  FRecordCount := 1;
   FActiveRecord := 0;
 
 // Fill the buffers before the active record
@@ -2139,7 +2142,7 @@ begin
 // Fill the rest of the buffer
   getnextrecords;
 // If the buffer is not full yet, try to fetch some more prior records
-  if FRecordcount < FBuffercount then inc(FActiverecord,getpriorrecords);
+  if FRecordCount < FBufferCount then inc(FActiveRecord,getpriorrecords);
 // That's all folks!
   DataEvent(deDatasetChange,0);
 end;
@@ -2204,7 +2207,7 @@ Procedure TDataset.UpdateCursorPos;
 
 begin
   If FRecordCount>0 then
-    SetCurrentRecord(FactiveRecord);
+    SetCurrentRecord(FActiveRecord);
 end;
 
 Procedure TDataset.UpdateRecord;
@@ -2244,8 +2247,8 @@ var TempBuf : pointer;
 
 begin
   TempBuf := FBuffers[0];
-  move(FBuffers[1],FBuffers[0],(fbuffercount)*sizeof(FBuffers[0]));
-  FBuffers[buffercount]:=TempBuf;
+  move(FBuffers[1],FBuffers[0],(FBufferCount)*sizeof(FBuffers[0]));
+  FBuffers[BufferCount]:=TempBuf;
 end;
 
 Procedure TDataset.ShiftBuffersForward;
@@ -2254,11 +2257,11 @@ var TempBuf : pointer;
 
 begin
   TempBuf := FBuffers[FBufferCount];
-  move(FBuffers[0],FBuffers[1],(fbuffercount)*sizeof(FBuffers[0]));
+  move(FBuffers[0],FBuffers[1],(FBufferCount)*sizeof(FBuffers[0]));
   FBuffers[0]:=TempBuf;
 end;
 
-function TDataset.GetFieldValues(const Fieldname: string): Variant;
+function TDataset.GetFieldValues(const FieldName: string): Variant;
 
 var i: Integer;
     FieldList: TList;
@@ -2311,7 +2314,7 @@ begin
 end;
 
 
-Procedure TDataset.UnRegisterDataSource(ADatasource : TDatasource);
+Procedure TDataset.UnRegisterDataSource(ADataSource : TDataSource);
 
 begin
   FDataSources.Remove(ADataSource);

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

@@ -418,7 +418,7 @@ begin
   end
   else
     NewQuery:=SQL;
-    
+
   Result := NewQuery;
 end;
 
@@ -607,84 +607,84 @@ end;
 
 Procedure TParam.SetAsBlob(const AValue: TBlobData);
 begin
-  Value:=AValue;
   FDataType:=ftBlob;
+  Value:=AValue;
 end;
 
 Procedure TParam.SetAsBoolean(AValue: Boolean);
 begin
-  Value:=AValue;
   FDataType:=ftBoolean;
+  Value:=AValue;
 end;
 
 Procedure TParam.SetAsCurrency(const AValue: Currency);
 begin
-  Value:=Avalue;
   FDataType:=ftCurrency;
+  Value:=Avalue;
 end;
 
 Procedure TParam.SetAsDate(const AValue: TDateTime);
 begin
-  Value:=Avalue;
   FDataType:=ftDate;
+  Value:=Avalue;
 end;
 
 Procedure TParam.SetAsDateTime(const AValue: TDateTime);
 begin
-  Value:=AValue;
   FDataType:=ftDateTime;
+  Value:=AValue;
 end;
 
 Procedure TParam.SetAsFloat(const AValue: Double);
 begin
-  Value:=AValue;
   FDataType:=ftFloat;
+  Value:=AValue;
 end;
 
 Procedure TParam.SetAsInteger(AValue: Longint);
 begin
-  Value:=AValue;
   FDataType:=ftInteger;
+  Value:=AValue;
 end;
 
 Procedure TParam.SetAsLargeInt(AValue: LargeInt);
 begin
-  Value:=AValue;
   FDataType:=ftLargeint;
+  Value:=AValue;
 end;
 
 Procedure TParam.SetAsMemo(const AValue: string);
 begin
-  Value:=AValue;
   FDataType:=ftMemo;
+  Value:=AValue;
 end;
 
 
 Procedure TParam.SetAsSmallInt(AValue: LongInt);
 begin
-  Value:=AValue;
   FDataType:=ftSmallInt;
+  Value:=AValue;
 end;
 
 Procedure TParam.SetAsString(const AValue: string);
 begin
-  Value:=AValue;
   if FDataType <> ftFixedChar then
     FDataType := ftString;
+  Value:=AValue;
 end;
 
 procedure TParam.SetAsWideString(const aValue: WideString);
 begin
-  Value := aValue;
   if FDataType <> ftFixedWideChar then
     FDataType := ftWideString;
+  Value := aValue;
 end;
 
 
 Procedure TParam.SetAsTime(const AValue: TDateTime);
 begin
-  Value:=AValue;
   FDataType:=ftTime;
+  Value:=AValue;
 end;
 
 Procedure TParam.SetAsVariant(const AValue: Variant);
@@ -720,14 +720,14 @@ end;
 
 Procedure TParam.SetAsWord(AValue: LongInt);
 begin
-  Value:=AValue;
   FDataType:=ftWord;
+  Value:=AValue;
 end;
 
 procedure TParam.SetAsFMTBCD(const AValue: TBCD);
 begin
-  FValue:=VarFmtBCDCreate(AValue);
   FDataType:=ftFMTBcd;
+  FValue:=VarFmtBCDCreate(AValue);
 end;
 
 Procedure TParam.SetDataType(AValue: TFieldType);
@@ -1095,7 +1095,7 @@ Var
   I : Integer;
   P : TParam;
   F : TField;
-  
+
 begin
   If (ADataSet<>Nil) then
     For I:=0 to Count-1 do

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

@@ -213,7 +213,7 @@ const
       LANG_FRENCH     or (SUBLANG_FRENCH_CANADIAN      shl 10) or (SORT_DEFAULT shl 16),
 {1E}  0,
 {1F}  LANG_CZECH      or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
-      LANG_CZECH      or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
+      0 {Used to be LANG_CZECH in previous versions but DBase IV tables show no support here.},
 {21}  0,
 {22}  LANG_HUNGARIAN  or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
       LANG_POLISH     or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
@@ -231,7 +231,7 @@ const
       LANG_THAI       or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),
 {51}  0,0,0,0,0,
 {56}  LANG_JAPANESE   or (SUBLANG_DEFAULT              shl 10) or (SORT_DEFAULT shl 16),    // JPN: Dic932 ??
-      0,                                                                                    // Ascii: Binary
+{57}  0, // ANSI/ASCII binary (interpret e.g. as ISO 8859_1 depending on client}
       LANG_ENGLISH    or (SUBLANG_ENGLISH_UK           shl 10) or (SORT_DEFAULT shl 16),    // Western Europe ??
       LANG_SPANISH    or (SUBLANG_SPANISH              shl 10) or (SORT_DEFAULT shl 16),
 {5A}  0,0,0,0,

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

@@ -9,12 +9,13 @@ SourceForge: http://sourceforge.net/projects/tdbf/forums/forum/107245
 
 TDbf readme:
 
-See history.txt for changelog.
-See history.txt for version number, latest version is at the top.
+See history.txt for changelog, and version number.
 See INSTALL for installation procedure.
 License is LGPL (Library General Public License); see COPYING.LIB for details.
 
-Development notes/additions to end user documentation
+Development notes
+=================
+(Includes possible additions to end user documentation)
 
 property RecNo: approximate record number. Does not take deleted records into account. Used mainly in grids.
 
@@ -22,6 +23,16 @@ File format references:
 Flagship/FoxPro/Clipper/DBase III..V .dbf file format description
 ftp://fship.com/pub/multisoft/flagship/docu/dbfspecs.txt
 
+DBase IV language drivers 
+- Russian list: ...
+http://www.autopark.ru/ASBProgrammerGuide/DBFSTRUC.HTM
+... English extract:
+- http://shapelib.maptools.org/codepage.html
+
+- as supported by ArcPad .shp files (basically DBase IV) (page 128):
+http://downloads.esri.com/support/documentation/pad_/ArcPad_RefGuide_dec2007.pdf
+
+
 FoxPro 2.x:
 http://support.microsoft.com/kb/98743/en-us
 Data type:

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

@@ -110,45 +110,47 @@ type
     FRole                : String;
     FStatements          : TFPList;
     function GetPort: cardinal;
-    function GetStatementInfo(const ASQL: string; Full: Boolean; ASchema : TSchemaType): TSQLStatementInfo;
     procedure SetPort(const AValue: cardinal);
   protected
     FConnOptions         : TConnOptions;
     FSQLFormatSettings : TFormatSettings;
     procedure GetDBInfo(const ASchemaType : TSchemaType; const ASchemaObjectName, AReturnField : string; AList: TStrings);
-    procedure SetTransaction(Value : TSQLTransaction);virtual;
-    function StrToStatementType(s : string) : TStatementType; virtual;
+    procedure SetTransaction(Value : TSQLTransaction); virtual;
     procedure DoInternalConnect; override;
     procedure DoInternalDisconnect; override;
     function GetAsSQLText(Field : TField) : string; overload; virtual;
     function GetAsSQLText(Param : TParam) : string; overload; virtual;
-    function GetHandle : pointer; virtual; virtual;
+    function GetHandle : pointer; virtual;
     Function LogEvent(EventType : TDBEventType) : Boolean;
     Procedure Log(EventType : TDBEventType; Const Msg : String); virtual;
-    Function AllocateCursorHandle : TSQLCursor; virtual; abstract;
-    Procedure DeAllocateCursorHandle(var cursor : TSQLCursor); virtual; abstract;
-    Function AllocateTransactionHandle : TSQLHandle; virtual; abstract;
     Procedure RegisterStatement(S : TCustomSQLStatement);
     Procedure UnRegisterStatement(S : TCustomSQLStatement);
 
+    Function AllocateCursorHandle : TSQLCursor; virtual; abstract;
+    Procedure DeAllocateCursorHandle(var cursor : TSQLCursor); virtual; abstract;
+    function StrToStatementType(s : string) : TStatementType; virtual;
+    function GetStatementInfo(const ASQL: string; Full: Boolean; ASchema : TSchemaType): TSQLStatementInfo; virtual;
     procedure PrepareStatement(cursor: TSQLCursor;ATransaction : TSQLTransaction;buf : string; AParams : TParams); virtual; abstract;
+    procedure UnPrepareStatement(cursor : TSQLCursor); virtual; abstract;
     procedure Execute(cursor: TSQLCursor;atransaction:tSQLtransaction; AParams : TParams); virtual; abstract;
+    function RowsAffected(cursor: TSQLCursor): TRowsCount; virtual;
     function Fetch(cursor : TSQLCursor) : boolean; virtual; abstract;
     procedure AddFieldDefs(cursor: TSQLCursor; FieldDefs : TfieldDefs); virtual; abstract;
-    procedure UnPrepareStatement(cursor : TSQLCursor); virtual; abstract;
-
-    procedure FreeFldBuffers(cursor : TSQLCursor); virtual;
     function LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; virtual; abstract;
+    procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); virtual; abstract;
+    procedure FreeFldBuffers(cursor : TSQLCursor); virtual;
+
+    Function AllocateTransactionHandle : TSQLHandle; virtual; abstract;
     function GetTransactionHandle(trans : TSQLHandle): pointer; virtual; abstract;
     function Commit(trans : TSQLHandle) : boolean; virtual; abstract;
     function RollBack(trans : TSQLHandle) : boolean; virtual; abstract;
     function StartdbTransaction(trans : TSQLHandle; aParams : string) : boolean; virtual; abstract;
     procedure CommitRetaining(trans : TSQLHandle); virtual; abstract;
     procedure RollBackRetaining(trans : TSQLHandle); virtual; abstract;
+
     procedure UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string); virtual;
     function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual;
-    procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); virtual; abstract;
-    function RowsAffected(cursor: TSQLCursor): TRowsCount; virtual;
+
     Property Statements : TFPList Read FStatements;
     property Port: cardinal read GetPort write SetPort;
   public
@@ -221,9 +223,9 @@ type
 
   TCustomSQLStatement = Class(TComponent)
   Private
-    FCheckParams: Boolean;
     FCursor : TSQLCursor;
     FDatabase: TSQLConnection;
+    FParamCheck: Boolean;
     FParams: TParams;
     FSQL: TStrings;
     FOrigSQL : String;
@@ -239,8 +241,8 @@ type
   Protected
     Function CreateDataLink : TDataLink; virtual;
     procedure OnChangeSQL(Sender : TObject); virtual;
-    function GetDataSource: TDatasource; Virtual;
-    procedure SetDataSource(AValue: TDatasource); virtual;
+    function GetDataSource: TDataSource; Virtual;
+    procedure SetDataSource(AValue: TDataSource); virtual;
     Procedure CopyParamsFromMaster(CopyBound : Boolean); virtual;
     procedure AllocateCursor;
     procedure DeAllocateCursor;
@@ -261,9 +263,9 @@ type
     Property Transaction : TSQLTransaction Read FTransaction Write SetTransaction;
     Property SQL : TStrings Read FSQL Write SetSQL;
     Property Params : TParams Read FParams Write SetParams;
-    Property Datasource : TDatasource Read GetDataSource Write SetDataSource;
+    Property DataSource : TDataSource Read GetDataSource Write SetDataSource;
     Property ParseSQL : Boolean Read FParseSQL Write FParseSQL;
-    Property CheckParams : Boolean Read FCheckParams Write FCheckParams default true;
+    Property ParamCheck : Boolean Read FParamCheck Write FParamCheck default true;
   Public
     constructor Create(AOwner : TComponent); override;
     destructor Destroy; override;
@@ -278,19 +280,18 @@ type
   TSQLStatement = Class(TCustomSQLStatement)
   Published
     Property Database;
-    Property Transaction;
-    Property SQL;
+    Property DataSource;
+    Property ParamCheck;
     Property Params;
-    Property Datasource;
     Property ParseSQL;
-    Property CheckParams;
+    Property SQL;
+    Property Transaction;
   end;
 
 { TCustomSQLQuery }
 
   TCustomSQLQuery = class (TCustomBufDataset)
   private
-    // FCheckParams: Boolean;
     // FCursor              : TSQLCursor;
     FSchemaType: TSchemaType;
 //    FSQL: TStringlist;
@@ -324,19 +325,19 @@ type
     FDeleteQry,
     FInsertQry           : TCustomSQLQuery;
     procedure FreeFldBuffers;
-    function GetCheckParams: Boolean;
+    function GetParamCheck: Boolean;
     function GetParams: TParams;
     function GetParseSQL: Boolean;
     function GetServerIndexDefs: TServerIndexDefs;
     function GetSQL: TStringlist;
     function GetStatementType : TStatementType;
-    procedure SetCheckParams(AValue: Boolean);
+    procedure SetParamCheck(AValue: Boolean);
+    procedure SetUpdateSQL(const AValue: TStringlist);
     procedure SetDeleteSQL(const AValue: TStringlist);
     procedure SetInsertSQL(const AValue: TStringlist);
     procedure SetParams(AValue: TParams);
     procedure SetParseSQL(AValue : Boolean);
     procedure SetSQL(const AValue: TStringlist);
-    procedure SetUpdateSQL(const AValue: TStringlist);
     procedure SetUsePrimaryKeyAsKey(AValue : Boolean);
     procedure SetUpdateMode(AValue : TUpdateMode);
 //    procedure OnChangeSQL(Sender : TObject);
@@ -364,8 +365,8 @@ type
     Procedure SetActive (Value : Boolean); override;
     procedure SetServerFiltered(Value: Boolean); virtual;
     procedure SetServerFilterText(const Value: string); virtual;
-    Function GetDataSource : TDatasource; override;
-    Procedure SetDataSource(AValue : TDatasource);
+    Function GetDataSource : TDataSource; override;
+    Procedure SetDataSource(AValue : TDataSource);
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField); override;
     procedure BeforeRefreshOpenCursor; override;
     procedure SetReadOnly(AValue : Boolean); override;
@@ -421,12 +422,12 @@ type
     property InsertSQL : TStringlist read FInsertSQL write SetInsertSQL;
     property DeleteSQL : TStringlist read FDeleteSQL write SetDeleteSQL;
     property Params : TParams read GetParams Write SetParams;
+    Property ParamCheck : Boolean Read GetParamCheck Write SetParamCheck default true;
+    property ParseSQL : Boolean read GetParseSQL write SetParseSQL default true;
     property UpdateMode : TUpdateMode read FUpdateMode write SetUpdateMode default upWhereKeyOnly;
     property UsePrimaryKeyAsKey : boolean read FUsePrimaryKeyAsKey write SetUsePrimaryKeyAsKey default true;
     property StatementType : TStatementType read GetStatementType;
-    property ParseSQL : Boolean read GetParseSQL write SetParseSQL default true;
-    Property CheckParams : Boolean Read GetCheckParams Write SetCheckParams default true;
-    Property DataSource : TDatasource Read GetDataSource Write SetDatasource;
+    Property DataSource : TDataSource Read GetDataSource Write SetDataSource;
     property ServerFilter: string read FServerFilterText write SetServerFilterText;
     property ServerFiltered: Boolean read FServerFiltered write SetServerFiltered default False;
     property ServerIndexDefs : TServerIndexDefs read GetServerIndexDefs;
@@ -478,10 +479,10 @@ type
     property DeleteSQL;
     property IndexDefs;
     property Params;
+    Property ParamCheck;
+    property ParseSQL;
     property UpdateMode;
     property UsePrimaryKeyAsKey;
-    property ParseSQL;
-    Property CheckParams;
     Property DataSource;
     property ServerFilter;
     property ServerFiltered;
@@ -645,7 +646,7 @@ var
 
 begin
   UnPrepare;
-  if not CheckParams then
+  if not ParamCheck then
     exit;
   if assigned(DataBase) then
     ConnOptions:=DataBase.ConnOptions
@@ -677,11 +678,10 @@ begin
     end;
 end;
 
-procedure TCustomSQLStatement.SetDataSource(AValue: TDatasource);
-
+procedure TCustomSQLStatement.SetDataSource(AValue: TDataSource);
 
 begin
-  if GetDatasource=AValue then Exit;
+  if GetDataSource=AValue then Exit;
   if (FDataLink=Nil) then
     FDataLink:=CreateDataLink;
   FDataLink.DataSource:=AValue;
@@ -722,7 +722,7 @@ end;
 
 procedure TCustomSQLStatement.DoExecute;
 begin
-  If (FParams.Count>0) and Assigned(Datasource) then
+  If (FParams.Count>0) and Assigned(DataSource) then
     CopyParamsFromMaster(False);
   If LogEvent(detExecute) then
     Log(detExecute,FServerSQL);
@@ -784,7 +784,7 @@ begin
   FSQL:=TStringList.Create;
   TStringList(FSQL).OnChange:=@OnChangeSQL;
   FParams:=CreateParams;
-  FCheckParams:=True;
+  FParamCheck:=True;
   FParseSQL:=True;
 end;
 
@@ -912,10 +912,10 @@ begin
       FreeAndNil(FCursor);
 end;
 
-function TCustomSQLStatement.GetDataSource: TDatasource;
+function TCustomSQLStatement.GetDataSource: TDataSource;
 begin
   if Assigned(FDataLink) then
-    Result:=FDataLink.Datasource
+    Result:=FDataLink.DataSource
   else
     Result:=Nil;
 end;
@@ -1402,7 +1402,7 @@ var ConnOptions : TConnOptions;
 
 begin
   FSchemaType:=stNoSchema;
-  if (FSQL <> nil) and CheckParams then
+  if (FSQL <> nil) and ParamCheck then
     begin
     if assigned(DataBase) then
       ConnOptions := TSQLConnection(DataBase).ConnOptions
@@ -1565,9 +1565,9 @@ begin
      TSQLConnection(Database).FreeFldBuffers(Cursor);
 end;
 
-function TCustomSQLQuery.GetCheckParams: Boolean;
+function TCustomSQLQuery.GetParamCheck: Boolean;
 begin
-  Result:=FStatement.CheckParams;
+  Result:=FStatement.ParamCheck;
 end;
 
 function TCustomSQLQuery.GetParams: TParams;
@@ -2009,7 +2009,7 @@ procedure TQuerySQLStatement.OnChangeSQL(Sender: TObject);
 begin
   UnPrepare;
   inherited OnChangeSQL(Sender);
-  If CheckParams and Assigned(FDataLink) then
+  If ParamCheck and Assigned(FDataLink) then
     (FDataLink as TMasterParamsDataLink).RefreshParamNames;
   FQuery.ServerIndexDefs.Updated:=false;
 end;
@@ -2317,9 +2317,9 @@ begin
     Result:=stUnknown;
 end;
 
-procedure TCustomSQLQuery.SetCheckParams(AValue: Boolean);
+procedure TCustomSQLQuery.SetParamCheck(AValue: Boolean);
 begin
-  FStatement.CheckParams:=Avalue;
+  FStatement.ParamCheck:=AValue;
 end;
 
 procedure TCustomSQLQuery.SetDeleteSQL(const AValue: TStringlist);
@@ -2337,10 +2337,10 @@ begin
   FStatement.Params.Assign(AValue);
 end;
 
-procedure TCustomSQLQuery.SetDataSource(AValue: TDatasource);
+procedure TCustomSQLQuery.SetDataSource(AValue: TDataSource);
 
 Var
-  DS : TDatasource;
+  DS : TDataSource;
 
 begin
   DS:=DataSource;
@@ -2350,15 +2350,15 @@ begin
       DatabaseError(SErrCircularDataSourceReferenceNotAllowed,Self);
     If Assigned(DS) then
       DS.RemoveFreeNotification(Self);
-    FStatement.Datasource:=AValue;
+    FStatement.DataSource:=AValue;
     end;
 end;
 
-function TCustomSQLQuery.GetDataSource: TDatasource;
+function TCustomSQLQuery.GetDataSource: TDataSource;
 
 begin
   If Assigned(FStatement) then
-    Result:=FStatement.Datasource
+    Result:=FStatement.DataSource
   else
     Result:=Nil;
 end;

packages/fcl-db/tests/testdbbasics.pas

@@ -410,7 +410,7 @@ begin
     with ds do
       begin
       aDatasource.DataSet := ds;
-      open;
+      Open;
       DataEvents := '';
       Resync([rmExact]);
       if IsUniDirectional then
@@ -418,9 +418,13 @@ begin
       else
         CheckEquals('deDataSetChange:0;DataSetChanged;',DataEvents);
       DataEvents := '';
-      next;
-      CheckEquals('deCheckBrowseMode:0;DataEvent;deDataSetScroll:0;DataSetScrolled:1;DataSetChanged;',DataEvents);
-      close;
+      Next;
+      if IsUniDirectional then
+        CheckEquals('deCheckBrowseMode:0;DataEvent;deDataSetScroll:-1;DataSetScrolled:1;DataSetChanged;',DataEvents)
+      else
+        CheckEquals('deCheckBrowseMode:0;DataEvent;deDataSetScroll:0;DataSetScrolled:1;DataSetChanged;',DataEvents);
+      DataEvents := '';
+      Close;
       end;
   finally
     aDatasource.Free;

packages/fcl-db/tests/testfieldtypes.pas

@@ -33,11 +33,17 @@ type
   published
     procedure TestEmptyUpdateQuery; // bug 13654
     procedure TestParseJoins; // bug 10148
-    procedure TestDoubleFieldNames; // bug 8457
     procedure TestParseUnion; // bug 8442
-    procedure TestInsertLargeStrFields; // bug 9600
+    procedure TestDoubleFieldNames; // bug 8457
     procedure TestNumericNames; // Bug9661
-    procedure TestApplyUpdFieldnames; // Bug 12275;
+    procedure TestApplyUpdFieldnames; // Bug 12275
+    procedure TestStringLargerThen8192;
+    procedure TestInsertLargeStrFields; // bug 9600
+    procedure TestLargeRecordSize;
+    procedure TestClearUpdateableStatus;
+    procedure TestReadOnlyParseSQL; // bug 9254
+    procedure TestpfInUpdateFlag; // bug 7565
+    procedure TestAggregates;
     procedure TestServerFilter; // bug 15456
     procedure Test11Params;
     procedure TestRowsAffected; // bug 9758
@@ -47,22 +53,18 @@ type
     procedure TestCircularParams;
     procedure TestBug9744;
     procedure TestCrossStringDateParam;
-    procedure TestGetFieldNames;
-    procedure TestUpdateIndexDefs;
-    procedure TestMultipleFieldPKIndexDefs;
-    procedure TestGetIndexDefs;
     procedure TestSetBlobAsMemoParam;
     procedure TestSetBlobAsBlobParam;
     procedure TestSetBlobAsStringParam;
     procedure TestNonNullableParams;
     procedure TestDblQuoteEscComments;
-    procedure TestpfInUpdateFlag; // bug 7565
     procedure TestInsertReturningQuery;
     procedure TestOpenStoredProc;
     procedure TestOpenSpecialStatements;
     
     procedure TestTemporaryTable;
     procedure TestRefresh;
+    procedure TestQueryAfterReconnect; // bug 16438
 
     procedure TestParametersAndDates;
     procedure TestExceptOnsecClose;
@@ -73,7 +75,6 @@ type
     procedure TestBlobGetText;
     procedure TestBlobSize;
 
-    procedure TestLargeRecordSize;
     procedure TestInt;
     procedure TestTinyint;
     procedure TestNumeric;
@@ -99,17 +100,15 @@ type
     procedure TestBytesParamQuery;
     procedure TestVarBytesParamQuery;
     procedure TestBooleanParamQuery;
-    procedure TestAggregates;
-
-    procedure TestStringLargerThen8192;
-    procedure TestQueryAfterReconnect; // bug 16438
 
     // SchemaType tests
     procedure TestTableNames;
-    procedure TestFieldNames;
-    procedure TestClearUpdateableStatus;
-    procedure TestReadOnlyParseSQL; // bug 9254
     procedure TestGetTables;
+    procedure TestFieldNames;
+    procedure TestGetFieldNames;
+    procedure TestUpdateIndexDefs;
+    procedure TestMultipleFieldPKIndexDefs;
+    procedure TestGetIndexDefs;
 
     // Test SQL-field type recognition
     procedure TestSQLClob;
@@ -165,67 +164,6 @@ const
   );
 
 
-procedure TTestFieldTypes.TestpfInUpdateFlag;
-var ds   : TCustomBufDataset;
-    AFld1, AFld2, AFld3 : Tfield;
-begin
-  ds := (DBConnector.GetNDataset(True,5) as TCustomBufDataset);
-  with ds do
-    begin
-    AFld1 := TIntegerField.Create(ds);
-    AFld1.FieldName := 'ID';
-    AFld1.DataSet := ds;
-    AFld1.ProviderFlags := AFld1.ProviderFlags + [pfInKey];
-
-    AFld2 := TStringField.Create(ds);
-    AFld2.FieldName := 'NAME';
-    AFld2.DataSet := ds;
-
-    AFld3 := TIntegerField.Create(ds);
-    AFld3.FieldName := 'CALCFLD';
-    AFld3.DataSet := ds;
-    Afld3.FieldKind := fkCalculated;
-    AFld3.ProviderFlags := [];  // do not include calculated fields into generated sql insert/update
-
-    Open;
-    Edit;
-    FieldByName('ID').AsInteger := 254;
-    Post;
-    ApplyUpdates;
-    Append;
-    FieldByName('ID').AsInteger := 255;
-    Post;
-    ApplyUpdates;
-    Close;
-    AFld1.Free;
-    AFld2.Free;
-    AFld3.Free;
-    end;
-end;
-
-procedure TTestFieldTypes.TestLargeRecordSize;
-
-begin
-  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (plant varchar(8192),sampling_type varchar(8192),area varchar(8192), area_description varchar(8192), batch varchar(8192), sampling_datetime timestamp, status varchar(8192), batch_commentary varchar(8192))');
-
-  // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
-  TSQLDBConnector(DBConnector).CommitDDL;
-
-  with TSQLDBConnector(DBConnector).Query do
-    begin
-    sql.clear;
-    sql.append('insert into FPDEV2 (plant,sampling_type,batch,sampling_datetime,status,batch_commentary) values (''ZUBNE PASTE'',''OTISCI POVR￿INA'',''000037756'',''2005-07-01'',''NE ODGOVARA'',''Ovdje se upisuje komentar o kontrolnom broju..............'')');
-    ExecSQL;
-
-    sql.clear;
-    sql.append('select * from FPDEV2');
-    open;
-    AssertEquals('ZUBNE PASTE',FieldByName('plant').AsString);
-    AssertEquals(EncodeDate(2005,07,01),FieldByName('sampling_datetime').AsDateTime);
-    close;
-    end;
-end;
-
 procedure TTestFieldTypes.CreateTableWithFieldType(ADatatype: TFieldType;
   ASQLTypeDecl: string);
 begin
@@ -1051,43 +989,6 @@ begin
 end;
 
 
-procedure TTestFieldTypes.TestAggregates;
-begin
-  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (FIELD1 INT, FIELD2 INT)');
-  // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
-  TSQLDBConnector(DBConnector).CommitDDL;
-
-  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (1,1)');
-  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (2,3)');
-  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (3,4)');
-  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (4,4)');
-
-  TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
-
-  with TSQLDBConnector(DBConnector).Query do
-    begin
-    sql.clear;
-    sql.append('select count(*) from FPDEV2');
-    open;
-    AssertEquals(4,Fields[0].AsInteger);
-    close;
-
-    sql.clear;
-    sql.append('select sum(FIELD1) from FPDEV2');
-    open;
-    AssertEquals(10,Fields[0].AsInteger);
-    close;
-
-    sql.clear;
-    sql.append('select avg(FIELD2) from FPDEV2');
-    open;
-    AssertEquals(3,Fields[0].AsInteger);
-    close;
-
-    end;
-
-end;
-
 procedure TTestFieldTypes.TestQueryAfterReconnect;
 var DS: TDataset;
 begin
@@ -1241,30 +1142,60 @@ begin
     end;
 end;
 
-procedure TTestFieldTypes.TestTableNames;
-var TableList : TStringList;
-    i         : integer;
+procedure TTestFieldTypes.TestInsertLargeStrFields;
+// See also: TestStringLargerThen8192
+const
+  FieldValue1='test1';
+var
+  FieldValue2: string;
 begin
-  TableList := TStringList.Create;
-  try
-    TSQLDBConnector(DBConnector).Connection.GetTableNames(TableList);
-    AssertTrue(TableList.Find('fpdev',i));
-  finally
-    TableList.Free;
-  end;
+  FieldValue2:=StringOfChar('t', 16000);
+  with TSQLDBConnector(DBConnector) do
+    begin
+    Connection.ExecuteDirect('create table FPDEV2 (  ' +
+                              '  ID INT NOT NULL ,   ' +
+                              '  NAME VARCHAR(16000),' +
+                              '  PRIMARY KEY (ID)    ' +
+                              ')                     ');
+    // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
+    TSQLDBConnector(DBConnector).CommitDDL;
+
+    query.sql.Text:='select * from FPDEV2';
+    Query.Open;
+    Query.InsertRecord([1,FieldValue1]); // string length <= 8192 (dsMaxStringSize)
+    Query.InsertRecord([2,FieldValue2]); // string length >  8192 (dsMaxStringSize)
+    Query.ApplyUpdates;
+    Query.Close;
+    Query.Open;
+    AssertEquals(FieldValue1, Query.FieldByName('NAME').AsString);
+    Query.Next;
+    AssertEquals(length(FieldValue2), length(Query.FieldByName('NAME').AsString));
+    AssertEquals(FieldValue2, Query.FieldByName('NAME').AsString);
+    Query.Close;
+    end;
 end;
 
-procedure TTestFieldTypes.TestFieldNames;
-var FieldList : TStringList;
-    i         : integer;
+procedure TTestFieldTypes.TestLargeRecordSize;
+
 begin
-  FieldList := TStringList.Create;
-  try
-    TSQLDBConnector(DBConnector).Connection.GetFieldNames('fpdev',FieldList);
-    AssertTrue(FieldList.Find('id',i));
-  finally
-    FieldList.Free;
-  end;
+  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (plant varchar(8192),sampling_type varchar(8192),area varchar(8192), area_description varchar(8192), batch varchar(8192), sampling_datetime timestamp, status varchar(8192), batch_commentary varchar(8192))');
+
+  // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
+  TSQLDBConnector(DBConnector).CommitDDL;
+
+  with TSQLDBConnector(DBConnector).Query do
+    begin
+    sql.clear;
+    sql.append('insert into FPDEV2 (plant,sampling_type,batch,sampling_datetime,status,batch_commentary) values (''ZUBNE PASTE'',''OTISCI POVR￿INA'',''000037756'',''2005-07-01'',''NE ODGOVARA'',''Ovdje se upisuje komentar o kontrolnom broju..............'')');
+    ExecSQL;
+
+    sql.clear;
+    sql.append('select * from FPDEV2');
+    open;
+    AssertEquals('ZUBNE PASTE',FieldByName('plant').AsString);
+    AssertEquals(EncodeDate(2005,07,01),FieldByName('sampling_datetime').AsDateTime);
+    close;
+    end;
 end;
 
 procedure TTestFieldTypes.TestInsertReturningQuery;
@@ -1491,6 +1422,81 @@ begin
     end;
 end;
 
+procedure TTestFieldTypes.TestpfInUpdateFlag;
+var ds   : TCustomBufDataset;
+    AFld1, AFld2, AFld3 : Tfield;
+begin
+  ds := (DBConnector.GetNDataset(True,5) as TCustomBufDataset);
+  with ds do
+    begin
+    AFld1 := TIntegerField.Create(ds);
+    AFld1.FieldName := 'ID';
+    AFld1.DataSet := ds;
+    AFld1.ProviderFlags := AFld1.ProviderFlags + [pfInKey];
+
+    AFld2 := TStringField.Create(ds);
+    AFld2.FieldName := 'NAME';
+    AFld2.DataSet := ds;
+
+    AFld3 := TIntegerField.Create(ds);
+    AFld3.FieldName := 'CALCFLD';
+    AFld3.DataSet := ds;
+    Afld3.FieldKind := fkCalculated;
+    AFld3.ProviderFlags := [];  // do not include calculated fields into generated sql insert/update
+
+    Open;
+    Edit;
+    FieldByName('ID').AsInteger := 254;
+    Post;
+    ApplyUpdates;
+    Append;
+    FieldByName('ID').AsInteger := 255;
+    Post;
+    ApplyUpdates;
+    Close;
+    AFld1.Free;
+    AFld2.Free;
+    AFld3.Free;
+    end;
+end;
+
+procedure TTestFieldTypes.TestAggregates;
+begin
+  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (FIELD1 INT, FIELD2 INT)');
+  // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
+  TSQLDBConnector(DBConnector).CommitDDL;
+
+  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (1,1)');
+  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (2,3)');
+  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (3,4)');
+  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (4,4)');
+
+  TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
+
+  with TSQLDBConnector(DBConnector).Query do
+    begin
+    sql.clear;
+    sql.append('select count(*) from FPDEV2');
+    open;
+    AssertEquals(4,Fields[0].AsInteger);
+    close;
+
+    sql.clear;
+    sql.append('select sum(FIELD1) from FPDEV2');
+    open;
+    AssertEquals(10,Fields[0].AsInteger);
+    close;
+
+    sql.clear;
+    sql.append('select avg(FIELD2) from FPDEV2');
+    open;
+    AssertEquals(3,Fields[0].AsInteger);
+    close;
+
+    end;
+
+end;
+
 procedure TTestFieldTypes.TestParseJoins;
 begin
   with TSQLDBConnector(DBConnector) do
@@ -1510,28 +1516,6 @@ begin
     end;
 end;
 
-procedure TTestFieldTypes.TestDoubleFieldNames;
-begin
-  with TSQLDBConnector(DBConnector) do
-    begin
-    with query do
-      begin
-      SQL.Text:='select FPDEV.*,TT.* from FPDEV left join FPDEV TT on TT.ID=FPDEV.ID';
-      Open;
-      AssertTrue(assigned(FindField('ID')));
-      AssertTrue (assigned(FindField('ID_1')));
-      AssertTrue(assigned(FindField('NAME')));
-      AssertTrue(assigned(FindField('NAME_1')));
-
-      AssertEquals(1,fieldbyname('ID').AsInteger);
-      AssertEquals(1,fieldbyname('ID_1').AsInteger);
-      AssertEquals('TestName1',fieldbyname('NAME').AsString);
-      AssertEquals('TestName1',fieldbyname('NAME_1').AsString);
-      close;
-      end;
-    end;
-end;
-
 procedure TTestFieldTypes.TestParseUnion;
 begin
   with TSQLDBConnector(DBConnector) do
@@ -1547,36 +1531,25 @@ begin
     end;
 end;
 
-procedure TTestFieldTypes.TestInsertLargeStrFields;
-// See also: TestStringLargerThen8192
-const
-  FieldValue1='test1';
-var
-  FieldValue2: string;
+procedure TTestFieldTypes.TestDoubleFieldNames;
 begin
-  FieldValue2:=StringOfChar('t', 16000);
   with TSQLDBConnector(DBConnector) do
     begin
-    Connection.ExecuteDirect('create table FPDEV2 (  ' +
-                              '  ID INT NOT NULL ,   ' +
-                              '  NAME VARCHAR(16000),' +
-                              '  PRIMARY KEY (ID)    ' +
-                              ')                     ');
-    // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
-    TSQLDBConnector(DBConnector).CommitDDL;
+    with query do
+      begin
+      SQL.Text:='select FPDEV.*,TT.* from FPDEV left join FPDEV TT on TT.ID=FPDEV.ID';
+      Open;
+      AssertTrue(assigned(FindField('ID')));
+      AssertTrue (assigned(FindField('ID_1')));
+      AssertTrue(assigned(FindField('NAME')));
+      AssertTrue(assigned(FindField('NAME_1')));
 
-    query.sql.Text:='select * from FPDEV2';
-    Query.Open;
-    Query.InsertRecord([1,FieldValue1]); // string length <= 8192 (dsMaxStringSize)
-    Query.InsertRecord([2,FieldValue2]); // string length >  8192 (dsMaxStringSize)
-    Query.ApplyUpdates;
-    Query.Close;
-    Query.Open;
-    AssertEquals(FieldValue1, Query.FieldByName('NAME').AsString);
-    Query.Next;
-    AssertEquals(length(FieldValue2), length(Query.FieldByName('NAME').AsString));
-    AssertEquals(FieldValue2, Query.FieldByName('NAME').AsString);
-    Query.Close;
+      AssertEquals(1,fieldbyname('ID').AsInteger);
+      AssertEquals(1,fieldbyname('ID_1').AsInteger);
+      AssertEquals('TestName1',fieldbyname('NAME').AsString);
+      AssertEquals('TestName1',fieldbyname('NAME_1').AsString);
+      close;
+      end;
     end;
 end;
 
@@ -1853,43 +1826,6 @@ begin
   end;
 end;
 
-procedure TTestFieldTypes.TestGetFieldNames;
-var FieldNames : TStringList;
-begin
-  with TSQLDBConnector(DBConnector) do
-    begin
-    FieldNames := TStringList.Create;
-    try
-      if SQLConnType in MySQLConnTypes then
-        Connection.GetFieldNames('FPDEV',FieldNames)
-      else
-        Connection.GetFieldNames('fpDEv',FieldNames);
-      AssertEquals(2,FieldNames.Count);
-      AssertEquals('ID',UpperCase(FieldNames[0]));
-      AssertEquals('NAME',UpperCase(FieldNames[1]));
-    finally
-      FieldNames.Free;
-      end;
-    end;
-end;
-
-procedure TTestFieldTypes.TestGetTables;
-var TableNames : TStringList;
-begin
-  with TSQLDBConnector(DBConnector) do
-    begin
-    TableNames := TStringList.Create;
-    try
-      Connection.GetTableNames(TableNames);
-      AssertTrue(TableNames.Count>0);
-      AssertTrue(TableNames.IndexOf('FPDEV')>-1);
-      AssertTrue(TableNames.IndexOf('FPDEV_FIELD')>-1);
-    finally
-      TableNames.Free;
-      end;
-    end;
-end;
-
 procedure TTestFieldTypes.TestSQLFieldType(ADatatype : TFieldType; ASQLTypeDecl : string; ADataSize: integer; AGetSQLTextProc: TGetSQLTextProc; ACheckFieldValueProc: TCheckFieldValueProc);
 var
   i          : byte;
@@ -2105,6 +2041,70 @@ begin
   TestSQLFieldType(ftFloat, datatype, sizeof(double), @TestSQLReal_GetSQLText, @CheckFieldValue);
 end;
 
+procedure TTestFieldTypes.TestTableNames;
+var TableList : TStringList;
+    i         : integer;
+begin
+  TableList := TStringList.Create;
+  try
+    TSQLDBConnector(DBConnector).Connection.GetTableNames(TableList);
+    AssertTrue(TableList.Find('fpdev',i));
+  finally
+    TableList.Free;
+  end;
+end;
+
+procedure TTestFieldTypes.TestGetTables;
+var TableNames : TStringList;
+begin
+  with TSQLDBConnector(DBConnector) do
+  begin
+    TableNames := TStringList.Create;
+    try
+      Connection.GetTableNames(TableNames);
+      AssertTrue(TableNames.Count>0);
+      AssertTrue(TableNames.IndexOf('FPDEV')>-1);
+      AssertTrue(TableNames.IndexOf('FPDEV_FIELD')>-1);
+    finally
+      TableNames.Free;
+    end;
+  end;
+end;
+
+procedure TTestFieldTypes.TestFieldNames;
+var FieldList : TStringList;
+    i         : integer;
+begin
+  FieldList := TStringList.Create;
+  try
+    TSQLDBConnector(DBConnector).Connection.GetFieldNames('fpdev',FieldList);
+    AssertTrue(FieldList.Find('id',i));
+  finally
+    FieldList.Free;
+  end;
+end;
+
+procedure TTestFieldTypes.TestGetFieldNames;
+var FieldNames : TStringList;
+begin
+  with TSQLDBConnector(DBConnector) do
+  begin
+    FieldNames := TStringList.Create;
+    try
+      if SQLConnType in MySQLConnTypes then
+        Connection.GetFieldNames('FPDEV',FieldNames)
+      else
+        Connection.GetFieldNames('fpDEv',FieldNames);
+      AssertEquals(2,FieldNames.Count);
+      AssertEquals('ID',UpperCase(FieldNames[0]));
+      AssertEquals('NAME',UpperCase(FieldNames[1]));
+    finally
+      FieldNames.Free;
+    end;
+  end;
+end;
+
+
 procedure TTestFieldTypes.TestUpdateIndexDefs;
 var ds : TSQLQuery;
 begin
@@ -2250,6 +2250,7 @@ begin
     end
 end;
 
+
 procedure TTestFieldTypes.TestExceptOnsecClose;
 
 var passed : boolean;