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/sqldbtoolsunit.pas svneol=native#text/plain
 packages/fcl-db/tests/tcgensql.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/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/tcsqlscanner.pas svneol=native#text/plain
 packages/fcl-db/tests/test.json svneol=native#text/plain
 packages/fcl-db/tests/test.json svneol=native#text/plain
 packages/fcl-db/tests/testbasics.pas 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;
     procedure InitDefaultIndexes;
   protected
   protected
     procedure UpdateIndexDefs; override;
     procedure UpdateIndexDefs; override;
-    function GetNewBlobBuffer : PBlobBuffer;
     function GetNewWriteBlobBuffer : PBlobBuffer;
     function GetNewWriteBlobBuffer : PBlobBuffer;
     procedure FreeBlobBuffer(var ABlobBuffer: PBlobBuffer);
     procedure FreeBlobBuffer(var ABlobBuffer: PBlobBuffer);
     procedure SetRecNo(Value: Longint); override;
     procedure SetRecNo(Value: Longint); override;
@@ -523,6 +522,7 @@ type
     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
     procedure AddIndex(const AName, AFields : string; AOptions : TIndexOptions; const ADescFields: string = '';
     procedure AddIndex(const AName, AFields : string; AOptions : TIndexOptions; const ADescFields: string = '';
       const ACaseInsFields: string = ''); virtual;
       const ACaseInsFields: string = ''); virtual;
+    function GetNewBlobBuffer : PBlobBuffer;
 
 
     procedure SetDatasetPacket(AReader : TDataPacketReader);
     procedure SetDatasetPacket(AReader : TDataPacketReader);
     procedure GetDatasetPacket(AWriter : TDataPacketReader);
     procedure GetDatasetPacket(AWriter : TDataPacketReader);
@@ -2712,26 +2712,30 @@ begin
 end;
 end;
 
 
 procedure TCustomBufDataset.CreateDataset;
 procedure TCustomBufDataset.CreateDataset;
+var AStoreFilename: string;
+
 begin
 begin
   CheckInactive;
   CheckInactive;
-  if not ((FieldCount=0) or (FieldDefs.Count=0)) then
+  if ((FieldCount=0) or (FieldDefs.Count=0)) then
     begin
     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;
     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;
     Open;
-    end
-  else
-    raise Exception.Create(SErrNoFieldsDefined);
+  finally
+    FFileName:=AStoreFilename;
+  end;
 end;
 end;
 
 
 function TCustomBufDataset.BookmarkValid(ABookmark: TBookmark): Boolean;
 function TCustomBufDataset.BookmarkValid(ABookmark: TBookmark): Boolean;
@@ -2751,8 +2755,12 @@ end;
 procedure TCustomBufDataset.IntLoadFielddefsFromFile;
 procedure TCustomBufDataset.IntLoadFielddefsFromFile;
 
 
 begin
 begin
+  FieldDefs.Clear;
   FDatasetReader.LoadFielddefs(FieldDefs);
   FDatasetReader.LoadFielddefs(FieldDefs);
-  if DefaultFields then CreateFields;
+  if DefaultFields then
+    CreateFields
+  else
+    BindFields(true);
 end;
 end;
 
 
 procedure TCustomBufDataset.IntLoadRecordsFromFile;
 procedure TCustomBufDataset.IntLoadRecordsFromFile;

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

@@ -62,7 +62,7 @@ type
 
 
 implementation
 implementation
 
 
-uses xmlwrite, xmlread;
+uses xmlwrite, xmlread, base64;
 
 
 const
 const
   XMLFieldtypenames : Array [TFieldType] of String[15] =
   XMLFieldtypenames : Array [TFieldType] of String[15] =
@@ -74,21 +74,21 @@ const
       'i4',
       'i4',
       'boolean',
       'boolean',
       'r8',
       'r8',
-      'r8',
+      'r8:Money',
       'fixed',
       'fixed',
       'date',
       'date',
       'time',
       'time',
       'datetime',
       'datetime',
       'bin.hex',
       'bin.hex',
       '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',
       'string',
       'string',
@@ -104,7 +104,7 @@ const
       '',
       '',
       '',
       '',
       '',
       '',
-      '',
+      'fixedFMT',
       '',
       '',
       ''
       ''
     );
     );
@@ -137,6 +137,7 @@ var i           : integer;
     AFieldDef   : TFieldDef;
     AFieldDef   : TFieldDef;
     iFieldType  : TFieldType;
     iFieldType  : TFieldType;
     FTString    : string;
     FTString    : string;
+    SubFTString : string;
     AFieldNode  : TDOMNode;
     AFieldNode  : TDOMNode;
 
 
 begin
 begin
@@ -160,6 +161,9 @@ begin
       AFieldDef.Name:=GetNodeAttribute(AFieldNode,'attrname');
       AFieldDef.Name:=GetNodeAttribute(AFieldNode,'attrname');
       AFieldDef.Size:=StrToIntDef(GetNodeAttribute(AFieldNode,'width'),0);
       AFieldDef.Size:=StrToIntDef(GetNodeAttribute(AFieldNode,'width'),0);
       FTString:=GetNodeAttribute(AFieldNode,'fieldtype');
       FTString:=GetNodeAttribute(AFieldNode,'fieldtype');
+      SubFTString:=GetNodeAttribute(AFieldNode,'subtype');
+      if SubFTString<>'' then
+        FTString:=FTString+':'+SubFTString;
 
 
       AFieldDef.DataType:=ftUnknown;
       AFieldDef.DataType:=ftUnknown;
       for iFieldType:=low(TFieldType) to high(TFieldType) do
       for iFieldType:=low(TFieldType) to high(TFieldType) do
@@ -181,8 +185,9 @@ end;
 
 
 procedure TXMLDatapacketReader.StoreFieldDefs(AFieldDefs: TFieldDefs);
 procedure TXMLDatapacketReader.StoreFieldDefs(AFieldDefs: TFieldDefs);
 
 
-var i           : integer;
+var i,p         : integer;
     AFieldNode  : TDOMElement;
     AFieldNode  : TDOMElement;
+    AStringFT   : string;
 
 
 begin
 begin
   XMLDocument := TXMLDocument.Create;
   XMLDocument := TXMLDocument.Create;
@@ -198,22 +203,15 @@ begin
     if Name <> '' then AFieldNode.SetAttribute('fieldname',Name);
     if Name <> '' then AFieldNode.SetAttribute('fieldname',Name);
     AFieldNode.SetAttribute('attrname',DisplayName);
     AFieldNode.SetAttribute('attrname',DisplayName);
     if size <> 0 then AFieldNode.SetAttribute('width',IntToStr(Size));
     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');
     if faReadonly in Attributes then AFieldNode.SetAttribute('readonly','true');
 
 
     FieldsNode.AppendChild(AFieldNode);
     FieldsNode.AppendChild(AFieldNode);
@@ -329,28 +327,49 @@ begin
 end;
 end;
 
 
 procedure TXMLDatapacketReader.RestoreRecord(ADataset : TCustomBufDataset);
 procedure TXMLDatapacketReader.RestoreRecord(ADataset : TCustomBufDataset);
-var FieldNr    : integer;
-    AFieldNode : TDomNode;
+var FieldNr      : integer;
+    AFieldNode   : TDomNode;
+    ABufBlobField: TBufBlobField;
+    AField: TField;
+    s: string;
 begin
 begin
-  with ADataset do for FieldNr:=0 to FieldCount-1 do
+  with ADataset do for FieldNr:=0 to FieldDefs.Count-1 do
     begin
     begin
-    AFieldNode := FRecordNode.Attributes.GetNamedItem(Fields[FieldNr].FieldName);
+    AFieldNode := FRecordNode.Attributes.GetNamedItem(FieldDefs[FieldNr].Name);
     if assigned(AFieldNode) then
     if assigned(AFieldNode) then
       begin
       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;
     end;
 end;
 end;
 
 
 procedure TXMLDatapacketReader.StoreRecord(ADataset : TCustomBufDataset; ARowState : TRowState; AUpdOrder : integer = 0);
 procedure TXMLDatapacketReader.StoreRecord(ADataset : TCustomBufDataset; ARowState : TRowState; AUpdOrder : integer = 0);
 var FieldNr : Integer;
 var FieldNr : Integer;
+    AField: TField;
     ARecordNode : TDOMElement;
     ARecordNode : TDOMElement;
 begin
 begin
   inc(FEntryNr);
   inc(FEntryNr);
   ARecordNode := XMLDocument.CreateElement('ROW');
   ARecordNode := XMLDocument.CreateElement('ROW');
-  for FieldNr := 0 to ADataset.Fields.Count-1 do
+  for FieldNr := 0 to ADataset.FieldDefs.Count-1 do
     begin
     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;
     end;
   if ARowState<>[] then
   if ARowState<>[] then
     begin
     begin

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

@@ -13,11 +13,13 @@ unit SdfData;
 ---------------
 ---------------
 Modifications
 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:
 14/Jul/11 BigChimp:
       Added AllowMultiLine property so user can use fields that have line endings
       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
       (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)
 12/Mar/04  Lazarus version (Sergey Smirnov AKA SSY)
       Locate and CheckString functions are removed because of Variant data type.
       Locate and CheckString functions are removed because of Variant data type.
       Many things are changed for FPC/Lazarus compatibility.
       Many things are changed for FPC/Lazarus compatibility.
@@ -939,25 +941,33 @@ end;
 
 
 function TSdfDataSet.StoreToBuf(Source: String): String;
 function TSdfDataSet.StoreToBuf(Source: String): String;
 const
 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
 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;
   Ret           :String;
 begin
 begin
   SetLength(Ret, FRecordSize);
   SetLength(Ret, FRecordSize);
-
   FillChar(PChar(Ret)^, FRecordSize, Ord(' '));
   FillChar(PChar(Ret)^, FRecordSize, Ord(' '));
-    PStrEnd := PChar(Source);
+
+  PStrEnd := PChar(Source);
   pRet := PChar(Ret);
   pRet := PChar(Ret);
 
 
   for i := 0 to FieldDefs.Count - 1 do
   for i := 0 to FieldDefs.Count - 1 do
    begin
    begin
-
+    FieldMaxSize := FieldDefs[i].Size;
+    IsQuoted := false;
     while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] in [#1..' ']) do
     while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] in [#1..' ']) do
     begin
     begin
      if FFMultiLine then
      if FFMultiLine then
@@ -980,14 +990,15 @@ begin
 
 
     pStr := pStrEnd;
     pStr := pStrEnd;
 
 
-    if (pStr[0] = '"') then
+    if (pStr[0] = Quote) then
      begin
      begin
+      IsQuoted := true; // See below: accept end of string without explicit quote
       if FFMultiLine then
       if FFMultiLine then
        begin
        begin
         repeat
         repeat
          Inc(pStrEnd);
          Inc(pStrEnd);
         until not Boolean(Byte(pStrEnd[0])) or
         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
        end
       else
       else
        begin
        begin
@@ -995,33 +1006,52 @@ begin
          repeat
          repeat
           Inc(pStrEnd);
           Inc(pStrEnd);
          until not Boolean(Byte(pStrEnd[0])) or
          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;
        end;
 
 
-
-      if (pStrEnd[0] = '"') then
-        Inc(pStr);
+      if (pStrEnd[0] = Quote) then
+       Inc(pStr); //Skip final quote
      end
      end
     else
     else
       while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] <> Delimiter) do
       while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] <> Delimiter) do
         Inc(pStrEnd);
         Inc(pStrEnd);
 
 
+    // Copy over entire field (or at least up to field length):
     p := pStrEnd - pStr;
     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
       while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] <> Delimiter) do
         Inc(pStrEnd);
         Inc(pStrEnd);
 
 
     if (pStrEnd[0] = Delimiter) then
     if (pStrEnd[0] = Delimiter) then
      Inc(pStrEnd);
      Inc(pStrEnd);
    end;
    end;
-  Result := Ret;
+
+  Result := ret;
 end;
 end;
 
 
 function TSdfDataSet.BufToStore(Buffer: TRecordBuffer): String;
 function TSdfDataSet.BufToStore(Buffer: TRecordBuffer): String;
@@ -1034,9 +1064,9 @@ var
 begin
 begin
   Result := '';
   Result := '';
   p := 1;
   p := 1;
-  QuoteMe:=false;
   for i := 0 to FieldDefs.Count - 1 do
   for i := 0 to FieldDefs.Count - 1 do
   begin
   begin
+    QuoteMe:=false;
     Str := Trim(Copy(pansichar(Buffer), p, FieldDefs[i].Size));
     Str := Trim(Copy(pansichar(Buffer), p, FieldDefs[i].Size));
     Inc(p, FieldDefs[i].Size);
     Inc(p, FieldDefs[i].Size);
     if FFMultiLine then
     if FFMultiLine then
@@ -1051,11 +1081,13 @@ begin
        Str := StringReplace(Str, #10, '', [rfReplaceAll]);
        Str := StringReplace(Str, #10, '', [rfReplaceAll]);
        Str := StringReplace(Str, #13, '', [rfReplaceAll]);
        Str := StringReplace(Str, #13, '', [rfReplaceAll]);
       end;
       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
     if (QuoteMe) then
       begin
       begin
-      Str:=Stringreplace(Str,QuoteDelimiter,QuoteDelimiter+QuoteDelimiter,[rfReplaceAll]);
+      Str := Stringreplace(Str, QuoteDelimiter, QuoteDelimiter+QuoteDelimiter, [rfReplaceAll]);
       Str := QuoteDelimiter + Str + QuoteDelimiter;
       Str := QuoteDelimiter + Str + QuoteDelimiter;
       end;
       end;
     Result := Result + Str + FDelimiter;
     Result := Result + Str + FDelimiter;

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

@@ -17,6 +17,7 @@ uses
   bufdatasettoolsunit,
   bufdatasettoolsunit,
   memdstoolsunit,
   memdstoolsunit,
   SdfDSToolsUnit,
   SdfDSToolsUnit,
+  tcsdfdata,
 // Units wich contains the tests
 // Units wich contains the tests
   TestBasics,
   TestBasics,
   TestFieldTypes,
   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 TestSeveralEditsXML;
     procedure TestDeleteAllXML;
     procedure TestDeleteAllXML;
     procedure TestDeleteAllInsertXML;
     procedure TestDeleteAllInsertXML;
+    procedure TestStreamingBlobFieldsXML;
+    procedure TestStreamingBigBlobFieldsXML;
+    procedure TestStreamingCalculatedFieldsXML;
 
 
     procedure TestAppendDeleteBIN;
     procedure TestAppendDeleteBIN;
 
 
@@ -452,6 +455,124 @@ begin
   TestChangesXML(@DeleteAllInsertChange);
   TestChangesXML(@DeleteAllInsertChange);
 end;
 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;
 procedure TTestBufDatasetStreams.TestAppendDeleteBIN;
 begin
 begin
   TestChanges(@AppendDeleteChange);
   TestChanges(@AppendDeleteChange);

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

@@ -42,6 +42,8 @@ type
     procedure TestSupportBCDFields;
     procedure TestSupportBCDFields;
     procedure TestSupportfmtBCDFields;
     procedure TestSupportfmtBCDFields;
     procedure TestSupportFixedStringFields;
     procedure TestSupportFixedStringFields;
+    procedure TestSupportBlobFields;
+    procedure TestSupportMemoFields;
 
 
     procedure TestDoubleClose;
     procedure TestDoubleClose;
     procedure TestCalculatedField;
     procedure TestCalculatedField;
@@ -2403,6 +2405,37 @@ begin
   ds.close;
   ds.close;
 end;
 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;
 procedure TTestDBBasics.TestDoubleClose;
 begin
 begin
   with DBConnector.GetNDataset(1) do
   with DBConnector.GetNDataset(1) do

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

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

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

@@ -19,9 +19,21 @@ uses Dynlibs,ctypes;
 {$IFDEF Unix}
 {$IFDEF Unix}
   {$DEFINE extdecl:=cdecl}
   {$DEFINE extdecl:=cdecl}
   const
   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}
 {$ENDIF}
 {$IFDEF Windows}
 {$IFDEF Windows}
   {$DEFINE extdecl:=stdcall}
   {$DEFINE extdecl:=stdcall}
@@ -2655,15 +2667,19 @@ function InitialiseIBase60 : integer;
 
 
 begin
 begin
   Result := 0;
   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
     begin
-    If (TryInitialiseIBase60(fbembedlib)=0) then
+    If (TryInitialiseIBase60(fbembedlib)=0) and (TryInitialiseIBase60(libem)=0) then
       Raise EInOutError.CreateFmt(SErrEmbeddedFailed,[fbembedlib]);
       Raise EInOutError.CreateFmt(SErrEmbeddedFailed,[fbembedlib]);
     end
     end
   else
   else
     begin
     begin
     If (TryInitialiseIBase60(fbclib)=0) and
     If (TryInitialiseIBase60(fbclib)=0) and
        (TryInitialiseIBase60(gdslib)=0) and
        (TryInitialiseIBase60(gdslib)=0) and
+       (TryInitialiseIBase60(libfc)=0) and
        (TryInitialiseIBase60(fbembedlib)=0) then
        (TryInitialiseIBase60(fbembedlib)=0) then
         Raise EInOutError.CreateFmt(SErrDefaultsFailed,[fbclib,gdslib,fbembedlib]);
         Raise EInOutError.CreateFmt(SErrDefaultsFailed,[fbclib,gdslib,fbembedlib]);
     end;    
     end;    

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

@@ -1596,7 +1596,8 @@ uses
 {$endif}
 {$endif}
 
 
 {$IFDEF LinkDynamically}
 {$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;
 Function InitialiseMysql(argc:cint = -1; argv:PPchar = nil; groups:PPchar = nil) : Integer;
 Procedure ReleaseMysql;
 Procedure ReleaseMysql;
 
 
@@ -1745,12 +1746,22 @@ Function InitialiseMysql(argc: cint; argv: PPchar; groups: PPchar) : Integer;
 
 
 begin
 begin
   Result := 0;
   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]);
       Raise EInOutError.CreateFmt(SErrDefaultsFailed,[mysqlvlib,mysqllib]);
   Result := RefCount;
   Result := RefCount;
 end;
 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;
 Function InitialiseMysql(Const LibraryName: String; argc: cint; argv: PPchar; groups:PPchar) : Integer;
 
 
 begin
 begin

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

@@ -16,11 +16,18 @@ uses
 
 
 {$IFDEF Unix}
 {$IFDEF Unix}
   const
   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}
 {$ENDIF}
 {$IFDEF Win32}
 {$IFDEF Win32}
   const
   const
-    pqlib = 'libpq.dll';
+    pqlib = 'libpq.dll'; // Not sure if it has a version number ?
 {$ENDIF}
 {$ENDIF}
 
 
 
 
@@ -210,7 +217,8 @@ var
 { Get encoding id from environment variable PGCLIENTENCODING  }
 { Get encoding id from environment variable PGCLIENTENCODING  }
   PQenv2encoding: function :longint;cdecl;
   PQenv2encoding: function :longint;cdecl;
 
 
-Procedure InitialisePostgres3(libpath:string=pqlib);
+Function InitialisePostgres3(Const libpath : shortstring) : integer;
+Procedure InitialisePostgres3;
 Procedure ReleasePostgres3;
 Procedure ReleasePostgres3;
 
 
 function PQsetdb(M_PGHOST,M_PGPORT,M_PGOPT,M_PGTTY,M_DBNAME : pchar) : ppgconn;
 function PQsetdb(M_PGHOST,M_PGPORT,M_PGOPT,M_PGTTY,M_DBNAME : pchar) : ppgconn;
@@ -227,10 +235,22 @@ var
   RefCount : integer;
   RefCount : integer;
   LoadedLibrary : String;
   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
 begin
   inc(RefCount);
   inc(RefCount);
+  Result:=Refcount;
   if RefCount = 1 then
   if RefCount = 1 then
     begin
     begin
     Postgres3LibraryHandle := loadlibrary(libpath);
     Postgres3LibraryHandle := loadlibrary(libpath);
@@ -344,7 +364,7 @@ begin
     pointer(PQmblen) := GetProcedureAddress(Postgres3LibraryHandle,'PQmblen');
     pointer(PQmblen) := GetProcedureAddress(Postgres3LibraryHandle,'PQmblen');
     pointer(PQenv2encoding) := GetProcedureAddress(Postgres3LibraryHandle,'PQenv2encoding');
     pointer(PQenv2encoding) := GetProcedureAddress(Postgres3LibraryHandle,'PQenv2encoding');
 
 
-    InitialiseDllist;
+    InitialiseDllist(libpath);
     end
     end
   else
   else
     if (libpath<>pqlib) and (LoadedLibrary<>libpath) then
     if (libpath<>pqlib) and (LoadedLibrary<>libpath) then