--- Merging r30137 into '.':

U    packages/sqlite/src/sqlite3.inc
--- Recording mergeinfo for merge of r30137 into '.':
 U   .
--- Merging r30138 into '.':
U    packages/sqlite/tests/test.pas
U    packages/sqlite/src/sqlite3db.pas
--- Recording mergeinfo for merge of r30138 into '.':
 G   .
--- Merging r30139 into '.':
G    packages/sqlite/src/sqlite3.inc
--- Recording mergeinfo for merge of r30139 into '.':
 G   .
--- Merging r30149 into '.':
G    packages/sqlite/src/sqlite3.inc
--- Recording mergeinfo for merge of r30149 into '.':
 G   .
--- Merging r30154 into '.':
U    packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Recording mergeinfo for merge of r30154 into '.':
 G   .
--- Merging r30155 into '.':
G    packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Recording mergeinfo for merge of r30155 into '.':
 G   .
--- Merging r30291 into '.':
U    packages/fcl-db/tests/testsqldb.pas
U    packages/fcl-db/src/sqldb/postgres/pqconnection.pp
U    packages/fcl-db/src/sqldb/interbase/ibconnection.pp
U    packages/fcl-db/src/sqldb/sqldb.pp
--- Recording mergeinfo for merge of r30291 into '.':
 G   .
--- Merging r30295 into '.':
U    packages/fcl-db/tests/testspecifictbufdataset.pas
U    packages/fcl-db/src/base/bufdataset.pas
--- Recording mergeinfo for merge of r30295 into '.':
 G   .
--- Merging r30305 into '.':
G    packages/fcl-db/src/sqldb/sqldb.pp
G    packages/fcl-db/src/sqldb/postgres/pqconnection.pp
G    packages/fcl-db/src/sqldb/interbase/ibconnection.pp
--- Recording mergeinfo for merge of r30305 into '.':
 G   .
--- Merging r30306 into '.':
U    packages/fcl-db/src/base/sqlscript.pp
--- Recording mergeinfo for merge of r30306 into '.':
 G   .
--- Merging r30325 into '.':
U    packages/fcl-db/tests/testdbbasics.pas
G    packages/fcl-db/src/base/bufdataset.pas
--- Recording mergeinfo for merge of r30325 into '.':
 G   .
--- Merging r30366 into '.':
U    packages/fcl-db/src/base/dataset.inc
U    packages/fcl-db/src/base/db.pas
--- Recording mergeinfo for merge of r30366 into '.':
 G   .
--- Merging r30383 into '.':
G    packages/fcl-db/src/base/bufdataset.pas
--- Recording mergeinfo for merge of r30383 into '.':
 G   .
--- Merging r30397 into '.':
G    packages/fcl-db/src/base/bufdataset.pas
--- Recording mergeinfo for merge of r30397 into '.':
 G   .
--- Merging r30399 into '.':
U    packages/fcl-db/tests/testfieldtypes.pas
U    packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
--- Recording mergeinfo for merge of r30399 into '.':
 G   .
--- Merging r30400 into '.':
G    packages/fcl-db/src/base/db.pas
--- Recording mergeinfo for merge of r30400 into '.':
 G   .
--- Merging r30417 into '.':
U    packages/fcl-db/fpmake.pp
A    packages/fcl-db/tests/tccsvdataset.pp
U    packages/fcl-db/tests/dbtestframework.pas
U    packages/fcl-db/tests/dbtestframework_gui.lpi
U    packages/fcl-db/tests/dbtestframework_gui.lpr
A    packages/fcl-db/src/base/csvdataset.pp
--- Recording mergeinfo for merge of r30417 into '.':
 G   .
--- Merging r30416 into '.':
U    packages/fcl-base/fpmake.pp
A    packages/fcl-base/src/csvdocument.pp
A    packages/fcl-base/src/csvreadwrite.pp
--- Recording mergeinfo for merge of r30416 into '.':
 G   .
--- Merging r30418 into '.':
U    packages/fcl-db/src/export/fpcsvexport.pp
U    packages/fcl-db/tests/testdbexport.pas
--- Recording mergeinfo for merge of r30418 into '.':
 G   .
--- Merging r30421 into '.':
U    packages/fcl-db/tests/tcsdfdata.pp
U    packages/fcl-db/src/sdf/sdfdata.pp
--- Recording mergeinfo for merge of r30421 into '.':
 G   .
--- Merging r30431 into '.':
G    packages/fcl-db/src/base/db.pas
U    packages/fcl-db/src/base/database.inc
--- Recording mergeinfo for merge of r30431 into '.':
 G   .
--- Merging r30433 into '.':
G    packages/fcl-db/src/base/bufdataset.pas
U    packages/fcl-db/src/base/csvdataset.pp
--- Recording mergeinfo for merge of r30433 into '.':
 G   .
--- Merging r30434 into '.':
U    packages/fcl-db/src/base/dbconst.pas
G    packages/fcl-db/src/base/bufdataset.pas
--- Recording mergeinfo for merge of r30434 into '.':
 G   .
--- Merging r30435 into '.':
G    packages/fcl-db/src/base/db.pas
U    packages/fcl-db/src/base/fields.inc
G    packages/fcl-db/src/base/dataset.inc
--- Recording mergeinfo for merge of r30435 into '.':
 G   .
--- Merging r30437 into '.':
G    packages/fcl-db/src/sqldb/sqldb.pp
--- Recording mergeinfo for merge of r30437 into '.':
 G   .

# revisions: 30137,30138,30139,30149,30154,30155,30291,30295,30305,30306,30325,30366,30383,30397,30399,30400,30417,30416,30418,30421,30431,30433,30434,30435,30437

git-svn-id: branches/fixes_3_0@31068 -

.gitattributes

@@ -1988,6 +1988,8 @@ packages/fcl-base/src/blowfish.pp svneol=native#text/plain
 packages/fcl-base/src/bufstream.pp svneol=native#text/plain
 packages/fcl-base/src/cachecls.pp svneol=native#text/plain
 packages/fcl-base/src/contnrs.pp svneol=native#text/plain
+packages/fcl-base/src/csvdocument.pp svneol=native#text/plain
+packages/fcl-base/src/csvreadwrite.pp svneol=native#text/plain
 packages/fcl-base/src/custapp.pp svneol=native#text/plain
 packages/fcl-base/src/dummy/eventlog.inc svneol=native#text/plain
 packages/fcl-base/src/eventlog.pp svneol=native#text/plain
@@ -2051,6 +2053,7 @@ packages/fcl-db/src/base/Makefile svneol=native#text/plain
 packages/fcl-db/src/base/Makefile.fpc svneol=native#text/plain
 packages/fcl-db/src/base/bufdataset.pas svneol=native#text/plain
 packages/fcl-db/src/base/bufdataset_parser.pp svneol=native#text/plain
+packages/fcl-db/src/base/csvdataset.pp svneol=native#text/plain
 packages/fcl-db/src/base/database.inc svneol=native#text/plain
 packages/fcl-db/src/base/dataset.inc svneol=native#text/plain
 packages/fcl-db/src/base/datasource.inc svneol=native#text/plain
@@ -2264,6 +2267,7 @@ packages/fcl-db/tests/memdstoolsunit.pas svneol=native#text/plain
 packages/fcl-db/tests/reruntest.sh svneol=native#text/plain
 packages/fcl-db/tests/sdfdstoolsunit.pas svneol=native#text/plain
 packages/fcl-db/tests/sqldbtoolsunit.pas svneol=native#text/plain
+packages/fcl-db/tests/tccsvdataset.pp svneol=native#text/plain
 packages/fcl-db/tests/tcgensql.pas svneol=native#text/plain
 packages/fcl-db/tests/tcparser.pas svneol=native#text/plain
 packages/fcl-db/tests/tcsdfdata.pp svneol=native#text/plain

packages/fcl-base/fpmake.pp

@@ -108,10 +108,15 @@ begin
     T:=P.Targets.AddUnit('fpexprpars.pp');
       T.ResourceStrings:=true;
 
-    // Windows units
     T:=P.Targets.AddUnit('fileinfo.pp');
     T:=P.Targets.addUnit('fpmimetypes.pp');
-
+    T:=P.Targets.AddUnit('csvreadwrite.pp');
+    T:=P.Targets.addUnit('csvdocument.pp');
+    With T.Dependencies do
+      begin
+      AddUnit('csvreadwrite');
+      AddUnit('contnrs');
+      end;
     // Additional sources
     P.Sources.AddSrcFiles('src/win/fclel.*');
     // Install windows resources

packages/fcl-base/src/csvdocument.pp

@@ -0,0 +1,586 @@
+{
+  CSV  Document classes.
+  Version 0.5 2014-10-25
+
+  Copyright (C) 2010-2014 Vladimir Zhirov <[email protected]>
+
+  Contributors:
+    Luiz Americo Pereira Camara
+    Mattias Gaertner
+    Reinier Olislagers
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+unit csvdocument;
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+
+interface
+
+uses
+  Classes, SysUtils, Contnrs, csvreadwrite;
+
+type
+  TCSVChar = csvreadwrite.TCSVChar;
+  TCSVParser = csvreadwrite.TCSVParser;
+  TCSVBuilder = csvreadwrite.TCSVBuilder;
+
+  {$IFNDEF FPC}
+  TFPObjectList = TObjectList;
+  {$ENDIF}
+
+  // Random access to CSV document. Reads entire document into memory.
+  TCSVDocument = class(TCSVHandler)
+  private
+    FRows: TFPObjectList;
+    FParser: TCSVParser;
+    FBuilder: TCSVBuilder;
+    // helpers
+    procedure ForceRowIndex(ARowIndex: Integer);
+    function  CreateNewRow(const AFirstCell: String = ''): TObject;
+    // property getters/setters
+    function  GetCell(ACol, ARow: Integer): String;
+    procedure SetCell(ACol, ARow: Integer; const AValue: String);
+    function  GetCSVText: String;
+    procedure SetCSVText(const AValue: String);
+    function  GetRowCount: Integer;
+    function  GetColCount(ARow: Integer): Integer;
+    function  GetMaxColCount: Integer;
+  public
+    constructor Create;
+    destructor  Destroy; override;
+
+    // Input/output
+
+    // Load document from file AFileName
+    procedure LoadFromFile(const AFilename: String);
+    // Load document from stream AStream
+    procedure LoadFromStream(AStream: TStream);
+    // Save document to file AFilename
+    procedure SaveToFile(const AFilename: String);
+    // Save document to stream AStream
+    procedure SaveToStream(AStream: TStream);
+
+    // Row and cell operations
+
+    // Add a new row and a cell with content AFirstCell
+    procedure AddRow(const AFirstCell: String = '');
+    // Add a cell at row ARow with data AValue
+    procedure AddCell(ARow: Integer; const AValue: String = '');
+    // Insert a row at row ARow with first cell data AFirstCell
+    // If there is no row ARow, insert row at end
+    procedure InsertRow(ARow: Integer; const AFirstCell: String = '');
+    // Insert a cell at specified position with data AValue
+    procedure InsertCell(ACol, ARow: Integer; const AValue: String = '');
+    // Remove specified row
+    procedure RemoveRow(ARow: Integer);
+    // Remove specified cell
+    procedure RemoveCell(ACol, ARow: Integer);
+    // Indicates if there is a row at specified position
+    function  HasRow(ARow: Integer): Boolean;
+    // Indicates if there is a cell at specified position
+    function  HasCell(ACol, ARow: Integer): Boolean;
+    
+    // Search
+    
+    // Return column for cell data AString at row ARow
+    function  IndexOfCol(const AString: String; ARow: Integer): Integer;
+    // Return row for cell data AString at coloumn ACol
+    function  IndexOfRow(const AString: String; ACol: Integer): Integer;
+
+    // Utils
+
+    // Remove all data
+    procedure Clear;
+    // Copy entire row ARow to row position AInsertPos.
+    // Adds empty rows if necessary
+    procedure CloneRow(ARow, AInsertPos: Integer);
+    // Exchange contents of the two specified rows
+    procedure ExchangeRows(ARow1, ARow2: Integer);
+    // Rewrite all line endings within cell data to LineEnding
+    procedure UnifyEmbeddedLineEndings;
+    // Remove empty cells at end of rows from entire document
+    procedure RemoveTrailingEmptyCells;
+
+    // Properties
+
+    // Cell data at column ACol, row ARow.
+    property Cells[ACol, ARow: Integer]: String read GetCell write SetCell; default;
+    // Number of rows
+    property RowCount: Integer read GetRowCount;
+    // Number of columns for row ARow
+    property ColCount[ARow: Integer]: Integer read GetColCount;
+    // Maximum number of columns found in all rows in document
+    property MaxColCount: Integer read GetMaxColCount;
+    // Document formatted as CSV text
+    property CSVText: String read GetCSVText write SetCSVText;
+  end;
+
+implementation
+
+
+//------------------------------------------------------------------------------
+
+type
+  TCSVCell = class
+  public
+    // Value (contents) of cell in string form
+    Value: String;
+  end;
+
+  TCSVRow = class
+  private
+    FCells: TFPObjectList;
+    procedure ForceCellIndex(ACellIndex: Integer);
+    function  CreateNewCell(const AValue: String): TCSVCell;
+    function  GetCellValue(ACol: Integer): String;
+    procedure SetCellValue(ACol: Integer; const AValue: String);
+    function  GetColCount: Integer;
+  public
+    constructor Create;
+    destructor  Destroy; override;
+    // cell operations
+    // Add cell with value AValue to row
+    procedure AddCell(const AValue: String = '');
+    // Insert cell with value AValue at specified column
+    procedure InsertCell(ACol: Integer; const AValue: String);
+    // Remove cell from specified column
+    procedure RemoveCell(ACol: Integer);
+    // Indicates if specified column contains a cell/data
+    function  HasCell(ACol: Integer): Boolean;
+    // utilities
+    // Copy entire row
+    function  Clone: TCSVRow;
+    // Remove all empty cells at the end of the row
+    procedure TrimEmptyCells;
+    // Replace various line endings in data with ALineEnding
+    procedure SetValuesLineEnding(const ALineEnding: String);
+    // properties
+    // Value/data of cell at column ACol
+    property CellValue[ACol: Integer]: String read GetCellValue write SetCellValue;
+    // Number of columns in row
+    property ColCount: Integer read GetColCount;
+  end;
+
+{ TCSVRow }
+
+procedure TCSVRow.ForceCellIndex(ACellIndex: Integer);
+begin
+  while FCells.Count <= ACellIndex do
+    AddCell();
+end;
+
+function TCSVRow.CreateNewCell(const AValue: String): TCSVCell;
+begin
+  Result := TCSVCell.Create;
+  Result.Value := AValue;
+end;
+
+function TCSVRow.GetCellValue(ACol: Integer): String;
+begin
+  if HasCell(ACol) then
+    Result := TCSVCell(FCells[ACol]).Value
+  else
+    Result := '';
+end;
+
+procedure TCSVRow.SetCellValue(ACol: Integer; const AValue: String);
+begin
+  ForceCellIndex(ACol);
+  TCSVCell(FCells[ACol]).Value := AValue;
+end;
+
+function TCSVRow.GetColCount: Integer;
+begin
+  Result := FCells.Count;
+end;
+
+constructor TCSVRow.Create;
+begin
+  inherited Create;
+  FCells := TFPObjectList.Create;
+end;
+
+destructor TCSVRow.Destroy;
+begin
+  FreeAndNil(FCells);
+  inherited Destroy;
+end;
+
+procedure TCSVRow.AddCell(const AValue: String = '');
+begin
+  FCells.Add(CreateNewCell(AValue));
+end;
+
+procedure TCSVRow.InsertCell(ACol: Integer; const AValue: String);
+begin
+  FCells.Insert(ACol, CreateNewCell(AValue));
+end;
+
+procedure TCSVRow.RemoveCell(ACol: Integer);
+begin
+  if HasCell(ACol) then
+    FCells.Delete(ACol);
+end;
+
+function TCSVRow.HasCell(ACol: Integer): Boolean;
+begin
+  Result := (ACol >= 0) and (ACol < FCells.Count);
+end;
+
+function TCSVRow.Clone: TCSVRow;
+var
+  I: Integer;
+begin
+  Result := TCSVRow.Create;
+  for I := 0 to ColCount - 1 do
+    Result.AddCell(CellValue[I]);
+end;
+
+procedure TCSVRow.TrimEmptyCells;
+var
+  I: Integer;
+  MaxCol: Integer;
+begin
+  MaxCol := FCells.Count - 1;
+  for I := MaxCol downto 0 do
+  begin
+    if (TCSVCell(FCells[I]).Value = '') then
+    begin
+      if (FCells.Count > 1) then
+        FCells.Delete(I);
+    end else
+      break; // We hit the first non-empty cell so stop
+  end;
+end;
+
+procedure TCSVRow.SetValuesLineEnding(const ALineEnding: String);
+var
+  I: Integer;
+begin
+  for I := 0 to FCells.Count - 1 do
+    CellValue[I] := ChangeLineEndings(CellValue[I], ALineEnding);
+end;
+
+{ TCSVDocument }
+
+procedure TCSVDocument.ForceRowIndex(ARowIndex: Integer);
+begin
+  while FRows.Count <= ARowIndex do
+    AddRow();
+end;
+
+function TCSVDocument.CreateNewRow(const AFirstCell: String): TObject;
+var
+  NewRow: TCSVRow;
+begin
+  NewRow := TCSVRow.Create;
+  if AFirstCell <> '' then
+    NewRow.AddCell(AFirstCell);
+  Result := NewRow;
+end;
+
+function TCSVDocument.GetCell(ACol, ARow: Integer): String;
+begin
+  if HasRow(ARow) then
+    Result := TCSVRow(FRows[ARow]).CellValue[ACol]
+  else
+    Result := '';
+end;
+
+procedure TCSVDocument.SetCell(ACol, ARow: Integer; const AValue: String);
+begin
+  ForceRowIndex(ARow);
+  TCSVRow(FRows[ARow]).CellValue[ACol] := AValue;
+end;
+
+function TCSVDocument.GetCSVText: String;
+var
+  StringStream: TStringStream;
+begin
+  StringStream := TStringStream.Create('');
+  try
+    SaveToStream(StringStream);
+    Result := StringStream.DataString;
+  finally
+    FreeAndNil(StringStream);
+  end;
+end;
+
+procedure TCSVDocument.SetCSVText(const AValue: String);
+var
+  StringStream: TStringStream;
+begin
+  StringStream := TStringStream.Create(AValue);
+  try
+    LoadFromStream(StringStream);
+  finally
+    FreeAndNil(StringStream);
+  end;
+end;
+
+function TCSVDocument.GetRowCount: Integer;
+begin
+  Result := FRows.Count;
+end;
+
+function TCSVDocument.GetColCount(ARow: Integer): Integer;
+begin
+  if HasRow(ARow) then
+    Result := TCSVRow(FRows[ARow]).ColCount
+  else
+    Result := 0;
+end;
+
+// Returns maximum number of columns in the document
+function TCSVDocument.GetMaxColCount: Integer;
+var
+  I, CC: Integer;
+begin
+  // While calling MaxColCount in TCSVParser could work,
+  // we'd need to adjust for any subsequent changes in
+  // TCSVDocument
+  Result := 0;
+  for I := 0 to RowCount - 1 do
+  begin
+    CC := ColCount[I];
+    if CC > Result then
+      Result := CC;
+  end;
+end;
+
+constructor TCSVDocument.Create;
+begin
+  inherited Create;
+  FRows := TFPObjectList.Create;
+  FParser := nil;
+  FBuilder := nil;
+end;
+
+destructor TCSVDocument.Destroy;
+begin
+  FreeAndNil(FBuilder);
+  FreeAndNil(FParser);
+  FreeAndNil(FRows);
+  inherited Destroy;
+end;
+
+procedure TCSVDocument.LoadFromFile(const AFilename: String);
+var
+  FileStream: TFileStream;
+begin
+  FileStream := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyNone);
+  try
+    LoadFromStream(FileStream);
+  finally
+    FileStream.Free;
+  end;
+end;
+
+procedure TCSVDocument.LoadFromStream(AStream: TStream);
+var
+  I, J, MaxCol: Integer;
+begin
+  Clear;
+
+  if not Assigned(FParser) then
+    FParser := TCSVParser.Create;
+
+  FParser.AssignCSVProperties(Self);
+  with FParser do
+  begin
+    SetSource(AStream);
+    while ParseNextCell do
+      Cells[CurrentCol, CurrentRow] := CurrentCellText;
+  end;
+
+  if FEqualColCountPerRow then
+  begin
+    MaxCol := MaxColCount - 1;
+    for I := 0 to RowCount - 1 do
+      for J := ColCount[I] to MaxCol do
+        Cells[J, I] := '';
+  end;
+end;
+
+procedure TCSVDocument.SaveToFile(const AFilename: String);
+var
+  FileStream: TFileStream;
+begin
+  FileStream := TFileStream.Create(AFilename, fmCreate);
+  try
+    SaveToStream(FileStream);
+  finally
+    FileStream.Free;
+  end;
+end;
+
+procedure TCSVDocument.SaveToStream(AStream: TStream);
+var
+  I, J, MaxCol: Integer;
+begin
+  if not Assigned(FBuilder) then
+    FBuilder := TCSVBuilder.Create;
+
+  FBuilder.AssignCSVProperties(Self);
+  with FBuilder do
+  begin
+    if FEqualColCountPerRow then
+      MaxCol := MaxColCount - 1;
+
+    SetOutput(AStream);
+    for I := 0 to RowCount - 1 do
+    begin
+      if not FEqualColCountPerRow then
+        MaxCol := ColCount[I] - 1;
+      for J := 0 to MaxCol do
+        AppendCell(Cells[J, I]);
+      AppendRow;
+    end;
+  end;
+end;
+
+procedure TCSVDocument.AddRow(const AFirstCell: String = '');
+begin
+  FRows.Add(CreateNewRow(AFirstCell));
+end;
+
+procedure TCSVDocument.AddCell(ARow: Integer; const AValue: String = '');
+begin
+  ForceRowIndex(ARow);
+  TCSVRow(FRows[ARow]).AddCell(AValue);
+end;
+
+procedure TCSVDocument.InsertRow(ARow: Integer; const AFirstCell: String = '');
+begin
+  if HasRow(ARow) then
+    FRows.Insert(ARow, CreateNewRow(AFirstCell))
+  else
+    AddRow(AFirstCell);
+end;
+
+procedure TCSVDocument.InsertCell(ACol, ARow: Integer; const AValue: String);
+begin
+  ForceRowIndex(ARow);
+  TCSVRow(FRows[ARow]).InsertCell(ACol, AValue);
+end;
+
+procedure TCSVDocument.RemoveRow(ARow: Integer);
+begin
+  if HasRow(ARow) then
+    FRows.Delete(ARow);
+end;
+
+procedure TCSVDocument.RemoveCell(ACol, ARow: Integer);
+begin
+  if HasRow(ARow) then
+    TCSVRow(FRows[ARow]).RemoveCell(ACol);
+end;
+
+function TCSVDocument.HasRow(ARow: Integer): Boolean;
+begin
+  Result := (ARow >= 0) and (ARow < FRows.Count);
+end;
+
+function TCSVDocument.HasCell(ACol, ARow: Integer): Boolean;
+begin
+  if HasRow(ARow) then
+    Result := TCSVRow(FRows[ARow]).HasCell(ACol)
+  else
+    Result := False;
+end;
+
+function TCSVDocument.IndexOfCol(const AString: String; ARow: Integer): Integer;
+var
+  CC: Integer;
+begin
+  CC := ColCount[ARow];
+  Result := 0;
+  while (Result < CC) and (Cells[Result, ARow] <> AString) do
+    Inc(Result);
+  if Result = CC then
+    Result := -1;
+end;
+
+function TCSVDocument.IndexOfRow(const AString: String; ACol: Integer): Integer;
+var
+  RC: Integer;
+begin
+  RC := RowCount;
+  Result := 0;
+  while (Result < RC) and (Cells[ACol, Result] <> AString) do
+    Inc(Result);
+  if Result = RC then
+    Result := -1;
+end;
+
+procedure TCSVDocument.Clear;
+begin
+  FRows.Clear;
+end;
+
+procedure TCSVDocument.CloneRow(ARow, AInsertPos: Integer);
+var
+  NewRow: TObject;
+begin
+  if not HasRow(ARow) then
+    Exit;
+  NewRow := TCSVRow(FRows[ARow]).Clone;
+  if not HasRow(AInsertPos) then
+  begin
+    ForceRowIndex(AInsertPos - 1);
+    FRows.Add(NewRow);
+  end else
+    FRows.Insert(AInsertPos, NewRow);
+end;
+
+procedure TCSVDocument.ExchangeRows(ARow1, ARow2: Integer);
+begin
+  if not (HasRow(ARow1) and HasRow(ARow2)) then
+    Exit;
+  FRows.Exchange(ARow1, ARow2);
+end;
+
+procedure TCSVDocument.UnifyEmbeddedLineEndings;
+var
+  I: Integer;
+begin
+  for I := 0 to FRows.Count - 1 do
+    TCSVRow(FRows[I]).SetValuesLineEnding(FLineEnding);
+end;
+
+procedure TCSVDocument.RemoveTrailingEmptyCells;
+var
+  I: Integer;
+begin
+  for I := 0 to FRows.Count - 1 do
+    TCSVRow(FRows[I]).TrimEmptyCells;
+end;
+
+end.

packages/fcl-base/src/csvreadwrite.pp

@@ -0,0 +1,599 @@
+{
+  CSV Parser, Builder classes.
+  Version 0.5 2014-10-25
+
+  Copyright (C) 2010-2014 Vladimir Zhirov <[email protected]>
+
+  Contributors:
+    Luiz Americo Pereira Camara
+    Mattias Gaertner
+    Reinier Olislagers
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+unit csvreadwrite;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, strutils;
+
+Type
+  TCSVChar = Char;
+
+  { TCSVHandler }
+
+  TCSVHandler = class(TPersistent)
+  private
+    procedure SetDelimiter(const AValue: TCSVChar);
+    procedure SetQuoteChar(const AValue: TCSVChar);
+    procedure UpdateCachedChars;
+  protected
+    // special chars
+    FDelimiter: TCSVChar;
+    FQuoteChar: TCSVChar;
+    FLineEnding: String;
+    // cached values to speed up special chars operations
+    FSpecialChars: TSysCharSet;
+    FDoubleQuote: String;
+    // parser settings
+    FIgnoreOuterWhitespace: Boolean;
+    // builder settings
+    FQuoteOuterWhitespace: Boolean;
+    // document settings
+    FEqualColCountPerRow: Boolean;
+  public
+    constructor Create; virtual;
+    procedure Assign(ASource: TPersistent); override;
+    procedure AssignCSVProperties(ASource: TCSVHandler);
+    // Delimiter that separates the field, e.g. comma, semicolon, tab
+    property Delimiter: TCSVChar read FDelimiter write SetDelimiter;
+    // Character used to quote "problematic" data
+    // (e.g. with delimiters or spaces in them)
+    // A common quotechar is "
+    property QuoteChar: TCSVChar read FQuoteChar write SetQuoteChar;
+    // String at the end of the line of data (e.g. CRLF)
+    property LineEnding: String read FLineEnding write FLineEnding;
+    // Ignore whitespace between delimiters and field data
+    property IgnoreOuterWhitespace: Boolean read FIgnoreOuterWhitespace write FIgnoreOuterWhitespace;
+    // Use quotes when outer whitespace is found
+    property QuoteOuterWhitespace: Boolean read FQuoteOuterWhitespace write FQuoteOuterWhitespace;
+    // When reading and writing: make sure every line has the same column count, create empty cells in the end of row if required
+    property EqualColCountPerRow: Boolean read FEqualColCountPerRow write FEqualColCountPerRow;
+  end;
+
+  // Sequential input from CSV stream
+
+  { TCSVParser }
+
+  TCSVParser = class(TCSVHandler)
+  private
+    FFreeStream: Boolean;
+    // fields
+    FSourceStream: TStream;
+    FStrStreamWrapper: TStringStream;
+    // parser state
+    EndOfFile: Boolean;
+    EndOfLine: Boolean;
+    FCurrentChar: TCSVChar;
+    FCurrentRow: Integer;
+    FCurrentCol: Integer;
+    FMaxColCount: Integer;
+    // output buffers
+    FCellBuffer: String;
+    FWhitespaceBuffer: String;
+    procedure ClearOutput;
+    // basic parsing
+    procedure SkipEndOfLine;
+    procedure SkipDelimiter;
+    procedure SkipWhitespace;
+    procedure NextChar;
+    // complex parsing
+    procedure ParseCell;
+    procedure ParseQuotedValue;
+    // simple parsing
+    procedure ParseValue;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    // Source data stream
+    procedure SetSource(AStream: TStream); overload;
+    // Source data string.
+    procedure SetSource(const AString: String); overload;
+    // Rewind to beginning of data
+    procedure ResetParser;
+    // Read next cell data; return false if end of file reached
+    function  ParseNextCell: Boolean;
+    // Current row (0 based)
+    property CurrentRow: Integer read FCurrentRow;
+    // Current column (0 based); -1 if invalid/before beginning of file
+    property CurrentCol: Integer read FCurrentCol;
+    // Data in current cell
+    property CurrentCellText: String read FCellBuffer;
+    // The maximum number of columns found in the stream:
+    property MaxColCount: Integer read FMaxColCount;
+    // Does the parser own the stream ? If true, a previous stream is freed when set or when parser is destroyed.
+    Property FreeStream : Boolean Read FFreeStream Write FFreeStream;
+  end;
+
+  // Sequential output to CSV stream
+  TCSVBuilder = class(TCSVHandler)
+  private
+    FOutputStream: TStream;
+    FDefaultOutput: TMemoryStream;
+    FNeedLeadingDelimiter: Boolean;
+    function GetDefaultOutputAsString: String;
+  protected
+    procedure AppendStringToStream(const AString: String; AStream: TStream);
+    function  QuoteCSVString(const AValue: String): String;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    // Set output/destination stream.
+    // If not called, output is sent to DefaultOutput
+    procedure SetOutput(AStream: TStream);
+    // If using default stream, reset output to beginning.
+    // If using user-defined stream, user should reposition stream himself
+    procedure ResetBuilder;
+    // Add a cell to the output with data AValue
+    procedure AppendCell(const AValue: String);
+    // Write end of row to the output, starting a new row
+    procedure AppendRow;
+    // Default output as memorystream (if output not set using SetOutput)
+    property DefaultOutput: TMemoryStream read FDefaultOutput;
+    // Default output in string format (if output not set using SetOutput)
+    property DefaultOutputAsString: String read GetDefaultOutputAsString;
+  end;
+
+function ChangeLineEndings(const AString, ALineEnding: String): String;
+
+implementation
+
+const
+  CsvCharSize = SizeOf(TCSVChar);
+  CR    = #13;
+  LF    = #10;
+  HTAB  = #9;
+  SPACE = #32;
+  WhitespaceChars = [HTAB, SPACE];
+  LineEndingChars = [CR, LF];
+
+// The following implementation of ChangeLineEndings function originates from
+// Lazarus CodeTools library by Mattias Gaertner. It was explicitly allowed
+// by Mattias to relicense it under modified LGPL and include into CsvDocument.
+
+function ChangeLineEndings(const AString, ALineEnding: String): String;
+var
+  I: Integer;
+  Src: PChar;
+  Dest: PChar;
+  DestLength: Integer;
+  EndingLength: Integer;
+  EndPos: PChar;
+begin
+  if AString = '' then
+    Exit(AString);
+  EndingLength := Length(ALineEnding);
+  DestLength := Length(AString);
+
+  Src := PChar(AString);
+  EndPos := Src + DestLength;
+  while Src < EndPos do
+  begin
+    if (Src^ = CR) then
+    begin
+      Inc(Src);
+      if (Src^ = LF) then
+      begin
+        Inc(Src);
+        Inc(DestLength, EndingLength - 2);
+      end else
+        Inc(DestLength, EndingLength - 1);
+    end else
+    begin
+      if (Src^ = LF) then
+        Inc(DestLength, EndingLength - 1);
+      Inc(Src);
+    end;
+  end;
+
+  SetLength(Result, DestLength);
+  Src := PChar(AString);
+  Dest := PChar(Result);
+  EndPos := Dest + DestLength;
+  while (Dest < EndPos) do
+  begin
+    if Src^ in LineEndingChars then
+    begin
+      for I := 1 to EndingLength do
+      begin
+        Dest^ := ALineEnding[I];
+        Inc(Dest);
+      end;
+      if (Src^ = CR) and (Src[1] = LF) then
+        Inc(Src, 2)
+      else
+        Inc(Src);
+    end else
+    begin
+      Dest^ := Src^;
+      Inc(Src);
+      Inc(Dest);
+    end;
+  end;
+end;
+
+{ TCSVHandler }
+
+procedure TCSVHandler.SetDelimiter(const AValue: TCSVChar);
+begin
+  if FDelimiter <> AValue then
+  begin
+    FDelimiter := AValue;
+    UpdateCachedChars;
+  end;
+end;
+
+procedure TCSVHandler.SetQuoteChar(const AValue: TCSVChar);
+begin
+  if FQuoteChar <> AValue then
+  begin
+    FQuoteChar := AValue;
+    UpdateCachedChars;
+  end;
+end;
+
+procedure TCSVHandler.UpdateCachedChars;
+begin
+  FDoubleQuote := FQuoteChar + FQuoteChar;
+  FSpecialChars := [CR, LF, FDelimiter, FQuoteChar];
+end;
+
+constructor TCSVHandler.Create;
+begin
+  inherited Create;
+  FDelimiter := ',';
+  FQuoteChar := '"';
+  FLineEnding := sLineBreak;
+  FIgnoreOuterWhitespace := False;
+  FQuoteOuterWhitespace := True;
+  FEqualColCountPerRow := True;
+  UpdateCachedChars;
+end;
+
+procedure TCSVHandler.Assign(ASource: TPersistent);
+begin
+  if (ASource is TCSVHandler) then
+    AssignCSVProperties(ASource as TCSVHandler)
+  else
+    inherited Assign(ASource);
+end;
+
+procedure TCSVHandler.AssignCSVProperties(ASource: TCSVHandler);
+begin
+  FDelimiter := ASource.FDelimiter;
+  FQuoteChar := ASource.FQuoteChar;
+  FLineEnding := ASource.FLineEnding;
+  FIgnoreOuterWhitespace := ASource.FIgnoreOuterWhitespace;
+  FQuoteOuterWhitespace := ASource.FQuoteOuterWhitespace;
+  FEqualColCountPerRow := ASource.FEqualColCountPerRow;
+  UpdateCachedChars;
+end;
+
+{ TCSVParser }
+
+procedure TCSVParser.ClearOutput;
+begin
+  FCellBuffer := '';
+  FWhitespaceBuffer := '';
+  FCurrentRow := 0;
+  FCurrentCol := -1;
+  FMaxColCount := 0;
+end;
+
+procedure TCSVParser.SkipEndOfLine;
+begin
+  // treat LF+CR as two linebreaks, not one
+  if (FCurrentChar = CR) then
+    NextChar;
+  if (FCurrentChar = LF) then
+    NextChar;
+end;
+
+procedure TCSVParser.SkipDelimiter;
+begin
+  if FCurrentChar = FDelimiter then
+    NextChar;
+end;
+
+procedure TCSVParser.SkipWhitespace;
+begin
+  while FCurrentChar = SPACE do
+    NextChar;
+end;
+
+procedure TCSVParser.NextChar;
+begin
+  if FSourceStream.Read(FCurrentChar, CsvCharSize) < CsvCharSize then
+  begin
+    FCurrentChar := #0;
+    EndOfFile := True;
+  end;
+  EndOfLine := FCurrentChar in LineEndingChars;
+end;
+
+procedure TCSVParser.ParseCell;
+begin
+  FCellBuffer := '';
+  if FIgnoreOuterWhitespace then
+    SkipWhitespace;
+  if FCurrentChar = FQuoteChar then
+    ParseQuotedValue
+  else
+    ParseValue;
+end;
+
+procedure TCSVParser.ParseQuotedValue;
+var
+  QuotationEnd: Boolean;
+begin
+  NextChar; // skip opening quotation char
+  repeat
+    // read value up to next quotation char
+    while not ((FCurrentChar = FQuoteChar) or EndOfFile) do
+    begin
+      if EndOfLine then
+      begin
+        AppendStr(FCellBuffer, FLineEnding);
+        SkipEndOfLine;
+      end else
+      begin
+        AppendStr(FCellBuffer, FCurrentChar);
+        NextChar;
+      end;
+    end;
+    // skip quotation char (closing or escaping)
+    if not EndOfFile then
+      NextChar;
+    // check if it was escaping
+    if FCurrentChar = FQuoteChar then
+    begin
+      AppendStr(FCellBuffer, FCurrentChar);
+      QuotationEnd := False;
+      NextChar;
+    end else
+      QuotationEnd := True;
+  until QuotationEnd;
+  // read the rest of the value until separator or new line
+  ParseValue;
+end;
+
+procedure TCSVParser.ParseValue;
+begin
+  while not ((FCurrentChar = FDelimiter) or EndOfLine or EndOfFile) do
+  begin
+    AppendStr(FWhitespaceBuffer, FCurrentChar);
+    NextChar;
+  end;
+  // merge whitespace buffer
+  if FIgnoreOuterWhitespace then
+    RemoveTrailingChars(FWhitespaceBuffer, WhitespaceChars);
+  AppendStr(FCellBuffer, FWhitespaceBuffer);
+  FWhitespaceBuffer := '';
+end;
+
+constructor TCSVParser.Create;
+begin
+  inherited Create;
+  ClearOutput;
+  FStrStreamWrapper := nil;
+  EndOfFile := True;
+end;
+
+destructor TCSVParser.Destroy;
+begin
+  if FFreeStream and (FSourceStream<>FStrStreamWrapper) then
+     FreeAndNil(FSourceStream);
+  FreeAndNil(FStrStreamWrapper);
+  inherited Destroy;
+end;
+
+procedure TCSVParser.SetSource(AStream: TStream);
+begin
+  If FSourceStream=AStream then exit;
+  if FFreeStream and (FSourceStream<>FStrStreamWrapper) then
+     FreeAndNil(FSourceStream);
+  FSourceStream := AStream;
+  ResetParser;
+end;
+
+procedure TCSVParser.SetSource(const AString: String); overload;
+begin
+  FreeAndNil(FStrStreamWrapper);
+  FStrStreamWrapper := TStringStream.Create(AString);
+  SetSource(FStrStreamWrapper);
+end;
+
+procedure TCSVParser.ResetParser;
+begin
+  ClearOutput;
+  FSourceStream.Seek(0, soFromBeginning);
+  EndOfFile := False;
+  NextChar;
+end;
+
+// Parses next cell; returns True if there are more cells in the input stream.
+function TCSVParser.ParseNextCell: Boolean;
+var
+  LineColCount: Integer;
+begin
+  if EndOfLine or EndOfFile then
+  begin
+    // Having read the previous line, adjust column count if necessary:
+    LineColCount := FCurrentCol + 1;
+    if LineColCount > FMaxColCount then
+      FMaxColCount := LineColCount;
+  end;
+
+  if EndOfFile then
+    Exit(False);
+
+  // Handle line ending
+  if EndOfLine then
+  begin
+    SkipEndOfLine;
+    if EndOfFile then
+      Exit(False);
+    FCurrentCol := 0;
+    Inc(FCurrentRow);
+  end else
+    Inc(FCurrentCol);
+
+  // Skipping a delimiter should be immediately followed by parsing a cell
+  // without checking for line break first, otherwise we miss last empty cell.
+  // But 0th cell does not start with delimiter unlike other cells, so
+  // the following check is required not to miss the first empty cell:
+  if FCurrentCol > 0 then
+    SkipDelimiter;
+  ParseCell;
+  Result := True;
+end;
+
+{ TCSVBuilder }
+
+function TCSVBuilder.GetDefaultOutputAsString: String;
+var
+  StreamSize: Integer;
+begin
+  Result := '';
+  StreamSize := FDefaultOutput.Size;
+  if StreamSize > 0 then
+  begin
+    SetLength(Result, StreamSize);
+    FDefaultOutput.ReadBuffer(Result[1], StreamSize);
+  end;
+end;
+
+procedure TCSVBuilder.AppendStringToStream(const AString: String; AStream: TStream);
+var
+  StrLen: Integer;
+begin
+  StrLen := Length(AString);
+  if StrLen > 0 then
+    AStream.WriteBuffer(AString[1], StrLen);
+end;
+
+function TCSVBuilder.QuoteCSVString(const AValue: String): String;
+var
+  I: Integer;
+  ValueLen: Integer;
+  NeedQuotation: Boolean;
+begin
+  ValueLen := Length(AValue);
+
+  NeedQuotation := (AValue <> '') and FQuoteOuterWhitespace
+    and ((AValue[1] in WhitespaceChars) or (AValue[ValueLen] in WhitespaceChars));
+
+  if not NeedQuotation then
+    for I := 1 to ValueLen do
+    begin
+      if AValue[I] in FSpecialChars then
+      begin
+        NeedQuotation := True;
+        Break;
+      end;
+    end;
+
+  if NeedQuotation then
+  begin
+    // double existing quotes
+    Result := FDoubleQuote;
+    Insert(StringReplace(AValue, FQuoteChar, FDoubleQuote, [rfReplaceAll]),
+      Result, 2);
+  end else
+    Result := AValue;
+end;
+
+constructor TCSVBuilder.Create;
+begin
+  inherited Create;
+  FDefaultOutput := TMemoryStream.Create;
+  FOutputStream := FDefaultOutput;
+end;
+
+destructor TCSVBuilder.Destroy;
+begin
+  FreeAndNil(FDefaultOutput);
+  inherited Destroy;
+end;
+
+procedure TCSVBuilder.SetOutput(AStream: TStream);
+begin
+  if Assigned(AStream) then
+    FOutputStream := AStream
+  else
+    FOutputStream := FDefaultOutput;
+
+  ResetBuilder;
+end;
+
+procedure TCSVBuilder.ResetBuilder;
+begin
+  if FOutputStream = FDefaultOutput then
+    FDefaultOutput.Clear;
+
+  // Do not clear external FOutputStream because it may be pipe stream
+  // or something else that does not support size and position.
+  // To clear external output is up to the user of TCSVBuilder.
+
+  FNeedLeadingDelimiter := False;
+end;
+
+procedure TCSVBuilder.AppendCell(const AValue: String);
+var
+  CellValue: String;
+begin
+  if FNeedLeadingDelimiter then
+    FOutputStream.WriteBuffer(FDelimiter, CsvCharSize);
+
+  CellValue := ChangeLineEndings(AValue, FLineEnding);
+  CellValue := QuoteCSVString(CellValue);
+  AppendStringToStream(CellValue, FOutputStream);
+
+  FNeedLeadingDelimiter := True;
+end;
+
+procedure TCSVBuilder.AppendRow;
+begin
+  AppendStringToStream(FLineEnding, FOutputStream);
+  FNeedLeadingDelimiter := False;
+end;
+
+end.
+

packages/fcl-db/fpmake.pp

@@ -92,6 +92,13 @@ begin
           AddUnit('dbconst');
         end;
 
+    T:=P.Targets.AddUnit('csvdataset.pp');
+      with T.Dependencies do
+        begin
+        AddUnit('db');
+        AddUnit('bufdataset');
+        end;
+
     T:=P.Targets.AddUnit('bufdataset_parser.pp');
       with T.Dependencies do
         begin

packages/fcl-db/src/base/bufdataset.pas

@@ -478,7 +478,8 @@ type
 
     FBlobBuffers      : array of PBlobBuffer;
     FUpdateBlobBuffers: array of PBlobBuffer;
-
+    FManualMergeChangeLog : Boolean;
+    
     procedure ProcessFieldsToCompareStruct(const AFields, ADescFields, ACInsFields: TList;
       const AIndexOptions: TIndexOptions; const ALocateOptions: TLocateOptions; out ACompareStruct: TDBCompareStruct);
     function BufferOffset: integer;
@@ -495,7 +496,6 @@ type
     function GetRecordUpdateBufferCached(const ABookmark : TBufBookmark; IncludePrior : boolean = false) : boolean;
     function GetActiveRecordUpdateBuffer : boolean;
     procedure ParseFilter(const AFilter: string);
-    function GetPacketReader(const Format: TDataPacketFormat; const AStream: TStream): TDataPacketReader;
 
     function GetIndexDefs : TIndexDefs;
     function GetIndexFieldNames: String;
@@ -559,6 +559,7 @@ type
     function IsReadFromPacket : Boolean;
     function getnextpacket : integer;
     procedure ActiveBufferToRecord;
+    function GetPacketReader(const Format: TDataPacketFormat; const AStream: TStream): TDataPacketReader; virtual;
     // abstracts, must be overidden by descendents
     function Fetch : boolean; virtual;
     function LoadField(FieldDef : TFieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; virtual;
@@ -597,6 +598,7 @@ type
     property ChangeCount : Integer read GetChangeCount;
     property MaxIndexesCount : Integer read FMaxIndexesCount write SetMaxIndexesCount default 2;
     property ReadOnly : Boolean read FReadOnly write SetReadOnly default false;
+    property ManualMergeChangeLog : Boolean read FManualMergeChangeLog write FManualMergeChangeLog default False;
   published
     property FileName : string read FFileName write FFileName;
     property PacketRecords : Integer read FPacketRecords write SetPacketRecords default 10;
@@ -842,6 +844,7 @@ end;
 constructor TCustomBufDataset.Create(AOwner : TComponent);
 begin
   Inherited Create(AOwner);
+  FManualMergeChangeLog := False;
   FMaxIndexesCount:=2;
   FIndexesCount:=0;
 
@@ -857,8 +860,15 @@ end;
 
 procedure TCustomBufDataset.SetPacketRecords(aValue : integer);
 begin
-  if (aValue = -1) or (aValue > 0) then FPacketRecords := aValue
-    else DatabaseError(SInvPacketRecordsValue);
+  if (aValue = -1) or (aValue > 0) then
+    begin
+    if (IndexFieldNames='') then
+      FPacketRecords := aValue
+    else if AValue<>-1 then
+      DatabaseError(SInvPacketRecordsValueFieldNames);
+    end
+  else
+    DatabaseError(SInvPacketRecordsValue);
 end;
 
 destructor TCustomBufDataset.Destroy;
@@ -1252,7 +1262,7 @@ begin
   InitDefaultIndexes;
   CalcRecordSize;
 
-  FBRecordcount := 0;
+  FBRecordCount := 0;
 
   for IndexNr:=0 to FIndexesCount-1 do with FIndexes[IndexNr] do
     InitialiseSpareRecord(IntAllocRecordBuffer);
@@ -1283,6 +1293,7 @@ var r  : integer;
 begin
   FOpen:=False;
   FReadFromFile:=False;
+  FBRecordCount:=0;
 
   if FIndexesCount>0 then with FIndexes[0] do if IsInitialized then
     begin
@@ -1891,6 +1902,7 @@ begin
       BuildIndex(FIndexes[1]);
       Resync([rmCenter]);
       end;
+    FPacketRecords:=-1;
     FIndexDefs.Updated:=false;
     end
   else
@@ -2416,9 +2428,8 @@ begin
       inc(r);
       end;
   finally
-    if FailedCount = 0 then
+    if (FailedCount=0) and Not ManualMergeChangeLog then
       MergeChangeLog;
-
     InternalGotoBookmark(@StoreCurrRec);
     Resync([]);
     EnableControls;
@@ -2676,7 +2687,10 @@ end;
 
 function TCustomBufDataset.GetRecordCount: Longint;
 begin
-  Result := FBRecordCount;
+  if Active then
+    Result := FBRecordCount
+  else
+    Result:=0;  
 end;
 
 function TCustomBufDataset.UpdateStatus: TUpdateStatus;

packages/fcl-db/src/base/csvdataset.pp

@@ -0,0 +1,399 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2014 by Michael Van Canneyt, member of the
+    Free Pascal development team
+
+    CSV Dataset implementation.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit csvdataset;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, bufdataset, csvreadwrite, db, sqldb;
+
+Type
+
+
+  { TCSVOptions }
+
+  TCSVOptions = Class(TCSVHandler)
+  private
+    FDefaultFieldLength: Word;
+    FFirstLineAsFieldNames: Boolean;
+  Public
+    Constructor Create; override;
+    Procedure Assign(Source : TPersistent); override;
+  Published
+    // Does first line of the file contain the field names to use ?
+    property FirstLineAsFieldNames : Boolean Read FFirstLineAsFieldNames Write FFirstLineAsFieldNames;
+    // Default is to create all fields as strings with the same length. Default string field length.
+    // If the CSV dataset has field defs prior to loading, this is ignored.
+    property DefaultFieldLength : Word Read FDefaultFieldLength Write FDefaultFieldLength;
+    // Field delimiter
+    property Delimiter;
+    // Character used to quote "problematic" data
+    // (e.g. with delimiters or spaces in them)
+    // A common quotechar is "
+    property QuoteChar;
+    // String at the end of the line of data (e.g. CRLF)
+    property LineEnding;
+    // Ignore whitespace between delimiters and field data
+    property IgnoreOuterWhitespace;
+    // Use quotes when outer whitespace is found
+    property QuoteOuterWhitespace;
+  end;
+
+  { TCSVDataPacketReader }
+
+  TCSVDataPacketReader = class(TDataPacketReader)
+  private
+    FOptions: TCSVOptions;
+    FOwnsOptions: Boolean;
+    FParser : TCSVParser;
+    FBuilder : TCSVBuilder;
+    FLine : TStringList;
+    FCurrentRow : Integer;
+    FEOF : Boolean;
+    FCreateFieldDefs : TFieldDefs;
+    // Read next row in Fline
+  Protected
+    Procedure ReadNextRow;virtual;
+    procedure SetCreateFieldDefs(AValue: TFieldDefs);virtual;
+  public
+    constructor Create(ADataSet: TCustomBufDataset; AStream : TStream); override;
+    constructor Create(ADataSet: TCustomBufDataset; AStream : TStream; AOptions : TCSVOptions);
+    Destructor Destroy; override;
+    procedure LoadFieldDefs(var AnAutoIncValue : integer); override;
+    procedure StoreFieldDefs(AnAutoIncValue : integer); override;
+    function GetRecordRowState(out AUpdOrder : Integer) : TRowState; override;
+    procedure FinalizeStoreRecords; override;
+    function GetCurrentRecord : boolean; override;
+    procedure GotoNextRecord; override;
+    procedure InitLoadRecords; override;
+    procedure RestoreRecord; override;
+    procedure StoreRecord(ARowState : TRowState; AUpdOrder : integer = 0); override;
+    class function RecognizeStream(AStream : TStream) : boolean; override;
+    Property Options : TCSVOptions Read FOptions;
+    Property CreateFieldDefs : TFieldDefs read FCreateFieldDefs Write SetCreateFieldDefs;
+  end;
+
+  { TCustomCSVDataset }
+
+  TCustomCSVDataset = Class(TBufDataset)
+  private
+    FCSVOptions: TCSVOptions;
+    procedure SetCSVOptions(AValue: TCSVOptions);
+  Protected
+    function GetPacketReader(const Format: TDataPacketFormat; const AStream: TStream): TDataPacketReader; override;
+    procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField); override;
+    procedure InternalInitFieldDefs; override;
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+    { If FieldDefs is filled prior to calling one of the load functions,
+      the fielddefs definitions will be checked against file contents
+      as far as possible: count and names if names are on first line}
+    procedure LoadFromCSVStream(AStream : TStream);
+    procedure LoadFromCSVFile(Const AFileName: string);
+    procedure SaveToCSVStream(AStream : TStream);
+    procedure SaveToCSVFile(AFileName: string = '');
+  Protected
+    Property CSVOptions : TCSVOptions Read FCSVOptions Write SetCSVOptions;
+  end;
+
+  TCSVDataset = Class(TCustomCSVDataset)
+  Published
+    Property CSVOptions;
+  end;
+
+implementation
+
+{ TCSVDataPacketReader }
+
+procedure TCSVDataPacketReader.ReadNextRow;
+
+
+begin
+  FLine.Clear;
+  if not FEOF then
+    begin
+    if (FCurrentRow>0) then
+      FLine.Add(FParser.CurrentCellText);
+    Repeat
+      FEOF:=Not FParser.ParseNextCell;
+      if (not FEOF) and (FParser.CurrentRow=FCurrentRow) then
+        FLine.Add(FParser.CurrentCellText);
+    until FEOF or (FParser.CurrentRow>FCurrentRow);
+    end;
+  FCurrentRow:=FParser.CurrentRow;
+end;
+
+procedure TCSVDataPacketReader.SetCreateFieldDefs(AValue: TFieldDefs);
+begin
+  if FCreateFieldDefs=AValue then Exit;
+  if (FCreateFieldDefs=Nil) then
+    begin
+    FCreateFieldDefs:=TFieldDefs.Create(AValue.Dataset);
+    FCreateFieldDefs.Assign(AValue);
+    end;
+end;
+
+constructor TCSVDataPacketReader.Create(ADataSet: TCustomBufDataset; AStream: TStream);
+begin
+  inherited Create(ADataSet,AStream);
+  if FOptions=Nil then
+    begin
+    FOptions:=TCSVOptions.Create;
+    FOptions.FFirstLineAsFieldNames:=True;
+    FOwnsOptions:=True;
+    end;
+  FLine:=TStringList.Create;
+end;
+
+constructor TCSVDataPacketReader.Create(ADataSet: TCustomBufDataset; AStream: TStream; AOptions: TCSVOptions);
+begin
+  FOptions:=AOptions;
+  Create(ADataset,AStream);
+  FOwnsOptions:=AOptions=Nil;
+end;
+
+destructor TCSVDataPacketReader.Destroy;
+begin
+  If FOwnsOptions then
+    FreeAndNil(FOPtions);
+  FreeAndNil(Fline);
+  inherited Destroy;
+end;
+
+procedure TCSVDataPacketReader.LoadFieldDefs(var AnAutoIncValue: integer);
+Var
+  FN : String;
+  I : Integer;
+
+begin
+  FParser:=TCSVParser.Create;
+  FParser.SetSource(Stream);
+  FCurrentRow:=0;
+  ReadNextRow;
+  If Assigned(CreateFieldDefs) then
+   begin
+   if (CreateFieldDefs.Count<>Fline.Count) then
+     DatabaseErrorFmt('CSV File Field count (%d) does not match dataset field count (%d).',[Fline.Count,CreateFieldDefs.Count],Dataset.FieldDefs.Dataset);
+   If FOptions.FirstLineAsFieldNames then
+     For I:=0 to FLine.Count-1 do
+       If (CompareText(FLine[i],CreateFieldDefs[i].Name)<>0) then
+         DatabaseErrorFmt('CSV File field %d: name "%s" does not match dataset field name "%s".',[I,FLine[i],CreateFieldDefs[i].Name],Dataset.FieldDefs.Dataset);
+   Dataset.FieldDefs.Assign(CreateFieldDefs);
+   end
+  else if (FLine.Count>0) then
+    For I:=0 to FLine.Count-1 do
+      begin
+      If FOptions.FirstLineAsFieldNames then
+        FN:=FLine[i]
+      else
+        FN:=Format('Column%d',[i+1]);
+      Dataset.FieldDefs.Add(FN,ftString,Foptions.DefaultFieldLength);
+      end;
+  if FOptions.FirstLineAsFieldNames then
+   ReadNextRow;
+end;
+
+procedure TCSVDataPacketReader.StoreFieldDefs(AnAutoIncValue: integer);
+
+Var
+  I : Integer;
+
+begin
+  FBuilder:=TCSVBuilder.Create;
+  FBuilder.SetOutput(Stream);
+  if FOptions.FirstLineAsFieldNames then
+    begin
+    For I:=0 to Dataset.FieldDefs.Count-1 do
+      FBuilder.AppendCell(Dataset.FieldDefs[i].Name);
+    FBuilder.AppendRow;
+    end;
+end;
+
+function TCSVDataPacketReader.GetRecordRowState(out AUpdOrder: Integer
+  ): TRowState;
+begin
+  AUpdOrder:=0;
+  Result:=[];
+end;
+
+procedure TCSVDataPacketReader.FinalizeStoreRecords;
+begin
+
+end;
+
+function TCSVDataPacketReader.GetCurrentRecord: boolean;
+begin
+  Result:=Fline.Count>0;
+end;
+
+procedure TCSVDataPacketReader.GotoNextRecord;
+begin
+  ReadNextRow;
+end;
+
+procedure TCSVDataPacketReader.InitLoadRecords;
+begin
+   // Do nothing
+end;
+
+procedure TCSVDataPacketReader.RestoreRecord;
+
+Var
+  I : integer;
+
+begin
+  For I:=0 to Fline.Count-1 do
+    Dataset.Fields[i].AsString:=Copy(FLine[i],1,Dataset.Fields[i].Size)
+end;
+
+procedure TCSVDataPacketReader.StoreRecord(ARowState: TRowState; AUpdOrder: integer);
+Var
+  I : integer;
+
+begin
+  For I:=0 to Dataset.Fields.Count-1 do
+    FBuilder.AppendCell(Dataset.Fields[i].AsString);
+  FBuilder.AppendRow;
+end;
+
+class function TCSVDataPacketReader.RecognizeStream(AStream: TStream): boolean;
+begin
+  Result:=False;
+end;
+
+{ TCSVOptions }
+
+Constructor TCSVOptions.Create;
+begin
+  inherited Create;
+  DefaultFieldLength:=255;
+end;
+
+Procedure TCSVOptions.Assign(Source: TPersistent);
+begin
+  if (Source is TCSVOptions) then
+    begin
+    FFirstLineAsFieldNames:=TCSVOptions(Source).FirstLineAsFieldNames;
+    FDefaultFieldLength:=TCSVOptions(Source).FDefaultFieldLength
+    end;
+  inherited Assign(Source);
+end;
+
+{ TCustomCSVDataset }
+
+procedure TCustomCSVDataset.SetCSVOptions(AValue: TCSVOptions);
+begin
+  if (FCSVOptions=AValue) then Exit;
+  FCSVOptions.Assign(AValue);
+end;
+
+function TCustomCSVDataset.GetPacketReader(const Format: TDataPacketFormat;
+  const AStream: TStream): TDataPacketReader;
+begin
+  If (Format=dfAny) then
+    Result:=TCSVDataPacketReader.Create(Self,AStream,FCSVOptions)
+  else
+    Result:=Inherited GetPacketReader(Format,AStream);
+end;
+
+procedure TCustomCSVDataset.LoadBlobIntoBuffer(FieldDef: TFieldDef;
+  ABlobBuf: PBufBlobField);
+begin
+  // Do nothing
+end;
+
+procedure TCustomCSVDataset.InternalInitFieldDefs;
+begin
+  // Do nothing
+end;
+
+constructor TCustomCSVDataset.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FCSVOptions:=TCSVOptions.Create;
+end;
+
+destructor TCustomCSVDataset.Destroy;
+begin
+  FreeAndNil(FCSVOptions);
+  inherited Destroy;
+end;
+
+procedure TCustomCSVDataset.LoadFromCSVStream(AStream: TStream);
+
+Var
+  P : TCSVDataPacketReader;
+
+begin
+  CheckInactive;
+  P:=TCSVDataPacketReader.Create(Self,AStream,FCSVOptions);
+  try
+    if FieldDefs.Count>0 then
+     P.CreateFieldDefs:=FieldDefs;
+    SetDatasetPacket(P);
+  finally
+    P.Free;
+  end;
+end;
+
+procedure TCustomCSVDataset.LoadFromCSVFile(const AFileName: string);
+
+Var
+  F : TFileStream;
+
+begin
+  F:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite);
+  try
+    LoadFromCSVStream(F);
+  finally
+    F.Free;
+  end;
+end;
+
+procedure TCustomCSVDataset.SaveToCSVStream(AStream: TStream);
+
+Var
+  P : TCSVDataPacketReader;
+
+begin
+  First;
+  MergeChangeLog;
+  P:=TCSVDataPacketReader.Create(Self,AStream,FCSVOPtions);
+  try
+    GetDatasetPacket(P);
+  finally
+    P.Free;
+  end;
+end;
+
+procedure TCustomCSVDataset.SaveToCSVFile(AFileName: string);
+Var
+  F : TFileStream;
+
+begin
+  F:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite);
+  try
+    SaveToCSVStream(F);
+  finally
+    F.Free;
+  end;
+end;
+
+end.
+

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

@@ -505,7 +505,25 @@ begin
   FBeforeConnect:=AValue;
 end;
 
+procedure TCustomConnection.DoLoginPrompt;
+
+var
+  ADatabaseName, AUserName, APassword: string;
+
+begin
+  if FLoginPrompt then
+    begin
+    GetLoginParams(ADatabaseName, AUserName, APassword);
+    if Assigned(FOnLogin) then
+      FOnLogin(Self, AUserName, APassword)
+    else if Assigned(LoginDialogExProc) then
+      LoginDialogExProc(ADatabaseName, AUserName, APassword, False);
+    SetLoginParams(ADatabaseName, AUserName, APassword);
+    end;
+end;
+
 procedure TCustomConnection.SetConnected(Value: boolean);
+
 begin
   If Value<>Connected then
     begin
@@ -520,8 +538,7 @@ begin
         begin
         if Assigned(BeforeConnect) then
           BeforeConnect(self);
-        if FLoginPrompt then if assigned(FOnLogin) then
-          FOnLogin(self,'','');
+        DoLoginPrompt;
         DoConnect;
         if Assigned(AfterConnect) then
           AfterConnect(self);
@@ -543,6 +560,26 @@ begin
   FBeforeDisconnect:=AValue;
 end;
 
+procedure TCustomConnection.GetLoginParams(out ADatabaseName, AUserName, APassword: string);
+begin
+  if IsPublishedProp(Self,'DatabaseName') then
+    ADatabaseName := GetStrProp(Self,'DatabaseName');
+  if IsPublishedProp(Self,'UserName') then
+    AUserName := GetStrProp(Self,'UserName');
+  if IsPublishedProp(Self,'Password') then
+    APassword := 'Password';
+end;
+
+procedure TCustomConnection.SetLoginParams(const ADatabaseName, AUserName, APassword: string);
+begin
+  if IsPublishedProp(Self,'DatabaseName') then
+    SetStrProp(Self,'DatabaseName',ADatabaseName);
+  if IsPublishedProp(Self,'UserName') then
+    SetStrProp(Self,'UserName',AUserName);
+  if IsPublishedProp(Self,'Password') then
+    SetStrProp(Self,'Password',APassword);
+end;
+
 procedure TCustomConnection.DoConnect;
 
 begin

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

@@ -90,39 +90,37 @@ begin
   FCalcFieldsSize := 0;
   FBlobFieldCount := 0;
   for i := 0 to Fields.Count - 1 do
-    with Fields[i] do begin
+    with Fields[i] do
+      begin
       FFieldDef:=Nil;
-      if Binding then begin
-        if FieldKind in [fkCalculated, fkLookup] then begin
-          FFieldNo := -1;
-          FOffset := FCalcFieldsSize;
-          Inc(FCalcFieldsSize, DataSize + 1);
-          if FieldKind in [fkLookup] then begin
-            if ((FLookupDataSet = nil) or (FLookupKeyFields = '') or
-               (FLookupResultField = '') or (FKeyFields = '')) then
-              DatabaseErrorFmt(SLookupInfoError, [DisplayName]);
-            FFields.CheckFieldNames(FKeyFields);
-            FLookupDataSet.Open;
-            FLookupDataSet.Fields.CheckFieldNames(FLookupKeyFields);
-            FLookupDataSet.FieldByName(FLookupResultField);
-            if FLookupCache then RefreshLookupList;
-          end
-        end else begin
-          FFieldDef := nil;
-          FieldIndex := FieldDefs.IndexOf(Fields[i].FieldName);
-          if FieldIndex <> -1 then begin
-            FFieldDef := FieldDefs[FieldIndex];
-            FFieldNo := FFieldDef.FieldNo;
-            if FieldDef.InternalCalcField then FInternalCalcFields := True;
-            if IsBlob then begin
-              FSize := FFieldDef.Size;
-              FOffset := FBlobFieldCount;
-              Inc(FBlobFieldCount);
+      if not Binding then
+        FFieldNo := 0
+      else if FieldKind in [fkCalculated, fkLookup] then
+        begin
+        FFieldNo := -1;
+        FOffset := FCalcFieldsSize;
+        Inc(FCalcFieldsSize, DataSize + 1);
+        end
+      else
+        begin
+        FFieldDef := nil;
+        FieldIndex := FieldDefs.IndexOf(Fields[i].FieldName);
+        if FieldIndex <> -1 then
+          begin
+          FFieldDef := FieldDefs[FieldIndex];
+          FFieldNo := FFieldDef.FieldNo;
+          if FieldDef.InternalCalcField then
+            FInternalCalcFields := True;
+          if IsBlob then
+            begin
+            FSize := FFieldDef.Size;
+            FOffset := FBlobFieldCount;
+            Inc(FBlobFieldCount);
             end;
-          end else FFieldNo := 0;
+          end
         end;
-      end else FFieldNo := 0;
-    end;
+      Bind(Binding);
+      end;
 end;
 
 function TDataSet.BookmarkAvailable: Boolean;
@@ -2482,3 +2480,30 @@ end;
 
 {------------------------------------------------------------------------------}
 
+operator Enumerator(ADataSet: TDataSet): TDataSetEnumerator;
+begin
+ Result:=TDataSetEnumerator.Create(ADataSet);
+end;
+
+constructor TDataSetEnumerator.Create(ADataSet: TDataSet);
+begin
+  inherited Create;
+  FDataSet:=ADataSet;
+  FBOF:=True;
+  FDataSet.First;
+end;
+
+function TDataSetEnumerator.GetCurrent: TFields;
+begin
+  Result := FDataSet.Fields;
+end;
+
+function TDataSetEnumerator.MoveNext: Boolean;
+
+begin
+  if FBOF then
+    FBOF:=False
+  else
+    FDataSet.Next;
+  Result:=not FDataSet.EOF;
+end;

packages/fcl-db/src/base/db.pas

@@ -322,6 +322,7 @@ type
     procedure CheckInactive;
     class procedure CheckTypeSize(AValue: Longint); virtual;
     procedure Change; virtual;
+    procedure Bind(Binding: Boolean); virtual;
     procedure DataChanged;
     procedure FreeBuffers; virtual;
     function GetAsBCD: TBCD; virtual;
@@ -1713,6 +1714,19 @@ type
     property OnPostError: TDataSetErrorEvent read FOnPostError write FOnPostError;
   end;
 
+  TDataSetEnumerator = class
+  private
+    FDataSet: TDataSet;
+    FBOF: Boolean;
+    function GetCurrent: TFields;
+  public  
+    constructor Create(ADataSet: TDataSet);
+    function MoveNext: Boolean;
+    property Current: TFields read GetCurrent;
+  end;
+
+{ TDataLink }
+
   TDataLink = class(TPersistent)
   private
     FFirstRecord,
@@ -1940,16 +1954,19 @@ type
     procedure SetBeforeConnect(const AValue: TNotifyEvent);
     procedure SetBeforeDisconnect(const AValue: TNotifyEvent);
   protected
+    procedure DoLoginPrompt; virtual;
     procedure DoConnect; virtual;
     procedure DoDisconnect; virtual;
     function GetConnected : boolean; virtual;
     Function GetDataset(Index : longint) : TDataset; virtual;
     Function GetDataSetCount : Longint; virtual;
+    procedure GetLoginParams(out ADatabaseName, AUserName, APassword: string); virtual;
     procedure InternalHandleException; virtual;
     procedure Loaded; override;
     procedure SetConnected (Value : boolean); virtual;
+    procedure SetLoginParams(const ADatabaseName, AUserName, APassword: string); virtual;
     property ForcedClose : Boolean read FForcedClose write FForcedClose;
-    property Streamedconnected: Boolean read FStreamedConnected write FStreamedConnected;
+    property StreamedConnected: Boolean read FStreamedConnected write FStreamedConnected;
   public
     procedure Close(ForceClose: Boolean=False);
     destructor Destroy; override;
@@ -2168,6 +2185,10 @@ const
   ftBlobTypes = [ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle,
     ftDBaseOle, ftTypedBinary, ftOraBlob, ftOraClob, ftWideMemo];
 
+var
+  LoginDialogExProc: function(const ADatabaseName: string; var AUserName, APassword: string; UserNameReadOnly: Boolean): Boolean = nil;
+
+
 { Auxiliary functions }
 
 Procedure DatabaseError (Const Msg : String); overload;
@@ -2183,6 +2204,8 @@ function BuffersEqual(Buf1, Buf2: Pointer; Size: Integer): Boolean;
 
 function SkipComments(var p: PChar; EscapeSlash, EscapeRepeat : Boolean) : boolean;
 
+operator Enumerator(ADataSet: TDataSet): TDataSetEnumerator;
+ 
 implementation
 
 uses dbconst,typinfo;

packages/fcl-db/src/base/dbconst.pas

@@ -83,6 +83,7 @@ Resourcestring
   SLookupInfoError         = 'Lookup information for field ''%s'' is incomplete';
   SUnsupportedFieldType    = 'Fieldtype %s is not supported';
   SInvPacketRecordsValue   = 'PacketRecords has to be larger then 0';
+  SInvPacketRecordsValueFieldNames = 'PacketRecords must be -1 if IndexFieldNames is set';
   SInvalidSearchFieldType  = 'Searching in fields of type %s is not supported';
   SDatasetEmpty            = 'The dataset is empty';
   SFieldIsNull             = 'The field is null';

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

@@ -384,6 +384,23 @@ begin
     end;
 end;
 
+procedure TField.Bind(Binding: Boolean);
+
+begin
+  if Binding and (FieldKind=fkLookup) then
+    begin
+    if ((FLookupDataSet = nil) or (FLookupKeyFields = '') or
+       (FLookupResultField = '') or (FKeyFields = '')) then
+      DatabaseErrorFmt(SLookupInfoError, [DisplayName]);
+    FFields.CheckFieldNames(FKeyFields);
+    FLookupDataSet.Open;
+    FLookupDataSet.Fields.CheckFieldNames(FLookupKeyFields);
+    FLookupDataSet.FieldByName(FLookupResultField);
+    if FLookupCache then
+      RefreshLookupList;
+    end;
+end;
+
 procedure TField.Change;
 
 begin

packages/fcl-db/src/base/sqlscript.pp

@@ -260,7 +260,7 @@ begin
     if (Result='') then
       begin
       if FEmitLine then
-        AddToStatement(S,(FCol=1));
+        AddToStatement(S,(FCol<=1));
       FCol:=1;
       FLine:=FLine+1;
       end
@@ -442,11 +442,12 @@ function TCustomSQLScript.NextStatement: AnsiString;
 
 var
   pnt: AnsiString;
-  terminator_found: Boolean;
+  addnewline,terminator_found: Boolean;
 
 begin
   terminator_found:=False;
   ClearStatement;
+  addnewline:=false;
   while FLine <= FSQL.Count do
     begin
     pnt:=FindNextSeparator([FTerminator, '/*', '"', '''', '--']);
@@ -476,7 +477,10 @@ begin
       begin
       FComment:=True;
       if FCommentsInSQL then
-        AddToStatement(Copy(FSQL[FLine-1],FCol,Length(FSQL[FLine-1])-FCol+1),True);
+        begin
+        AddToStatement(Copy(FSQL[FLine-1],FCol,Length(FSQL[FLine-1])-FCol+1),False);
+        AddNewLine:=true;
+        end;
       Inc(Fline);
       FCol:=0;
       FComment:=False;
@@ -494,7 +498,8 @@ begin
       AddToStatement(pnt,False);
       FCol:=FCol + length(pnt);
       pnt:=FindNextSeparator(['''']);
-      AddToStatement(pnt,false);
+      AddToStatement(pnt,addnewline);
+      addnewline:=False;
       FCol:=FCol + length(pnt);
       end;
     end;

packages/fcl-db/src/export/fpcsvexport.pp

@@ -5,7 +5,7 @@ unit fpcsvexport;
 interface
 
 uses
-  Classes, SysUtils, DB, fpDBExport;
+  Classes, SysUtils, fpDBExport, csvreadwrite;
 
 Type
   { TCSVFormatSettings }
@@ -14,35 +14,40 @@ Type
   Private
     FDelimiter: String;
     FHeaderRow: Boolean;
-    FQuoteStrings: TQuoteStrings;
+    FIgnoreOuterWhiteSpace: Boolean;
     FRowDelimiter: String;
-    FStringQuoteChar: String;
+    FQuoteChar: Char;
   Public
     Constructor Create(DoInitSettings : Boolean); override;
     Procedure Assign(Source : TPersistent); override;
+    // Kept for compatibility with older versions; please replace with QuoteChar
+    Property StringQuoteChar : Char Read FQuoteChar Write FQuoteChar; deprecated 'Please replace with QuoteChar';
   Published
     // Properties
+    // Delimiter between fields/columns. Traditionally , for CSV.
     Property FieldDelimiter : String Read FDelimiter Write FDelimiter;
+    //If no, CSV is RFC 4180 compliant; if yes, it matches the unofficial Creativyst specification
+    Property IgnoreOuterWhitespace : Boolean Read FIgnoreOuterWhiteSpace write FIgnoreOuterWhiteSpace;
+    // Line ending to be used between rows of data (e.g. #13#10 for standard CSV)
     Property RowDelimiter : String Read FRowDelimiter Write FRowDelimiter;
+    // Whether or not the file should have a header row with field names
     Property HeaderRow : Boolean Read FHeaderRow Write FHeaderRow default true;
-    Property QuoteStrings : TQuoteStrings Read FQuoteStrings Write FQuoteStrings;
-    Property StringQuoteChar : String Read FStringQuoteChar Write FStringQuoteChar;
+    // If fields need to be surrounded by quotes, use this character (e.g. ")
+    Property QuoteChar : Char Read FQuoteChar Write FQuoteChar;
   end;
 
   { TCustomCSVExporter }
 
   TCustomCSVExporter = Class(TCustomFileExporter)
   private
-    FCurrentRow:String;
+    FCSVOut: TCSVBuilder;
     function GetCSVFormatsettings: TCSVFormatSettings;
-    procedure OutputRow(const ARow: String);
     procedure SetCSVFormatSettings(const AValue: TCSVFormatSettings);
   Protected
     Function CreateFormatSettings : TCustomExportFormatSettings; override;
     Procedure DoBeforeExecute; override;
     Procedure DoAfterExecute; override;
     Procedure DoDataHeader; override;
-    Procedure DoDataRowStart; override;
     Procedure ExportField(EF : TExportFieldItem); override;
     Procedure DoDataRowEnd; override;
   Public
@@ -82,27 +87,23 @@ implementation
 procedure TCustomCSVExporter.DoBeforeExecute;
 begin
   inherited DoBeforeExecute;
+  FCSVOut:=TCSVBuilder.Create;
+  if (FormatSettings.FieldDelimiter<>'') then
+    FCSVOut.Delimiter:=FormatSettings.FieldDelimiter[1];
+  FCSVOut.IgnoreOuterWhitespace:=FormatSettings.IgnoreOuterWhitespace;
+  FCSVOut.LineEnding:=FormatSettings.RowDelimiter;
+  FCSVOut.QuoteChar:=FormatSettings.QuoteChar;
   OpenTextFile;
+  FCSVOut.SetOutput(Stream); //output to the export stream
 end;
 
 procedure TCustomCSVExporter.DoAfterExecute;
 begin
+  FCSVOut.Free;
   CloseTextFile;
   inherited DoAfterExecute;
 end;
 
-procedure TCustomCSVExporter.OutputRow(Const ARow : String);
-
-Var
-  RD : String;
-
-begin
-  RD:=FormatSettings.RowDelimiter;
-  If (RD='') then
-    Writeln(TextFile,ARow)
-  else
-    Write(TextFile,ARow,RD)
-end;
 
 function TCustomCSVExporter.GetCSVFormatsettings: TCSVFormatSettings;
 begin
@@ -124,84 +125,29 @@ end;
 procedure TCustomCSVExporter.DoDataHeader;
 
 Var
-  S : String;
   I : Integer;
 
 begin
   If FormatSettings.HeaderRow then
     begin
-    S:='';
     For I:=0 to ExportFields.Count-1 do
       begin
-      If (S<>'') then
-        S:=S+FormatSettings.FieldDelimiter;
-      S:=S+ExportFields[i].ExportedName;
+      FCSVOut.AppendCell(ExportFields[i].ExportedName);
       end;
-    OutputRow(S);
+    FCSVOut.AppendRow; //close off with line ending
     end;
   inherited DoDataHeader;
 end;
 
 
-procedure TCustomCSVExporter.DoDataRowStart;
-begin
-  FCurrentRow:='';
-end;
-
 procedure TCustomCSVExporter.ExportField(EF: TExportFieldItem);
-
-  Function HaveSpace(Const S : String;QS : TQuoteStrings) : Boolean;
-
-  begin
-    Result:=(qsSpace in QS) and (Pos(' ',S)<>0)
-  end;
-
-  Function HaveDelimiter(Const S : String;QS : TQuoteStrings) : Boolean;
-
-  Var
-    FD : String;
-
-  begin
-    Result:=(qsDelimiter in QS);
-    If Result then
-      begin
-      FD:=FormatSettings.FieldDelimiter;
-      Result:=(FD<>'') and (Pos(FD,S)<>0);
-      end;
-  end;
-
-Var
-  S,C : String;
-  QS  : TQuoteStrings;
-
 begin
-  S:=FormatField(EF.Field);
-  QS:=FormatSettings.QuoteStrings;
-  {If specified, quote everything that can contain delimiters;
-  leave numeric, date fields alone:}
-  If (
-  (EF.Field.DataType in StringFieldTypes) or
-  (EF.Field.DataType in MemoFieldTypes) or
-  (EF.Field.DataType in BlobFieldTypes)
-  )
-  and (QS<>[]) then
-    begin
-    If (qsAlways in QS) or HaveSpace(S,QS) or HaveDelimiter(S,QS) then
-      begin
-      C:=FormatSettings.StringQuoteChar;
-      S:=C+S+C;
-      end;
-    end;
-  If (FCurrentRow<>'') then
-    FCurrentRow:=FCurrentRow+FormatSettings.FieldDelimiter;
-  FCurrentRow:=FCurrentRow+S;
+  FCSVOut.AppendCell(FormatField(EF.Field));
 end;
 
-
 procedure TCustomCSVExporter.DoDataRowEnd;
 begin
-  OutputRow(FCurrentRow);
-  FCurrentRow:='';
+  FCSVOut.AppendRow; //Line ending
 end;
 
 constructor TCustomCSVExporter.Create(Aowner: TComponent);
@@ -213,14 +159,12 @@ end;
 
 constructor TCSVFormatSettings.Create(DoInitSettings: Boolean);
 begin
+  // These defaults are meant to be Excel CSV compatible
   inherited Create(DoInitSettings);
   FHeaderRow:=True;
   FDelimiter:=',';
-  FStringQuoteChar:='"';
-  FQuoteStrings:=[qsSpace, qsDelimiter];
-  {Sensible defaults as reading unquoted strings with delimiters/spaces will
-  either fail by creating phantom fields (qsDelimiter) or delete leading or
-  trailing data/spaces (qsSpace)}
+  FQuoteChar:='"';
+  FRowDelimiter:=LineEnding;
 end;
 
 procedure TCSVFormatSettings.Assign(Source: TPersistent);
@@ -233,10 +177,9 @@ begin
     begin
     FS:=Source as TCSVFormatSettings;
     FDelimiter:=FS.FDelimiter;
-    FHeaderRow:=FS.FHEaderRow;
-    FQuoteStrings:=FS.FQuoteStrings;
+    FHeaderRow:=FS.FHeaderRow;
     FRowDelimiter:=FS.FRowDelimiter;
-    FStringQuoteChar:=FS.FStringQuoteChar;
+    FQuoteChar:=FS.FQuoteChar;
     end;
   inherited Assign(Source);
 end;
@@ -250,8 +193,8 @@ end;
 Procedure UnRegisterCSVExportFormat;
 
 begin
+  ExportFormats.UnRegisterExportFormat(SCSVExport);
 end;
 
 
 end.
-

packages/fcl-db/src/sdf/sdfdata.pp

@@ -258,11 +258,14 @@ type
   private
     FDelimiter : Char;
     FFirstLineAsSchema : Boolean;
-    FFMultiLine         :Boolean;
+    FFMultiLine        : Boolean;
+    FStripTrailingDelimiters : Boolean;
+    procedure DoStripTrailingDelimiters(var S: String; All : Boolean);
     procedure SetMultiLine(const Value: Boolean);
     procedure SetFirstLineAsSchema(Value : Boolean);
     procedure SetDelimiter(Value : Char);
   protected
+    function GetRecordCount: Integer; override;
     procedure InternalInitFieldDefs; override;
     function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean)
              : TGetResult; override;
@@ -274,6 +277,8 @@ type
     property AllowMultiLine: Boolean read FFMultiLine write SetMultiLine default True; //Whether or not to allow fields containing CR and/or LF
     property Delimiter: Char read FDelimiter write SetDelimiter;
     property FirstLineAsSchema: Boolean read FFirstLineAsSchema write SetFirstLineAsSchema;
+    // Set this to True if you want to strip all last delimiters
+    Property StripTrailingDelimiters : Boolean Read FStripTrailingDelimiters Write FStripTrailingDelimiters;
   end;
 procedure Register;
 
@@ -859,6 +864,8 @@ end;
 procedure TSdfDataSet.InternalInitFieldDefs;
 var
   pStart, pEnd, len : Integer;
+  SL,Fn : String;
+
 begin
   if not IsCursorOpen then
     exit;
@@ -875,43 +882,45 @@ begin
   else if (Schema.Count = 0) or (FirstLineAsSchema) then
   begin
     Schema.Clear;
-    len := Length(FData[0]);
+    SL:=FData[0];
+    if StripTrailingDelimiters then
+      DoStripTrailingDelimiters(SL,True);
+    len := Length(SL);
     pEnd := 1;
     repeat
-      while (pEnd <= len) and (FData[0][pEnd] in [#1..' ']) do
+      while (pEnd<=len) and (SL[pEnd] in [#1..' ']) do
         Inc(pEnd);
-
       if (pEnd > len) then
         break;
-
       pStart := pEnd;
-
-      if (FData[0][pStart] = '"') then
-       begin
+      if (SL[pStart] = '"') then
+        begin
         repeat
           Inc(pEnd);
-        until (pEnd > len)  or (FData[0][pEnd] = '"');
-
-        if (FData[0][pEnd] = '"') then
+        until (pEnd > len)  or (SL[pEnd] = '"');
+        if (SL[pEnd] = '"') then
           Inc(pStart);
-       end
+        end
       else
-       while (pEnd <= len) and (FData[0][pEnd]  <> Delimiter) do
-        Inc(pEnd);
-
+        while (pEnd<=len) and (SL[pEnd]<>Delimiter) do
+          Inc(pEnd);
       if (FirstLineAsSchema) then
-       Schema.Add(Copy(FData[0], pStart, pEnd - pStart))
+        FN:=Copy(SL,pStart,pEnd - pStart)
       else
-       Schema.Add(Format('Field%d', [Schema.Count + 1]));
-
-      if (FData[0][pEnd] = '"') then
-        while (pEnd <= len) and (FData[0][pEnd] <> Delimiter) do
-          Inc(pEnd);
-
-      if (FData[0][pEnd] = Delimiter) then
+        FN:='';
+      if (FN='') then // Pend-PStart=0 is possible: a,b,,c
+        FN:=Format('Field%d', [Schema.Count + 1]);
+      Schema.Add(FN);
+      if (Pend<=Len) and (SL[pEnd] = '"') then
+        while (pEnd <= len) and (SL[pEnd] <> Delimiter) do
           Inc(pEnd);
-
+//      if (SL[pEnd]=Delimiter) then
+        Inc(pEnd);
     until (pEnd > len);
+    // Special case: f1,f2, is 3 fields, last unnamed.
+    if (Len>0) and (SL[Len]=Delimiter) then
+      Schema.Add(Format('Field%d', [Schema.Count + 1]));
+
   end;
   inherited;
 end;
@@ -1092,12 +1101,22 @@ begin
       end;
     Result := Result + Str + FDelimiter;
   end;
-  p := Length(Result);
-  while (p > 0) and (Result[p] = FDelimiter) do
-  begin
-    System.Delete(Result, p, 1);
+  DoStripTrailingDelimiters(Result,StripTrailingDelimiters)
+end;
+
+procedure TSdfDataSet.DoStripTrailingDelimiters(var S: String; All: Boolean);
+
+var
+  L,P : integer;
+begin
+//  Write('S "',S,'" -> "');
+  L:=Length(S);
+  P:=L;
+  while (p>0) and (S[p]=FDelimiter) and (All or (P=L)) do
     Dec(p);
-  end;
+  if P<L then
+    S:=Copy(S,1,P);
+//  Writeln(s,'"');
 end;
 
 procedure TSdfDataSet.SetDelimiter(Value : Char);
@@ -1106,6 +1125,13 @@ begin
   FDelimiter := Value;
 end;
 
+function TSdfDataSet.GetRecordCount: Integer;
+begin
+  Result:=Inherited GetRecordCount;
+  If Result>0 then
+    Result:=Result-Ord(FirstLineAsSchema);
+end;
+
 procedure TSdfDataSet.SetFirstLineAsSchema(Value : Boolean);
 begin
   CheckInactive;

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

@@ -103,13 +103,14 @@ type
     function GetTransactionHandle(trans : TSQLHandle): pointer; override;
     function Commit(trans : TSQLHandle) : boolean; override;
     function RollBack(trans : TSQLHandle) : boolean; override;
-    function StartdbTransaction(trans : TSQLHandle; AParams : string) : boolean; override;
+    function StartDBTransaction(trans : TSQLHandle; AParams : string) : boolean; override;
     procedure CommitRetaining(trans : TSQLHandle); override;
     procedure RollBackRetaining(trans : TSQLHandle); override;
     procedure UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string); override;
-    function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override;
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); override;
     function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
+    function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override;
+    function GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string; override;
   public
     constructor Create(AOwner : TComponent); override;
     function GetConnectionInfo(InfoType:TConnInfoType): string; override;
@@ -208,7 +209,8 @@ begin
   else result := true;
 end;
 
-function TIBConnection.StartDBTransaction(trans : TSQLHandle;AParams : String) : boolean;
+function TIBConnection.StartDBTransaction(trans: TSQLHandle; AParams: string
+  ): boolean;
 var
   DBHandle : pointer;
   tr       : TIBTrans;
@@ -641,7 +643,7 @@ begin
   end;
 end;
 
-Function TIBConnection.AllocateCursorHandle : TSQLCursor;
+function TIBConnection.AllocateCursorHandle: TSQLCursor;
 
 var curs : TIBCursor;
 
@@ -665,7 +667,7 @@ begin
   FreeAndNil(cursor);
 end;
 
-Function TIBConnection.AllocateTransactionHandle : TSQLHandle;
+function TIBConnection.AllocateTransactionHandle: TSQLHandle;
 
 begin
   result := TIBTrans.create;
@@ -1388,12 +1390,27 @@ begin
                           '(r.rdb$system_flag = 0 or r.rdb$system_flag is null) and (rdb$relation_name = ''' + Uppercase(SchemaObjectName) + ''') ' +
                         'ORDER BY '+
                           'r.rdb$field_name';
+    stSequences  : s := 'SELECT ' +
+                          'rdb$generator_id         as recno,' +
+                          '''' + DatabaseName + ''' as sequence_catalog,' +
+                          '''''                     as sequence_schema,' +
+                          'rdb$generator_name       as sequence_name ' +
+                        'FROM ' +
+                          'rdb$generators ' +
+                        'WHERE ' +
+                          'rdb$system_flag = 0 or rdb$system_flag is null ' +
+                        'ORDER BY ' +
+                          'rdb$generator_name';
   else
     DatabaseError(SMetadataUnavailable)
   end; {case}
   result := s;
 end;
 
+function TIBConnection.GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string;
+begin
+  Result := Format('SELECT gen_id(%s, %d) FROM RDB$DATABASE', [SequenceName, IncrementBy]);
+end;
 
 procedure TIBConnection.UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string);
 
@@ -1480,7 +1497,7 @@ begin
   end;
 end;
 
-procedure TIBConnection.GetFloat(CurrBuff, Buffer : pointer; Size : byte);
+procedure TIBConnection.GetFloat(CurrBuff, Buffer: pointer; Size: Byte);
 var
   Ext : extended;
   Dbl : double;

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

@@ -791,7 +791,7 @@ begin
   srctype:=dbcoltype(FDBProc,i);
   data:=dbdata(FDBProc,i);
   datalen:=dbdatlen(FDBProc,i);
-  Result:=assigned(data) and (datalen<>0);
+  Result:=assigned(data) and (datalen>=0);
   if not Result then
     Exit;
 

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

@@ -214,8 +214,8 @@ implementation
 
 uses
   dbconst,
-  strutils,
-  dateutils,
+  StrUtils,
+  DateUtils,
   FmtBCD;
 
 const
@@ -838,7 +838,7 @@ begin
     Result := StrToInt(S);
 end;
 
-function InternalStrToFloat(S: string): Extended;
+function InternalStrToFloat(const S: string): Extended;
 
 var
   I: Integer;
@@ -856,7 +856,7 @@ begin
   Result := StrToFloat(Tmp);
 end;
 
-function InternalStrToCurrency(S: string): Extended;
+function InternalStrToCurrency(const S: string): Currency;
 
 var
   I: Integer;
@@ -874,7 +874,7 @@ begin
   Result := StrToCurr(Tmp);
 end;
 
-function InternalStrToDate(S: string): TDateTime;
+function InternalStrToDate(const S: string): TDateTime;
 
 var
   EY, EM, ED: Word;
@@ -889,7 +889,26 @@ begin
     Result:=EncodeDate(EY, EM, ED);
 end;
 
-function InternalStrToDateTime(S: string): TDateTime;
+function StrToMSecs(const S: string): Word;
+var C: char;
+    d, MSecs: double;
+begin
+{$IFDEF MYSQL56_UP}
+  // datetime(n), where n is fractional seconds precision (between 0 and 6)
+  MSecs := 0;
+  d := 100;
+  for C in S do
+    begin
+    MSecs := MSecs + (ord(C)-ord('0'))*d;
+    d := d / 10;
+    end;
+  Result := Round(MSecs);
+{$ELSE}
+  Result := 0;
+{$ENDIF}
+end;
+
+function InternalStrToDateTime(const S: string): TDateTime;
 
 var
   EY, EM, ED: Word;
@@ -902,19 +921,15 @@ begin
   EH := StrToInt(Copy(S, 12, 2));
   EN := StrToInt(Copy(S, 15, 2));
   ES := StrToInt(Copy(S, 18, 2));
-  EMS:=0;
-{$IFDEF mysql56}
-  if (Copy(S, 21, 3)<>'') then
-    EMS := StrToIntDef(Copy(S, 21, 3),0);
-{$ENDIF} 
+  EMS:= StrToMSecs(Copy(S, 21, 6));
   if (EY = 0) or (EM = 0) or (ED = 0) then
     Result := 0
   else
     Result := EncodeDate(EY, EM, ED);
-  Result := ComposeDateTime(Result,EncodeTime(EH, EN, ES, EMS));
+  Result := ComposeDateTime(Result, EncodeTime(EH, EN, ES, EMS));
 end;
 
-function InternalStrToTime(S: string): TDateTime;
+function InternalStrToTime(const S: string): TDateTime;
 
 var
   EH, EM, ES, EMS: Word;
@@ -922,24 +937,20 @@ var
 
 begin
   p := 1;
-  EMS:=0;
   EH := StrToInt(ExtractSubstr(S, p, [':'])); //hours can be 2 or 3 digits
   EM := StrToInt(ExtractSubstr(S, p, [':']));
   ES := StrToInt(ExtractSubstr(S, p, ['.']));
-{$IFDEF mysql56}
-   EMS:= StrToIntDef(ExtractSubstr(S, p, ['.']),0);
-{$ENDIF}   
+  EMS:= StrToMSecs(Copy(S, p, 6));
   Result := EncodeTimeInterval(EH, EM, ES, EMS);
 end;
 
-function InternalStrToTimeStamp(S: string): TDateTime;
+function InternalStrToTimeStamp(const S: string): TDateTime;
 
 var
   EY, EM, ED: Word;
   EH, EN, ES, EMS: Word;
 
 begin
-  EMS:=0;
 {$IFNDEF mysql40}
   EY := StrToInt(Copy(S, 1, 4));
   EM := StrToInt(Copy(S, 6, 2));
@@ -947,10 +958,7 @@ begin
   EH := StrToInt(Copy(S, 12, 2));
   EN := StrToInt(Copy(S, 15, 2));
   ES := StrToInt(Copy(S, 18, 2));
-{$IFDEF mysql56}
-  if (Copy(S, 21, 3)<>'') then
-    EMS := StrToIntDef(Copy(S, 21, 3),0);
-{$ENDIF} 
+  EMS:= StrToMSecs(Copy(S, 21, 6));
 {$ELSE}
   EY := StrToInt(Copy(S, 1, 4));
   EM := StrToInt(Copy(S, 5, 2));
@@ -958,6 +966,7 @@ begin
   EH := StrToInt(Copy(S, 9, 2));
   EN := StrToInt(Copy(S, 11, 2));
   ES := StrToInt(Copy(S, 13, 2));
+  EMS:= 0;
 {$ENDIF}
   if (EY = 0) or (EM = 0) or (ED = 0) then
     Result := 0

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

@@ -121,12 +121,13 @@ type
     function Commit(trans : TSQLHandle) : boolean; override;
     procedure CommitRetaining(trans : TSQLHandle); override;
     function StartImplicitTransaction(trans : TSQLHandle; AParams : string) : boolean; override;
-    function StartdbTransaction(trans : TSQLHandle; AParams : string) : boolean; override;
+    function StartDBTransaction(trans : TSQLHandle; AParams : string) : boolean; override;
     procedure RollBackRetaining(trans : TSQLHandle); override;
     procedure UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string); override;
-    function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override;
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor;ATransaction : TSQLTransaction); override;
     function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
+    function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override;
+    function GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string; override;
   public
     constructor Create(AOwner : TComponent); override;
     destructor Destroy; override;
@@ -332,7 +333,7 @@ begin
 {$EndIf}
 end;
 
-Procedure TPQConnection.GetExtendedFieldInfo(cursor: TPQCursor;
+procedure TPQConnection.GetExtendedFieldInfo(cursor: TPQCursor;
   Bindings: TFieldBindings);
 
 Var
@@ -387,7 +388,7 @@ begin
     P.SQLDBData:=TPQCursor(C).GetFieldBinding(F.FieldDef);
 end;
 
-Function TPQConnection.ErrorOnUnknownType: Boolean;
+function TPQConnection.ErrorOnUnknownType: Boolean;
 begin
   Result:=False;
 end;
@@ -555,8 +556,8 @@ begin
   Result := true;
 end;
 
-function TPQConnection.StartDBTransaction(trans: TSQLHandle;
-  AParams: string): boolean;
+function TPQConnection.StartDBTransaction(trans: TSQLHandle; AParams: string
+  ): boolean;
 
 Var
   res : PPGresult;
@@ -724,7 +725,7 @@ begin
 end;
 
 function TPQConnection.TranslateFldType(res: PPGresult; Tuple: integer; out
-  Size: integer; Out ATypeOID: oid): TFieldType;
+  Size: integer; out ATypeOID: oid): TFieldType;
 
 const
   VARHDRSZ=sizeof(longint);
@@ -805,18 +806,18 @@ begin
   end;
 end;
 
-Function TPQConnection.AllocateCursorHandle: TSQLCursor;
+function TPQConnection.AllocateCursorHandle: TSQLCursor;
 
 begin
   result := TPQCursor.create;
 end;
 
-Procedure TPQConnection.DeAllocateCursorHandle(var cursor: TSQLCursor);
+procedure TPQConnection.DeAllocateCursorHandle(var cursor: TSQLCursor);
 begin
   FreeAndNil(cursor);
 end;
 
-Function TPQConnection.AllocateTransactionHandle: TSQLHandle;
+function TPQConnection.AllocateTransactionHandle: TSQLHandle;
 
 begin
   result := TPQTrans.create;
@@ -1495,6 +1496,11 @@ begin
   result := s;
 end;
 
+function TPQConnection.GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string;
+begin
+  Result := Format('SELECT nextval(''%s'')', [SequenceName]);
+end;
+
 procedure TPQConnection.LoadBlobIntoBuffer(FieldDef: TFieldDef;
   ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction: TSQLTransaction);
 var

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

@@ -23,7 +23,7 @@ interface
 uses SysUtils, Classes, DB, bufdataset, sqlscript;
 
 type
-  TSchemaType = (stNoSchema, stTables, stSysTables, stProcedures, stColumns, stProcedureParams, stIndexes, stPackages, stSchemata);
+  TSchemaType = (stNoSchema, stTables, stSysTables, stProcedures, stColumns, stProcedureParams, stIndexes, stPackages, stSchemata, stSequences);
 
   TStatementType = (stUnknown, stSelect, stInsert, stUpdate, stDelete,
     stDDL, stGetSegment, stPutSegment, stExecProcedure,
@@ -210,12 +210,13 @@ type
     function Commit(trans : TSQLHandle) : boolean; virtual; abstract;
     function RollBack(trans : TSQLHandle) : boolean; virtual; abstract;
     function StartImplicitTransaction(trans : TSQLHandle; aParams : string) : boolean; virtual;
-    function StartdbTransaction(trans : TSQLHandle; aParams : string) : 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;
+    function GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string; virtual;
 
     Procedure MaybeConnect;
 
@@ -234,10 +235,12 @@ type
     procedure GetProcedureNames(List : TStrings); virtual;
     procedure GetFieldNames(const TableName : string; List : TStrings); virtual;
     procedure GetSchemaNames(List: TStrings); virtual;
+    procedure GetSequenceNames(List: TStrings); virtual;
     function GetConnectionInfo(InfoType:TConnInfoType): string; virtual;
     function GetStatementInfo(const ASQL: string): TSQLStatementInfo; virtual;
     procedure CreateDB; virtual;
     procedure DropDB; virtual;
+    function GetNextValue(const SequenceName: string; IncrementBy: integer=1): Int64; virtual;
     property ConnOptions: TConnOptions read FConnOptions;
   published
     property Password : string read FPassword write FPassword;
@@ -372,9 +375,34 @@ type
     Property Transaction;
   end;
 
+
+  { TSQLSequence }
+
+  TSQLSequenceApplyEvent = (saeOnNewRecord, saeOnPost);
+
+  TSQLSequence = class(TPersistent)
+  private
+    FQuery: TCustomSQLQuery;
+    FFieldName: String;
+    FSequenceName: String;
+    FIncrementBy: Integer;
+    FApplyEvent: TSQLSequenceApplyEvent;
+  public
+    constructor Create(AQuery: TCustomSQLQuery);
+    procedure Assign(Source: TPersistent); override;
+    procedure Apply;
+    function GetNextValue: Int64;
+  published
+    property FieldName: String read FFieldName write FFieldName;
+    property SequenceName: String read FSequenceName write FSequenceName;
+    property IncrementBy: Integer read FIncrementBy write FIncrementBy default 1;
+    property ApplyEvent: TSQLSequenceApplyEvent read FApplyEvent write FApplyEvent default saeOnNewRecord;
+  end;
+
+
   { TCustomSQLQuery }
 
-  TSQLQueryOption = (sqoKeepOpenOnCommit, sqoAutoApplyUpdates, sqoAutoCommit);
+  TSQLQueryOption = (sqoKeepOpenOnCommit, sqoAutoApplyUpdates, sqoAutoCommit, sqoCancelUpdatesOnRefresh);
   TSQLQueryOptions = Set of TSQLQueryOption;
 
   TCustomSQLQuery = class (TCustomBufDataset)
@@ -406,6 +434,7 @@ type
     FInsertQry,
     FUpdateQry,
     FDeleteQry           : TCustomSQLStatement;
+    FSequence            : TSQLSequence;
     procedure FreeFldBuffers;
     function GetParamCheck: Boolean;
     function GetParams: TParams;
@@ -454,6 +483,7 @@ type
     procedure InternalClose; override;
     procedure InternalInitFieldDefs; override;
     procedure InternalOpen; override;
+    Procedure InternalRefresh; override;
     function  GetCanModify: Boolean; override;
     Function IsPrepared : Boolean; virtual;
     Procedure SetActive (Value : Boolean); override;
@@ -464,6 +494,8 @@ type
     procedure BeforeRefreshOpenCursor; override;
     procedure SetReadOnly(AValue : Boolean); override;
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+    procedure DoOnNewRecord; override;
+    procedure DoBeforePost; override;
     class function FieldDefsClass : TFieldDefsClass; override;
     // IProviderSupport methods
     function PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; override;
@@ -531,6 +563,7 @@ type
     property UsePrimaryKeyAsKey : boolean read FUsePrimaryKeyAsKey write SetUsePrimaryKeyAsKey default true;
     property StatementType : TStatementType read GetStatementType;
     Property DataSource : TDataSource Read GetDataSource Write SetDataSource;
+    property Sequence: TSQLSequence read FSequence write FSequence;
     property ServerFilter: string read FServerFilterText write SetServerFilterText;
     property ServerFiltered: Boolean read FServerFiltered write SetServerFiltered default False;
     property ServerIndexDefs : TServerIndexDefs read GetServerIndexDefs;
@@ -589,6 +622,7 @@ type
     property UpdateMode;
     property UsePrimaryKeyAsKey;
     Property DataSource;
+    property Sequence;
     property ServerFilter;
     property ServerFiltered;
     property ServerIndexDefs;
@@ -665,7 +699,7 @@ type
     function GetTransactionHandle(trans : TSQLHandle): pointer; override;
     function Commit(trans : TSQLHandle) : boolean; override;
     function RollBack(trans : TSQLHandle) : boolean; override;
-    function StartdbTransaction(trans : TSQLHandle; aParams : string) : boolean; override;
+    function StartDBTransaction(trans : TSQLHandle; aParams : string) : boolean; override;
     procedure CommitRetaining(trans : TSQLHandle); override;
     procedure RollBackRetaining(trans : TSQLHandle); override;
     procedure UpdateIndexDefs(IndexDefs : TIndexDefs; TableName : string); override;
@@ -745,6 +779,7 @@ begin
   Result := Format('%.2d:%.2d:%.2d.%.3d',[hour,minute,second,millisecond]);
 end;
 
+
 { TSQLDBFieldDefs }
 
 class function TSQLDBFieldDefs.FieldDefClass: TFieldDefClass;
@@ -752,6 +787,7 @@ begin
   Result:=TSQLDBFieldDef;
 end;
 
+
 { TSQLDBParams }
 
 class function TSQLDBParams.ParamClass: TParamClass;
@@ -759,6 +795,7 @@ begin
   Result:=TSQLDBParam;
 end;
 
+
 { ESQLDatabaseError }
 
 constructor ESQLDatabaseError.CreateFmt(const Fmt: string; const Args: array of const;
@@ -782,8 +819,6 @@ begin
   SQLState  := ASQLState;
 end;
 
-Type
-  TInternalTransaction = Class(TSQLTransaction);
 
 { TCustomSQLStatement }
 
@@ -976,8 +1011,6 @@ begin
   Result:=False;
 end;
 
-
-
 procedure TCustomSQLStatement.GetStatementInfo(var ASQL: String; out Info: TSQLStatementInfo);
 
 begin
@@ -1090,6 +1123,7 @@ begin
   Result:=FRowsAffected;
 end;
 
+
 { TSQLConnection }
 
 constructor TSQLConnection.Create(AOwner: TComponent);
@@ -1287,6 +1321,11 @@ begin
   GetDBInfo(stSchemata,'','SCHEMA_NAME',List);
 end;
 
+procedure TSQLConnection.GetSequenceNames(List: TStrings);
+begin
+  GetDBInfo(stSequences,'','SEQUENCE_NAME',List);
+end;
+
 function TSQLConnection.GetConnectionInfo(InfoType: TConnInfoType): string;
 var i: TConnInfoType;
 begin
@@ -1509,12 +1548,12 @@ begin
   Result := nil;
 end;
 
-Function TSQLConnection.LogEvent(EventType: TDBEventType): Boolean;
+function TSQLConnection.LogEvent(EventType: TDBEventType): Boolean;
 begin
   Result:=(Assigned(FOnLog) or Assigned(GlobalDBLogHook)) and (EventType in LogEvents);
 end;
 
-Procedure TSQLConnection.Log(EventType: TDBEventType; Const Msg: String);
+procedure TSQLConnection.Log(EventType: TDBEventType; const Msg: String);
 
 Var
   M : String;
@@ -1535,13 +1574,13 @@ begin
     end;
 end;
 
-Procedure TSQLConnection.RegisterStatement(S: TCustomSQLStatement);
+procedure TSQLConnection.RegisterStatement(S: TCustomSQLStatement);
 begin
   if FStatements.IndexOf(S)=-1 then
     FStatements.Add(S);
 end;
 
-Procedure TSQLConnection.UnRegisterStatement(S: TCustomSQLStatement);
+procedure TSQLConnection.UnRegisterStatement(S: TCustomSQLStatement);
 begin
   if Assigned(FStatements) then // Can be nil, when we are destroying and datasets are uncoupled.
     FStatements.Remove(S);
@@ -1764,11 +1803,36 @@ begin
   case SchemaType of
     stProcedures: Result := 'SELECT *, ROUTINE_NAME AS PROCEDURE_NAME FROM INFORMATION_SCHEMA.ROUTINES';
     stSchemata  : Result := 'SELECT * FROM INFORMATION_SCHEMA.SCHEMATA';
+    stSequences : Result := 'SELECT * FROM INFORMATION_SCHEMA.SEQUENCES';
     else DatabaseError(SMetadataUnavailable);
   end;
 end;
 
-Procedure TSQLConnection.MaybeConnect;
+function TSQLConnection.GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string;
+begin
+  Result := 'SELECT NEXT VALUE FOR ' + SequenceName;
+end;
+
+function TSQLConnection.GetNextValue(const SequenceName: string; IncrementBy: integer): Int64;
+var
+  Q: TCustomSQLQuery;
+begin
+  Result := 0;
+  Q := TCustomSQLQuery.Create(nil);
+  try
+    Q.DataBase := Self;
+    Q.Transaction := Transaction;
+    Q.SQL.Text := GetNextValueSQL(SequenceName, IncrementBy);
+    Q.Open;
+    if not Q.Eof then
+      Result := Q.Fields[0].AsLargeInt;
+    Q.Close;
+  finally
+    FreeAndNil(Q);
+  end;
+end;
+
+procedure TSQLConnection.MaybeConnect;
 begin
   If Not Connected then
     begin
@@ -1790,6 +1854,7 @@ begin
   DatabaseError(SNotSupported);
 end;
 
+
 { TSQLTransaction }
 
 procedure TSQLTransaction.EndTransaction;
@@ -1931,7 +1996,7 @@ begin
     end
   else
     begin
-    if Db.StartdbTransaction(FTrans,FParams.CommaText) then
+    if Db.StartDBTransaction(FTrans,FParams.CommaText) then
       OpenTrans
     end;
 end;
@@ -1995,6 +2060,50 @@ begin
 end;
 
 
+{ TSQLSequence }
+
+constructor TSQLSequence.Create(AQuery: TCustomSQLQuery);
+begin
+  inherited Create;
+  FQuery := AQuery;
+  FApplyEvent := saeOnNewRecord;
+  FIncrementBy := 1;
+end;
+
+procedure TSQLSequence.Assign(Source: TPersistent);
+var SourceSequence: TSQLSequence;
+begin
+  if Source is TSQLSequence then
+  begin
+    SourceSequence := TSQLSequence(Source);
+    FFieldName    := SourceSequence.FieldName;
+    FSequenceName := SourceSequence.SequenceName;
+    FIncrementBy  := SourceSequence.IncrementBy;
+    FApplyEvent   := SourceSequence.ApplyEvent;
+  end
+  else
+    inherited;
+end;
+
+procedure TSQLSequence.Apply;
+var Field: TField;
+begin
+  if Assigned(FQuery) and (FSequenceName<>'') and (FFieldName<>'') then
+  begin
+    Field := FQuery.FindField(FFieldName);
+    if Assigned(Field) and Field.IsNull then
+      Field.AsLargeInt := GetNextValue;
+  end;
+end;
+
+function TSQLSequence.GetNextValue: Int64;
+begin
+  if (FQuery=Nil) or (FQuery.SQLConnection=Nil) then
+    DatabaseError(SErrDatabasenAssigned);
+  Result := FQuery.SQLConnection.GetNextValue(FSequenceName, FIncrementBy);
+end;
+
+
 Type
 
   { TQuerySQLStatement }
@@ -2096,6 +2205,7 @@ begin
   FRefreshSQL := TStringList.Create;
   FRefreshSQL.OnChange := @OnChangeModifySQL;
 
+  FSequence := TSQLSequence.Create(Self);
   FServerIndexDefs := TServerIndexDefs.Create(Self);
 
   FServerFiltered := False;
@@ -2120,11 +2230,12 @@ begin
   FreeAndNil(FUpdateSQL);
   FreeAndNil(FDeleteSQL);
   FreeAndNil(FRefreshSQL);
-  FServerIndexDefs.Free;
+  FreeAndNil(FSequence);
+  FreeAndNil(FServerIndexDefs);
   inherited Destroy;
 end;
 
-function TCustomSQLQuery.ParamByName(Const AParamName: String): TParam;
+function TCustomSQLQuery.ParamByName(const AParamName: String): TParam;
 
 begin
   Result:=Params.ParamByName(AParamName);
@@ -2136,7 +2247,7 @@ begin
   CheckInactive;
 end;
 
-Procedure TCustomSQLQuery.SetTransaction(Value: TDBTransaction);
+procedure TCustomSQLQuery.SetTransaction(Value: TDBTransaction);
 
 begin
   UnPrepare;
@@ -2166,7 +2277,7 @@ begin
     end;
 end;
 
-Function TCustomSQLQuery.IsPrepared: Boolean;
+function TCustomSQLQuery.IsPrepared: Boolean;
 
 begin
   if Assigned(Fstatement) then
@@ -2175,7 +2286,7 @@ begin
     Result := False;
 end;
 
-Function TCustomSQLQuery.AddFilter(SQLstr: string): string;
+function TCustomSQLQuery.AddFilter(SQLstr: string): string;
 
 begin
   if (FWhereStartPos > 0) and (FWhereStopPos > 0) then
@@ -2193,7 +2304,7 @@ begin
   Result := SQLstr;
 end;
 
-Function TCustomSQLQuery.NeedRefreshRecord(UpdateKind: TUpdateKind): Boolean;
+function TCustomSQLQuery.NeedRefreshRecord(UpdateKind: TUpdateKind): Boolean;
 
 
 Var
@@ -2213,7 +2324,7 @@ begin
     end;
 end;
 
-Function TCustomSQLQuery.RefreshRecord(UpdateKind: TUpdateKind) : Boolean;
+function TCustomSQLQuery.RefreshRecord(UpdateKind: TUpdateKind): Boolean;
 
 Var
   Q : TCustomSQLQuery;
@@ -2276,7 +2387,7 @@ begin
   First;
 end;
 
-Procedure TCustomSQLQuery.SetActive(Value: Boolean);
+procedure TCustomSQLQuery.SetActive(Value: Boolean);
 
 begin
   inherited SetActive(Value);
@@ -2351,7 +2462,7 @@ begin
   Result := FServerIndexDefs;
 end;
 
-function TCustomSQLQuery.GetSQL: TStringlist;
+function TCustomSQLQuery.GetSQL: TStringList;
 begin
   Result:=TStringList(Fstatement.SQL);
 end;
@@ -2366,7 +2477,7 @@ begin
   Result:=Transaction as TSQLTransaction;
 end;
 
-Function TCustomSQLQuery.Cursor: TSQLCursor;
+function TCustomSQLQuery.Cursor: TSQLCursor;
 begin
   Result:=FStatement.Cursor;
 end;
@@ -2513,6 +2624,13 @@ begin
   inherited InternalOpen;
 end;
 
+procedure TCustomSQLQuery.InternalRefresh;
+begin
+  if (sqoCancelUpdatesOnRefresh in Options) then
+    CancelUpdates;
+  inherited InternalRefresh;
+end;
+
 // public part
 
 procedure TCustomSQLQuery.ExecSQL;
@@ -2534,7 +2652,7 @@ begin
   end;
 end;
 
-Procedure TCustomSQLQuery.ApplyUpdates(MaxErrors: Integer);
+procedure TCustomSQLQuery.ApplyUpdates(MaxErrors: Integer);
 begin
   inherited ApplyUpdates(MaxErrors);
   If sqoAutoCommit in Options then
@@ -2545,14 +2663,14 @@ begin
     end;
 end;
 
-Procedure TCustomSQLQuery.Post;
+procedure TCustomSQLQuery.Post;
 begin
   inherited Post;
   If (sqoAutoApplyUpdates in Options) then
     ApplyUpdates;
 end;
 
-Procedure TCustomSQLQuery.Delete;
+procedure TCustomSQLQuery.Delete;
 begin
   inherited Delete;
   If (sqoAutoApplyUpdates in Options) then
@@ -2575,7 +2693,7 @@ begin
     FServerFiltered := False;
 end;
 
-procedure TCustomSQLQuery.SetSQL(const AValue: TStringlist);
+procedure TCustomSQLQuery.SetSQL(const AValue: TStringList);
 begin
   FStatement.SQL.Assign(AValue);
 end;
@@ -2599,7 +2717,7 @@ begin
     SQLConnection.UpdateIndexDefs(ServerIndexDefs,FTableName);
 end;
 
-Function TCustomSQLQuery.NeedLastInsertID : TField;
+function TCustomSQLQuery.NeedLastInsertID: TField;
 
 Var
   I : Integer;
@@ -2619,7 +2737,7 @@ begin
     end
 end;
 
-Function TCustomSQLQuery.RefreshLastInsertID(Field : TField) : Boolean;
+function TCustomSQLQuery.RefreshLastInsertID(Field: TField): Boolean;
 
 begin
   Result:=SQLConnection.RefreshLastInsertID(Self, Field);
@@ -2705,12 +2823,12 @@ begin
     UnPrepareStatement(Cursor);
 end;
 
-Function TCustomSQLQuery.LogEvent(EventType: TDBEventType): Boolean;
+function TCustomSQLQuery.LogEvent(EventType: TDBEventType): Boolean;
 begin
   Result:=Assigned(Database) and SQLConnection.LogEvent(EventType);
 end;
 
-Procedure TCustomSQLQuery.Log(EventType: TDBEventType; Const Msg: String);
+procedure TCustomSQLQuery.Log(EventType: TDBEventType; const Msg: String);
 
 Var
   M : String;
@@ -2789,7 +2907,7 @@ begin
   FStatement.Params.Assign(AValue);
 end;
 
-Procedure TCustomSQLQuery.SetDataSource(AValue: TDataSource);
+procedure TCustomSQLQuery.SetDataSource(AValue: TDataSource);
 
 Var
   DS : TDataSource;
@@ -2806,7 +2924,7 @@ begin
     end;
 end;
 
-Function TCustomSQLQuery.GetDataSource: TDataSource;
+function TCustomSQLQuery.GetDataSource: TDataSource;
 
 begin
   If Assigned(FStatement) then
@@ -2823,6 +2941,20 @@ begin
     DataSource:=Nil;
 end;
 
+procedure TCustomSQLQuery.DoOnNewRecord;
+begin
+  inherited;
+  if FSequence.ApplyEvent = saeOnNewRecord then
+    FSequence.Apply;
+end;
+
+procedure TCustomSQLQuery.DoBeforePost;
+begin
+  if (State = dsInsert) and (FSequence.ApplyEvent = saeOnPost) then
+    FSequence.Apply;
+  inherited;
+end;
+
 function TCustomSQLQuery.PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError;
 var
   PrevErrorCode, ErrorCode: Integer;
@@ -3205,11 +3337,10 @@ begin
   Result:=FProxy.RollBack(trans);
 end;
 
-function TSQLConnector.StartdbTransaction(trans: TSQLHandle; aParams: string
-  ): boolean;
+function TSQLConnector.StartDBTransaction(trans: TSQLHandle; aParams: string): boolean;
 begin
   CheckProxy;
-  Result:=FProxy.StartdbTransaction(trans, aParams);
+  Result:=FProxy.StartDBTransaction(trans, aParams);
 end;
 
 procedure TSQLConnector.CommitRetaining(trans: TSQLHandle);

packages/fcl-db/tests/dbtestframework.pas

@@ -28,7 +28,7 @@ uses
   TestSpecificTBufDataset,
   TestSpecificTDBF,
   TestSpecificTMemDataset,
-  TestDBExport,
+  TestDBExport, tccsvdataset,
   consoletestrunner;
 
 Procedure LegacyOutput;

packages/fcl-db/tests/dbtestframework_gui.lpi

@@ -27,12 +27,6 @@
             <IncludeFiles Value="$(ProjOutDir)"/>
             <OtherUnitFiles Value="../src/base;../src/sqldb/odbc;../src/sqldb/mssql;../src/sqldb/sqlite;../src/sqldb/postgres;../src/sqldb/oracle;../src/memds;../src/sqldb;../src/sqldb/interbase;../src/sqldb/mysql;../src/dbase;../src/sdf"/>
           </SearchPaths>
-          <Other>
-            <CompilerMessages>
-              <UseMsgFile Value="True"/>
-            </CompilerMessages>
-            <CompilerPath Value="$(CompPath)"/>
-          </Other>
         </CompilerOptions>
       </Item2>
       <Item3 Name="Default_no_local_ppus">
@@ -46,12 +40,6 @@
               <GenerateDebugInfo Value="False"/>
             </Debugging>
           </Linking>
-          <Other>
-            <CompilerMessages>
-              <UseMsgFile Value="True"/>
-            </CompilerMessages>
-            <CompilerPath Value="$(CompPath)"/>
-          </Other>
         </CompilerOptions>
       </Item3>
       <Item4 Name="Default_no_local_ppus_debug">
@@ -65,12 +53,6 @@
               <OptimizationLevel Value="0"/>
             </Optimizations>
           </CodeGeneration>
-          <Other>
-            <CompilerMessages>
-              <UseMsgFile Value="True"/>
-            </CompilerMessages>
-            <CompilerPath Value="$(CompPath)"/>
-          </Other>
         </CompilerOptions>
       </Item4>
     </BuildModes>
@@ -82,7 +64,6 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
     <RequiredPackages Count="4">
@@ -99,17 +80,20 @@
         <PackageName Value="FCL"/>
       </Item4>
     </RequiredPackages>
-    <Units Count="2">
+    <Units Count="3">
       <Unit0>
         <Filename Value="dbtestframework_gui.lpr"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="dbtestframework_gui"/>
       </Unit0>
       <Unit1>
         <Filename Value="dbguitestrunner.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="DBGuiTestRunner"/>
       </Unit1>
+      <Unit2>
+        <Filename Value="tccsvdataset.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tccsvdataset"/>
+      </Unit2>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
@@ -123,12 +107,6 @@
         <GenerateDebugInfo Value="False"/>
       </Debugging>
     </Linking>
-    <Other>
-      <CompilerMessages>
-        <UseMsgFile Value="True"/>
-      </CompilerMessages>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="7">

packages/fcl-db/tests/dbtestframework_gui.lpr

@@ -35,7 +35,7 @@ uses
   TestSpecificTBufDataset,
   TestSpecificTDBF,
   TestSpecificTMemDataset,
-  TestDBExport;
+  TestDBExport, tccsvdataset;
 
 {$R *.res}
 

packages/fcl-db/tests/tccsvdataset.pp

@@ -0,0 +1,404 @@
+unit tccsvdataset;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, db, SysUtils, fpcunit, testutils, testregistry, csvdataset;
+
+type
+
+  { TTestCSVDataset }
+
+  TTestCSVDataset= class(TTestCase)
+  private
+    FCSVDataset: TCSVDataset;
+    // Load CSVDataset from CSV stream containing lines
+    Procedure LoadFromLines(Const Lines: Array of string);
+    // Save CSVDataset to CSV stream, transform to lines
+    Procedure SaveToLines(Const Lines: TStrings);
+    // Save CSVDataset to CSV stream, transform to lines, compare with given lines
+    Procedure AssertLines(Const Lines: Array of string);
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    Property CSVDataset : TCSVDataset Read FCSVDataset;
+  published
+    procedure TestEmpty;
+    procedure TestDefaults;
+    Procedure TestLoadEmptyDefault;
+    Procedure TestLoadEmptyFirstLineAsNames;
+    Procedure TestLoad2fieldsFirstLineAsNames;
+    Procedure TestLoad2fields;
+    Procedure TestLoad2Records2fields;
+    Procedure TestSaveEmptyDefault;
+    Procedure TestSaveEmptyFirstLineAsNames;
+    Procedure TestSaveOneRecordDefault;
+    Procedure TestSaveOneRecordFirstLineAsNames;
+    Procedure TestSaveTwoRecordsDefault;
+    Procedure TestSaveTwoRecordsFirstLineAsNames;
+    Procedure TestSaveOneRecord2FieldsDefault;
+    Procedure TestSaveOneRecord2FieldsFirstLineAsNames;
+    Procedure TestLoadPriorFieldDefs;
+    Procedure TestLoadPriorFieldDefsNoFieldNames;
+    Procedure TestLoadPriorFieldDefsNoFieldNamesWrongCount;
+    Procedure TestLoadPriorFieldDefsFieldNamesWrongCount;
+    Procedure TestLoadPriorFieldDefsFieldNamesWrongNames;
+  end;
+
+implementation
+
+procedure TTestCSVDataset.TestEmpty;
+begin
+  AssertNotNull('Have CSV dataset',CSVDataset);
+  AssertFalse('Not open',CSVDataset.Active);
+  AssertEquals('No fielddefs',0,CSVDataset.FieldDefs.Count);
+  AssertEquals('Name','DS',CSVDataset.Name);
+end;
+
+procedure TTestCSVDataset.TestDefaults;
+begin
+  With CSVDataset.CSVOptions do
+    begin
+    AssertEquals('DefaultFieldLength',255,DefaultFieldLength);
+    AssertEquals('FirstLineAsFieldNames',False,FirstLineAsFieldNames);
+    AssertEquals('Delimiter',',',Delimiter);
+    AssertEquals('QuoteChar','"',QuoteChar);
+    AssertEquals('LineEnding',sLineBreak,LineEnding);
+    AssertEquals('IgnoreOuterWhitespace',False,IgnoreOuterWhitespace);
+    AssertEquals('QuoteOuterWhitespace',True,QuoteOuterWhitespace);
+    AssertEquals('EqualColCountPerRow',True,EqualColCountPerRow);
+    end;
+end;
+
+Procedure TTestCSVDataset.LoadFromLines(Const Lines : Array of string);
+
+Var
+  L : TStringList;
+  s : TStream;
+begin
+  S:=Nil;
+  L:=TStringList.Create;
+  try
+    L.AddStrings(Lines);
+    S:=TStringStream.Create(L.Text);
+    CSVDataset.LoadFromCSVStream(S);
+  finally
+    S.Free;
+    L.Free;
+  end;
+end;
+
+Procedure TTestCSVDataset.SaveToLines(Const Lines: TStrings);
+
+Var
+  S : TStringStream;
+
+begin
+  S:=TStringStream.Create('');
+  try
+    CSVDataset.SaveToCSVStream(S);
+    Lines.Text:=S.DataString;
+    {
+    Writeln('----');
+    Writeln(S.DataString);
+    Writeln('----');
+    }
+  finally
+    S.Free;
+  end;
+end;
+
+Procedure TTestCSVDataset.AssertLines(Const Lines: Array of string);
+
+Var
+  L : TStrings;
+  I : Integer;
+begin
+  L:=TStringList.Create;
+  try
+    SaveToLines(L);
+    AssertEquals('Number of lines',Length(Lines),L.Count);
+    For I:=0 to L.Count-1 do
+      AssertEquals('Correct line '+IntToStr(0),Lines[I],L[i]);
+  finally
+    L.Free;
+  end;
+end;
+
+Procedure TTestCSVDataset.TestLoadEmptyDefault;
+begin
+  LoadFromLines(['a']);
+  AssertEquals('Active',True,CSVDataset.Active);
+  AssertEquals('field count',1,CSVDataset.FieldDefs.Count);
+  AssertEquals('field name','Column1',CSVDataset.FieldDefs[0].Name);
+  AssertEquals('field size',CSVDataset.CSVOptions.DefaultFieldLength,CSVDataset.FieldDefs[0].Size);
+  AssertEquals('Not Empty',False,CSVDataset.EOF and CSVDataset.BOF);
+  AssertEquals('field contents','a',CSVDataset.Fields[0].AsString);
+end;
+
+Procedure TTestCSVDataset.TestLoadEmptyFirstLineAsNames;
+
+begin
+  CSVDataset.CSVOptions.FirstLineAsFieldNames:=True;
+  CSVDataset.CSVOptions.DefaultFieldLength:=128;
+  LoadFromLines(['a']);
+  AssertEquals('Active',True,CSVDataset.Active);
+  AssertEquals('field count',1,CSVDataset.FieldDefs.Count);
+  AssertEquals('field name','a',CSVDataset.FieldDefs[0].Name);
+  AssertEquals('field size',CSVDataset.CSVOptions.DefaultFieldLength,CSVDataset.FieldDefs[0].Size);
+  AssertEquals('Empty',True,CSVDataset.EOF and CSVDataset.BOF);
+end;
+
+Procedure TTestCSVDataset.TestLoad2fieldsFirstLineAsNames;
+begin
+  CSVDataset.CSVOptions.FirstLineAsFieldNames:=True;
+  CSVDataset.CSVOptions.DefaultFieldLength:=128;
+  LoadFromLines(['a,b']);
+  AssertEquals('Active',True,CSVDataset.Active);
+  AssertEquals('field count',2,CSVDataset.FieldDefs.Count);
+  AssertEquals('field 0 name','a',CSVDataset.FieldDefs[0].Name);
+  AssertEquals('field 0 size',CSVDataset.CSVOptions.DefaultFieldLength,CSVDataset.FieldDefs[0].Size);
+  AssertEquals('field 1 name','b',CSVDataset.FieldDefs[1].Name);
+  AssertEquals('field 1 size',CSVDataset.CSVOptions.DefaultFieldLength,CSVDataset.FieldDefs[1].Size);
+  AssertEquals('Empty',True,CSVDataset.EOF and CSVDataset.BOF);
+end;
+
+Procedure TTestCSVDataset.TestLoad2fields;
+
+begin
+  CSVDataset.CSVOptions.DefaultFieldLength:=128;
+  LoadFromLines(['a,b']);
+  AssertEquals('Active',True,CSVDataset.Active);
+  AssertEquals('field count',2,CSVDataset.FieldDefs.Count);
+  AssertEquals('field 0 name','Column1',CSVDataset.FieldDefs[0].Name);
+  AssertEquals('field 0 size',CSVDataset.CSVOptions.DefaultFieldLength,CSVDataset.FieldDefs[0].Size);
+  AssertEquals('field 1 name','Column2',CSVDataset.FieldDefs[1].Name);
+  AssertEquals('field 1 size',CSVDataset.CSVOptions.DefaultFieldLength,CSVDataset.FieldDefs[1].Size);
+  AssertEquals('Empty',False,CSVDataset.EOF and CSVDataset.BOF);
+  AssertEquals('Not Empty',False,CSVDataset.EOF and CSVDataset.BOF);
+  AssertEquals('field 0 contents','a',CSVDataset.Fields[0].AsString);
+  AssertEquals('field 1 contents','b',CSVDataset.Fields[1].AsString);
+end;
+
+Procedure TTestCSVDataset.TestLoad2Records2fields;
+begin
+  CSVDataset.CSVOptions.DefaultFieldLength:=128;
+  LoadFromLines(['a,b','c,d']);
+  AssertEquals('Active',True,CSVDataset.Active);
+  AssertEquals('field count',2,CSVDataset.FieldDefs.Count);
+  AssertEquals('field 0 name','Column1',CSVDataset.FieldDefs[0].Name);
+  AssertEquals('field 0 size',CSVDataset.CSVOptions.DefaultFieldLength,CSVDataset.FieldDefs[0].Size);
+  AssertEquals('field 1 name','Column2',CSVDataset.FieldDefs[1].Name);
+  AssertEquals('field 1 size',CSVDataset.CSVOptions.DefaultFieldLength,CSVDataset.FieldDefs[1].Size);
+  AssertEquals('Empty',False,CSVDataset.EOF and CSVDataset.BOF);
+  AssertEquals('Not Empty',False,CSVDataset.EOF and CSVDataset.BOF);
+  AssertEquals('field 0 contents','a',CSVDataset.Fields[0].AsString);
+  AssertEquals('field 1 contents','b',CSVDataset.Fields[1].AsString);
+  CSVDataset.Next;
+  AssertEquals('not At EOF',False,CSVDataset.EOF);
+  AssertEquals('field 0 contents','c',CSVDataset.Fields[0].AsString);
+  AssertEquals('field 1 contents','d',CSVDataset.Fields[1].AsString);
+  CSVDataset.Next;
+  AssertEquals('At EOF',True,CSVDataset.EOF);
+end;
+
+Procedure TTestCSVDataset.TestSaveEmptyDefault;
+begin
+  CSVDataset.FieldDefs.Add('a',ftString);
+  CSVDataset.CreateDataset;
+  AssertLines([]);
+end;
+
+Procedure TTestCSVDataset.TestSaveEmptyFirstLineAsNames;
+begin
+  CSVDataset.CSVOptions.FirstLineAsFieldNames:=True;
+  CSVDataset.FieldDefs.Add('a',ftString);
+  CSVDataset.CreateDataset;
+  AssertLines(['a']);
+end;
+
+Procedure TTestCSVDataset.TestSaveOneRecordDefault;
+begin
+//  CSVDataset.CSVOptions.FirstLineAsFieldNames:=True;
+  CSVDataset.FieldDefs.Add('a',ftString,20);
+  CSVDataset.CreateDataset;
+  CSVDataset.Append;
+  CSVDataset.Fields[0].AsString:='b';
+  CSVDataset.Post;
+  AssertLines(['b']);
+end;
+
+Procedure TTestCSVDataset.TestSaveOneRecordFirstLineAsNames;
+begin
+  CSVDataset.CSVOptions.FirstLineAsFieldNames:=True;
+  CSVDataset.FieldDefs.Add('a',ftString,20);
+  CSVDataset.CreateDataset;
+  CSVDataset.Append;
+  CSVDataset.Fields[0].AsString:='b';
+  CSVDataset.Post;
+  AssertLines(['a','b']);
+end;
+
+Procedure TTestCSVDataset.TestSaveTwoRecordsDefault;
+begin
+  CSVDataset.FieldDefs.Add('a',ftString,20);
+  CSVDataset.CreateDataset;
+  CSVDataset.Append;
+  CSVDataset.Fields[0].AsString:='b';
+  CSVDataset.Post;
+  CSVDataset.Append;
+  CSVDataset.Fields[0].AsString:='c';
+  CSVDataset.Post;
+  AssertLines(['b','c']);
+end;
+
+Procedure TTestCSVDataset.TestSaveTwoRecordsFirstLineAsNames;
+begin
+  CSVDataset.CSVOptions.FirstLineAsFieldNames:=True;
+  CSVDataset.FieldDefs.Add('a',ftString,20);
+  CSVDataset.CreateDataset;
+  CSVDataset.Append;
+  CSVDataset.Fields[0].AsString:='b';
+  CSVDataset.Post;
+  CSVDataset.Append;
+  CSVDataset.Fields[0].AsString:='c';
+  CSVDataset.Post;
+  AssertLines(['a','b','c']);
+end;
+
+Procedure TTestCSVDataset.TestSaveOneRecord2FieldsDefault;
+begin
+  CSVDataset.FieldDefs.Add('a',ftString,20);
+  CSVDataset.FieldDefs.Add('b',ftString,20);
+  CSVDataset.CreateDataset;
+  CSVDataset.Append;
+  CSVDataset.Fields[0].AsString:='c';
+  CSVDataset.Fields[1].AsString:='d';
+  CSVDataset.Post;
+  AssertLines(['c,d']);
+end;
+
+Procedure TTestCSVDataset.TestSaveOneRecord2FieldsFirstLineAsNames;
+begin
+  CSVDataset.CSVOptions.FirstLineAsFieldNames:=True;
+  CSVDataset.FieldDefs.Add('a',ftString,20);
+  CSVDataset.FieldDefs.Add('b',ftString,20);
+  CSVDataset.CreateDataset;
+  CSVDataset.Append;
+  CSVDataset.Fields[0].AsString:='c';
+  CSVDataset.Fields[1].AsString:='d';
+  CSVDataset.Post;
+  AssertLines(['a,b','c,d']);
+end;
+
+Procedure TTestCSVDataset.TestLoadPriorFieldDefs;
+begin
+  CSVDataset.CSVOptions.FirstLineAsFieldNames:=True;
+  CSVDataset.FieldDefs.Add('a',ftString,20);
+  CSVDataset.FieldDefs.Add('b',ftInteger,4);
+  LoadFromLines(['a,b','1,2']);
+  AssertEquals('field count',2,CSVDataset.FieldDefs.Count);
+  AssertEquals('field 0 name','a',CSVDataset.FieldDefs[0].Name);
+  AssertEquals('field 0 size',20,CSVDataset.FieldDefs[0].Size);
+  AssertEquals('field 1 name','b',CSVDataset.FieldDefs[1].Name);
+  AssertEquals('field 1 size',4,CSVDataset.FieldDefs[1].Size);
+  AssertEquals('field 1 typee',Ord(ftInteger),Ord(CSVDataset.FieldDefs[1].DataType));
+  AssertEquals('Not Empty',False,CSVDataset.EOF and CSVDataset.BOF);
+  AssertEquals('field 0 contents','1',CSVDataset.Fields[0].AsString);
+  AssertEquals('field 1 contents',2,CSVDataset.Fields[1].AsInteger);
+end;
+
+Procedure TTestCSVDataset.TestLoadPriorFieldDefsNoFieldNames;
+begin
+  CSVDataset.FieldDefs.Add('a',ftString,20);
+  CSVDataset.FieldDefs.Add('b',ftInteger,4);
+  LoadFromLines(['1,2']);
+  AssertEquals('field count',2,CSVDataset.FieldDefs.Count);
+  AssertEquals('field 0 name','a',CSVDataset.FieldDefs[0].Name);
+  AssertEquals('field 0 size',20,CSVDataset.FieldDefs[0].Size);
+  AssertEquals('field 1 name','b',CSVDataset.FieldDefs[1].Name);
+  AssertEquals('field 1 size',4,CSVDataset.FieldDefs[1].Size);
+  AssertEquals('field 1 typee',Ord(ftInteger),Ord(CSVDataset.FieldDefs[1].DataType));
+  AssertEquals('Not Empty',False,CSVDataset.EOF and CSVDataset.BOF);
+  AssertEquals('field 0 contents','1',CSVDataset.Fields[0].AsString);
+  AssertEquals('field 1 contents',2,CSVDataset.Fields[1].AsInteger);
+end;
+
+Procedure TTestCSVDataset.TestLoadPriorFieldDefsNoFieldNamesWrongCount;
+
+Var
+  OK : Boolean;
+begin
+  CSVDataset.FieldDefs.Add('a',ftString,20);
+  CSVDataset.FieldDefs.Add('b',ftInteger,4);
+  try
+    LoadFromLines(['1']);
+    OK:=False;
+  except
+    OK:=true;
+  end;
+  if not OK then
+    Fail('Expected exception, but none raised');
+end;
+
+Procedure TTestCSVDataset.TestLoadPriorFieldDefsFieldNamesWrongCount;
+
+const
+  EM = 'DS : CSV File Field count (1) does not match dataset field count (2).';
+Var
+  OK : String;
+begin
+  CSVDataset.CSVOptions.FirstLineAsFieldNames:=True;
+  CSVDataset.FieldDefs.Add('a',ftString,20);
+  CSVDataset.FieldDefs.Add('b',ftInteger,4);
+  try
+    LoadFromLines(['A']);
+    OK:='Expected exception, but none raised';
+  except
+    on E : Exception do
+      if  (E.Message<>EM) then
+        OK:=ComparisonMsg(EM,E.Message);
+  end;
+  if (OK<>'') then
+    Fail(OK);
+end;
+
+Procedure TTestCSVDataset.TestLoadPriorFieldDefsFieldNamesWrongNames;
+const
+  EM = 'DS : CSV File field 1: name "c" does not match dataset field name "b".';
+Var
+  OK : String;
+begin
+  CSVDataset.CSVOptions.FirstLineAsFieldNames:=True;
+  CSVDataset.FieldDefs.Add('a',ftString,20);
+  CSVDataset.FieldDefs.Add('b',ftInteger,4);
+  try
+    LoadFromLines(['a,c']);
+    OK:='No exception raised';
+  except
+    on E : Exception do
+      if  (E.Message<>EM) then
+        OK:=ComparisonMsg(EM,E.Message)
+  end;
+  if (OK<>'') then
+    Fail(OK);
+end;
+
+procedure TTestCSVDataset.SetUp;
+begin
+  FCSVDataset:=TCSVDataset.Create(Nil);
+  FCSVDataset.Name:='DS';
+end;
+
+procedure TTestCSVDataset.TearDown;
+begin
+  FreeAndNil(FCSVDataset);
+end;
+
+Initialization
+
+  RegisterTest(TTestCSVDataset);
+end.
+

packages/fcl-db/tests/tcsdfdata.pp

@@ -14,6 +14,8 @@ type
   { Ttestsdfspecific }
 
   Ttestsdfspecific = class(Ttestcase)
+  private
+    procedure TestEmptyFieldContents;
   protected
     TestDataset: TSDFDataset;
     procedure Setup; override;
@@ -31,6 +33,10 @@ type
     procedure TestInputOurFormat;
     }
     procedure TestDelimitedTextOutput;
+    procedure TestEmptyHeader;
+    Procedure TestEmptyHeader2;
+    Procedure TestEmptyHeaderStripTrailingDelimiters;
+    Procedure TestStripTrailingDelimiters;
   end;
 
 implementation
@@ -260,45 +266,184 @@ const
   Value5='multi'+#13+#10+'line';
   Value6='Delimiter,and;done';
   Value7='Some "random" quotes';
-var
+Var
+  F : Text;
   FileStrings: TStringList;
   OneRecord: TStringList;
 begin
   TestDataset.Close;
   TestDataset.AllowMultiLine:=true;
+  TestDataset.FirstLineAsSchema:=true;
   if FileExists(OutputFileName) then DeleteFile(OutputFileName);
-  FileStrings:=TStringList.Create;
-  OneRecord:=TStringList.Create;
-  try
-    FileStrings.Add('Field1,Field2,Field3,Field4,Field5,Field6,Field7');
-    OneRecord.Add(Value1);
-    OneRecord.Add(Value2);
-    OneRecord.Add(Value3);
-    OneRecord.Add(Value4);
-    OneRecord.Add(Value5);
-    OneRecord.Add(Value6);
-    OneRecord.Add(Value7);
-    OneRecord.Delimiter:=',';
-    OneRecord.QuoteChar:='"';
-    OneRecord.StrictDelimiter:=true;
-    FileStrings.Add(OneRecord.DelimitedText);
-    FileStrings.SaveToFile(OutputFileName);
-  finally
-    FileStrings.Free;
-    OneRecord.Free;
-  end;
-
+  Assign(F,OutputFileName);
+  Rewrite(F);
+  Writeln(F,'Field1,Field2,Field3,Field4,Field5,Field6,Field7');
+  Writeln(F,'"Delimiter,""and"";quote","J""T""",Just a long line,"Just a quoted long line","multi');
+  Writeln(F,'line","Delimiter,and;done","Some ""random"" quotes"');
+  Close(F);
   // Load our dataset
   TestDataset.FileName:=OutputFileName;
   TestDataset.Open;
+//  AssertEquals('Field count',7,TEstDataset.Fielddefs.Count);
+//  AssertEquals('Record count',1,TEstDataset.RecordCount);
   TestDataset.First;
-  AssertEquals(Value1, TestDataSet.Fields[0].AsString);
-  AssertEquals(Value2, TestDataSet.Fields[1].AsString);
-  AssertEquals(Value3, TestDataSet.Fields[2].AsString);
-  AssertEquals(Value4, TestDataSet.Fields[3].AsString);
-  AssertEquals(Value5, TestDataSet.Fields[4].AsString);
-  AssertEquals(Value6, TestDataSet.Fields[5].AsString);
-  AssertEquals(Value7, TestDataSet.Fields[6].AsString);
+  AssertEquals('Field1',Value1, TestDataSet.Fields[0].AsString);
+  AssertEquals('Field2',Value2, TestDataSet.Fields[1].AsString);
+  AssertEquals('Field3',Value3, TestDataSet.Fields[2].AsString);
+  AssertEquals('Field4',Value4, TestDataSet.Fields[3].AsString);
+  AssertEquals('Field5',Value5, TestDataSet.Fields[4].AsString);
+  AssertEquals('Field6',Value6, TestDataSet.Fields[5].AsString);
+  AssertEquals('Field7',Value7, TestDataSet.Fields[6].AsString);
+end;
+
+procedure Ttestsdfspecific.TestEmptyHeader;
+
+const
+  OutputFileName='delim.csv';
+
+Var
+  F : Text;
+begin
+  TestDataset.Close;
+  TestDataset.AllowMultiLine:=False;
+  if FileExists(OutputFileName) then DeleteFile(OutputFileName);
+  Assign(F,OutputFileName);
+  Rewrite(F);
+  Writeln(F,'1;2;3;;5');
+  Close(F);
+  TestDataset.FirstLineAsSchema:=True;
+  TestDataset.Delimiter := ';';
+  TestDataset.FileName:=OutputFileName;
+  TestDataset.Open;
+  AssertEquals('Correct field count',5,TestDataset.FieldDefs.Count);
+end;
+
+procedure Ttestsdfspecific.TestEmptyHeader2;
+
+const
+  OutputFileName='delim.csv';
+
+Var
+  F : Text;
+  S : String;
+
+begin
+  TestDataset.Close;
+  TestDataset.AllowMultiLine:=False;
+  if FileExists(OutputFileName) then DeleteFile(OutputFileName);
+  Assign(F,OutputFileName);
+  Rewrite(F);
+  Writeln(F,'value1;value2;;;');
+  Close(F);
+  TestDataset.FirstLineAsSchema:=False;
+  TestDataset.Delimiter := ';';
+  TestDataset.FileName:=OutputFileName;
+  TestDataset.Schema.Clear;
+  TestDataset.Open;
+  AssertEquals('Correct field count',5,TestDataset.FieldDefs.Count);
+  TestDataset.Edit;
+  TestDataset.Fields[0].AsString:='Value1';
+  TestDataset.Post;
+  TestDataset.Close;
+  Assign(F,OutputFileName);
+  Reset(F);
+  ReadLn(F,S);
+  Close(F);
+  AssertEquals('No data lost','Value1;value2;;;',S);
+end;
+
+procedure Ttestsdfspecific.TestEmptyHeaderStripTrailingDelimiters;
+const
+  OutputFileName='delim.csv';
+
+Var
+  F : Text;
+  S : String;
+
+begin
+  TestDataset.Close;
+  TestDataset.AllowMultiLine:=False;
+  if FileExists(OutputFileName) then DeleteFile(OutputFileName);
+  Assign(F,OutputFileName);
+  Rewrite(F);
+  Writeln(F,'value1;value2;;;');
+  Close(F);
+  TestDataset.StripTrailingDelimiters:=True;
+  TestDataset.FirstLineAsSchema:=False;
+  TestDataset.Delimiter := ';';
+  TestDataset.FileName:=OutputFileName;
+  TestDataset.Schema.Clear;
+  TestDataset.Open;
+  AssertEquals('Correct field count',2,TestDataset.FieldDefs.Count);
+  TestDataset.Edit;
+  TestDataset.Fields[0].AsString:='Value1';
+  TestDataset.Post;
+  TestDataset.Close;
+  Assign(F,OutputFileName);
+  Reset(F);
+  ReadLn(F,S);
+  Close(F);
+  AssertEquals('No data lost','Value1;value2',S);
+end;
+
+procedure Ttestsdfspecific.TestStripTrailingDelimiters;
+const
+  OutputFileName='delim.csv';
+
+Var
+  F : Text;
+  S,S2 : String;
+
+begin
+  TestDataset.Close;
+  TestDataset.AllowMultiLine:=False;
+  if FileExists(OutputFileName) then DeleteFile(OutputFileName);
+  Assign(F,OutputFileName);
+  Rewrite(F);
+  Writeln(F,'value1;value2;;;');
+  Writeln(F,'value1;value2;;;');
+  Close(F);
+  TestDataset.StripTrailingDelimiters:=True;
+  TestDataset.FirstLineAsSchema:=False;
+  TestDataset.Delimiter := ';';
+  TestDataset.FileName:=OutputFileName;
+  TestDataset.Schema.Clear;
+  TestDataset.Open;
+  AssertEquals('Correct field count',2,TestDataset.FieldDefs.Count);
+  TestDataset.Edit;
+  TestDataset.Fields[0].AsString:='Value1';
+  TestDataset.Post;
+  TestDataset.Close;
+  Assign(F,OutputFileName);
+  Reset(F);
+  ReadLn(F,S);
+  ReadLn(F,S2);
+  Close(F);
+  AssertEquals('Headers lost','Value1;value2',S);
+  AssertEquals('Data lost','Value1;value2',S);
+end;
+
+procedure Ttestsdfspecific.TestEmptyFieldContents;
+
+const
+  OutputFileName='delim.csv';
+
+Var
+  F : Text;
+begin
+  TestDataset.Close;
+  TestDataset.AllowMultiLine:=False;
+  if FileExists(OutputFileName) then DeleteFile(OutputFileName);
+  Assign(F,OutputFileName);
+  Rewrite(F);
+  Writeln(F,'1;2;3;;5');
+  Writeln(F,'11;12;13;;15');
+  Close(F);
+  TestDataset.FirstLineAsSchema:=True;
+  TestDataset.Delimiter := ';';
+  TestDataset.FileName:=OutputFileName;
+  TestDataset.Open;
+  AssertEquals('Correct field count',5,TestDataset.FieldDefs.Count);
 end;
 
 

packages/fcl-db/tests/testdbbasics.pas

@@ -454,17 +454,17 @@ var
 begin
   query1:= DBConnector.GetNDataset(11);
   datalink1:= TDataLink.create;
-  datasource1:= tdatasource.create(nil);
+  datasource1:= TDataSource.create(nil);
   try
-    datalink1.datasource:= datasource1;
-    datasource1.dataset:= query1;
+    datalink1.DataSource:= datasource1;
+    datasource1.DataSet:= query1;
 
-    query1.active := true;
+    query1.active := True;
     query1.active := False;
     CheckEquals(0, THackDataLink(datalink1).RecordCount);
-    query1.active := true;
+    query1.active := True;
     CheckTrue(THackDataLink(datalink1).RecordCount>0);
-    query1.active := false;
+    query1.active := False;
   finally
     datalink1.free;
     datasource1.free;
@@ -488,13 +488,11 @@ begin
     CheckEquals(count,RecordCount);
 
     Close;
-
     end;
 end;
 
 procedure TTestCursorDBBasics.TestRecNo;
-var i       : longint;
-    passed  : boolean;
+var passed  : boolean;
 begin
   with DBConnector.GetNDataset(0) do
     begin
@@ -502,27 +500,23 @@ begin
     // return 0
     passed := false;
     try
-      i := recno;
+      passed := RecNo = 0;
     except on E: Exception do
-      begin
       passed := E.classname = EDatabaseError.className
-      end;
     end;
     if not passed then
       CheckEquals(0,RecNo,'Failed to get the RecNo from a closed dataset');
 
-    // Accessing Recordcount on a closed dataset should raise an EDatabaseError or should
+    // Accessing RecordCount on a closed dataset should raise an EDatabaseError or should
     // return 0
     passed := false;
     try
-      i := recordcount;
+      passed := RecordCount = 0;
     except on E: Exception do
-      begin
       passed := E.classname = EDatabaseError.className
-      end;
     end;
     if not passed then
-      CheckEquals(0,RecNo,'Failed to get the Recordcount from a closed dataset');
+      CheckEquals(0,RecordCount,'Failed to get the RecordCount from a closed dataset');
 
     Open;
 
@@ -564,6 +558,16 @@ begin
     CheckEquals(1,RecordCount);
 
     Close;
+
+    // Tests if RecordCount resets to 0 after dataset is closed
+    passed := false;
+    try
+      passed := RecordCount = 0;
+    except on E: Exception do
+      passed := E.classname = EDatabaseError.className
+    end;
+    if not passed then
+      CheckEquals(0,RecordCount,'RecordCount after Close');
     end;
 end;
 

packages/fcl-db/tests/testdbexport.pas

@@ -517,7 +517,6 @@ begin
   ExportSettings:=TCSVFormatSettings.Create(true);
   try
     ExportSettings.FieldDelimiter:=';';
-    ExportSettings.QuoteStrings:=[qsAlways,qsSpace,qsDelimiter]; //quote everything we can
     ExportSettings.StringQuoteChar:='"'; //try explicit assignment
     ExportSettings.RowDelimiter:=#10; //Unix/Linux format
     ExportSettings.BooleanFalse:='onwaar'; //why not a Dutch output format?

packages/fcl-db/tests/testfieldtypes.pas

@@ -211,7 +211,7 @@ begin
     SQL.Add('select * from FPDEV2');
     Open;
     AssertEquals(1,FieldCount);
-    AssertTrue(CompareText('FT',fields[0].FieldName)=0);
+    AssertTrue(SameText('FT',Fields[0].FieldName));
     AssertEquals('DataSize', ADataSize, Fields[0].DataSize);
     AssertEquals('DataType', ord(ADatatype), ord(Fields[0].DataType));
     Close;
@@ -449,9 +449,10 @@ begin
     for i := 0 to testValuesCount-1 do
       begin
       AssertEquals(testValues[i], Fields[0].AsString);
+      AssertEquals('IsNull', False, Fields[0].IsNull); // '' is not NULL
       Next;
       end;
-    close;
+    Close;
     end;
 end;
 
@@ -1665,6 +1666,7 @@ begin
       else
         AssertTrue('no test for paramtype available',False);
       end;
+      AssertEquals('IsNull', False, FieldByName('FIELD1').IsNull);
       Next;
       end;
     AssertTrue('Expected IsNull', FieldByName('FIELD1').IsNull);

packages/fcl-db/tests/testspecifictbufdataset.pas

@@ -39,6 +39,7 @@ type
     procedure TestAutoIncField;
     procedure TestAutoIncFieldStreaming;
     procedure TestAutoIncFieldStreamingXML;
+    Procedure TestRecordCount;
   end;
 
 implementation
@@ -248,6 +249,22 @@ begin
   IntTestAutoIncFieldStreaming(true);
 end;
 
+procedure TTestSpecificTBufDataset.TestRecordCount;
+var
+  BDS:TBufDataSet;
+  
+begin
+  BDS:=TBufDataSet.Create(nil);
+  BDS.FieldDefs.Add('ID',ftLargeint);
+  BDS.CreateDataSet;
+  BDS.AppendRecord([1]);
+  BDS.AppendRecord([2]);
+  BDS.AppendRecord([3]);
+  BDS.Close;
+  AssertEquals('IsEmpty: ',True,BDS.IsEmpty);
+  AssertEquals('RecordCount: ',0,BDS.RecordCount);
+end;
+  
 initialization
 {$ifdef fpc}
 

packages/fcl-db/tests/testsqldb.pas

@@ -53,6 +53,7 @@ type
     Procedure TestRefreshSQLMultipleRecords;
     Procedure TestRefreshSQLNoRecords;
     Procedure TestFetchAutoInc;
+    procedure TestSequence;
   end;
 
   { TTestTSQLConnection }
@@ -86,7 +87,7 @@ implementation
 
 { TTestTSQLQuery }
 
-Procedure TTestTSQLQuery.Setup;
+procedure TTestTSQLQuery.Setup;
 begin
   inherited Setup;
   SQLDBConnector.Connection.Options:=[];
@@ -181,7 +182,7 @@ begin
   end;
 end;
 
-Procedure TTestTSQLQuery.TestKeepOpenOnCommit;
+procedure TTestTSQLQuery.TestKeepOpenOnCommit;
 var Q: TSQLQuery;
     I: Integer;
 begin
@@ -219,12 +220,12 @@ begin
     end;
 end;
 
-Procedure TTestTSQLQuery.TrySetPacketRecords;
+procedure TTestTSQLQuery.TrySetPacketRecords;
 begin
   FMyQ.PacketRecords:=10;
 end;
 
-Procedure TTestTSQLQuery.TestKeepOpenOnCommitPacketRecords;
+procedure TTestTSQLQuery.TestKeepOpenOnCommitPacketRecords;
 begin
   with SQLDBConnector do
     begin
@@ -234,12 +235,12 @@ begin
     end;
 end;
 
-Procedure TTestTSQLQuery.TrySetQueryOptions;
+procedure TTestTSQLQuery.TrySetQueryOptions;
 begin
   FMyQ.Options:=[sqoKeepOpenOnCommit];
 end;
 
-Procedure TTestTSQLQuery.TestCheckSettingsOnlyWhenInactive;
+procedure TTestTSQLQuery.TestCheckSettingsOnlyWhenInactive;
 begin
   // Check that we can only set QueryOptions when the query is inactive.
   with SQLDBConnector do
@@ -261,7 +262,7 @@ begin
   AssertTrue('Have modifications in after post',FMyq.UpdateStatus=usModified)
 end;
 
-Procedure TTestTSQLQuery.TestAutoApplyUpdatesPost;
+procedure TTestTSQLQuery.TestAutoApplyUpdatesPost;
 var Q: TSQLQuery;
     I: Integer;
 begin
@@ -296,7 +297,7 @@ begin
 
 end;
 
-Procedure TTestTSQLQuery.TestAutoApplyUpdatesDelete;
+procedure TTestTSQLQuery.TestAutoApplyUpdatesDelete;
 
 var Q: TSQLQuery;
     I: Integer;
@@ -328,13 +329,13 @@ begin
     end;
 end;
 
-Procedure TTestTSQLQuery.DoApplyUpdates;
+procedure TTestTSQLQuery.DoApplyUpdates;
 
 begin
   FMyQ.ApplyUpdates();
 end;
 
-Procedure TTestTSQLQuery.TestCheckRowsAffected;
+procedure TTestTSQLQuery.TestCheckRowsAffected;
 var Q: TSQLQuery;
     I: Integer;
 begin
@@ -359,7 +360,7 @@ begin
     end;
 end;
 
-Procedure TTestTSQLQuery.TestAutoCommit;
+procedure TTestTSQLQuery.TestAutoCommit;
 var
   I : Integer;
 begin
@@ -389,7 +390,7 @@ begin
     end;
 end;
 
-Procedure TTestTSQLQuery.TestRefreshSQL;
+procedure TTestTSQLQuery.TestRefreshSQL;
 var
   Q: TSQLQuery;
 
@@ -424,7 +425,7 @@ begin
   AssertEquals('Field value has been fetched from the database', 1, Q.FieldByName('b').AsInteger);
 end;
 
-Procedure TTestTSQLQuery.TestGeneratedRefreshSQL;
+procedure TTestTSQLQuery.TestGeneratedRefreshSQL;
 
 var
   Q: TSQLQuery;
@@ -456,7 +457,7 @@ begin
   AssertEquals('Field value has been fetched from the database ','fgh',Q.FieldByName('b').AsString);
 end;
 
-Procedure TTestTSQLQuery.TestGeneratedRefreshSQL1Field;
+procedure TTestTSQLQuery.TestGeneratedRefreshSQL1Field;
 var
   Q: TSQLQuery;
 
@@ -485,7 +486,7 @@ begin
   AssertEquals('Field value b has NOT been fetched from the database ','',Q.FieldByName('b').AsString);
 end;
 
-Procedure TTestTSQLQuery.TestGeneratedRefreshSQLNoKey;
+procedure TTestTSQLQuery.TestGeneratedRefreshSQLNoKey;
 begin
   with SQLDBConnector do
     begin
@@ -507,7 +508,7 @@ begin
   AssertException('Cannot refresh without primary key',EUpdateError,@DoApplyUpdates);
 end;
 
-Procedure TTestTSQLQuery.TestRefreshSQLMultipleRecords;
+procedure TTestTSQLQuery.TestRefreshSQLMultipleRecords;
 
 begin
   with SQLDBConnector do
@@ -534,7 +535,7 @@ begin
   AssertException('Multiple records returned by RefreshSQL gives an error',EUpdateError,@DoApplyUpdates);
 end;
 
-Procedure TTestTSQLQuery.TestRefreshSQLNoRecords;
+procedure TTestTSQLQuery.TestRefreshSQLNoRecords;
 begin
   with SQLDBConnector do
     begin
@@ -560,7 +561,7 @@ begin
   AssertException('No records returned by RefreshSQL gives an error',EUpdateError,@DoApplyUpdates);
 end;
 
-Procedure TTestTSQLQuery.TestFetchAutoInc;
+procedure TTestTSQLQuery.TestFetchAutoInc;
 var datatype: string;
     id: largeint;
 begin
@@ -602,6 +603,50 @@ begin
     end;
 end;
 
+procedure TTestTSQLQuery.TestSequence;
+var SequenceNames : TStringList;
+begin
+  case SQLServerType of
+    ssFirebird:
+      SQLDBConnector.ExecuteDirect('create sequence FPDEV_SEQ1');
+    ssMSSQL, ssOracle, ssPostgreSQL:
+      SQLDBConnector.ExecuteDirect('create sequence FPDEV_SEQ1 MINVALUE 1');
+    else
+      Ignore(STestNotApplicable);
+  end;
+  SQLDBConnector.ExecuteDirect('create table FPDEV2 (id integer)');
+  SQLDBConnector.CommitDDL;
+
+  with SQLDBConnector.Query do
+    begin
+    SQL.Text := 'select * from FPDEV2';
+    Sequence.FieldName:='id';
+    Sequence.SequenceName:='FPDEV_SEQ1';
+    Open;
+    // default is get next value on new record
+    Append;
+    AssertEquals(1, FieldByName('id').AsInteger);
+
+    Sequence.ApplyEvent:=saeOnPost;
+    Append;
+    AssertTrue('Field ID must be null after Append', FieldByName('id').IsNull);
+    Post;
+    AssertEquals(2, FieldByName('id').AsInteger);
+    end;
+
+  // test GetSequenceNames
+  SequenceNames := TStringList.Create;
+  try
+    SQLDBConnector.Connection.GetSequenceNames(SequenceNames);
+    AssertTrue(SequenceNames.IndexOf('FPDEV_SEQ1') >= 0);
+  finally
+    SequenceNames.Free;
+  end;
+
+  SQLDBConnector.ExecuteDirect('drop sequence FPDEV_SEQ1');
+  SQLDBConnector.CommitDDL;
+end;
+
 
 { TTestTSQLConnection }
 

packages/sqlite/src/sqlite3.inc

@@ -36,10 +36,10 @@ const
   {$DEFINE S}
 {$ENDIF}
 
-const
-  SQLITE_VERSION        = '3.7.9';
-  SQLITE_VERSION_NUMBER = 3007009;
-  SQLITE_SOURCE_ID      = '2011-11-01 00:52:41 c7c6050ef060877ebe77b41d959e9df13f8c9b5e';
+{
+  Header converted from Sqlite version 3.7.9
+  SOURCE_ID = '2011-11-01 00:52:41 c7c6050ef060877ebe77b41d959e9df13f8c9b5e'
+}
 
 //SQLITE_EXTERN const char sqlite3_version[];
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_libversion{$IFDEF D}: function{$ENDIF}(): pansichar; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
@@ -250,16 +250,17 @@ type
     Open         : function(vfs: psqlite3_vfs; zName: pansichar; f: psqlite3_file; flags: cint; pOutFlags: pcint): cint; cdecl;
     Delete       : function(vfs: psqlite3_vfs; zName: pansichar; syncDir: cint): cint; cdecl;
     Access       : function(vfs: psqlite3_vfs; zName: pansichar; flags: cint): cint; cdecl;
-    GetTempname  : function(vfs: psqlite3_vfs; nOut: cint; zOut: pansichar): cint; cdecl;
     FullPathname : function(vfs: psqlite3_vfs; zName: pansichar; nOut: cint; zOut: pansichar): cint; cdecl;
     DlOpen       : function(vfs: psqlite3_vfs; zFilename: pansichar): pointer; cdecl;
     DlError      : procedure(vfs: psqlite3_vfs; nByte: cint; zErrMsg: pansichar); cdecl;
     DlSym        : function(vfs: psqlite3_vfs; addr: pointer; zSymbol: pansichar): pointer; cdecl;
     DlClose      : procedure(vfs: psqlite3_vfs; addr: pointer); cdecl;
     Randomness   : function(vfs: psqlite3_vfs; nByte: cint; zOut: pansichar): cint; cdecl;
-    Sleep        : function(vfs: psqlite3_vfs; microseconds: cint): cint; cdecl;
+    Sleep        : function(vfs: psqlite3_vfs; microseconds: cint): cint; cdecl;    
     CurrentTime  : function(vfs: psqlite3_vfs; time: pcdouble): cint; cdecl;
-    xSetSystemCall : function(vfs: psqlite3_vfs; zName: pansichar; sqlite3_syscall_ptr : pointer) : cint;
+    GetLastError : function(vfs: psqlite3_vfs; code: cint; msg: pansichar): cint; cdecl;
+    CurrentTimeInt64 : function(vfs: psqlite3_vfs; time: psqlite3_int64): cint; cdecl; 	
+    xSetSystemCall : function(vfs: psqlite3_vfs; zName: pansichar; sqlite3_syscall_ptr : pointer) : cint; cdecl;
     xGetSystemCall : function(vfs: psqlite3_vfs; zName: pansichar) : pointer; cdecl;
     xNextSystemCall : function(vfs: psqlite3_vfs; zName: pansichar) : pansichar; cdecl;
   end;

packages/sqlite/src/sqlite3db.pas

@@ -24,7 +24,12 @@ type
 {*************************************************************}
 {*************************************************************}   
    private
-   fPSQlite: PPsqlite3;
+   type
+     TFieldList = class(TList)
+       protected
+         procedure Notify(Ptr: Pointer; Action: TListNotification); override;
+     end;
+   var
    fSQLite:Psqlite3;
    fMsg: String;
    fIsOpen: Boolean;
@@ -39,7 +44,7 @@ type
    fOnBusy: TOnBusy;
    fOnQueryComplete: TOnQueryComplete;
    fBusyTimeout: longint;
-   fPMsg: PChar;
+   fPMsg: PAnsiChar;
    fChangeCount: longint;
    fNb_Champ :  Integer;
    fList_FieldName : TStringList;
@@ -48,9 +53,9 @@ type
 {*************************************************************}
 {*************************************************************}   
    public
-   constructor Create(DBFileName: String);
+   constructor Create(const DBFileName: String);
    destructor Destroy; override;
-   function Query(Sql: String; Table: TStrings ): boolean;
+   function Query(const Sql: String; Table: TStrings ): boolean;
    function ErrorMessage(ErrNo: Integer): string;
    function IsComplete(Sql: String): boolean;
    function LastInsertRow: integer;
@@ -65,12 +70,12 @@ type
    property OnQueryComplete: TOnQueryComplete read fOnQueryComplete write fOnQueryComplete;
    property BusyTimeout: longint read fBusyTimeout write SetBusyTimeout;
    property ChangeCount: longint read fChangeCount;
-   property List_FieldName: TStringList read fList_FieldName write fList_FieldName;
-   property List_Field: TList read fList_Field write fList_Field;
+   property List_FieldName: TStringList read fList_FieldName;
+   property List_Field: TList read fList_Field;
    property Nb_Champ: integer read fNb_Champ write fNb_Champ;
- procedure SQLOnData(Sender: TObject; Columns: Integer; ColumnNames, ColumnValues: String);
-
+   procedure SQLOnData(Sender: TObject; Columns: Integer; ColumnNames, ColumnValues: String);
  end;
+
 function Pas2SQLStr(const PasString: string): string;
 function SQL2PasStr(const SQLString: string): string;
 function QuoteStr(const s: string; QuoteChar: Char ): string;
@@ -314,20 +319,27 @@ begin
    end;
    if length(InterS) > 0 then Field.add(InterS);
    List_Field.add(Field);
-   Field.Free;
 end;
+
+{*************************************************************}
+procedure TSQLite.TFieldList.Notify(Ptr: Pointer; Action: TListNotification);
+{*************************************************************}
+begin
+  if Action=lnDeleted then
+    TObject(Ptr).Free;
+  inherited;
+end;
+
 {*************************************************************}
-constructor TSQLite.Create(DBFileName: String);
+constructor TSQLite.Create(const DBFileName: String);
 {*************************************************************
 SQlite3 constructor
 G. Marcou
 *************************************************************}
-var
-   name	  : pchar;
-begin	  
+begin
    inherited Create;
-   List_FieldName := TStringList.Create;
-   List_Field := TList.Create;
+   fList_FieldName := TStringList.Create;
+   fList_Field := TFieldList.Create;
    fError := SQLITE_ERROR;
    fIsOpen := False;
    fLstName := TStringList.Create;
@@ -336,10 +348,8 @@ begin
    fOnBusy := nil;
    fOnQueryComplete := nil;
    fChangeCount := 0;
-   name:=StrAlloc (length(DBFileName)+1);
-   strpcopy(name,DBFileName);
    OnData:=@SQLOnData;
-   sqlite3_open(name,@fSQLite);
+   sqlite3_open(PAnsiChar(DBFileName), @fSQLite);
    sqlite3_free(fPMsg);
    if fSQLite <> nil then
    begin
@@ -349,7 +359,6 @@ begin
       fError := SQLITE_OK;
    end;
    fMsg := sqlite3_errmsg(fSQLite);
-   strdispose(name);
 end;
 {*************************************************************}
 destructor TSQLite.Destroy;
@@ -369,12 +378,12 @@ begin
    fOnQueryComplete := nil;
    fLstName := nil;
    fLstVal := nil;
-   List_FieldName.destroy;
-   List_Field.destroy;
+   fList_FieldName.destroy;
+   fList_Field.destroy;
    inherited Destroy;
 end;
 {*************************************************************}
-function TSQLite.Query(Sql: String; Table: TStrings ): boolean;
+function TSQLite.Query(const Sql: String; Table: TStrings ): boolean;
 {*************************************************************
 SQLite3 query the database
 G. Marcou
@@ -394,7 +403,7 @@ begin
       List_FieldName.clear;
       List_Field.clear;
       Nb_Champ:=-1;
-      fError := sqlite3_exec(fSQLite, PChar(sql), @ExecCallback, Self, @fPMsg);
+      fError := sqlite3_exec(fSQLite, PAnsiChar(sql), @ExecCallback, Self, @fPMsg);
       sqlite3_free(fPMsg);
       fChangeCount := sqlite3_changes(fSQLite);
       fTable := nil;

packages/sqlite/tests/test.pas

@@ -1,6 +1,6 @@
 program test;
 
-uses sqlite,sqlitedb, strings,classes;
+uses sqlite3,sqlite3db, strings,classes;
 
 var
   MySQL: TSQLite;