Browse Source

--- Merging r21735 into '.':
U packages/fcl-db/tests/testbufdatasetstreams.pas
U packages/fcl-db/tests/toolsunit.pas
U packages/fcl-db/tests/testdbbasics.pas
U packages/fcl-db/src/base/xmldatapacketreader.pp
U packages/fcl-db/src/base/bufdataset.pas
--- Merging r21756 into '.':
G packages/fcl-db/tests/testbufdatasetstreams.pas
G packages/fcl-db/src/base/bufdataset.pas
--- Merging r22145 into '.':
U packages/fcl-db/tests/dbtestframework.pas
A packages/fcl-db/tests/tcsdfdata.pp
U packages/fcl-db/src/sdf/sdfdata.pp
--- Merging r22162 into '.':
U packages/postgres/src/postgres3dyn.pp
U packages/ibase/src/ibase60.inc
U packages/mysql/src/mysql.inc

# revisions: 21735,21756,22145,22162
deleted corrected entry 216127 Invalid stream operation
r21735 | joost | 2012-06-29 18:04:55 +0200 (Fri, 29 Jun 2012) | 8 lines
Changed paths:
M /trunk/packages/fcl-db/src/base/bufdataset.pas
M /trunk/packages/fcl-db/src/base/xmldatapacketreader.pp
M /trunk/packages/fcl-db/tests/testbufdatasetstreams.pas
M /trunk/packages/fcl-db/tests/testdbbasics.pas
M /trunk/packages/fcl-db/tests/toolsunit.pas

* Stream TBufdataset fmtBcd fields (xml)
* Stream TBufdataset blob and memo-fields (xml)
* Refactored code to recognize xml-fieldtypes
* ftVarBytes fields do not have the 'Binary' subtype (delphi compat)
* Use fielddefs instead of fields to stream dataset (fixes problems with
calculated fields)
* Added basic blob-tests
deleted corrected entry 216127 Invalid stream operation
r21756 | joost | 2012-07-02 12:28:37 +0200 (Mon, 02 Jul 2012) | 5 lines
Changed paths:
M /trunk/packages/fcl-db/src/base/bufdataset.pas
M /trunk/packages/fcl-db/tests/testbufdatasetstreams.pas

* Fixed CreateDataset when TBufDataset.Filename is set
* Clear old fielddefs before reading TBufDataset from file
* Call bindfields while reading a dataset from file while there are
(calculated) fields present + test
deleted corrected entry 216127 Invalid stream operation
r22145 | michael | 2012-08-20 18:41:15 +0200 (Mon, 20 Aug 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sdf/sdfdata.pp
M /trunk/packages/fcl-db/tests/dbtestframework.pas
A /trunk/packages/fcl-db/tests/tcsdfdata.pp

* Patch for sdfdata multiline support and assoiated test case from Reinier Olislagers (bug 22237 and bug #22213)
deleted corrected entry 216127 Invalid stream operation
r22162 | michael | 2012-08-21 21:40:20 +0200 (Tue, 21 Aug 2012) | 1 line
Changed paths:
M /trunk/packages/ibase/src/ibase60.inc
M /trunk/packages/mysql/src/mysql.inc
M /trunk/packages/postgres/src/postgres3dyn.pp

* Changed library names to include version number, make uniform dynamic loader interface

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

marco 13 years ago
parent
commit
de199ce202

+ 1 - 0
.gitattributes

@@ -2012,6 +2012,7 @@ packages/fcl-db/tests/sdfdstoolsunit.pas svneol=native#text/plain
 packages/fcl-db/tests/sqldbtoolsunit.pas 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-db/tests/tcsqlscanner.pas svneol=native#text/plain
 packages/fcl-db/tests/test.json svneol=native#text/plain
 packages/fcl-db/tests/testbasics.pas svneol=native#text/plain

+ 25 - 17
packages/fcl-db/src/base/bufdataset.pas

@@ -457,7 +457,6 @@ type
     procedure InitDefaultIndexes;
   protected
     procedure UpdateIndexDefs; override;
-    function GetNewBlobBuffer : PBlobBuffer;
     function GetNewWriteBlobBuffer : PBlobBuffer;
     procedure FreeBlobBuffer(var ABlobBuffer: PBlobBuffer);
     procedure SetRecNo(Value: Longint); override;
@@ -523,6 +522,7 @@ type
     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
     procedure AddIndex(const AName, AFields : string; AOptions : TIndexOptions; const ADescFields: string = '';
       const ACaseInsFields: string = ''); virtual;
+    function GetNewBlobBuffer : PBlobBuffer;
 
     procedure SetDatasetPacket(AReader : TDataPacketReader);
     procedure GetDatasetPacket(AWriter : TDataPacketReader);
@@ -2712,26 +2712,30 @@ begin
 end;
 
 procedure TCustomBufDataset.CreateDataset;
+var AStoreFilename: string;
+
 begin
   CheckInactive;
-  if not ((FieldCount=0) or (FieldDefs.Count=0)) then
+  if ((FieldCount=0) or (FieldDefs.Count=0)) then
     begin
-    Open;
-    Exit;
+    if (FieldDefs.Count>0) then
+      CreateFields
+    else if (fields.Count>0) then
+      begin
+      InitFieldDefsFromfields;
+      BindFields(True);
+      end
+    else
+      raise Exception.Create(SErrNoFieldsDefined);
     end;
-  if (FieldDefs.Count>0) then
-    begin
-    CreateFields;
-    Open;
-    end
-  else if (fields.Count>0) then
-    begin
-    InitFieldDefsFromfields;
-    BindFields(True);
+  // When a filename is set, do not read from this file
+  AStoreFilename:=FFileName;
+  FFileName := '';
+  try
     Open;
-    end
-  else
-    raise Exception.Create(SErrNoFieldsDefined);
+  finally
+    FFileName:=AStoreFilename;
+  end;
 end;
 
 function TCustomBufDataset.BookmarkValid(ABookmark: TBookmark): Boolean;
@@ -2751,8 +2755,12 @@ end;
 procedure TCustomBufDataset.IntLoadFielddefsFromFile;
 
 begin
+  FieldDefs.Clear;
   FDatasetReader.LoadFielddefs(FieldDefs);
-  if DefaultFields then CreateFields;
+  if DefaultFields then
+    CreateFields
+  else
+    BindFields(true);
 end;
 
 procedure TCustomBufDataset.IntLoadRecordsFromFile;

+ 54 - 35
packages/fcl-db/src/base/xmldatapacketreader.pp

@@ -62,7 +62,7 @@ type
 
 implementation
 
-uses xmlwrite, xmlread;
+uses xmlwrite, xmlread, base64;
 
 const
   XMLFieldtypenames : Array [TFieldType] of String[15] =
@@ -74,21 +74,21 @@ const
       'i4',
       'boolean',
       'r8',
-      'r8',
+      'r8:Money',
       'fixed',
       'date',
       'time',
       'datetime',
       'bin.hex',
       'bin.hex',
-      'i4',
-      'bin.hex',
-      'bin.hex',
-      'bin.hex',
-      'bin.hex',
-      'bin.hex',
-      'bin.hex',
-      'bin.hex',
+      'i4:Autoinc',
+      'bin.hex:Binary',
+      'bin.hex:Text',
+      'bin.hex:Graphics',
+      'bin.hex:Formatted',
+      'bin.hex:Ole',
+      'bin.hex:Ole',
+      'bin.hex:Graphics',
       '',
       'string',
       'string',
@@ -104,7 +104,7 @@ const
       '',
       '',
       '',
-      '',
+      'fixedFMT',
       '',
       ''
     );
@@ -137,6 +137,7 @@ var i           : integer;
     AFieldDef   : TFieldDef;
     iFieldType  : TFieldType;
     FTString    : string;
+    SubFTString : string;
     AFieldNode  : TDOMNode;
 
 begin
@@ -160,6 +161,9 @@ begin
       AFieldDef.Name:=GetNodeAttribute(AFieldNode,'attrname');
       AFieldDef.Size:=StrToIntDef(GetNodeAttribute(AFieldNode,'width'),0);
       FTString:=GetNodeAttribute(AFieldNode,'fieldtype');
+      SubFTString:=GetNodeAttribute(AFieldNode,'subtype');
+      if SubFTString<>'' then
+        FTString:=FTString+':'+SubFTString;
 
       AFieldDef.DataType:=ftUnknown;
       for iFieldType:=low(TFieldType) to high(TFieldType) do
@@ -181,8 +185,9 @@ end;
 
 procedure TXMLDatapacketReader.StoreFieldDefs(AFieldDefs: TFieldDefs);
 
-var i           : integer;
+var i,p         : integer;
     AFieldNode  : TDOMElement;
+    AStringFT   : string;
 
 begin
   XMLDocument := TXMLDocument.Create;
@@ -198,22 +203,15 @@ begin
     if Name <> '' then AFieldNode.SetAttribute('fieldname',Name);
     AFieldNode.SetAttribute('attrname',DisplayName);
     if size <> 0 then AFieldNode.SetAttribute('width',IntToStr(Size));
-    AFieldNode.SetAttribute('fieldtype',XMLFieldtypenames[DataType]);
-    case DataType of
-      ftAutoInc : begin
-                  AFieldNode.SetAttribute('readonly','true');
-                  AFieldNode.SetAttribute('subtype','Autoinc');
-                  end;
-      ftCurrency: AFieldNode.SetAttribute('subtype','Money');
-      ftVarBytes,
-        ftBlob  : AFieldNode.SetAttribute('subtype','Binary');
-      ftMemo    : AFieldNode.SetAttribute('subtype','Text');
-      ftTypedBinary,
-        ftGraphic: AFieldNode.SetAttribute('subtype','Graphics');
-      ftFmtMemo : AFieldNode.SetAttribute('subtype','Formatted');
-      ftParadoxOle,
-        ftDBaseOle : AFieldNode.SetAttribute('subtype','Ole');
-    end; {case}
+    AStringFT:=XMLFieldtypenames[DataType];
+    p := pos(':',AStringFT);
+    if p > 1 then
+      begin
+      AFieldNode.SetAttribute('fieldtype',copy(AStringFT,1,p-1));
+      AFieldNode.SetAttribute('subtype',copy(AStringFT,p+1,25));
+      end
+    else
+      AFieldNode.SetAttribute('fieldtype',AStringFT);
     if faReadonly in Attributes then AFieldNode.SetAttribute('readonly','true');
 
     FieldsNode.AppendChild(AFieldNode);
@@ -329,28 +327,49 @@ begin
 end;
 
 procedure TXMLDatapacketReader.RestoreRecord(ADataset : TCustomBufDataset);
-var FieldNr    : integer;
-    AFieldNode : TDomNode;
+var FieldNr      : integer;
+    AFieldNode   : TDomNode;
+    ABufBlobField: TBufBlobField;
+    AField: TField;
+    s: string;
 begin
-  with ADataset do for FieldNr:=0 to FieldCount-1 do
+  with ADataset do for FieldNr:=0 to FieldDefs.Count-1 do
     begin
-    AFieldNode := FRecordNode.Attributes.GetNamedItem(Fields[FieldNr].FieldName);
+    AFieldNode := FRecordNode.Attributes.GetNamedItem(FieldDefs[FieldNr].Name);
     if assigned(AFieldNode) then
       begin
-      Fields[FieldNr].AsString := AFieldNode.NodeValue;  // set it to the filterbuffer
+      if FieldDefs[FieldNr].DataType in [ftMemo,ftBlob] then
+        begin
+        ABufBlobField.BlobBuffer:=ADataset.GetNewBlobBuffer;
+        afield := Fields.FieldByNumber(FieldDefs[FieldNr].FieldNo);
+        AField.SetData(@ABufBlobField);
+        s := AFieldNode.NodeValue;
+        if (FieldDefs[FieldNr].DataType = ftBlob) and (s<>'') then
+          s := DecodeStringBase64(s);
+        ABufBlobField.BlobBuffer^.Size:=length(s);
+        ReAllocMem(ABufBlobField.BlobBuffer^.Buffer,ABufBlobField.BlobBuffer^.Size);
+        move(s[1],ABufBlobField.BlobBuffer^.Buffer^,ABufBlobField.BlobBuffer^.Size);
+        end
+      else
+        Fields.FieldByNumber(FieldDefs[FieldNr].FieldNo).AsString := AFieldNode.NodeValue;  // set it to the filterbuffer
       end
     end;
 end;
 
 procedure TXMLDatapacketReader.StoreRecord(ADataset : TCustomBufDataset; ARowState : TRowState; AUpdOrder : integer = 0);
 var FieldNr : Integer;
+    AField: TField;
     ARecordNode : TDOMElement;
 begin
   inc(FEntryNr);
   ARecordNode := XMLDocument.CreateElement('ROW');
-  for FieldNr := 0 to ADataset.Fields.Count-1 do
+  for FieldNr := 0 to ADataset.FieldDefs.Count-1 do
     begin
-    ARecordNode.SetAttribute(ADataset.fields[FieldNr].FieldName,ADataset.fields[FieldNr].AsString);
+    AField := ADataset.Fields.FieldByNumber(ADataset.FieldDefs[FieldNr].FieldNo);
+    if AField.DataType=ftBlob then
+      ARecordNode.SetAttribute(AField.FieldName,EncodeStringBase64(AField.AsString))
+    else
+      ARecordNode.SetAttribute(AField.FieldName,AField.AsString);
     end;
   if ARowState<>[] then
     begin

+ 61 - 29
packages/fcl-db/src/sdf/sdfdata.pp

@@ -13,11 +13,13 @@ unit SdfData;
 ---------------
 Modifications
 ---------------
+7/Jun/12 BigChimp:
+      Quote fields with delimiters or quotes to match Delphi SDF definition
+      (see e.g. help on TStrings.CommaText)
 14/Jul/11 BigChimp:
       Added AllowMultiLine property so user can use fields that have line endings
       (Carriage Return and/or Line Feed) embedded in their fields (fields need to be
-      quoted). Enabled by default; will break compatibility with earlier versions of
-      SdfData, but using multilines would have resulted in corrupted import anyway.
+      quoted). For now: output only (reading these fields does not work yet)
 12/Mar/04  Lazarus version (Sergey Smirnov AKA SSY)
       Locate and CheckString functions are removed because of Variant data type.
       Many things are changed for FPC/Lazarus compatibility.
@@ -939,25 +941,33 @@ end;
 
 function TSdfDataSet.StoreToBuf(Source: String): String;
 const
- CR :char = #13;
- LF :char = #10;
+ CR    :char = #13;
+ LF    :char = #10;
+ Quote :char = #34; // Character that encloses field if quoted. Hard-coded to "
 var
-  i,
-  p             :Integer;
-  pRet,
-  pStr,
-  pStrEnd       :PChar;
+  IsQuoted   // Whether or not field starts with a quote
+                :Boolean;
+  FieldMaxSize, // Maximum fields size as defined in FieldDefs
+  i,         // Field counter (0..)
+  p          // Length of string in field
+                :Integer;
+  pDeQuoted, // Temporary buffer for dedoubling quotes
+  pRet,      // Pointer to insertion point in return value
+  pStr,      // Beginning of field
+  pStrEnd    // End of field
+                :PChar;
   Ret           :String;
 begin
   SetLength(Ret, FRecordSize);
-
   FillChar(PChar(Ret)^, FRecordSize, Ord(' '));
-    PStrEnd := PChar(Source);
+
+  PStrEnd := PChar(Source);
   pRet := PChar(Ret);
 
   for i := 0 to FieldDefs.Count - 1 do
    begin
-
+    FieldMaxSize := FieldDefs[i].Size;
+    IsQuoted := false;
     while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] in [#1..' ']) do
     begin
      if FFMultiLine then
@@ -980,14 +990,15 @@ begin
 
     pStr := pStrEnd;
 
-    if (pStr[0] = '"') then
+    if (pStr[0] = Quote) then
      begin
+      IsQuoted := true; // See below: accept end of string without explicit quote
       if FFMultiLine then
        begin
         repeat
          Inc(pStrEnd);
         until not Boolean(Byte(pStrEnd[0])) or
-         ((pStrEnd[0] = '"') and ((pStrEnd + 1)[0] in [Delimiter,#0]));
+         ((pStrEnd[0] = Quote) and ((pStrEnd + 1)[0] in [Delimiter,#0]));
        end
       else
        begin
@@ -995,33 +1006,52 @@ begin
          repeat
           Inc(pStrEnd);
          until not Boolean(Byte(pStrEnd[0])) or
-          ((pStrEnd[0] = '"') and ((pStrEnd + 1)[0] in [Delimiter,CR,LF, #0]));
+          ((pStrEnd[0] = Quote) and ((pStrEnd + 1)[0] in [Delimiter,CR,LF,#0]));
        end;
 
-
-      if (pStrEnd[0] = '"') then
-        Inc(pStr);
+      if (pStrEnd[0] = Quote) then
+       Inc(pStr); //Skip final quote
      end
     else
       while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] <> Delimiter) do
         Inc(pStrEnd);
 
+    // Copy over entire field (or at least up to field length):
     p := pStrEnd - pStr;
-    if (p > FieldDefs[i].Size) then
-      p := FieldDefs[i].Size;
-
-    Move(pStr[0], pRet[0], p);
+    if IsQuoted then
+    begin
+     pDeQuoted := pRet; //Needed to avoid changing insertion point
+     // Copy entire field but not more than maximum field length:
+     // (We can mess with pStr now; the next loop will reset it after
+     // pStrEnd):
+     while (pstr < pStrEnd) and (pDeQuoted-pRet <= FieldMaxSize) do
+     begin
+      if pStr^ = Quote then inc(pStr);// skip first quote
+      pDeQuoted^ := pStr^;
+      inc(pStr);
+      inc(pDeQuoted);
+     end;
+    end
+    else
+    begin
+     if (p > FieldMaxSize) then
+       p := FieldMaxSize;
+     Move(pStr[0], pRet[0], p);
+    end;
 
-    Inc(pRet, FieldDefs[i].Size);
+    Inc(pRet, FieldMaxSize);
 
-    if (pStrEnd[0] = '"') then
+    // Move the end of field position past quotes and delimiters
+    // ready for processing the next field
+    if (pStrEnd[0] = Quote) then
       while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] <> Delimiter) do
         Inc(pStrEnd);
 
     if (pStrEnd[0] = Delimiter) then
      Inc(pStrEnd);
    end;
-  Result := Ret;
+
+  Result := ret;
 end;
 
 function TSdfDataSet.BufToStore(Buffer: TRecordBuffer): String;
@@ -1034,9 +1064,9 @@ var
 begin
   Result := '';
   p := 1;
-  QuoteMe:=false;
   for i := 0 to FieldDefs.Count - 1 do
   begin
+    QuoteMe:=false;
     Str := Trim(Copy(pansichar(Buffer), p, FieldDefs[i].Size));
     Inc(p, FieldDefs[i].Size);
     if FFMultiLine then
@@ -1051,11 +1081,13 @@ begin
        Str := StringReplace(Str, #10, '', [rfReplaceAll]);
        Str := StringReplace(Str, #13, '', [rfReplaceAll]);
       end;
-    // Check for any delimiters occurring in field text
-    if ((not QuoteMe) and (StrScan(PChar(Str), FDelimiter) <> nil)) then QuoteMe:=true;
+    // Check for any delimiters or quotes occurring in field text  
+    if (not QuoteMe) then
+	  if (StrScan(PChar(Str), FDelimiter) <> nil) or
+	    (StrScan(PChar(Str), QuoteDelimiter) <> nil) then QuoteMe:=true;
     if (QuoteMe) then
       begin
-      Str:=Stringreplace(Str,QuoteDelimiter,QuoteDelimiter+QuoteDelimiter,[rfReplaceAll]);
+      Str := Stringreplace(Str, QuoteDelimiter, QuoteDelimiter+QuoteDelimiter, [rfReplaceAll]);
       Str := QuoteDelimiter + Str + QuoteDelimiter;
       end;
     Result := Result + Str + FDelimiter;

+ 1 - 0
packages/fcl-db/tests/dbtestframework.pas

@@ -17,6 +17,7 @@ uses
   bufdatasettoolsunit,
   memdstoolsunit,
   SdfDSToolsUnit,
+  tcsdfdata,
 // Units wich contains the tests
   TestBasics,
   TestFieldTypes,

+ 228 - 0
packages/fcl-db/tests/tcsdfdata.pp

@@ -0,0 +1,228 @@
+unit tcsdfdata;
+// Tests multiline functionality of sdfdataset
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Fpcunit, Testutils, Testregistry,
+  dateutils, sdfdata;
+
+type
+
+  { Ttestexport1 }
+
+  Ttestexport1 = class(Ttestcase)
+  protected
+    TestDataset: TSDFDataset;
+    procedure Setup; override;
+    procedure Teardown; override;
+  published
+    procedure TestOutput;
+    procedure TestInputOurFormat;
+    procedure TestDelimitedTextOutput;
+  end;
+
+implementation
+
+procedure Ttestexport1.TestOutput;
+const
+  OutputFilename='output.csv';
+begin
+  TestDataSet.Close;
+
+  if FileExists(OutputFilename) then DeleteFile(OutputFileName);
+  TestDataset.FileName:=OutputFileName;
+  TestDataset.Open;
+  // Fill test data
+  TestDataset.Append;
+  TestDataset.FieldByName('ID').AsInteger := 1;
+  // Data with quotes
+  TestDataset.FieldByName('NAME').AsString := 'J"T"';
+  TestDataset.FieldByName('BIRTHDAY').AsDateTime := ScanDateTime('yyyymmdd', '19761231', 1);
+  TestDataset.Post;
+
+  TestDataset.Append;
+  TestDataset.FieldByName('ID').AsInteger := 2;
+  // Data with delimiter
+  TestDataset.FieldByName('NAME').AsString := 'Hello'+TestDataset.Delimiter+' goodbye';
+  TestDataset.FieldByName('BIRTHDAY').AsDateTime := ScanDateTime('yyyymmdd', '19761231', 1);
+  TestDataset.Post;
+
+  TestDataset.Append;
+  TestDataset.FieldByName('ID').AsInteger := 3;
+  //Data with delimiter and quote (to test 19376)
+  TestDataset.FieldByName('NAME').AsString := 'Delimiter,"and";quote';
+  TestDataset.FieldByName('BIRTHDAY').AsDateTime := ScanDateTime('yyyymmdd', '19761231', 1);
+  TestDataset.Post;
+
+
+  TestDataset.Append;
+  TestDataset.FieldByName('ID').AsInteger := 4;
+  // Regular data
+  TestDataset.FieldByName('NAME').AsString := 'Just a long line of text without anything special';
+  TestDataset.FieldByName('BIRTHDAY').AsDateTime := ScanDateTime('yyyymmdd', '19761231', 1);
+  TestDataset.Post;
+
+  TestDataset.Last;
+  TestDataset.First;
+  // This fails - seems it sees the header as a record, too?
+  AssertEquals('Number of records in test dataset', 4, TestDataset.RecordCount);
+  TestDataset.Close;
+end;
+
+procedure Ttestexport1.TestInputOurFormat;
+// Test if input works with our format
+// Mainly check if reading quotes is according to Delphi sdf specs and works.
+// See test results from bug 19610 for evidence that the strings below should work.
+// If this works, we can switch to this and be RFC 4180 compliant and Delphi compliant.
+const
+  OutputFileName='input.csv';
+  //Value1 is the on disk format; it should translate to Expected1
+  Value1='"Delimiter,""and"";quote"';
+  Expected1='Delimiter,"and";quote';
+  Value2='"J""T"""';
+  Expected2='J"T"';
+  Value3='Just a long line';
+  Expected3='Just a long line';
+  //Note: Delphi can read this, see evidence in bug 19610 (the "quoted and space" value)
+  Value4='"Just a quoted long line"';
+  Expected4='Just a quoted long line';
+  // Delphi can read multiline, see evidence in bug 19610 (the multiline entry)
+  Value5='"quoted_multi'+#13+#10+'line"';
+  Expected5='quoted_multi'+#13+#10+'line';
+  Value6='"Delimiter,and;quoted"';
+  Expected6='Delimiter,and;quoted';
+  Value7='"A random""quote"';
+  Expected7='A random"quote';
+var
+  FileStrings: TStringList;
+begin
+  TestDataset.Close;
+  TestDataset.AllowMultiLine:=true;
+  if FileExists(OutputFilename) then DeleteFile(OutputFileName);
+  FileStrings:=TStringList.Create;
+  try
+    FileStrings.Add('ID,NAME,BIRTHDAY');
+    FileStrings.Add('1,'+Value1+',31-12-1976');
+    FileStrings.Add('2,'+Value2+',31-12-1976');
+    FileStrings.Add('3,'+Value3+',31-12-1976');
+    FileStrings.Add('4,'+Value4+',31-12-1976');
+    FileStrings.Add('5,'+Value5+',31-12-1976');
+    FileStrings.Add('6,'+Value6+',31-12-1976');
+    FileStrings.Add('7,'+Value7+',31-12-1976');
+    FileStrings.SaveToFile(OutputFileName);
+  finally
+    FileStrings.Free;
+  end;
+
+  // Load our dataset
+  TestDataset.FileName:=OutputFileName;
+  TestDataset.Open;
+  TestDataset.First;
+  AssertEquals(Expected1, TestDataSet.FieldByName('NAME').AsString);
+  TestDataSet.Next;
+  AssertEquals(Expected2, TestDataSet.FieldByName('NAME').AsString);
+  TestDataSet.Next;
+  AssertEquals(Expected3, TestDataSet.FieldByName('NAME').AsString);
+  TestDataSet.Next;
+  AssertEquals(Expected4, TestDataSet.FieldByName('NAME').AsString);
+  TestDataSet.Next;
+  AssertEquals(Expected5, TestDataSet.FieldByName('NAME').AsString);
+  TestDataSet.Next;
+  AssertEquals(Expected6, TestDataSet.FieldByName('NAME').AsString);
+  TestDataSet.Next;
+  AssertEquals(Expected7, TestDataSet.FieldByName('NAME').AsString);
+end;
+
+procedure Ttestexport1.TestDelimitedTextOutput;
+// Test if input works with our format
+// Mainly check if reading quotes is according to Delphi sdf specs and works.
+// See test results from bug 19610 for evidence that the strings below should work.
+// If this works, we can switch to this and be RFC 4180 compliant and Delphi compliant.
+const
+  OutputFileName='delim.csv';
+  //Value1 is the on disk format; it should translate to Expected1
+  Value1='Delimiter,"and";quote';
+  Value2='J"T"';
+  Value3='Just a long line';
+  Value4='Just a quoted long line';
+  Value5='multi'+#13+#10+'line';
+  Value6='Delimiter,and;done';
+  Value7='Some "random" quotes';
+var
+  FileStrings: TStringList;
+  OneRecord: TStringList;
+begin
+  TestDataset.Close;
+  TestDataset.AllowMultiLine:=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;
+
+  // Load our dataset
+  TestDataset.FileName:=OutputFileName;
+  TestDataset.Open;
+  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);
+end;
+
+
+procedure Ttestexport1.Setup;
+
+begin
+  TestDataset := TSDFDataset.Create(nil);
+  TestDataset.Delimiter := ',';
+  TestDataset.FileMustExist:=false;
+  TestDataset.FirstLineAsSchema := True;
+  TestDataset.Schema.Add('ID');
+  TestDataset.Schema.Add('NAME');
+  TestDataset.Schema.Add('BIRTHDAY');
+end;
+
+procedure Ttestexport1.Teardown;
+begin
+  try
+    TestDataset.Close;
+  except
+    //swallow
+  end;
+
+  TestDataset.Free;
+  try
+    //DeleteFile(FCSVFileName);
+  except
+    //swallow
+  end;
+end;
+
+initialization
+
+  Registertest(Ttestexport1);
+end.
+

+ 121 - 0
packages/fcl-db/tests/testbufdatasetstreams.pas

@@ -69,6 +69,9 @@ type
     procedure TestSeveralEditsXML;
     procedure TestDeleteAllXML;
     procedure TestDeleteAllInsertXML;
+    procedure TestStreamingBlobFieldsXML;
+    procedure TestStreamingBigBlobFieldsXML;
+    procedure TestStreamingCalculatedFieldsXML;
 
     procedure TestAppendDeleteBIN;
 
@@ -452,6 +455,124 @@ begin
   TestChangesXML(@DeleteAllInsertChange);
 end;
 
+procedure TTestBufDatasetStreams.TestStreamingBlobFieldsXML;
+var SaveDs: TCustomBufDataset;
+    LoadDs: TCustomBufDataset;
+begin
+  SaveDs := DBConnector.GetFieldDataset as TCustomBufDataset;
+  SaveDs.Open;
+  SaveDs.SaveToFile('FieldsDS.xml',dfXML);
+
+  LoadDs := TCustomBufDataset.Create(nil);
+  LoadDs.LoadFromFile('FieldsDS.xml');
+
+  LoadDS.First;
+  SaveDS.First;
+  while not LoadDS.EOF do
+    begin
+    AssertEquals(LoadDS.FieldByName('FBLOB').AsString,SaveDS.FieldByName('FBLOB').AsString);
+    AssertEquals(LoadDS.FieldByName('FMEMO').AsString,SaveDS.FieldByName('FMEMO').AsString);
+    LoadDS.Next;
+    SaveDS.Next;
+    end;
+
+  LoadDs.Free;
+end;
+
+procedure TTestBufDatasetStreams.TestStreamingBigBlobFieldsXML;
+var
+  SaveDs: TCustomBufDataset;
+  LoadDs: TCustomBufDataset;
+  j: integer;
+  i: byte;
+  s: string;
+  f: file of byte;
+  fn: string;
+  fs: TMemoryStream;
+begin
+  // Create a temp. file with blob-data.
+  fn := GetTempFileName;
+  assign(f,fn);
+  Rewrite(f);
+  s := 'This is a blob-field test file.';
+  for j := 0 to 250 do
+    begin
+    for i := 1 to length(s) do
+      write(f,ord(s[i]));
+    for i := 0 to 255 do
+      write(f,i);
+    end;
+  close(f);
+
+  try
+    // Open dataset and set blob-field-data to content of blob-file.
+    SaveDs := DBConnector.GetFieldDataset(true) as TCustomBufDataset;
+    SaveDs.Open;
+    SaveDs.Edit;
+    TBlobField(SaveDs.FieldByName('FBLOB')).LoadFromFile(fn);
+    SaveDs.Post;
+
+    // Save this dataset to file.
+    SaveDs.SaveToFile('FieldsDS.xml',dfXML);
+
+    // Load this file in another dataset
+    LoadDs := TCustomBufDataset.Create(nil);
+    try
+      LoadDs.LoadFromFile('FieldsDS.xml');
+      LoadDS.First;
+
+      // Compare the content of the blob-field with the file on disc
+      fs := TMemoryStream.Create;
+      try
+        TBlobField(SaveDs.FieldByName('FBLOB')).SaveToStream(fs);
+        fs.Seek(0,soBeginning);
+        assign(f,fn);
+        reset(f);
+        for j := 0 to fs.Size-1 do
+          begin
+          read(f,i);
+          CheckEquals(i,fs.ReadByte);
+          end;
+      finally
+        fs.free;
+      end;
+    finally
+      LoadDs.Free;
+    end;
+  finally
+    DeleteFile(fn);
+  end;
+end;
+
+procedure TTestBufDatasetStreams.TestStreamingCalculatedFieldsXML;
+var
+  ADataset: TCustomBufDataset;
+  f: tfield;
+begin
+  ADataset := DBConnector.GetNDataset(true,10) as TCustomBufDataset;
+  f := TIntegerField.Create(ADataset);
+  f.FieldName:='ID';
+  f.dataset := ADataset;
+
+  f := TIntegerField.Create(ADataset);
+  f.FieldName:='CalcID';
+  f.dataset := ADataset;
+  f.FieldKind:=fkCalculated;
+
+  f := TStringField.Create(ADataset);
+  f.FieldName:='NAME';
+  f.dataset := ADataset;
+
+  ADataset.Open;
+  ADataset.SaveToFile('FieldsDS.xml',dfXML);
+  ADataset.Close;
+
+  ADataset.LoadFromFile('FieldsDS.xml',dfXML);
+  AssertEquals(ADataset.FieldByName('ID').AsInteger,1);
+  AssertEquals(ADataset.FieldByName('NAME').AsString,'TestName1');
+  ADataset.Close;
+end;
+
 procedure TTestBufDatasetStreams.TestAppendDeleteBIN;
 begin
   TestChanges(@AppendDeleteChange);

+ 33 - 0
packages/fcl-db/tests/testdbbasics.pas

@@ -42,6 +42,8 @@ type
     procedure TestSupportBCDFields;
     procedure TestSupportfmtBCDFields;
     procedure TestSupportFixedStringFields;
+    procedure TestSupportBlobFields;
+    procedure TestSupportMemoFields;
 
     procedure TestDoubleClose;
     procedure TestCalculatedField;
@@ -2403,6 +2405,37 @@ begin
   ds.close;
 end;
 
+procedure TTestDBBasics.TestSupportBlobFields;
+
+var i          : byte;
+    ds         : TDataset;
+    Fld        : TField;
+begin
+  TestfieldDefinition(ftBlob,0,ds,Fld);
+
+  for i := 0 to testValuesCount-1 do
+    begin
+    CheckEquals(testValues[ftBlob,i],Fld.AsString);
+    ds.Next;
+    end;
+  ds.close;
+end;
+
+procedure TTestDBBasics.TestSupportMemoFields;
+var i          : byte;
+    ds         : TDataset;
+    Fld        : TField;
+begin
+  TestfieldDefinition(ftMemo,0,ds,Fld);
+
+  for i := 0 to testValuesCount-1 do
+    begin
+    CheckEquals(testValues[ftMemo,i],Fld.AsString);
+    ds.Next;
+    end;
+  ds.close;
+end;
+
 procedure TTestDBBasics.TestDoubleClose;
 begin
   with DBConnector.GetNDataset(1) do

+ 2 - 0
packages/fcl-db/tests/toolsunit.pas

@@ -311,6 +311,8 @@ begin
   testValues[ftFixedChar] := testStringValues;
   testValues[ftTime] := testTimeValues;
   testValues[ftDate] := testDateValues;
+  testValues[ftBlob] := testStringValues;
+  testValues[ftMemo] := testStringValues;
   testValues[ftFMTBcd] := testFmtBCDValues;
   for i := 0 to testValuesCount-1 do
     begin

+ 21 - 5
packages/ibase/src/ibase60.inc

@@ -19,9 +19,21 @@ uses Dynlibs,ctypes;
 {$IFDEF Unix}
   {$DEFINE extdecl:=cdecl}
   const
-    gdslib = 'libgds.'+sharedsuffix;
-    fbclib = 'libfbclient.'+sharedsuffix;
-    fbembedlib = 'libfbembed.'+sharedsuffix;
+    gdslib = 'libgds.'+sharedsuffix; // Needs completion ?
+    libfc  = 'libfbclient.'+sharedsuffix;
+    libem  = 'libfbembed.'+sharedsuffix;
+    v2  = {$ifndef darwin}'.2'{$endif};
+    v21 = {$ifndef darwin}'.2.1'{$endif};
+    v25 = {$ifndef darwin}'.2.5'{$endif};
+    fbclib2      = libfc+v2;
+    fbembedlib2  = libem+v2;
+    fbclib21     = libfc+v21;
+    fbembedlib21 = libem+v21;
+    fbclib25     = libfc+v25;
+    fbembedlib25 = libem+v25;
+    // Set default here
+    fbclib       = fbclib25;
+    fbembedlib   = fbembedlib25;
 {$ENDIF}
 {$IFDEF Windows}
   {$DEFINE extdecl:=stdcall}
@@ -2655,15 +2667,19 @@ function InitialiseIBase60 : integer;
 
 begin
   Result := 0;
-  If UseEmbeddedFirebird then
+  if (RefCount<>0) then
+    // pretend to load whatever is already loaded, so we do not get a library name conflict.
+    Inc(RefCount)
+  else If UseEmbeddedFirebird then
     begin
-    If (TryInitialiseIBase60(fbembedlib)=0) then
+    If (TryInitialiseIBase60(fbembedlib)=0) and (TryInitialiseIBase60(libem)=0) then
       Raise EInOutError.CreateFmt(SErrEmbeddedFailed,[fbembedlib]);
     end
   else
     begin
     If (TryInitialiseIBase60(fbclib)=0) and
        (TryInitialiseIBase60(gdslib)=0) and
+       (TryInitialiseIBase60(libfc)=0) and
        (TryInitialiseIBase60(fbembedlib)=0) then
         Raise EInOutError.CreateFmt(SErrDefaultsFailed,[fbclib,gdslib,fbembedlib]);
     end;    

+ 14 - 3
packages/mysql/src/mysql.inc

@@ -1596,7 +1596,8 @@ uses
 {$endif}
 
 {$IFDEF LinkDynamically}
-Function InitialiseMysql(Const LibraryName : String; argc:cint = -1; argv:PPchar = nil; groups:PPchar = nil) : Integer;
+Function InitialiseMysql(Const LibraryName : String) : Integer;
+Function InitialiseMysql(Const LibraryName : String; argc: cint; argv:PPchar = Nil; groups:PPchar = nil) : Integer;
 Function InitialiseMysql(argc:cint = -1; argv:PPchar = nil; groups:PPchar = nil) : Integer;
 Procedure ReleaseMysql;
 
@@ -1745,12 +1746,22 @@ Function InitialiseMysql(argc: cint; argv: PPchar; groups: PPchar) : Integer;
 
 begin
   Result := 0;
-  If (TryInitialiseMysql(mysqlvlib,argc,argv,groups) = 0) and
-     (TryInitialiseMysql(mysqllib,argc,argv,groups) = 0) then
+  if (RefCount<>0) then
+    // pretend to load whatever is already loaded, so we do not get a library name conflict.
+    Inc(RefCount)
+  else
+    If (TryInitialiseMysql(mysqllib,argc,argv,groups)=0)
+       and (TryInitialiseMysql(mysqlvlib,argc,argv,groups)=0) then
       Raise EInOutError.CreateFmt(SErrDefaultsFailed,[mysqlvlib,mysqllib]);
   Result := RefCount;
 end;
 
+Function InitialiseMysql(Const LibraryName: String) : Integer;
+
+begin
+  Result:=InitialiseMySQL(LibraryName,-1,Nil,Nil);
+end;
+
 Function InitialiseMysql(Const LibraryName: String; argc: cint; argv: PPchar; groups:PPchar) : Integer;
 
 begin

+ 25 - 5
packages/postgres/src/postgres3dyn.pp

@@ -16,11 +16,18 @@ uses
 
 {$IFDEF Unix}
   const
-    pqlib = 'libpq.'+sharedsuffix;
+{$ifdef darwin}
+    pqlib = 'libpq.'+sharedsuffix; // No version number.
+{$else}
+    pqlib5 = 'libpq.'+sharedsuffix+'.5'; // 8.2 and higher
+    pqlib4 = 'libpq.'+sharedsuffix+'.4'; // 8.0, 8.1
+    pqlib3 = 'libpq.'+sharedsuffix+'.3'; // 7.3, 7.4
+    pqlib  = pqlib5;
+{$endif}
 {$ENDIF}
 {$IFDEF Win32}
   const
-    pqlib = 'libpq.dll';
+    pqlib = 'libpq.dll'; // Not sure if it has a version number ?
 {$ENDIF}
 
 
@@ -210,7 +217,8 @@ var
 { Get encoding id from environment variable PGCLIENTENCODING  }
   PQenv2encoding: function :longint;cdecl;
 
-Procedure InitialisePostgres3(libpath:string=pqlib);
+Function InitialisePostgres3(Const libpath : shortstring) : integer;
+Procedure InitialisePostgres3;
 Procedure ReleasePostgres3;
 
 function PQsetdb(M_PGHOST,M_PGPORT,M_PGOPT,M_PGTTY,M_DBNAME : pchar) : ppgconn;
@@ -227,10 +235,22 @@ var
   RefCount : integer;
   LoadedLibrary : String;
 
-Procedure InitialisePostgres3(libpath:string=pqlib);
+procedure InitialisePostgres3;
+
+begin
+  if (RefCount<>0) then
+      // pretend to load whatever is already loaded, so we do not get a library name conflict.
+    inc(Refcount)
+  else
+    InitialisePostgres3(pqlib)
+end;
+
+
+function InitialisePostgres3(Const libpath : shortstring) : Integer;
 
 begin
   inc(RefCount);
+  Result:=Refcount;
   if RefCount = 1 then
     begin
     Postgres3LibraryHandle := loadlibrary(libpath);
@@ -344,7 +364,7 @@ begin
     pointer(PQmblen) := GetProcedureAddress(Postgres3LibraryHandle,'PQmblen');
     pointer(PQenv2encoding) := GetProcedureAddress(Postgres3LibraryHandle,'PQenv2encoding');
 
-    InitialiseDllist;
+    InitialiseDllist(libpath);
     end
   else
     if (libpath<>pqlib) and (LoadedLibrary<>libpath) then