* adds new virtual method GetConnectionInfo into TSQLConnection

  (allows retrieval of various connection related informations like type and version of DBMS, name and version of client library)
* implements this method for MySQL, PostgreSQL, SQLite, ODBC
Patch by DB-Core team

git-svn-id: trunk@22886 -

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

@@ -121,6 +121,7 @@ Type
     constructor Create(AOwner : TComponent); override;
     procedure GetFieldNames(const TableName : string; List :  TStrings); override;
     procedure GetTableNames(List : TStrings; SystemTables : Boolean = false); override;
+    function GetConnectionInfo(InfoType:TConnInfoType): string; override;
     procedure CreateDB; override;
     procedure DropDB; override;
     Property ServerInfo : String Read FServerInfo;
@@ -146,6 +147,7 @@ Type
     Class Function DefaultLibraryName : String; override;
     Class Function LoadFunction : TLibraryLoadFunction; override;
     Class Function UnLoadFunction : TLibraryUnLoadFunction; override;
+    Class Function LoadedLibraryName : string; override;
   end;
 
 
@@ -1104,6 +1106,32 @@ begin
   GetDBInfo(stTables,'','tables_in_'+DatabaseName,List)
 end;
 
+function TConnectionName.GetConnectionInfo(InfoType: TConnInfoType): string;
+begin
+  Result:='';
+  try
+    InitialiseMysql;
+    case InfoType of
+      citServerType:
+        Result:='MySQL';
+      citServerVersion:
+        if Connected then
+          Result:=format('%6.6d', [mysql_get_server_version(FMySQL)]);
+      citServerVersionString:
+        if Connected then
+          Result:=mysql_get_server_info(FMySQL);
+      citClientVersion:
+        Result:=format('%6.6d', [mysql_get_client_version()]);
+      citClientName:
+        Result:=TMySQLConnectionDef.LoadedLibraryName;
+      else
+        Result:=inherited GetConnectionInfo(InfoType);
+    end;
+  finally
+    ReleaseMysql;
+  end;
+end;
+
 function TConnectionName.GetTransactionHandle(trans: TSQLHandle): pointer;
 begin
   Result:=Nil;
@@ -1214,7 +1242,7 @@ end;
 
 class function TMySQLConnectionDef.LoadFunction: TLibraryLoadFunction;
 begin
-  Result:=@initialisemysql;
+  Result:=@InitialiseMySQL;
 end;
 
 class function TMySQLConnectionDef.UnLoadFunction: TLibraryUnLoadFunction;
@@ -1222,6 +1250,11 @@ begin
   Result:=@ReleaseMySQL;
 end;
 
+class function TMySQLConnectionDef.LoadedLibraryName: string;
+begin
+  Result:=MysqlLoadedLibrary;
+end;
+
 {$IfDef mysql55}
   initialization
     RegisterConnection(TMySQL55ConnectionDef);

packages/fcl-db/src/sqldb/odbc/odbcconn.pas

@@ -112,6 +112,7 @@ type
     function CreateConnectionString:string;
   public
     constructor Create(AOwner : TComponent); override;
+    function GetConnectionInfo(InfoType:TConnInfoType): string; override;
     property Environment:TODBCEnvironment read FEnvironment;
   published
     property Driver:string read FDriver write FDriver;    // will be passed as DRIVER connection parameter
@@ -149,7 +150,7 @@ type
 implementation
 
 uses
-  Math, DBConst, ctypes;
+  DBConst, ctypes;
 
 const
   DefaultEnvironment:TODBCEnvironment = nil;
@@ -1412,6 +1413,32 @@ begin
     DatabaseError(SMetadataUnavailable);
 end;
 
+function TODBCConnection.GetConnectionInfo(InfoType: TConnInfoType): string;
+var i,l: SQLSMALLINT;
+    b: array[0..41] of AnsiChar;
+begin
+  case InfoType of
+    citServerType:
+      i:=17{SQL_DBMS_NAME};
+    citServerVersion,
+    citServerVersionString:
+      i:=18{SQL_DBMS_VER};
+    citClientName:
+      i:=6{SQL_DRIVER_NAME};
+    citClientVersion:
+      i:=7{SQL_DRIVER_VER};
+  else
+    Result:=inherited GetConnectionInfo(InfoType);
+    Exit;
+  end;
+
+  if Connected and (SQLGetInfo(FDBCHandle, i, @b, sizeof(b), @l) = SQL_SUCCESS) then
+    SetString(Result, @b, l)
+  else
+    Result:='';
+end;
+
+
 { TODBCEnvironment }
 
 constructor TODBCEnvironment.Create;

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

@@ -80,6 +80,7 @@ type
     function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
   public
     constructor Create(AOwner : TComponent); override;
+    function GetConnectionInfo(InfoType:TConnInfoType): string; override;
     procedure CreateDB; override;
     procedure DropDB; override;
   published
@@ -99,6 +100,7 @@ type
     Class Function DefaultLibraryName : String; override;
     Class Function LoadFunction : TLibraryLoadFunction; override;
     Class Function UnLoadFunction : TLibraryUnLoadFunction; override;
+    Class Function LoadedLibraryName: string; override;
   end;
 
 implementation
@@ -334,7 +336,7 @@ begin
     end;
 // This does only work for pg>=8.0, so timestamps won't work with earlier versions of pg which are compiled with integer_datetimes on
   if PQparameterStatus<>nil then
-    FIntegerDatetimes := pqparameterstatus(FSQLDatabaseHandle,'integer_datetimes') = 'on';
+    FIntegerDateTimes := PQparameterStatus(FSQLDatabaseHandle,'integer_datetimes') = 'on';
 end;
 
 procedure TPQConnection.DoInternalDisconnect;
@@ -864,7 +866,7 @@ begin
         ftDateTime, ftTime :
           begin
           dbl := pointer(buffer);
-          if FIntegerDatetimes then
+          if FIntegerDateTimes then
             dbl^ := BEtoN(pint64(CurrBuff)^) / 1000000
           else
             pint64(dbl)^ := BEtoN(pint64(CurrBuff)^);
@@ -1074,11 +1076,38 @@ begin
     Result := -1;
 end;
 
+function TPQConnection.GetConnectionInfo(InfoType: TConnInfoType): string;
+begin
+  Result:='';
+  try
+    {$IFDEF LinkDynamically}
+    InitialisePostgres3;
+    {$ENDIF}
+    case InfoType of
+      citServerType:
+        Result:=TPQConnectionDef.TypeName;
+      citServerVersion,
+      citServerVersionString:
+        if Connected then
+          Result:=format('%6.6d', [PQserverVersion(FSQLDatabaseHandle)]);
+      citClientName:
+        Result:=TPQConnectionDef.LoadedLibraryName;
+    else
+      Result:=inherited GetConnectionInfo(InfoType);
+    end;
+  finally
+    {$IFDEF LinkDynamically}
+    ReleasePostgres3;
+    {$ENDIF}
+  end;
+end;
+
+
 { TPQConnectionDef }
 
 class function TPQConnectionDef.TypeName: String;
 begin
-  Result:='PostGreSQL';
+  Result:='PostgreSQL';
 end;
 
 class function TPQConnectionDef.ConnectionClass: TSQLConnectionClass;
@@ -1088,7 +1117,7 @@ end;
 
 class function TPQConnectionDef.Description: String;
 begin
-  Result:='Connect to a PostGreSQL database directly via the client library';
+  Result:='Connect to a PostgreSQL database directly via the client library';
 end;
 
 class function TPQConnectionDef.DefaultLibraryName: String;
@@ -1096,7 +1125,7 @@ begin
   {$IfDef LinkDynamically}
   Result:=pqlib;
   {$else}
-  result:='';
+  Result:='';
   {$endif}
 end;
 
@@ -1105,7 +1134,7 @@ begin
   {$IfDef LinkDynamically}
   Result:=@InitialisePostgres3;
   {$else}
-  result:=Nil;
+  Result:=Nil;
   {$endif}
 end;
 
@@ -1114,7 +1143,16 @@ begin
   {$IfDef LinkDynamically}
   Result:=@ReleasePostgres3;
   {$else}
-  result:=Nil;
+  Result:=Nil;
+  {$endif}
+end;
+
+class function TPQConnectionDef.LoadedLibraryName: string;
+begin
+  {$IfDef LinkDynamically}
+  Result:=Postgres3LoadedLibrary;
+  {$else}
+  Result:='';
   {$endif}
 end;
 

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

@@ -25,6 +25,7 @@ uses SysUtils, Classes, DB, bufdataset, sqlscript;
 type TSchemaType = (stNoSchema, stTables, stSysTables, stProcedures, stColumns, stProcedureParams, stIndexes, stPackages);
      TConnOption = (sqSupportParams,sqEscapeSlash,sqEscapeRepeat);
      TConnOptions= set of TConnOption;
+     TConnInfoType=(citAll=-1, citServerType, citServerVersion, citServerVersionString, citClientName, citClientVersion);
 
      TRowsCount = LargeInt;
 
@@ -96,9 +97,8 @@ type
     FCharSet             : string;
     FRole                : String;
 
-
     function GetPort: cardinal;
-    procedure Setport(const AValue: cardinal);
+    procedure SetPort(const AValue: cardinal);
   protected
     FConnOptions         : TConnOptions;
     FSQLFormatSettings : TFormatSettings;
@@ -134,7 +134,7 @@ type
     function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual;
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); virtual; abstract;
     function RowsAffected(cursor: TSQLCursor): TRowsCount; virtual;
-    property port: cardinal read GetPort write Setport;
+    property Port: cardinal read GetPort write SetPort;
   public
     property Handle: Pointer read GetHandle;
     property FieldNameQuoteChars: TQuoteChars read FFieldNameQuoteChars write FFieldNameQuoteChars;
@@ -147,7 +147,8 @@ type
     procedure ExecuteDirect(SQL : String; ATransaction : TSQLTransaction); overload; virtual;
     procedure GetTableNames(List : TStrings; SystemTables : Boolean = false); virtual;
     procedure GetProcedureNames(List : TStrings); virtual;
-    procedure GetFieldNames(const TableName : string; List :  TStrings); virtual;
+    procedure GetFieldNames(const TableName : string; List : TStrings); virtual;
+    function GetConnectionInfo(InfoType:TConnInfoType): string; virtual;
     procedure CreateDB; virtual;
     procedure DropDB; virtual;
   published
@@ -483,6 +484,7 @@ type
     Class Function DefaultLibraryName : String; virtual;
     Class Function LoadFunction : TLibraryLoadFunction; virtual;
     Class Function UnLoadFunction : TLibraryUnLoadFunction; virtual;
+    Class Function LoadedLibraryName : string; virtual;
     Procedure ApplyParams(Params : TStrings; AConnection : TSQLConnection); virtual;
   end;
   TConnectionDefClass = class of TConnectionDef;
@@ -638,7 +640,7 @@ begin
   result := StrToIntDef(Params.Values['Port'],0);
 end;
 
-procedure TSQLConnection.Setport(const AValue: cardinal);
+procedure TSQLConnection.SetPort(const AValue: cardinal);
 begin
   if AValue<>0 then
     params.Values['Port']:=IntToStr(AValue)
@@ -701,6 +703,18 @@ begin
   GetDBInfo(stColumns,TableName,'column_name',List);
 end;
 
+function TSQLConnection.GetConnectionInfo(InfoType: TConnInfoType): string;
+var i: TConnInfoType;
+begin
+  Result:='';
+  if InfoType = citAll then
+    for i:=citServerType to citClientVersion do
+      begin
+      if Result<>'' then Result:=Result+',';
+      Result:=Result+'"'+GetConnectionInfo(i)+'"';
+      end;
+end;
+
 function TSQLConnection.GetAsSQLText(Field : TField) : string;
 
 begin
@@ -2258,6 +2272,11 @@ begin
   Result:=Nil;
 end;
 
+class function TConnectionDef.LoadedLibraryName: string;
+begin
+  Result:='';
+end;
+
 procedure TConnectionDef.ApplyParams(Params: TStrings;
   AConnection: TSQLConnection);
 begin

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

@@ -92,8 +92,9 @@ type
     function StrToStatementType(s : string) : TStatementType; override;
   public
     constructor Create(AOwner : TComponent); override;
-    function GetInsertID: int64;
     procedure GetFieldNames(const TableName : string; List :  TStrings); override;
+    function GetConnectionInfo(InfoType:TConnInfoType): string; override;
+    function GetInsertID: int64;
     // See http://www.sqlite.org/c3ref/create_collation.html for detailed information
     // If eTextRep=0 a default UTF-8 compare function is used (UTF8CompareCallback)
     // Warning: UTF8CompareCallback needs a wide string manager on linux such as cwstring
@@ -110,6 +111,7 @@ type
     class function TypeName: string; override;
     class function ConnectionClass: TSQLConnectionClass; override;
     class function Description: string; override;
+    class function LoadedLibraryName: string; override;
   end;
   
 Var
@@ -926,6 +928,29 @@ begin
   GetDBInfo(stColumns,TableName,'name',List);
 end;
 
+function TSQLite3Connection.GetConnectionInfo(InfoType: TConnInfoType): string;
+begin
+  Result:='';
+  try
+    InitializeSqlite;
+    case InfoType of
+      citServerType:
+        Result:=TSQLite3ConnectionDef.TypeName;
+      citServerVersion,
+      citClientVersion:
+        Result:=inttostr(sqlite3_libversion_number());
+      citServerVersionString:
+        Result:=sqlite3_libversion();
+      citClientName:
+        Result:=TSQLite3ConnectionDef.LoadedLibraryName;
+    else
+      Result:=inherited GetConnectionInfo(InfoType);
+    end;
+  finally
+    ReleaseSqlite;
+  end;
+end;
+
 function UTF8CompareCallback(user: pointer; len1: longint; data1: pointer; len2: longint; data2: pointer): longint; cdecl;
 var S1, S2: AnsiString;
 begin
@@ -997,6 +1022,11 @@ begin
   Result := 'Connect to a SQLite3 database directly via the client library';
 end;
 
+class function TSQLite3ConnectionDef.LoadedLibraryName: string;
+begin
+  Result := SQLiteLoadedLibrary;
+end;
+
 initialization
   RegisterConnection(TSQLite3ConnectionDef);