Browse Source

--- Merging r31200 into '.':
U packages/fcl-db/src/sqldb/odbc/odbcconn.pas
--- Recording mergeinfo for merge of r31200 into '.':
U .
--- Merging r31215 into '.':
U packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
--- Recording mergeinfo for merge of r31215 into '.':
G .
--- Merging r31218 into '.':
U packages/mysql/fpmake.pp
A packages/mysql/src/mysql57dyn.pp
U packages/mysql/src/mysql.inc
--- Recording mergeinfo for merge of r31218 into '.':
G .
--- Merging r31220 into '.':
U packages/fcl-db/tests/sqldbtoolsunit.pas
U packages/fcl-db/src/sqldb/mysql/Makefile.fpc
U packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Recording mergeinfo for merge of r31220 into '.':
G .
--- Merging r31235 into '.':
U packages/fcl-passrc/src/pastree.pp
--- Recording mergeinfo for merge of r31235 into '.':
G .
--- Merging r31243 into '.':
U packages/fcl-db/tests/tcsdfdata.pp
U packages/fcl-db/src/sdf/sdfdata.pp
--- Recording mergeinfo for merge of r31243 into '.':
G .
--- Merging r31266 into '.':
G packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Recording mergeinfo for merge of r31266 into '.':
G .

# revisions: 31200,31215,31218,31220,31235,31243,31266

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

marco 10 years ago
parent
commit
c18e4da76e

+ 1 - 0
.gitattributes

@@ -5697,6 +5697,7 @@ packages/mysql/src/mysql51emb.pp svneol=native#text/plain
 packages/mysql/src/mysql55.pp svneol=native#text/plain
 packages/mysql/src/mysql55.pp svneol=native#text/plain
 packages/mysql/src/mysql55dyn.pp svneol=native#text/plain
 packages/mysql/src/mysql55dyn.pp svneol=native#text/plain
 packages/mysql/src/mysql56dyn.pp svneol=native#text/plain
 packages/mysql/src/mysql56dyn.pp svneol=native#text/plain
+packages/mysql/src/mysql57dyn.pp svneol=native#text/plain
 packages/ncurses/Makefile svneol=native#text/plain
 packages/ncurses/Makefile svneol=native#text/plain
 packages/ncurses/Makefile.fpc svneol=native#text/plain
 packages/ncurses/Makefile.fpc svneol=native#text/plain
 packages/ncurses/Makefile.fpc.fpcmake svneol=native#text/plain
 packages/ncurses/Makefile.fpc.fpcmake svneol=native#text/plain

+ 89 - 20
packages/fcl-db/src/sdf/sdfdata.pp

@@ -13,6 +13,9 @@ unit SdfData;
 ---------------
 ---------------
 Modifications
 Modifications
 ---------------
 ---------------
+30/Jul/15 LacaK:
+      Added TSDFStringList to support reading of CSV files, which have embedded
+      CRLF between double-quotes.
 7/Jun/12 BigChimp:
 7/Jun/12 BigChimp:
       Quote fields with delimiters or quotes to match Delphi SDF definition
       Quote fields with delimiters or quotes to match Delphi SDF definition
       (see e.g. help on TStrings.CommaText)
       (see e.g. help on TStrings.CommaText)
@@ -50,7 +53,7 @@ Modifications
            characters.
            characters.
            Altered buffer method to create on constructor and cleared when opened.
            Altered buffer method to create on constructor and cleared when opened.
       New Resource File. Nice Icons
       New Resource File. Nice Icons
-      SavetoStream method included
+      SaveToStream method included
       LoadFromStream method included
       LoadFromStream method included
                 ****** THANKS LESLIE *****
                 ****** THANKS LESLIE *****
 14/Ago/01  Version 2.00 (Orlando Arrocha)
 14/Ago/01  Version 2.00 (Orlando Arrocha)
@@ -141,10 +144,18 @@ type
     BookmarkFlag: TBookmarkFlag;
     BookmarkFlag: TBookmarkFlag;
   end;
   end;
 //-----------------------------------------------------------------------------
 //-----------------------------------------------------------------------------
-// TBaseTextDataSet
 
 
-  { TFixedFormatDataSet }
+  { TSDFStringList }
 
 
+  TSDFStringList = class(TStringList)
+    protected
+      FMultiLine: boolean;
+      procedure SetTextStr(const Value: string); override;
+  end;
+
+//-----------------------------------------------------------------------------
+// TFixedFormatDataSet
+//-----------------------------------------------------------------------------
   TFixedFormatDataSet = class(TDataSet)
   TFixedFormatDataSet = class(TDataSet)
   private
   private
     FSchema             :TStringList;
     FSchema             :TStringList;
@@ -152,7 +163,7 @@ type
     FFilterBuffer       :TRecordBuffer;
     FFilterBuffer       :TRecordBuffer;
     FFileMustExist      :Boolean;
     FFileMustExist      :Boolean;
     FReadOnly           :Boolean;
     FReadOnly           :Boolean;
-    FLoadfromStream     :Boolean;
+    FLoadFromStream     :Boolean;
     FTrimSpace          :Boolean;
     FTrimSpace          :Boolean;
     procedure SetSchema(const Value: TStringList);
     procedure SetSchema(const Value: TStringList);
     procedure SetFileName(Value : TFileName);
     procedure SetFileName(Value : TFileName);
@@ -164,7 +175,7 @@ type
     function GetActiveRecBuf(out RecBuf: TRecordBuffer): Boolean;
     function GetActiveRecBuf(out RecBuf: TRecordBuffer): Boolean;
     procedure SetFieldOfs(var Buffer : TRecordBuffer; FieldNo : Integer);
     procedure SetFieldOfs(var Buffer : TRecordBuffer; FieldNo : Integer);
   protected
   protected
-    FData               :TStringlist;
+    FData               :TSDFStringList;
     FDataOffset         :Integer;
     FDataOffset         :Integer;
     FCurRec             :Integer;
     FCurRec             :Integer;
     FRecordSize         :Integer;
     FRecordSize         :Integer;
@@ -217,7 +228,7 @@ type
     procedure SaveFileAs(strFileName : String); dynamic;
     procedure SaveFileAs(strFileName : String); dynamic;
     property  CanModify;
     property  CanModify;
     procedure LoadFromStream(Stream :TStream);
     procedure LoadFromStream(Stream :TStream);
-    procedure SavetoStream(Stream :TStream);
+    procedure SaveToStream(Stream :TStream);
   published
   published
     property FileMustExist: Boolean read FFileMustExist write SetFileMustExist;
     property FileMustExist: Boolean read FFileMustExist write SetFileMustExist;
     property ReadOnly: Boolean read FReadOnly write SetReadOnly;
     property ReadOnly: Boolean read FReadOnly write SetReadOnly;
@@ -256,6 +267,7 @@ type
 
 
 //-----------------------------------------------------------------------------
 //-----------------------------------------------------------------------------
 // TSdfDataSet
 // TSdfDataSet
+//-----------------------------------------------------------------------------
   TSdfDataSet = class(TFixedFormatDataSet)
   TSdfDataSet = class(TFixedFormatDataSet)
   private
   private
     FDelimiter : Char;
     FDelimiter : Char;
@@ -285,6 +297,7 @@ type
 procedure Register;
 procedure Register;
 
 
 implementation
 implementation
+
 //{$R *.Res}
 //{$R *.Res}
 
 
 //-----------------------------------------------------------------------------
 //-----------------------------------------------------------------------------
@@ -294,11 +307,11 @@ constructor TFixedFormatDataSet.Create(AOwner : TComponent);
 begin
 begin
   FDefaultRecordLength := 250;
   FDefaultRecordLength := 250;
   FFileMustExist  := TRUE;
   FFileMustExist  := TRUE;
-  FLoadfromStream := False;
+  FLoadFromStream := False;
   FRecordSize   := 0;
   FRecordSize   := 0;
   FTrimSpace    := TRUE;
   FTrimSpace    := TRUE;
   FSchema       := TStringList.Create;
   FSchema       := TStringList.Create;
-  FData         := TStringList.Create;  // Load the textfile into a StringList
+  FData         := TSDFStringList.Create;  // Load the textfile into a StringList
   inherited Create(AOwner);
   inherited Create(AOwner);
 end;
 end;
 
 
@@ -344,8 +357,7 @@ var
   i, Len, MaxLen :Integer;
   i, Len, MaxLen :Integer;
   LstFields      :TStrings;
   LstFields      :TStrings;
 begin
 begin
-  if not Assigned(FData) then
-    exit;
+  if not Assigned(FData) then Exit;
 
 
   MaxLen := 0;
   MaxLen := 0;
   FieldDefs.Clear;
   FieldDefs.Clear;
@@ -382,15 +394,15 @@ procedure TFixedFormatDataSet.InternalOpen;
 var
 var
   Stream : TStream;
   Stream : TStream;
 begin
 begin
+  if not Assigned(FData) then Exit;
+
   FSaveChanges := FALSE;
   FSaveChanges := FALSE;
-  if not Assigned(FData) then
-    FData := TStringList.Create;
   if (not FileMustExist) and (not FileExists(FileName)) then
   if (not FileMustExist) and (not FileExists(FileName)) then
   begin
   begin
     Stream := TFileStream.Create(FileName, fmCreate);
     Stream := TFileStream.Create(FileName, fmCreate);
     Stream.Free;
     Stream.Free;
   end;
   end;
-  if not FLoadfromStream then
+  if not FLoadFromStream then
     FData.LoadFromFile(FileName);
     FData.LoadFromFile(FileName);
   FRecordSize := FDefaultRecordLength;
   FRecordSize := FDefaultRecordLength;
   InternalInitFieldDefs;
   InternalInitFieldDefs;
@@ -413,7 +425,7 @@ procedure TFixedFormatDataSet.InternalClose;
 begin
 begin
   if (not FReadOnly) and (FSaveChanges) then  // Write any edits to disk
   if (not FReadOnly) and (FSaveChanges) then  // Write any edits to disk
     FData.SaveToFile(FileName);
     FData.SaveToFile(FileName);
-  FLoadfromStream := False;
+  FLoadFromStream := False;
   FData.Clear;          // Clear data
   FData.Clear;          // Clear data
   BindFields(FALSE);
   BindFields(FALSE);
   if DefaultFields then // Destroy the TField
   if DefaultFields then // Destroy the TField
@@ -444,9 +456,9 @@ begin
   begin
   begin
     Active          := False; //Make sure the Dataset is Closed.
     Active          := False; //Make sure the Dataset is Closed.
     Stream.Position := 0;     //Make sure you are at the top of the Stream.
     Stream.Position := 0;     //Make sure you are at the top of the Stream.
-    FLoadfromStream := True;
+    FLoadFromStream := True;
     if not Assigned(FData) then
     if not Assigned(FData) then
-     raise Exception.Create('Data buffer unassigned');
+      raise Exception.Create('Data buffer unassigned');
     FData.LoadFromStream(Stream);
     FData.LoadFromStream(Stream);
     Active := True;
     Active := True;
   end
   end
@@ -455,7 +467,7 @@ begin
 end;
 end;
 
 
 // Saves Data as text to a stream.
 // Saves Data as text to a stream.
-procedure TFixedFormatDataSet.SavetoStream(Stream: TStream);
+procedure TFixedFormatDataSet.SaveToStream(Stream: TStream);
 begin
 begin
   if assigned(stream) then
   if assigned(stream) then
     FData.SaveToStream(Stream)
     FData.SaveToStream(Stream)
@@ -886,6 +898,62 @@ begin
   end;
   end;
 end;
 end;
 
 
+
+//-----------------------------------------------------------------------------
+// TSDFStringList
+//-----------------------------------------------------------------------------
+
+procedure TSDFStringList.SetTextStr(const Value: string);
+var
+  S: string;
+  P: integer;
+
+  function GetNextLine(const Value: string; out S: string; var P: Integer): Boolean;
+  const
+    CR: char = #13;
+    LF: char = #10;
+    DQ: char = '"';
+  var
+    L, P1: integer;
+    InDQ: boolean;
+  begin
+    // RFC 4180:
+    //  Each record is located on a separate line, delimited by a line break (CRLF)
+    //  Fields containing line breaks (CRLF), double quotes, and commas should be enclosed in double-quotes.
+    Result := False;
+    L := Length(Value);
+    if P > L then Exit;
+    P1 := P;
+    InDQ := False;
+    while (P <= L) and (not(Value[P] in [CR,LF]) or InDQ) do
+    begin
+      if Value[P] = DQ then InDQ := not InDQ;
+      inc(P);
+    end;
+    S := Copy(Value, P1, P-P1);
+    if (P <= L) and (Value[P] = CR) then
+      inc(P);
+    if (P <= L) and (Value[P] = LF) then
+      inc(P);
+    Result := True;
+  end;
+
+begin
+  if FMultiLine then // CRLF can be enclosed between double-quotes
+    try
+      BeginUpdate;
+      Clear;
+      P:=1;
+      while GetNextLine(Value,S,P) do
+        Add(S);
+    finally
+      EndUpdate;
+    end
+  else
+    inherited;
+end;
+
+
 //-----------------------------------------------------------------------------
 //-----------------------------------------------------------------------------
 // TSdfDataSet
 // TSdfDataSet
 //-----------------------------------------------------------------------------
 //-----------------------------------------------------------------------------
@@ -919,7 +987,7 @@ begin
   if (S[Pos] = DQ) then
   if (S[Pos] = DQ) then
     // quoted field
     // quoted field
     begin
     begin
-    // skip leading quote
+    // skip leading double-quote
     Inc(Pos);
     Inc(Pos);
     // allocate output buffer
     // allocate output buffer
     SetLength(Result, Len-P1+1);
     SetLength(Result, Len-P1+1);
@@ -931,7 +999,7 @@ begin
         begin
         begin
         if (pSrc[1] = DQ) then // doubled DQ
         if (pSrc[1] = DQ) then // doubled DQ
           begin
           begin
-          Inc(pSrc);
+          Inc(pSrc);           // dequote double-quote
           Inc(Pos);
           Inc(Pos);
           end
           end
         else if (pSrc[1] in [Delimiter,' ',CR,LF,#0]) then // DQ followed by delimiter or end of record
         else if (pSrc[1] in [Delimiter,' ',CR,LF,#0]) then // DQ followed by delimiter or end of record
@@ -950,7 +1018,7 @@ begin
       Inc(Pos);
       Inc(Pos);
     end
     end
   else
   else
-    // unquoted field name
+    // unquoted field
     begin
     begin
     while (Pos <= Len) and not(S[Pos] in [Delimiter,CR,LF,#0]) do
     while (Pos <= Len) and not(S[Pos] in [Delimiter,CR,LF,#0]) do
       Inc(Pos);
       Inc(Pos);
@@ -1118,6 +1186,7 @@ end;
 procedure TSdfDataSet.SetMultiLine(const Value: Boolean);
 procedure TSdfDataSet.SetMultiLine(const Value: Boolean);
 begin
 begin
   FMultiLine:=Value;
   FMultiLine:=Value;
+  FData.FMultiLine:=Value;
 end;
 end;
 
 
 
 

+ 3 - 2
packages/fcl-db/src/sqldb/mysql/Makefile.fpc

@@ -6,8 +6,9 @@
 main=fcl-db
 main=fcl-db
 
 
 [target]
 [target]
-units=mysql40conn mysql41conn mysql50conn mysql51conn mysql55conn mysql56conn
-rsts=mysql40conn mysql41conn mysql50conn mysql51conn mysql55conn mysql56conn
+units=mysql40conn mysql41conn mysql50conn mysql51conn mysql55conn mysql56conn mysql57conn
+rsts=mysql40conn mysql41conn mysql50conn mysql51conn mysql55conn mysql56conn mysql57conn
+
 [require]
 [require]
 packages=fcl-xml mysql
 packages=fcl-xml mysql
 
 

+ 49 - 6
packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -1,3 +1,6 @@
+{$IFDEF MYSQL57_UP}
+  {$DEFINE MYSQL56_UP}
+{$ENDIF}
 {$IFDEF MYSQL56_UP}
 {$IFDEF MYSQL56_UP}
   {$DEFINE MYSQL55_UP}
   {$DEFINE MYSQL55_UP}
 {$ENDIF}
 {$ENDIF}
@@ -14,6 +17,9 @@ interface
 
 
 uses
 uses
   Classes, SysUtils,bufdataset,sqldb,db,ctypes,
   Classes, SysUtils,bufdataset,sqldb,db,ctypes,
+{$IFDEF mysql57}
+  mysql57dyn;
+{$ELSE}
 {$IFDEF mysql56}
 {$IFDEF mysql56}
   mysql56dyn;
   mysql56dyn;
 {$ELSE}
 {$ELSE}
@@ -35,9 +41,13 @@ uses
 {$endif}
 {$endif}
 {$endif}
 {$endif}
 {$ENDIF}
 {$ENDIF}
+{$ENDIF}
 
 
 Const
 Const
   MySQLVersion =
   MySQLVersion =
+{$IFDEF mysql57}
+    '5.7';
+{$ELSE}
 {$IFDEF mysql56}
 {$IFDEF mysql56}
     '5.6';
     '5.6';
 {$ELSE}
 {$ELSE}
@@ -59,11 +69,17 @@ Const
 {$endif}
 {$endif}
 {$endif}
 {$endif}
 {$ENDIF}
 {$ENDIF}
+{$ENDIF}
+
   MariaDBVersion =
   MariaDBVersion =
+{$IFDEF mysql57}
+    '10.1';
+{$ELSE}
 {$IFDEF mysql56}   // MariaDB 10.0 is compatible with MySQL 5.6
 {$IFDEF mysql56}   // MariaDB 10.0 is compatible with MySQL 5.6
-    '10.0';
+    '10.';
 {$ELSE} // MariaDB 5.1..5.5 presumably report the same version number as MySQL
 {$ELSE} // MariaDB 5.1..5.5 presumably report the same version number as MySQL
-     MySQLVersion;
+    MySQLVersion;
+{$ENDIF}
 {$ENDIF}
 {$ENDIF}
 
 
 Type
 Type
@@ -170,6 +186,12 @@ Type
   end;
   end;
 
 
 
 
+  {$IFDEF mysql57}
+    TMySQL57Connection = Class(TConnectionName);
+    TMySQL57ConnectionDef = Class(TMySQLConnectionDef);
+    TMySQL57Transaction = Class(TTransactionName);
+    TMySQL57Cursor = Class(TCursorName);
+  {$ELSE}
   {$IFDEF mysql56}
   {$IFDEF mysql56}
     TMySQL56Connection = Class(TConnectionName);
     TMySQL56Connection = Class(TConnectionName);
     TMySQL56ConnectionDef = Class(TMySQLConnectionDef);
     TMySQL56ConnectionDef = Class(TMySQLConnectionDef);
@@ -209,6 +231,7 @@ Type
     {$EndIf}
     {$EndIf}
   {$ENDIF}
   {$ENDIF}
   {$ENDIF}
   {$ENDIF}
+  {$ENDIF}
 
 
 implementation
 implementation
 
 
@@ -242,6 +265,9 @@ const
      ,'MYSQL_SERVER_PUBLIC_KEY'
      ,'MYSQL_SERVER_PUBLIC_KEY'
      ,'MYSQL_ENABLE_CLEARTEXT_PLUGIN'
      ,'MYSQL_ENABLE_CLEARTEXT_PLUGIN'
      ,'MYSQL_OPT_CAN_HANDLE_EXPIRED_PASSWORDS'
      ,'MYSQL_OPT_CAN_HANDLE_EXPIRED_PASSWORDS'
+{$IFDEF MYSQL57_UP}
+     ,'MYSQL_OPT_SSL_ENFORCE'
+{$ENDIF}
 {$ENDIF}
 {$ENDIF}
 {$ENDIF}
 {$ENDIF}
 {$ENDIF}
 {$ENDIF}
@@ -470,12 +496,12 @@ var
   FullVersion: string;
   FullVersion: string;
 begin
 begin
   InitialiseMysql;
   InitialiseMysql;
-  Fullversion:=strpas(mysql_get_client_info());
+  FullVersion:=strpas(mysql_get_client_info());
   // Version string should start with version number:
   // Version string should start with version number:
   // Note: in case of MariaDB version mismatch: tough luck, we report MySQL
   // Note: in case of MariaDB version mismatch: tough luck, we report MySQL
   // version only.
   // version only.
-  if (pos(MySQLVersion, Fullversion) <> 1) and
-    (pos(MariaDBVersion, Fullversion) <> 1) then
+  if (pos(MySQLVersion, FullVersion) <> 1) and
+     (pos(MariaDBVersion, FullVersion) <> 1) then
     Raise EInOutError.CreateFmt(SErrVersionMisMatch,[ClassName,MySQLVersion,FullVersion]);
     Raise EInOutError.CreateFmt(SErrVersionMisMatch,[ClassName,MySQLVersion,FullVersion]);
   inherited DoInternalConnect;
   inherited DoInternalConnect;
   ConnectToServer;
   ConnectToServer;
@@ -497,6 +523,9 @@ end;
 
 
 Function TConnectionName.AllocateCursorHandle: TSQLCursor;
 Function TConnectionName.AllocateCursorHandle: TSQLCursor;
 begin
 begin
+  {$IFDEF mysql57}
+    Result:=TMySQL57Cursor.Create;
+  {$ELSE}
   {$IFDEF mysql56}
   {$IFDEF mysql56}
     Result:=TMySQL56Cursor.Create;
     Result:=TMySQL56Cursor.Create;
   {$ELSE}
   {$ELSE}
@@ -518,6 +547,7 @@ begin
     {$EndIf}
     {$EndIf}
   {$EndIf}
   {$EndIf}
   {$ENDIF}
   {$ENDIF}
+  {$ENDIF}
 end;
 end;
 
 
 Procedure TConnectionName.DeAllocateCursorHandle(var cursor : TSQLCursor);
 Procedure TConnectionName.DeAllocateCursorHandle(var cursor : TSQLCursor);
@@ -599,12 +629,14 @@ begin
       // paramreplacestring kan een probleem geven bij postgres als hij niet meer gewoon $ is?
       // paramreplacestring kan een probleem geven bij postgres als hij niet meer gewoon $ is?
       C.FStatement := stringsreplace(C.FStatement,ParamNames,ParamValues,[rfReplaceAll]);
       C.FStatement := stringsreplace(C.FStatement,ParamNames,ParamValues,[rfReplaceAll]);
       end;
       end;
+
     if LogEvent(detParamValue) then
     if LogEvent(detParamValue) then
       LogParams(AParams);
       LogParams(AParams);
     if LogEvent(detExecute) then
     if LogEvent(detExecute) then
       Log(detExecute, C.FStatement);
       Log(detExecute, C.FStatement);
     if LogEvent(detActualSQL) then
     if LogEvent(detActualSQL) then
       Log(detActualSQL,C.FStatement);
       Log(detActualSQL,C.FStatement);
+
     if mysql_query(FMySQL,Pchar(C.FStatement))<>0 then
     if mysql_query(FMySQL,Pchar(C.FStatement))<>0 then
       begin
       begin
       if not ForcedClose then
       if not ForcedClose then
@@ -1274,6 +1306,9 @@ end;
 
 
 class function TMySQLConnectionDef.ConnectionClass: TSQLConnectionClass;
 class function TMySQLConnectionDef.ConnectionClass: TSQLConnectionClass;
 begin
 begin
+  {$IFDEF mysql57}
+    Result:=TMySQL57Connection;
+  {$ELSE}
   {$IFDEF mysql56}
   {$IFDEF mysql56}
     Result:=TMySQL56Connection;
     Result:=TMySQL56Connection;
   {$ELSE}
   {$ELSE}
@@ -1295,11 +1330,12 @@ begin
     {$endif}
     {$endif}
   {$endif}
   {$endif}
   {$ENDIF}
   {$ENDIF}
+  {$ENDIF}
 end;
 end;
 
 
 class function TMySQLConnectionDef.Description: String;
 class function TMySQLConnectionDef.Description: String;
 begin
 begin
-  Result:='Connect to a MySQL '+MySQLVersion+'database directly via the client library';
+  Result:='Connect to a MySQL '+MySQLVersion+' database directly via the client library';
 end;
 end;
 
 
 class function TMySQLConnectionDef.DefaultLibraryName: String;
 class function TMySQLConnectionDef.DefaultLibraryName: String;
@@ -1322,6 +1358,12 @@ begin
   Result:=MysqlLoadedLibrary;
   Result:=MysqlLoadedLibrary;
 end;
 end;
 
 
+{$IFDEF mysql57}
+  initialization
+    RegisterConnection(TMySQL57ConnectionDef);
+  finalization
+    UnRegisterConnection(TMySQL57ConnectionDef);
+{$ELSE}
 {$IFDEF mysql56}
 {$IFDEF mysql56}
   initialization
   initialization
     RegisterConnection(TMySQL56ConnectionDef);
     RegisterConnection(TMySQL56ConnectionDef);
@@ -1361,5 +1403,6 @@ end;
   {$ENDIF}
   {$ENDIF}
 {$endif}
 {$endif}
 {$ENDIF}
 {$ENDIF}
+{$ENDIF}
 
 
 end.
 end.

+ 43 - 10
packages/fcl-db/src/sqldb/odbc/odbcconn.pas

@@ -16,7 +16,7 @@ unit odbcconn;
 interface
 interface
 
 
 uses
 uses
-  Classes, SysUtils, sqldb, db, odbcsqldyn, BufDataset;
+  Classes, SysUtils, db, sqldb, BufDataset, odbcsqldyn;
 
 
 type
 type
 
 
@@ -152,7 +152,7 @@ const
 
 
 { Generic ODBC helper functions }
 { Generic ODBC helper functions }
 
 
-function ODBCSucces(const Res:SQLRETURN):boolean;
+function ODBCSuccess(const Res:SQLRETURN):boolean;
 begin
 begin
   Result:=(Res=SQL_SUCCESS) or (Res=SQL_SUCCESS_WITH_INFO);
   Result:=(Res=SQL_SUCCESS) or (Res=SQL_SUCCESS_WITH_INFO);
 end;
 end;
@@ -195,7 +195,7 @@ var
   RecNumber:SQLSMALLINT;
   RecNumber:SQLSMALLINT;
 begin
 begin
   // check result
   // check result
-  if ODBCSucces(LastReturnCode) then
+  if ODBCSuccess(LastReturnCode) then
     Exit; // no error; all is ok
     Exit; // no error; all is ok
 
 
   //WriteLn('LastResultCode: ',ODBCResultToStr(LastReturnCode));
   //WriteLn('LastResultCode: ',ODBCResultToStr(LastReturnCode));
@@ -694,6 +694,7 @@ begin
       else
       else
         begin
         begin
         FDBMSInfo.GetLastInsertIDSQL := '';
         FDBMSInfo.GetLastInsertIDSQL := '';
+        Exclude(FConnOptions, sqLastInsertID);
         end;
         end;
     end;
     end;
 
 
@@ -860,7 +861,7 @@ begin
 
 
     if (Res<>SQL_NO_DATA) then ODBCCheckResult( Res, SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not execute statement.' );
     if (Res<>SQL_NO_DATA) then ODBCCheckResult( Res, SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not execute statement.' );
 
 
-    if ODBCSucces(SQLNumResultCols(ODBCCursor.FSTMTHandle, ColumnCount)) then
+    if ODBCSuccess(SQLNumResultCols(ODBCCursor.FSTMTHandle, ColumnCount)) then
       ODBCCursor.FSelectable:=ColumnCount>0
       ODBCCursor.FSelectable:=ColumnCount>0
     else
     else
       ODBCCursor.FSelectable:=False;
       ODBCCursor.FSelectable:=False;
@@ -876,7 +877,7 @@ var
   RowCount: SQLLEN;
   RowCount: SQLLEN;
 begin
 begin
   if assigned(cursor) then
   if assigned(cursor) then
-    if ODBCSucces( SQLRowCount((cursor as TODBCCursor).FSTMTHandle, RowCount) ) then
+    if ODBCSuccess( SQLRowCount((cursor as TODBCCursor).FSTMTHandle, RowCount) ) then
        Result:=RowCount
        Result:=RowCount
     else
     else
        Result:=-1
        Result:=-1
@@ -890,6 +891,7 @@ var
   StrLenOrInd: SQLLEN;
   StrLenOrInd: SQLLEN;
   LastInsertID: LargeInt;
   LastInsertID: LargeInt;
 begin
 begin
+  Result := false;
   if SQLAllocHandle(SQL_HANDLE_STMT, FDBCHandle, STMTHandle) = SQL_SUCCESS then
   if SQLAllocHandle(SQL_HANDLE_STMT, FDBCHandle, STMTHandle) = SQL_SUCCESS then
     begin
     begin
     if SQLExecDirect(STMTHandle, PChar(FDBMSInfo.GetLastInsertIDSQL), Length(FDBMSInfo.GetLastInsertIDSQL)) = SQL_SUCCESS then
     if SQLExecDirect(STMTHandle, PChar(FDBMSInfo.GetLastInsertIDSQL), Length(FDBMSInfo.GetLastInsertIDSQL)) = SQL_SUCCESS then
@@ -969,6 +971,7 @@ begin
       SQL_LONGVARCHAR:   begin FieldType:=ftMemo;       FieldSize:=BLOB_BUF_SIZE; end; // is a blob
       SQL_LONGVARCHAR:   begin FieldType:=ftMemo;       FieldSize:=BLOB_BUF_SIZE; end; // is a blob
       SQL_WCHAR:         begin FieldType:=ftFixedWideChar; FieldSize:=ColumnSize*sizeof(Widechar); end;
       SQL_WCHAR:         begin FieldType:=ftFixedWideChar; FieldSize:=ColumnSize*sizeof(Widechar); end;
       SQL_WVARCHAR:      begin FieldType:=ftWideString; FieldSize:=ColumnSize*sizeof(Widechar); end;
       SQL_WVARCHAR:      begin FieldType:=ftWideString; FieldSize:=ColumnSize*sizeof(Widechar); end;
+      SQL_SS_XML,
       SQL_WLONGVARCHAR:  begin FieldType:=ftWideMemo;   FieldSize:=BLOB_BUF_SIZE; end; // is a blob
       SQL_WLONGVARCHAR:  begin FieldType:=ftWideMemo;   FieldSize:=BLOB_BUF_SIZE; end; // is a blob
       SQL_DECIMAL:       begin FieldType:=ftFloat;      FieldSize:=0; end;
       SQL_DECIMAL:       begin FieldType:=ftFloat;      FieldSize:=0; end;
       SQL_NUMERIC:       begin FieldType:=ftFloat;      FieldSize:=0; end;
       SQL_NUMERIC:       begin FieldType:=ftFloat;      FieldSize:=0; end;
@@ -1003,6 +1006,7 @@ begin
 {      SQL_INTERVAL_HOUR_TO_SECOND:  FieldType:=ftUnknown;}
 {      SQL_INTERVAL_HOUR_TO_SECOND:  FieldType:=ftUnknown;}
 {      SQL_INTERVAL_MINUTE_TO_SECOND:FieldType:=ftUnknown;}
 {      SQL_INTERVAL_MINUTE_TO_SECOND:FieldType:=ftUnknown;}
       SQL_GUID:          begin FieldType:=ftGuid;       FieldSize:=38; end; //SQL_GUID defines 36, but TGuidField requires 38
       SQL_GUID:          begin FieldType:=ftGuid;       FieldSize:=38; end; //SQL_GUID defines 36, but TGuidField requires 38
+      SQL_SS_VARIANT:    begin FieldType:=ftVariant;    FieldSize:=0; end;
     else
     else
       begin FieldType:=ftUnknown; FieldSize:=ColumnSize; end
       begin FieldType:=ftUnknown; FieldSize:=ColumnSize; end
     end;
     end;
@@ -1143,9 +1147,11 @@ const
   DEFAULT_BLOB_BUFFER_SIZE = 1024;
   DEFAULT_BLOB_BUFFER_SIZE = 1024;
 
 
 function TODBCConnection.LoadField(cursor: TSQLCursor; FieldDef: TFieldDef; buffer: pointer; out CreateBlob : boolean): boolean;
 function TODBCConnection.LoadField(cursor: TSQLCursor; FieldDef: TFieldDef; buffer: pointer; out CreateBlob : boolean): boolean;
+const
+  SQL_CA_SS_VARIANT_TYPE = 1215;
 var
 var
   ODBCCursor:TODBCCursor;
   ODBCCursor:TODBCCursor;
-  StrLenOrInd:SQLLEN;
+  StrLenOrInd,VariantCType:SQLLEN;
   ODBCDateStruct:SQL_DATE_STRUCT;
   ODBCDateStruct:SQL_DATE_STRUCT;
   ODBCTimeStruct:SQL_TIME_STRUCT;
   ODBCTimeStruct:SQL_TIME_STRUCT;
   ODBCTimeStampStruct:SQL_TIMESTAMP_STRUCT;
   ODBCTimeStampStruct:SQL_TIMESTAMP_STRUCT;
@@ -1215,15 +1221,42 @@ begin
       else
       else
         PWord(buffer)^ := StrLenOrInd;
         PWord(buffer)^ := StrLenOrInd;
     end;
     end;
+    ftVariant:
+    begin
+      // Try to read sql_variant header
+      Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BINARY, buffer, 0, @StrLenOrInd);
+      if ODBCSuccess(Res) then
+      begin
+        Res := SQLColAttribute(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_CA_SS_VARIANT_TYPE, nil, 0, nil, @VariantCType);
+        // map only types, which holds values directly in TVarData record
+        case VariantCType of
+          SQL_C_SSHORT, SQL_C_USHORT, SQL_C_SLONG, SQL_C_ULONG, SQL_C_SBIGINT:
+            begin
+            VariantCType := SQL_C_SBIGINT;
+            PVarData(buffer)^.vtype := varInt64;
+            buffer := @PVarData(buffer)^.vint64;
+            end;
+          SQL_C_FLOAT, SQL_C_DOUBLE:
+            begin
+            VariantCType := SQL_C_DOUBLE;
+            PVarData(buffer)^.vtype := varDouble;
+            buffer := @PVarData(buffer)^.vdouble;
+            end
+          else
+            StrLenOrInd := SQL_NULL_DATA;
+        end;
+        if StrLenOrInd<>SQL_NULL_DATA then
+          Res := SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, VariantCType, buffer, 8, @StrLenOrInd);
+      end;
+    end;
     ftWideMemo,
     ftWideMemo,
     ftBlob, ftMemo:       // BLOBs
     ftBlob, ftMemo:       // BLOBs
     begin
     begin
       //Writeln('BLOB');
       //Writeln('BLOB');
       // Try to discover BLOB data length
       // Try to discover BLOB data length
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BINARY, buffer, 0, @StrLenOrInd);
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BINARY, buffer, 0, @StrLenOrInd);
-      ODBCCheckResult(Res, SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get field data for field "%s" (index %d).',[FieldDef.Name, FieldDef.Index+1]);
       // Read the data if not NULL
       // Read the data if not NULL
-      if StrLenOrInd<>SQL_NULL_DATA then
+      if ODBCSuccess(Res) and (StrLenOrInd<>SQL_NULL_DATA) then
       begin
       begin
         CreateBlob:=true; // defer actual loading of blob data to LoadBlobIntoBuffer method
         CreateBlob:=true; // defer actual loading of blob data to LoadBlobIntoBuffer method
         //WriteLn('Deferring loading of blob of length ',StrLenOrInd);
         //WriteLn('Deferring loading of blob of length ',StrLenOrInd);
@@ -1396,7 +1429,7 @@ begin
         if Res=SQL_NO_DATA then
         if Res=SQL_NO_DATA then
           Break;
           Break;
         // handle data
         // handle data
-        if ODBCSucces(Res) then begin
+        if ODBCSuccess(Res) then begin
           if OrdinalPos=1 then begin
           if OrdinalPos=1 then begin
             // create new IndexDef if OrdinalPos=1
             // create new IndexDef if OrdinalPos=1
             IndexDef:=IndexDefs.AddIndexDef;
             IndexDef:=IndexDefs.AddIndexDef;
@@ -1453,7 +1486,7 @@ begin
         if Res=SQL_NO_DATA then
         if Res=SQL_NO_DATA then
           Break;
           Break;
         // handle data
         // handle data
-        if ODBCSucces(Res) then begin
+        if ODBCSuccess(Res) then begin
           // note: SQLStatistics not only returns index info, but also statistics; we skip the latter
           // note: SQLStatistics not only returns index info, but also statistics; we skip the latter
           if _Type<>SQL_TABLE_STAT then begin
           if _Type<>SQL_TABLE_STAT then begin
             if PChar(@IndexName[1])=KeyName then begin
             if PChar(@IndexName[1])=KeyName then begin

+ 5 - 6
packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -781,8 +781,7 @@ begin
   Inherited;
   Inherited;
   if DatabaseName = '' then
   if DatabaseName = '' then
     DatabaseError(SErrNoDatabaseName,self);
     DatabaseError(SErrNoDatabaseName,self);
-  if SQLiteLoadedLibrary = '' then
-    InitializeSqlite(SQLiteDefaultLibrary);
+  InitializeSQLite;
   filename := DatabaseName;
   filename := DatabaseName;
   checkerror(sqlite3_open(PAnsiChar(filename),@fhandle));
   checkerror(sqlite3_open(PAnsiChar(filename),@fhandle));
   if (Length(Password)>0) and assigned(sqlite3_key) then
   if (Length(Password)>0) and assigned(sqlite3_key) then
@@ -799,7 +798,7 @@ begin
     begin
     begin
     checkerror(sqlite3_close(fhandle));
     checkerror(sqlite3_close(fhandle));
     fhandle:= nil;
     fhandle:= nil;
-    releasesqlite;
+    ReleaseSQLite;
     end; 
     end; 
 end;
 end;
 
 
@@ -976,7 +975,7 @@ function TSQLite3Connection.GetConnectionInfo(InfoType: TConnInfoType): string;
 begin
 begin
   Result:='';
   Result:='';
   try
   try
-    InitializeSqlite;
+    InitializeSQLite;
     case InfoType of
     case InfoType of
       citServerType:
       citServerType:
         Result:=TSQLite3ConnectionDef.TypeName;
         Result:=TSQLite3ConnectionDef.TypeName;
@@ -1000,7 +999,7 @@ var filename: ansistring;
 begin
 begin
   CheckDisConnected;
   CheckDisConnected;
   try
   try
-    InitializeSqlite;
+    InitializeSQLite;
     try
     try
       filename := DatabaseName;
       filename := DatabaseName;
       checkerror(sqlite3_open(PAnsiChar(filename),@fhandle));
       checkerror(sqlite3_open(PAnsiChar(filename),@fhandle));
@@ -1094,7 +1093,7 @@ end;
 
 
 class function TSQLite3ConnectionDef.LoadFunction: TLibraryLoadFunction;
 class function TSQLite3ConnectionDef.LoadFunction: TLibraryLoadFunction;
 begin
 begin
-  Result:=@InitializeSqliteANSI; //the function taking the filename argument
+  Result:=@InitializeSQLiteANSI; //the function taking the filename argument
 end;
 end;
 
 
 class function TSQLite3ConnectionDef.UnLoadFunction: TLibraryUnLoadFunction;
 class function TSQLite3ConnectionDef.UnLoadFunction: TLibraryUnLoadFunction;

+ 21 - 18
packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -7,7 +7,7 @@ interface
 uses
 uses
   Classes, SysUtils, toolsunit
   Classes, SysUtils, toolsunit
   ,db, sqldb
   ,db, sqldb
-  ,mysql40conn, mysql41conn, mysql50conn, mysql51conn, mysql55conn, mysql56conn
+  ,mysql40conn, mysql41conn, mysql50conn, mysql51conn, mysql55conn, mysql56conn, mysql57conn
   ,ibconnection
   ,ibconnection
   ,pqconnection
   ,pqconnection
   ,odbcconn
   ,odbcconn
@@ -20,13 +20,13 @@ uses
   ;
   ;
 
 
 type
 type
-  TSQLConnType = (mysql40,mysql41,mysql50,mysql51,mysql55,mysql56,postgresql,interbase,odbc,oracle,sqlite3,mssql,sybase);
+  TSQLConnType = (mysql40,mysql41,mysql50,mysql51,mysql55,mysql56,mysql57,postgresql,interbase,odbc,oracle,sqlite3,mssql,sybase);
   TSQLServerType = (ssFirebird, ssInterbase, ssMSSQL, ssMySQL, ssOracle, ssPostgreSQL, ssSQLite, ssSybase, ssUnknown);
   TSQLServerType = (ssFirebird, ssInterbase, ssMSSQL, ssMySQL, ssOracle, ssPostgreSQL, ssSQLite, ssSybase, ssUnknown);
 
 
 const
 const
-  MySQLConnTypes = [mysql40,mysql41,mysql50,mysql51,mysql55,mysql56];
+  MySQLConnTypes = [mysql40,mysql41,mysql50,mysql51,mysql55,mysql56,mysql57];
   SQLConnTypesNames : Array [TSQLConnType] of String[19] =
   SQLConnTypesNames : Array [TSQLConnType] of String[19] =
-        ('MYSQL40','MYSQL41','MYSQL50','MYSQL51','MYSQL55','MYSQL56','POSTGRESQL','INTERBASE','ODBC','ORACLE','SQLITE3','MSSQL','SYBASE');
+        ('MYSQL40','MYSQL41','MYSQL50','MYSQL51','MYSQL55','MYSQL56','MYSQL57','POSTGRESQL','INTERBASE','ODBC','ORACLE','SQLITE3','MSSQL','SYBASE');
              
              
   STestNotApplicable = 'This test does not apply to this sqldb connection type';
   STestNotApplicable = 'This test does not apply to this sqldb connection type';
 
 
@@ -142,7 +142,7 @@ const
 
 
   // fall back mapping (e.g. in case GetConnectionInfo(citServerType) is not implemented)
   // fall back mapping (e.g. in case GetConnectionInfo(citServerType) is not implemented)
   SQLConnTypeToServerTypeMap : array[TSQLConnType] of TSQLServerType =
   SQLConnTypeToServerTypeMap : array[TSQLConnType] of TSQLServerType =
-    (ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssPostgreSQL,ssFirebird,ssUnknown,ssOracle,ssSQLite,ssMSSQL,ssSybase);
+    (ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssPostgreSQL,ssFirebird,ssUnknown,ssOracle,ssSQLite,ssMSSQL,ssSybase);
 
 
 
 
 function IdentifierCase(const s: string): string;
 function IdentifierCase(const s: string): string;
@@ -167,21 +167,24 @@ begin
   for t := low(SQLConnTypesNames) to high(SQLConnTypesNames) do
   for t := low(SQLConnTypesNames) to high(SQLConnTypesNames) do
     if UpperCase(dbconnectorparams) = SQLConnTypesNames[t] then SQLConnType := t;
     if UpperCase(dbconnectorparams) = SQLConnTypesNames[t] then SQLConnType := t;
 
 
-  if SQLConnType = MYSQL40 then Fconnection := TMySQL40Connection.Create(nil);
-  if SQLConnType = MYSQL41 then Fconnection := TMySQL41Connection.Create(nil);
-  if SQLConnType = MYSQL50 then Fconnection := TMySQL50Connection.Create(nil);
-  if SQLConnType = MYSQL51 then Fconnection := TMySQL51Connection.Create(nil);
-  if SQLConnType = MYSQL55 then Fconnection := TMySQL55Connection.Create(nil);
-  if SQLConnType = MYSQL56 then Fconnection := TMySQL56Connection.Create(nil);
-  if SQLConnType = SQLITE3 then Fconnection := TSQLite3Connection.Create(nil);
-  if SQLConnType = POSTGRESQL then Fconnection := TPQConnection.Create(nil);
-  if SQLConnType = INTERBASE then Fconnection := TIBConnection.Create(nil);
-  if SQLConnType = ODBC then Fconnection := TODBCConnection.Create(nil);
+  case SQLConnType of
+    MYSQL40:    Fconnection := TMySQL40Connection.Create(nil);
+    MYSQL41:    Fconnection := TMySQL41Connection.Create(nil);
+    MYSQL50:    Fconnection := TMySQL50Connection.Create(nil);
+    MYSQL51:    Fconnection := TMySQL51Connection.Create(nil);
+    MYSQL55:    Fconnection := TMySQL55Connection.Create(nil);
+    MYSQL56:    Fconnection := TMySQL56Connection.Create(nil);
+    MYSQL57:    Fconnection := TMySQL57Connection.Create(nil);
+    SQLITE3:    Fconnection := TSQLite3Connection.Create(nil);
+    POSTGRESQL: Fconnection := TPQConnection.Create(nil);
+    INTERBASE : Fconnection := TIBConnection.Create(nil);
+    ODBC:       Fconnection := TODBCConnection.Create(nil);
   {$IFNDEF Win64}
   {$IFNDEF Win64}
-  if SQLConnType = ORACLE then Fconnection := TOracleConnection.Create(nil);
+    ORACLE:     Fconnection := TOracleConnection.Create(nil);
   {$ENDIF Win64}
   {$ENDIF Win64}
-  if SQLConnType = MSSQL then Fconnection := TMSSQLConnection.Create(nil);
-  if SQLConnType = SYBASE then Fconnection := TSybaseConnection.Create(nil);
+    MSSQL:      Fconnection := TMSSQLConnection.Create(nil);
+    SYBASE:     Fconnection := TSybaseConnection.Create(nil);
+  end;
 
 
   if not assigned(Fconnection) then writeln('Invalid database type, check if a valid database type for your achitecture was provided in the file ''database.ini''');
   if not assigned(Fconnection) then writeln('Invalid database type, check if a valid database type for your achitecture was provided in the file ''database.ini''');
 
 

+ 20 - 14
packages/fcl-db/tests/tcsdfdata.pp

@@ -228,9 +228,7 @@ end;
 
 
 procedure Ttestsdfspecific.TestDelimitedTextOutput;
 procedure Ttestsdfspecific.TestDelimitedTextOutput;
 // Test if saving and loading data keeps the original values.
 // Test if saving and loading data keeps the original values.
-
-// Mainly check if writing & reading quotes works.
-// to do: more fully test RFC4180
+// Mainly check if writing & reading embedded quotes and CRLF works.
 const
 const
   Value1='Delimiter,"and";quote';
   Value1='Delimiter,"and";quote';
   Value2='J"T"';
   Value2='J"T"';
@@ -241,6 +239,7 @@ const
   Value7='Some "random" quotes';
   Value7='Some "random" quotes';
 Var
 Var
   F : Text;
   F : Text;
+  i : integer;
 begin
 begin
   // with Schema, with Header line
   // with Schema, with Header line
   TestDataset.Close;
   TestDataset.Close;
@@ -250,21 +249,28 @@ begin
   Assign(F, TestDataset.FileName);
   Assign(F, TestDataset.FileName);
   Rewrite(F);
   Rewrite(F);
   Writeln(F,'Field1,Field2,Field3,Field4,Field5,Field6,Field7');
   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"');
+  for i:=1 to 3 do
+  begin
+    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"');
+  end;
   Close(F);
   Close(F);
   // Load our dataset
   // Load our dataset
   TestDataset.Open;
   TestDataset.Open;
-//  AssertEquals('Field count',7,TestDataset.FieldDefs.Count);
-//  AssertEquals('Record count',1,TestDataset.RecordCount);
+  AssertEquals('FieldDefs.Count', 7, TestDataset.FieldDefs.Count);
+  AssertEquals('RecordCount', 3, TestDataset.RecordCount);
   TestDataset.First;
   TestDataset.First;
-  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);
+  for i:=1 to 3 do
+  begin
+    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);
+    TestDataSet.Next;
+  end;
 end;
 end;
 
 
 procedure Ttestsdfspecific.TestEmptyFieldContents;
 procedure Ttestsdfspecific.TestEmptyFieldContents;

+ 9 - 13
packages/fcl-passrc/src/pastree.pp

@@ -1743,23 +1743,19 @@ begin
 end;
 end;
 
 
 function TPasElement.GetModule: TPasModule;
 function TPasElement.GetModule: TPasModule;
+
+Var
+  p : TPaselement;
 begin
 begin
   if self is  TPasPackage then
   if self is  TPasPackage then
     Result := nil
     Result := nil
   else
   else
-  begin
-    if self is TPasModule then
-      begin
-        Result := TPasModule(Self);
-        while Assigned(Result) and not (Result is TPasModule) do
-        Result := TPasModule(Result.Parent);
-      end
-    else
-     begin
-       // typical case that this happens: symbol was loaded from .XCT
-       result:=nil;
-     end;
-  end;
+    begin
+    P:=Self;
+    While (P<>Nil) and Not (P is TPasModule) do
+      P:=P.Parent;
+    Result:=TPasModule(P);
+    end;
 end;
 end;
 
 
 function TPasElement.GetDeclaration(full: Boolean): string;
 function TPasElement.GetDeclaration(full: Boolean): string;

+ 7 - 0
packages/mysql/fpmake.pp

@@ -141,6 +141,13 @@ begin
         end;
         end;
     T.ResourceStrings := True;
     T.ResourceStrings := True;
 
 
+    T:=P.Targets.AddUnit('mysql57dyn.pp');
+      with T.Dependencies do
+        begin
+          AddInclude('mysql.inc');
+        end;
+    T.ResourceStrings := True;
+
     P.ExamplePath.Add('examples');
     P.ExamplePath.Add('examples');
     P.Targets.AddExampleProgram('testdb3.pp');
     P.Targets.AddExampleProgram('testdb3.pp');
     P.Targets.AddExampleProgram('testdb4.pp');
     P.Targets.AddExampleProgram('testdb4.pp');

+ 87 - 39
packages/mysql/src/mysql.inc

@@ -23,15 +23,17 @@ interface
 {$ifdef Load_Dynamically}{$define LinkDynamically}{$endif}
 {$ifdef Load_Dynamically}{$define LinkDynamically}{$endif}
 uses
 uses
 {$IFDEF LinkDynamically}
 {$IFDEF LinkDynamically}
-      sysutils,
+     sysutils,
 {$ENDIF}
 {$ENDIF}
-     dynlibs,ctypes;
+     ctypes, dynlibs;
 
 
 {$IFDEF Unix}
 {$IFDEF Unix}
   {$DEFINE extdecl:=cdecl}
   {$DEFINE extdecl:=cdecl}
   const
   const
     mysqllib = 'libmysqlclient.'+sharedsuffix;
     mysqllib = 'libmysqlclient.'+sharedsuffix;
-  {$IF DEFINED(mysql55) or DEFINED(mysql56)}
+  {$IF DEFINED(mysql57)}
+    mysqlvlib = mysqllib+'.20';
+  {$ELSEIF DEFINED(mysql55) or DEFINED(mysql56)}
     mysqlvlib = mysqllib+'.18';
     mysqlvlib = mysqllib+'.18';
   {$ELSEIF DEFINED(mysql51)}
   {$ELSEIF DEFINED(mysql51)}
     mysqlvlib = mysqllib+'.16';
     mysqlvlib = mysqllib+'.16';
@@ -51,6 +53,10 @@ uses
 {$ENDIF}
 {$ENDIF}
 
 
 
 
+{$IFDEF mysql57}
+  {$DEFINE mysql56}
+{$ENDIF mysql57}
+
 {$IFDEF mysql56}
 {$IFDEF mysql56}
   {$DEFINE mysql55}
   {$DEFINE mysql55}
 {$ENDIF mysql56}
 {$ENDIF mysql56}
@@ -88,8 +94,8 @@ uses
     type
     type
        my_bool = cchar;
        my_bool = cchar;
        Pmy_bool  = ^my_bool;
        Pmy_bool  = ^my_bool;
-//       pppchar = ^ppchar;
-//       ppbyte = ^pbyte;
+       ppcchar = ^pcchar;
+       psize_t = pointer;
 
 
        PVIO = Pointer;
        PVIO = Pointer;
 
 
@@ -111,6 +117,7 @@ uses
      HOSTNAME_LENGTH = 60;
      HOSTNAME_LENGTH = 60;
 {$IFDEF mysql51}
 {$IFDEF mysql51}
      SYSTEM_CHARSET_MBMAXLEN = 3;
      SYSTEM_CHARSET_MBMAXLEN = 3;
+     FILENAME_CHARSET_MBMAXLEN = 5;
      NAME_CHAR_LEN = 64;              // Field/table name length
      NAME_CHAR_LEN = 64;              // Field/table name length
      USERNAME_CHAR_LENGTH = 16;
      USERNAME_CHAR_LENGTH = 16;
      NAME_LEN = (NAME_CHAR_LEN*SYSTEM_CHARSET_MBMAXLEN);
      NAME_LEN = (NAME_CHAR_LEN*SYSTEM_CHARSET_MBMAXLEN);
@@ -133,6 +140,12 @@ uses
      INDEX_COMMENT_MAXLEN = 1024;
      INDEX_COMMENT_MAXLEN = 1024;
      TABLE_PARTITION_COMMENT_MAXLEN = 1024;
      TABLE_PARTITION_COMMENT_MAXLEN = 1024;
 
 
+  { Maximum length of protocol packet. }
+  { OK packet length limit also restricted to this value as any length greater
+    than this value will have first byte of OK packet to be 254 thus does not
+    provide a means to identify if this is OK or EOF packet. }
+     MAX_PACKET_LENGTH = (256*256*256-1);
+
   const
   const
      MYSQL_NAMEDPIPE = 'MySQL';
      MYSQL_NAMEDPIPE = 'MySQL';
      MYSQL_SERVICENAME = 'MySQL';
      MYSQL_SERVICENAME = 'MySQL';
@@ -152,6 +165,9 @@ uses
        COM_DAEMON,
        COM_DAEMON,
   {$IFDEF mysql56}
   {$IFDEF mysql56}
        COM_BINLOG_DUMP_GTID,
        COM_BINLOG_DUMP_GTID,
+   {$IFDEF mysql57}
+       COM_RESET_CONNECTION,
+   {$ENDIF}
   {$ENDIF}
   {$ENDIF}
  {$ENDIF}
  {$ENDIF}
 {$ELSE}
 {$ELSE}
@@ -160,6 +176,7 @@ uses
        COM_RESET_STMT,COM_SET_OPTION,
        COM_RESET_STMT,COM_SET_OPTION,
   {$ENDIF}
   {$ENDIF}
 {$ENDIF}
 {$ENDIF}
+       { Must be last }
        COM_END
        COM_END
        );
        );
 
 
@@ -217,6 +234,9 @@ uses
        FIELD_FLAGS_COLUMN_FORMAT_MASK = (3 shl FIELD_FLAGS_COLUMN_FORMAT);
        FIELD_FLAGS_COLUMN_FORMAT_MASK = (3 shl FIELD_FLAGS_COLUMN_FORMAT);
   {$IFDEF mysql56}
   {$IFDEF mysql56}
        FIELD_IS_DROPPED = (1 shl 26);         // Intern: Field is being dropped
        FIELD_IS_DROPPED = (1 shl 26);         // Intern: Field is being dropped
+   {$IFDEF mysql57}
+       EXPLICIT_NULL_FLAG = (1 shl 27);       // Field is explicitly specified as NULL by the user
+   {$ENDIF}
   {$ENDIF}
   {$ENDIF}
  {$ENDIF}
  {$ENDIF}
 {$ENDIF}
 {$ENDIF}
@@ -245,6 +265,7 @@ uses
        REFRESH_DES_KEY_FILE = $40000;
        REFRESH_DES_KEY_FILE = $40000;
        REFRESH_USER_RESOURCES = $80000;
        REFRESH_USER_RESOURCES = $80000;
        REFRESH_FOR_EXPORT = $100000;       // FLUSH TABLES ... FOR EXPORT
        REFRESH_FOR_EXPORT = $100000;       // FLUSH TABLES ... FOR EXPORT
+       REFRESH_OPTIMIZER_COSTS = $200000;  // FLUSH OPTIMIZER_COSTS
 
 
        CLIENT_LONG_PASSWORD = 1;           // new more secure passwords
        CLIENT_LONG_PASSWORD = 1;           // new more secure passwords
        CLIENT_FOUND_ROWS = 2;              // Found instead of affected rows
        CLIENT_FOUND_ROWS = 2;              // Found instead of affected rows
@@ -261,7 +282,7 @@ uses
        CLIENT_IGNORE_SIGPIPE = 4096;       // IGNORE sigpipes
        CLIENT_IGNORE_SIGPIPE = 4096;       // IGNORE sigpipes
        CLIENT_TRANSACTIONS = 8192;         // Client knows about transactions
        CLIENT_TRANSACTIONS = 8192;         // Client knows about transactions
        CLIENT_RESERVED = 16384;            // Old flag for 4.1 protocol
        CLIENT_RESERVED = 16384;            // Old flag for 4.1 protocol
-       CLIENT_SECURE_CONNECTION = 32768;   // New 4.1 authentication
+       CLIENT_SECURE_CONNECTION = 32768;   // Old flag for 4.1 authentication
        CLIENT_MULTI_STATEMENTS = 65536;    // Enable/disable multi-stmt support
        CLIENT_MULTI_STATEMENTS = 65536;    // Enable/disable multi-stmt support
        CLIENT_MULTI_RESULTS = 131072;      // Enable/disable multi-results
        CLIENT_MULTI_RESULTS = 131072;      // Enable/disable multi-results
        CLIENT_PS_MULTI_RESULTS : cardinal = 1 shl 18; // Multi-results in PS-protocol
        CLIENT_PS_MULTI_RESULTS : cardinal = 1 shl 18; // Multi-results in PS-protocol
@@ -269,6 +290,8 @@ uses
        CLIENT_CONNECT_ATTRS : cardinal = (1 shl 20);  // Client supports connection attributes
        CLIENT_CONNECT_ATTRS : cardinal = (1 shl 20);  // Client supports connection attributes
        CLIENT_PLUGIN_AUTH_LENENC_CLIENT_DATA : cardinal = (1 shl 21);  // Enable authentication response packet to be larger than 255 bytes.
        CLIENT_PLUGIN_AUTH_LENENC_CLIENT_DATA : cardinal = (1 shl 21);  // Enable authentication response packet to be larger than 255 bytes.
        CLIENT_CAN_HANDLE_EXPIRED_PASSWORDS : cardinal = (1 shl 22);    // Don't close the connection for a connection with expired password.
        CLIENT_CAN_HANDLE_EXPIRED_PASSWORDS : cardinal = (1 shl 22);    // Don't close the connection for a connection with expired password.
+       CLIENT_SESSION_TRACK : cardinal = (1 shl 23);  // Capable of handling server state change information. Its a hint to the server to include the state change information in Ok packet.
+       CLIENT_DEPRECATE_EOF : cardinal = (1 shl 24);  // Client no longer needs EOF packet
        CLIENT_SSL_VERIFY_SERVER_CERT : cardinal = 1 shl 30;
        CLIENT_SSL_VERIFY_SERVER_CERT : cardinal = 1 shl 30;
        CLIENT_REMEMBER_OPTIONS : cardinal = 1 shl 31;
        CLIENT_REMEMBER_OPTIONS : cardinal = 1 shl 31;
 
 
@@ -294,21 +317,24 @@ uses
        SERVER_STATUS_DB_DROPPED = 256;     // A database was dropped
        SERVER_STATUS_DB_DROPPED = 256;     // A database was dropped
 {$IFDEF mysql50}
 {$IFDEF mysql50}
        SERVER_STATUS_NO_BACKSLASH_ESCAPES = 512;
        SERVER_STATUS_NO_BACKSLASH_ESCAPES = 512;
-{$ENDIF}
-{$IFDEF mysql51}
+ {$IFDEF mysql51}
     {
     {
       Sent to the client if after a prepared statement reprepare
       Sent to the client if after a prepared statement reprepare
       we discovered that the new statement returns a different
       we discovered that the new statement returns a different
       number of result set columns.
       number of result set columns.
     }
     }
        SERVER_STATUS_METADATA_CHANGED = 1024;
        SERVER_STATUS_METADATA_CHANGED = 1024;
-{$ENDIF}
-{$IFDEF mysql55}
+  {$IFDEF mysql55}
        SERVER_QUERY_WAS_SLOW = 2048;
        SERVER_QUERY_WAS_SLOW = 2048;
        SERVER_PS_OUT_PARAMS = 4096; // To mark ResultSet containing output parameter values.
        SERVER_PS_OUT_PARAMS = 4096; // To mark ResultSet containing output parameter values.
-{$ENDIF}
-{$IFDEF mysql56}
+   {$IFDEF mysql56}
        SERVER_STATUS_IN_TRANS_READONLY = 8192;
        SERVER_STATUS_IN_TRANS_READONLY = 8192;
+    {$IFDEF mysql57}
+       SERVER_SESSION_STATE_CHANGED = (1 shl 14); // This status flag, when on, implies that one of the state information has changed on the server because of the execution of the last statement.
+    {$ENDIF}
+   {$ENDIF}
+  {$ENDIF}
+ {$ENDIF}
 {$ENDIF}
 {$ENDIF}
 
 
 {$IFDEF mysql41}
 {$IFDEF mysql41}
@@ -340,7 +366,6 @@ uses
     type
     type
        Pst_net = ^st_net;
        Pst_net = ^st_net;
        st_net = record
        st_net = record
-{ $if !defined(CHECK_EMBEDDED_DIFFERENCES) || !defined(EMBEDDED_LIBRARY) }
             vio : PVio;
             vio : PVio;
             buff : pcuchar;
             buff : pcuchar;
             buff_end : pcuchar;
             buff_end : pcuchar;
@@ -365,7 +390,6 @@ uses
             unused3: my_bool;  // Please remove with the next incompatible ABI change
             unused3: my_bool;  // Please remove with the next incompatible ABI change
             { Pointer to query object in query cache, do not equal NULL (0) for
             { Pointer to query object in query cache, do not equal NULL (0) for
               queries in cache that have not stored its results yet }
               queries in cache that have not stored its results yet }
-{ $endif }
             unused: pcuchar;
             unused: pcuchar;
             last_errno: cuint;
             last_errno: cuint;
             error: cuchar;
             error: cuchar;
@@ -531,6 +555,24 @@ uses
          MYSQL_OPTION_MULTI_STATEMENTS_OFF
          MYSQL_OPTION_MULTI_STATEMENTS_OFF
          );
          );
 
 
+{$IFDEF mysql57}
+    { Type of state change information that the server can include in the Ok
+      packet.
+      Note : 1) session_state_type shouldn't go past 255 (i.e. 1-byte boundary).
+             2) Modify the definition of SESSION_TRACK_END when a new member is added.
+    }
+       enum_session_state_type = (
+         SESSION_TRACK_SYSTEM_VARIABLES, // Session system variables
+         SESSION_TRACK_SCHEMA,           // Current schema
+         SESSION_TRACK_STATE_CHANGE,     // track session state changes
+         SESSION_TRACK_GTIDS
+       );
+
+    const
+       SESSION_TRACK_BEGIN = ord(SESSION_TRACK_SYSTEM_VARIABLES);
+       SESSION_TRACK_END = ord(SESSION_TRACK_GTIDS);
+{$ENDIF}
+
     function net_new_transaction(net : st_net) : st_net;
     function net_new_transaction(net : st_net) : st_net;
 
 
 {$IFNDEF LinkDynamically}
 {$IFNDEF LinkDynamically}
@@ -721,10 +763,6 @@ uses
          CLIENT_NET_READ_TIMEOUT = 365*24*3600;     // Timeout on read
          CLIENT_NET_READ_TIMEOUT = 365*24*3600;     // Timeout on read
          CLIENT_NET_WRITE_TIMEOUT = 365*24*3600;    // Timeout on write
          CLIENT_NET_WRITE_TIMEOUT = 365*24*3600;    // Timeout on write
       
       
-{$ifdef NETWARE}
-(** unsupported pragma#pragma pack(push, 8)		/* 8 byte alignment */*)
-{$endif}
-
     type
     type
        Pst_mysql_field = ^st_mysql_field;
        Pst_mysql_field = ^st_mysql_field;
        st_mysql_field = record
        st_mysql_field = record
@@ -892,6 +930,9 @@ uses
          ,MYSQL_SERVER_PUBLIC_KEY
          ,MYSQL_SERVER_PUBLIC_KEY
          ,MYSQL_ENABLE_CLEARTEXT_PLUGIN
          ,MYSQL_ENABLE_CLEARTEXT_PLUGIN
          ,MYSQL_OPT_CAN_HANDLE_EXPIRED_PASSWORDS
          ,MYSQL_OPT_CAN_HANDLE_EXPIRED_PASSWORDS
+    {$IFDEF mysql57}
+         ,MYSQL_OPT_SSL_ENFORCE
+    {$ENDIF}
    {$ENDIF}
    {$ENDIF}
   {$ENDIF}
   {$ENDIF}
  {$ENDIF}
  {$ENDIF}
@@ -1510,6 +1551,13 @@ uses
     function mysql_real_query(mysql:PMYSQL; q:Pchar; length:culong):cint;extdecl;external mysqllib name 'mysql_real_query';
     function mysql_real_query(mysql:PMYSQL; q:Pchar; length:culong):cint;extdecl;external mysqllib name 'mysql_real_query';
     function mysql_store_result(mysql:PMYSQL):PMYSQL_RES;extdecl;external mysqllib name 'mysql_store_result';
     function mysql_store_result(mysql:PMYSQL):PMYSQL_RES;extdecl;external mysqllib name 'mysql_store_result';
     function mysql_use_result(mysql:PMYSQL):PMYSQL_RES;extdecl;external mysqllib name 'mysql_use_result';
     function mysql_use_result(mysql:PMYSQL):PMYSQL_RES;extdecl;external mysqllib name 'mysql_use_result';
+ {$IFDEF mysql50}
+    procedure mysql_get_character_set_info(mysql:PMYSQL; charset:PMY_CHARSET_INFO);extdecl;external mysqllib name 'mysql_get_character_set_info';
+  {$IFDEF mysql57}
+    function mysql_session_track_get_first(mysql:PMYSQL; typ:enum_session_state_type; data:ppcchar; length:psize_t):cint; extdecl; external mysqllib name 'mysql_session_track_get_first';
+    function mysql_session_track_get_next(mysql:PMYSQL; typ:enum_session_state_type; data:ppcchar; length:psize_t):cint; extdecl; external mysqllib name 'mysql_session_track_get_next';
+  {$ENDIF}
+ {$ENDIF}
 
 
 {$ELSE}
 {$ELSE}
 
 
@@ -1548,6 +1596,14 @@ uses
       mysql_real_query: function (mysql:PMYSQL; q:Pchar; length:culong):cint;extdecl;
       mysql_real_query: function (mysql:PMYSQL; q:Pchar; length:culong):cint;extdecl;
       mysql_store_result: function (mysql:PMYSQL):PMYSQL_RES;extdecl;
       mysql_store_result: function (mysql:PMYSQL):PMYSQL_RES;extdecl;
       mysql_use_result: function (mysql:PMYSQL):PMYSQL_RES;extdecl;
       mysql_use_result: function (mysql:PMYSQL):PMYSQL_RES;extdecl;
+ {$IFDEF mysql50}
+      mysql_get_character_set_info: procedure(mysql:PMYSQL; charset:PMY_CHARSET_INFO);extdecl;
+  {$IFDEF mysql57}
+      mysql_session_track_get_first: function(mysql:PMYSQL; typ:enum_session_state_type; data:ppcchar; length:psize_t):cint; extdecl;
+      mysql_session_track_get_next: function(mysql:PMYSQL; typ:enum_session_state_type; data:ppcchar; length:psize_t):cint; extdecl;
+  {$ENDIF}
+ {$ENDIF}
+
 {$ENDIF}
 {$ENDIF}
 
 
 {$IFNDEF LinkDynamically}
 {$IFNDEF LinkDynamically}
@@ -1558,9 +1614,6 @@ uses
     { perform query on slave  }
     { perform query on slave  }
     function mysql_slave_query(mysql:PMYSQL; q:Pchar; length:culong):my_bool;extdecl;external mysqllib name 'mysql_slave_query';
     function mysql_slave_query(mysql:PMYSQL; q:Pchar; length:culong):my_bool;extdecl;external mysqllib name 'mysql_slave_query';
     function mysql_slave_send_query(mysql:PMYSQL; q:Pchar; length:culong):my_bool;extdecl;external mysqllib name 'mysql_slave_send_query';
     function mysql_slave_send_query(mysql:PMYSQL; q:Pchar; length:culong):my_bool;extdecl;external mysqllib name 'mysql_slave_send_query';
-{$IFDEF mysql50}
-    procedure mysql_get_character_set_info(mysql : PMYSQL; charset : PMY_CHARSET_INFO);extdecl;external mysqllib name 'mysql_get_character_set_info';
-{$ENDIF}
 {$ENDIF}
 {$ENDIF}
 
 
     { local infile support  }
     { local infile support  }
@@ -1696,6 +1749,9 @@ uses
       mysql_options: function (mysql:PMYSQL; option:mysql_option; arg:Pchar):cint;extdecl;
       mysql_options: function (mysql:PMYSQL; option:mysql_option; arg:Pchar):cint;extdecl;
 {$IFDEF mysql56}
 {$IFDEF mysql56}
       mysql_options4: function (mysql:PMYSQL; option:mysql_option; arg1,arg2:Pointer):cint;extdecl;
       mysql_options4: function (mysql:PMYSQL; option:mysql_option; arg1,arg2:Pointer):cint;extdecl;
+ {$IFDEF mysql57}
+      mysql_get_option: function (mysql:PMYSQL; option:mysql_option; arg:Pointer):cint;extdecl;
+ {$ENDIF}
 {$ENDIF}
 {$ENDIF}
       mysql_free_result: procedure (result:PMYSQL_RES);extdecl;
       mysql_free_result: procedure (result:PMYSQL_RES);extdecl;
       mysql_data_seek: procedure (result:PMYSQL_RES; offset:my_ulonglong);extdecl;
       mysql_data_seek: procedure (result:PMYSQL_RES; offset:my_ulonglong);extdecl;
@@ -1708,6 +1764,10 @@ uses
       mysql_escape_string: function (fto:Pchar; from:Pchar; from_length:culong):culong;extdecl;
       mysql_escape_string: function (fto:Pchar; from:Pchar; from_length:culong):culong;extdecl;
       mysql_hex_string: function (fto:Pchar; from:Pchar; from_length:culong):culong;extdecl;
       mysql_hex_string: function (fto:Pchar; from:Pchar; from_length:culong):culong;extdecl;
       mysql_real_escape_string: function (mysql:PMYSQL; fto:Pchar; from:Pchar; length:culong):culong;extdecl;
       mysql_real_escape_string: function (mysql:PMYSQL; fto:Pchar; from:Pchar; length:culong):culong;extdecl;
+{$IFDEF mysql57}
+      mysql_real_escape_string_quote: function(mysql:PMYSQL; fto:pcchar; from:pcchar; length:culong; quote: cchar):culong;extdecl;
+      mysql_reset_connection: function(mysql:PMYSQL):cint;extdecl;
+{$ENDIF}
       mysql_debug: procedure (debug:Pchar);extdecl;
       mysql_debug: procedure (debug:Pchar);extdecl;
 
 
       mysql_rollback: function (mysql:PMYSQL):my_bool;extdecl;
       mysql_rollback: function (mysql:PMYSQL):my_bool;extdecl;
@@ -1757,16 +1817,8 @@ uses
 
 
     function mysql_reload(mysql : PMySQL) : cint;
     function mysql_reload(mysql : PMySQL) : cint;
 
 
-{$IFNDEF LinkDynamically}
-{$ifdef USE_OLD_FUNCTIONS}
-    function mysql_connect(mysql:PMYSQL; host:Pchar; user:Pchar; passwd:Pchar):PMYSQL;extdecl;external External_library name 'mysql_connect';
-    function mysql_create_db(mysql:PMYSQL; DB:Pchar):cint;extdecl;external External_library name 'mysql_create_db';
-    function mysql_drop_db(mysql:PMYSQL; DB:Pchar):cint;extdecl;external External_library name 'mysql_drop_db';
-    function mysql_reload(mysql : PMySQL) : cint;
-{$endif}
-{$endif}
+{$define HAVE_MYSQL_REAL_CONNECT}
 
 
-{$define HAVE_MYSQL_REAL_CONNECT}    
     { The following functions are mainly exported because of mysqlbinlog;
     { The following functions are mainly exported because of mysqlbinlog;
       They are not for general usage     }
       They are not for general usage     }
 
 
@@ -1775,9 +1827,6 @@ uses
     function net_safe_read(mysql:PMYSQL):cuint;cdecl;external mysqllib name 'net_safe_read';
     function net_safe_read(mysql:PMYSQL):cuint;cdecl;external mysqllib name 'net_safe_read';
 {$ENDIF}
 {$ENDIF}
 
 
-{$ifdef NETWARE}
-(** unsupported pragma#pragma pack(pop)		/* restore alignment */*)
-{$endif}
 
 
 {$IFDEF LinkDynamically}
 {$IFDEF LinkDynamically}
 Function InitialiseMysql(Const LibraryName : AnsiString) : Integer;
 Function InitialiseMysql(Const LibraryName : AnsiString) : Integer;
@@ -1812,6 +1861,7 @@ begin
       Exit;
       Exit;
     Inc(RefCount);
     Inc(RefCount);
     MysqlLoadedLibrary:=LibraryName;
     MysqlLoadedLibrary:=LibraryName;
+
 // Only the procedure that are given in the c-library documentation are loaded, to
 // Only the procedure that are given in the c-library documentation are loaded, to
 // avoid problems with 'incomplete' libraries
 // avoid problems with 'incomplete' libraries
     pointer(my_init) := GetProcedureAddress(MysqlLibraryHandle,'my_init');
     pointer(my_init) := GetProcedureAddress(MysqlLibraryHandle,'my_init');
@@ -1821,13 +1871,9 @@ begin
     pointer(mysql_affected_rows) := GetProcedureAddress(MysqlLibraryHandle,'mysql_affected_rows');
     pointer(mysql_affected_rows) := GetProcedureAddress(MysqlLibraryHandle,'mysql_affected_rows');
     pointer(mysql_autocommit) := GetProcedureAddress(MysqlLibraryHandle,'mysql_autocommit');
     pointer(mysql_autocommit) := GetProcedureAddress(MysqlLibraryHandle,'mysql_autocommit');
     pointer(mysql_change_user) := GetProcedureAddress(MysqlLibraryHandle,'mysql_change_user');
     pointer(mysql_change_user) := GetProcedureAddress(MysqlLibraryHandle,'mysql_change_user');
-//    pointer(mysql_charset_name) := GetProcedureAddress(MysqlLibraryHandle,'mysql_charset_name');
     pointer(mysql_close) := GetProcedureAddress(MysqlLibraryHandle,'mysql_close');
     pointer(mysql_close) := GetProcedureAddress(MysqlLibraryHandle,'mysql_close');
     pointer(mysql_commit) := GetProcedureAddress(MysqlLibraryHandle,'mysql_commit');
     pointer(mysql_commit) := GetProcedureAddress(MysqlLibraryHandle,'mysql_commit');
-//    pointer(mysql_connect) := GetProcedureAddress(MysqlLibraryHandle,'mysql_connect');
-//    pointer(mysql_create_db) := GetProcedureAddress(MysqlLibraryHandle,'mysql_create_db');
     pointer(mysql_data_seek) := GetProcedureAddress(MysqlLibraryHandle,'mysql_data_seek');
     pointer(mysql_data_seek) := GetProcedureAddress(MysqlLibraryHandle,'mysql_data_seek');
-//    pointer(mysql_drop_db) := GetProcedureAddress(MysqlLibraryHandle,'mysql_drop_db');
     pointer(mysql_debug) := GetProcedureAddress(MysqlLibraryHandle,'mysql_debug');
     pointer(mysql_debug) := GetProcedureAddress(MysqlLibraryHandle,'mysql_debug');
     pointer(mysql_dump_debug_info) := GetProcedureAddress(MysqlLibraryHandle,'mysql_dump_debug_info');
     pointer(mysql_dump_debug_info) := GetProcedureAddress(MysqlLibraryHandle,'mysql_dump_debug_info');
     pointer(mysql_eof) := GetProcedureAddress(MysqlLibraryHandle,'mysql_eof');
     pointer(mysql_eof) := GetProcedureAddress(MysqlLibraryHandle,'mysql_eof');
@@ -1870,7 +1916,6 @@ begin
     pointer(mysql_real_escape_string) := GetProcedureAddress(MysqlLibraryHandle,'mysql_real_escape_string');
     pointer(mysql_real_escape_string) := GetProcedureAddress(MysqlLibraryHandle,'mysql_real_escape_string');
     pointer(mysql_real_query) := GetProcedureAddress(MysqlLibraryHandle,'mysql_real_query');
     pointer(mysql_real_query) := GetProcedureAddress(MysqlLibraryHandle,'mysql_real_query');
     pointer(mysql_refresh) := GetProcedureAddress(MysqlLibraryHandle,'mysql_refresh');
     pointer(mysql_refresh) := GetProcedureAddress(MysqlLibraryHandle,'mysql_refresh');
-//    pointer(mysql_reload) := GetProcedureAddress(MysqlLibraryHandle,'mysql_reload');
     pointer(mysql_rollback) := GetProcedureAddress(MysqlLibraryHandle,'mysql_rollback');
     pointer(mysql_rollback) := GetProcedureAddress(MysqlLibraryHandle,'mysql_rollback');
     pointer(mysql_row_seek) := GetProcedureAddress(MysqlLibraryHandle,'mysql_row_seek');
     pointer(mysql_row_seek) := GetProcedureAddress(MysqlLibraryHandle,'mysql_row_seek');
     pointer(mysql_row_tell) := GetProcedureAddress(MysqlLibraryHandle,'mysql_row_tell');
     pointer(mysql_row_tell) := GetProcedureAddress(MysqlLibraryHandle,'mysql_row_tell');
@@ -1884,7 +1929,6 @@ begin
     pointer(mysql_stat) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stat');
     pointer(mysql_stat) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stat');
     pointer(mysql_store_result) := GetProcedureAddress(MysqlLibraryHandle,'mysql_store_result');
     pointer(mysql_store_result) := GetProcedureAddress(MysqlLibraryHandle,'mysql_store_result');
     pointer(mysql_thread_id) := GetProcedureAddress(MysqlLibraryHandle,'mysql_thread_id');
     pointer(mysql_thread_id) := GetProcedureAddress(MysqlLibraryHandle,'mysql_thread_id');
-//    pointer(mysql_thread_save) := GetProcedureAddress(MysqlLibraryHandle,'mysql_thread_save');
     pointer(mysql_use_result) := GetProcedureAddress(MysqlLibraryHandle,'mysql_use_result');
     pointer(mysql_use_result) := GetProcedureAddress(MysqlLibraryHandle,'mysql_use_result');
     pointer(mysql_warning_count) := GetProcedureAddress(MysqlLibraryHandle,'mysql_warning_count');
     pointer(mysql_warning_count) := GetProcedureAddress(MysqlLibraryHandle,'mysql_warning_count');
     pointer(mysql_stmt_init) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_init');
     pointer(mysql_stmt_init) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_init');
@@ -1915,6 +1959,10 @@ begin
     pointer(mysql_stmt_insert_id) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_insert_id');
     pointer(mysql_stmt_insert_id) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_insert_id');
     pointer(mysql_stmt_field_count) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_field_count');
     pointer(mysql_stmt_field_count) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_field_count');
     pointer(mysql_stmt_next_result) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_next_result');
     pointer(mysql_stmt_next_result) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_next_result');
+{$IFDEF mysql57}
+    pointer(mysql_real_escape_string_quote) := GetProcedureAddress(MysqlLibraryHandle,'mysql_real_escape_string_quote');
+    pointer(mysql_reset_connection) := GetProcedureAddress(MysqlLibraryHandle,'mysql_reset_connection');
+{$ENDIF}
 
 
     if mysql_library_init(argc, argv, groups) <> 0 then
     if mysql_library_init(argc, argv, groups) <> 0 then
       Exit;
       Exit;

+ 12 - 0
packages/mysql/src/mysql57dyn.pp

@@ -0,0 +1,12 @@
+{
+  Contains the MySQL calls for MySQL 5.7
+}
+
+unit mysql57dyn;
+
+{$DEFINE LinkDynamically}
+{$DEFINE MYSQL57}
+
+{$i mysql.inc}
+
+end.