paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 18:09:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

* adds new virtual method GetConnectionInfo into TSQLConnection

Browse Source 
(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 -
This commit is contained in:
lacak 2012-10-31 09:13:32 +00:00
parent 1dfbc377e5
commit d338b2c63b
5 changed files with 162 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
View File

@ -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);

29
packages/fcl-db/src/sqldb/odbc/odbcconn.pas
View File

@ -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;

52
packages/fcl-db/src/sqldb/postgres/pqconnection.pp
View File

@ -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;

29
packages/fcl-db/src/sqldb/sqldb.pp
View File

@ -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

32
packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
View File

@ -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);