Browse Source

--- Merging r22886 into '.':
U packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
U packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
U packages/fcl-db/src/sqldb/postgres/pqconnection.pp
U packages/fcl-db/src/sqldb/odbc/odbcconn.pas
U packages/fcl-db/src/sqldb/sqldb.pp
--- Merging r22919 into '.':
U packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
--- Merging r22934 into '.':
G packages/fcl-db/src/sqldb/postgres/pqconnection.pp
U packages/fcl-db/src/sqldb/interbase/fbadmin.pp
--- Merging r22935 into '.':
U packages/fcl-db/src/base/bufdataset.pas
U packages/fcl-db/src/base/fields.inc
G packages/fcl-db/src/sqldb/odbc/odbcconn.pas
G packages/fcl-db/src/sqldb/sqldb.pp
G packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
--- Merging r22939 into '.':
U packages/fcl-db/src/base/datasource.inc
U packages/fcl-db/src/base/db.pas

# revisions: 22886,22919,22934,22935,22939
r22886 | lacak | 2012-10-31 10:13:32 +0100 (Wed, 31 Oct 2012) | 4 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas
M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp
M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

* 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
r22919 | lacak | 2012-11-02 12:10:33 +0100 (Fri, 02 Nov 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/mssql/mssqlconn.pp

fcl-db: implemented GetConnectionInfo for TMSSQLConnection
(basic support, more options later)
r22934 | reiniero | 2012-11-05 08:00:12 +0100 (Mon, 05 Nov 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/interbase/fbadmin.pp
M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp

* FCL-DB: cosmetic changes in comments
r22935 | ludob | 2012-11-05 16:23:15 +0100 (Mon, 05 Nov 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/bufdataset.pas
M /trunk/packages/fcl-db/src/base/fields.inc
M /trunk/packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp

sqldb: Modified ftAutoinc behavior slightly to match Delphi behavior and allow updating of ftAutoInc fields for those db backends that support it. Added support for odbc ReadOnly fields. Patch from Lacak2 Mantis #22531
r22939 | lacak | 2012-11-06 10:29:22 +0100 (Tue, 06 Nov 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/datasource.inc
M /trunk/packages/fcl-db/src/base/db.pas

fcl-db: formatting

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

marco 12 years ago
parent
commit
169d1e760b

+ 1 - 12
packages/fcl-db/src/base/bufdataset.pas

@@ -2203,8 +2203,6 @@ Var ABuff        : TRecordBuffer;
     i            : integer;
     i            : integer;
     blobbuf      : tbufblobfield;
     blobbuf      : tbufblobfield;
     NullMask     : pbyte;
     NullMask     : pbyte;
-    li           : longint;
-    StoreReadOnly: boolean;
     ABookmark    : PBufBookmark;
     ABookmark    : PBufBookmark;
 
 
 begin
 begin
@@ -2227,16 +2225,7 @@ begin
     begin
     begin
     if assigned(FAutoIncField) then
     if assigned(FAutoIncField) then
       begin
       begin
-      li := FAutoIncValue;
-      // In principle all TAutoIncfields are read-only, but in theory it is
-      // possible to set readonly to false.
-      StoreReadOnly:=FAutoIncField.ReadOnly;
-      FAutoIncField.ReadOnly:=false;
-      try
-        FAutoIncField.SetData(@li);
-      finally
-        FAutoIncField.ReadOnly:=FAutoIncField.ReadOnly;
-      end;
+      FAutoIncField.AsInteger := FAutoIncValue;
       inc(FAutoIncValue);
       inc(FAutoIncValue);
       end;
       end;
 
 

+ 2 - 2
packages/fcl-db/src/base/datasource.inc

@@ -429,7 +429,7 @@ begin
 end;
 end;
 
 
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
-    TMasterDataLink
+    TMasterParamsDataLink
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
 constructor TMasterParamsDataLink.Create(ADataSet: TDataSet);
 constructor TMasterParamsDataLink.Create(ADataSet: TDataSet);
@@ -448,7 +448,7 @@ begin
 end;
 end;
 
 
 
 
-Procedure TMasterParamsDataLink.SetParams(AVAlue : TParams);  
+Procedure TMasterParamsDataLink.SetParams(AValue : TParams);
 
 
 begin
 begin
   FParams:=AValue;
   FParams:=AValue;

+ 19 - 17
packages/fcl-db/src/base/db.pas

@@ -1756,6 +1756,22 @@ type
     property OnMasterDisable: TNotifyEvent read FOnMasterDisable write FOnMasterDisable;
     property OnMasterDisable: TNotifyEvent read FOnMasterDisable write FOnMasterDisable;
   end;
   end;
 
 
+{ TMasterParamsDataLink }
+
+  TMasterParamsDataLink = Class(TMasterDataLink)
+  Private
+    FParams : TParams;
+    Procedure SetParams(AVAlue : TParams);
+  Protected
+    Procedure DoMasterDisable; override;
+    Procedure DoMasterChange; override;
+  Public
+    constructor Create(ADataSet: TDataSet); override;
+    Procedure RefreshParamNames; virtual;
+    Procedure CopyParamsFromMaster(CopyBound : Boolean); virtual;
+    Property Params : TParams Read FParams Write SetParams;
+  end;
+
 { TDataSource }
 { TDataSource }
 
 
   TDataChangeEvent = procedure(Sender: TObject; Field: TField) of object;
   TDataChangeEvent = procedure(Sender: TObject; Field: TField) of object;
@@ -1796,7 +1812,7 @@ type
     property OnUpdateData: TNotifyEvent read FOnUpdateData write FOnUpdateData;
     property OnUpdateData: TNotifyEvent read FOnUpdateData write FOnUpdateData;
   end;
   end;
 
 
- { TDBDataset }
+  { TDBDataset }
 
 
   TDBDatasetClass = Class of TDBDataset;
   TDBDatasetClass = Class of TDBDataset;
   TDBDataset = Class(TDataset)
   TDBDataset = Class(TDataset)
@@ -1813,7 +1829,7 @@ type
       Property Transaction : TDBTransaction Read FTransaction Write SetTransaction;
       Property Transaction : TDBTransaction Read FTransaction Write SetTransaction;
     end;
     end;
 
 
- { TDBTransaction }
+  { TDBTransaction }
 
 
   TDBTransactionClass = Class of TDBTransaction;
   TDBTransactionClass = Class of TDBTransaction;
   TDBTransaction = Class(TComponent)
   TDBTransaction = Class(TComponent)
@@ -1848,7 +1864,7 @@ type
     property Active : boolean read FActive write setactive;
     property Active : boolean read FActive write setactive;
   end;
   end;
 
 
-    { TCustomConnection }
+  { TCustomConnection }
 
 
   TLoginEvent = procedure(Sender: TObject; Username, Password: string) of object;
   TLoginEvent = procedure(Sender: TObject; Username, Password: string) of object;
 
 
@@ -1947,20 +1963,6 @@ type
   end;
   end;
 
 
 
 
-  TMasterParamsDataLink = Class(TMasterDataLink)
-  Private
-    FParams : TParams;
-    Procedure SetParams(AVAlue : TParams);  
-  Protected  
-    Procedure DoMasterDisable; override;
-    Procedure DoMasterChange; override;
-  Public
-    constructor Create(ADataSet: TDataSet); override;
-    Procedure RefreshParamNames; virtual;
-    Procedure CopyParamsFromMaster(CopyBound : Boolean); virtual;
-    Property Params : TParams Read FParams Write SetParams;  
-  end;
-
 const
 const
   FieldTypetoVariantMap : array[TFieldType] of Integer = (varError, varOleStr, varSmallint,
   FieldTypetoVariantMap : array[TFieldType] of Integer = (varError, varOleStr, varSmallint,
     varInteger, varSmallint, varBoolean, varDouble, varCurrency, varCurrency,
     varInteger, varSmallint, varBoolean, varDouble, varCurrency, varCurrency,

+ 2 - 4
packages/fcl-db/src/base/fields.inc

@@ -1750,8 +1750,6 @@ constructor TAutoIncField.Create(AOwner: TComponent);
 begin
 begin
   Inherited Create(AOWner);
   Inherited Create(AOWner);
   SetDataType(ftAutoInc);
   SetDataType(ftAutoInc);
-  FReadOnly:=True;
-  FProviderFlags:=FProviderFlags-[pfInUpdate];
 end;
 end;
 
 
 Procedure TAutoIncField.SetAsLongint(AValue : Longint);
 Procedure TAutoIncField.SetAsLongint(AValue : Longint);
@@ -1760,8 +1758,8 @@ begin
   // Some databases allows insertion of explicit values into identity columns
   // Some databases allows insertion of explicit values into identity columns
   // (some of them also allows (some not) updating identity columns)
   // (some of them also allows (some not) updating identity columns)
   // So allow it at client side and leave check for server side
   // So allow it at client side and leave check for server side
-  if not(FDataSet.State in [dsFilter,dsSetKey,dsInsert]) then
-    DataBaseError(SCantSetAutoIncFields);
+  //if not(FDataSet.State in [dsFilter,dsSetKey,dsInsert]) then
+  //  DataBaseError(SCantSetAutoIncFields);
   inherited;
   inherited;
 end;
 end;
 
 

+ 2 - 2
packages/fcl-db/src/sqldb/interbase/fbadmin.pp

@@ -93,7 +93,7 @@ type
   public
   public
     constructor Create(AOwner: TComponent); override;
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     destructor Destroy; override;
-    //Connect to service manage. Specify User,Password and, for remote databases,
+    //Connect to service manager. Specify User,Password and, for remote databases,
     //Host and, if not standard, Port
     //Host and, if not standard, Port
     function Connect:boolean;
     function Connect:boolean;
     //Disconnect from service manager. Done automatically when destroying component
     //Disconnect from service manager. Done automatically when destroying component
@@ -158,7 +158,7 @@ type
     property Port: word read FPort write FPort default 3050;
     property Port: word read FPort write FPort default 3050;
     //Protocol used to connect to service manager. One of:
     //Protocol used to connect to service manager. One of:
     //IBSPLOCAL: Host and port ignored
     //IBSPLOCAL: Host and port ignored
-    //IBSPTCPIP: Connectoct to Host:Port
+    //IBSPTCPIP: Connect to Host:Port
     //IBSPNETBEUI: Connect to \\Host\
     //IBSPNETBEUI: Connect to \\Host\
     //IBSPNAMEDPIPE: Connect to //Host/
     //IBSPNAMEDPIPE: Connect to //Host/
     property Protocol: TServiceProtocol read FProtocol write FProtocol;
     property Protocol: TServiceProtocol read FProtocol write FProtocol;

+ 44 - 2
packages/fcl-db/src/sqldb/mssql/mssqlconn.pp

@@ -98,6 +98,7 @@ type
     function GetSchemaInfoSQL(SchemaType:TSchemaType; SchemaObjectName, SchemaObjectPattern:string):string; override;
     function GetSchemaInfoSQL(SchemaType:TSchemaType; SchemaObjectName, SchemaObjectPattern:string):string; override;
   public
   public
     constructor Create(AOwner : TComponent); override;
     constructor Create(AOwner : TComponent); override;
+    function GetConnectionInfo(InfoType:TConnInfoType): string; override;
     procedure CreateDB; override;
     procedure CreateDB; override;
     procedure DropDB; override;
     procedure DropDB; override;
     //property TDS:integer read Ftds;
     //property TDS:integer read Ftds;
@@ -138,11 +139,15 @@ type
     Class Function TypeName : String; override;
     Class Function TypeName : String; override;
     Class Function ConnectionClass : TSQLConnectionClass; override;
     Class Function ConnectionClass : TSQLConnectionClass; override;
     Class Function Description : String; override;
     Class Function Description : String; override;
+    Class Function DefaultLibraryName : String; override;
+    Class Function LoadFunction : TLibraryLoadFunction; override;
+    Class Function UnLoadFunction : TLibraryUnLoadFunction; override;
+    Class Function LoadedLibraryName: string; override;
   end;
   end;
 
 
   { TSybaseConnectionDef }
   { TSybaseConnectionDef }
 
 
-  TSybaseConnectionDef = Class(TConnectionDef)
+  TSybaseConnectionDef = Class(TMSSQLConnectionDef)
     Class Function TypeName : String; override;
     Class Function TypeName : String; override;
     Class Function ConnectionClass : TSQLConnectionClass; override;
     Class Function ConnectionClass : TSQLConnectionClass; override;
     Class Function Description : String; override;
     Class Function Description : String; override;
@@ -638,7 +643,8 @@ begin
 }
 }
     with TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(FieldName), FieldType, FieldSize, (col.Null=0) and (not col.Identity), i) do
     with TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(FieldName), FieldType, FieldSize, (col.Null=0) and (not col.Identity), i) do
     begin
     begin
-      //if col.Updatable = 0 then Attributes := Attributes + [faReadonly];
+      // identity, timestamp and calculated column are not updatable
+      if col.Updatable = 0 then Attributes := Attributes + [faReadonly];
       case FieldType of
       case FieldType of
         ftBCD,
         ftBCD,
         ftFmtBCD: Precision := col.Precision;
         ftFmtBCD: Precision := col.Precision;
@@ -885,6 +891,22 @@ begin
   end;
   end;
 end;
 end;
 
 
+function TMSSQLConnection.GetConnectionInfo(InfoType: TConnInfoType): string;
+begin
+  Result:='';
+  try
+    InitialiseDBLib(DBLibLibraryName);
+    case InfoType of
+      citClientName:
+        Result:=TMSSQLConnectionDef.LoadedLibraryName;
+    else
+      Result:=inherited GetConnectionInfo(InfoType);
+    end;
+  finally
+    ReleaseDBLib;
+  end;
+end;
+
 
 
 { TMSSQLConnectionDef }
 { TMSSQLConnectionDef }
 
 
@@ -903,6 +925,26 @@ begin
    Result:='Connect to MS SQL Server via Microsoft client library or via FreeTDS db-lib';
    Result:='Connect to MS SQL Server via Microsoft client library or via FreeTDS db-lib';
 end;
 end;
 
 
+class function TMSSQLConnectionDef.DefaultLibraryName: String;
+begin
+  Result:=DBLibLibraryName;
+end;
+
+class function TMSSQLConnectionDef.LoadFunction: TLibraryLoadFunction;
+begin
+  Result:=@InitialiseDBLib;
+end;
+
+class function TMSSQLConnectionDef.UnLoadFunction: TLibraryUnLoadFunction;
+begin
+  Result:=@ReleaseDBLib;
+end;
+
+class function TMSSQLConnectionDef.LoadedLibraryName: string;
+begin
+  Result:=DBLibLoadedLibrary;
+end;
+
 
 
 { TSybaseConnectionDef }
 { TSybaseConnectionDef }
 
 

+ 34 - 1
packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -121,6 +121,7 @@ Type
     constructor Create(AOwner : TComponent); override;
     constructor Create(AOwner : TComponent); override;
     procedure GetFieldNames(const TableName : string; List :  TStrings); override;
     procedure GetFieldNames(const TableName : string; List :  TStrings); override;
     procedure GetTableNames(List : TStrings; SystemTables : Boolean = false); override;
     procedure GetTableNames(List : TStrings; SystemTables : Boolean = false); override;
+    function GetConnectionInfo(InfoType:TConnInfoType): string; override;
     procedure CreateDB; override;
     procedure CreateDB; override;
     procedure DropDB; override;
     procedure DropDB; override;
     Property ServerInfo : String Read FServerInfo;
     Property ServerInfo : String Read FServerInfo;
@@ -146,6 +147,7 @@ Type
     Class Function DefaultLibraryName : String; override;
     Class Function DefaultLibraryName : String; override;
     Class Function LoadFunction : TLibraryLoadFunction; override;
     Class Function LoadFunction : TLibraryLoadFunction; override;
     Class Function UnLoadFunction : TLibraryUnLoadFunction; override;
     Class Function UnLoadFunction : TLibraryUnLoadFunction; override;
+    Class Function LoadedLibraryName : string; override;
   end;
   end;
 
 
 
 
@@ -1104,6 +1106,32 @@ begin
   GetDBInfo(stTables,'','tables_in_'+DatabaseName,List)
   GetDBInfo(stTables,'','tables_in_'+DatabaseName,List)
 end;
 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;
 function TConnectionName.GetTransactionHandle(trans: TSQLHandle): pointer;
 begin
 begin
   Result:=Nil;
   Result:=Nil;
@@ -1214,7 +1242,7 @@ end;
 
 
 class function TMySQLConnectionDef.LoadFunction: TLibraryLoadFunction;
 class function TMySQLConnectionDef.LoadFunction: TLibraryLoadFunction;
 begin
 begin
-  Result:=@initialisemysql;
+  Result:=@InitialiseMySQL;
 end;
 end;
 
 
 class function TMySQLConnectionDef.UnLoadFunction: TLibraryUnLoadFunction;
 class function TMySQLConnectionDef.UnLoadFunction: TLibraryUnLoadFunction;
@@ -1222,6 +1250,11 @@ begin
   Result:=@ReleaseMySQL;
   Result:=@ReleaseMySQL;
 end;
 end;
 
 
+class function TMySQLConnectionDef.LoadedLibraryName: string;
+begin
+  Result:=MysqlLoadedLibrary;
+end;
+
 {$IfDef mysql55}
 {$IfDef mysql55}
   initialization
   initialization
     RegisterConnection(TMySQL55ConnectionDef);
     RegisterConnection(TMySQL55ConnectionDef);

+ 46 - 3
packages/fcl-db/src/sqldb/odbc/odbcconn.pas

@@ -112,6 +112,7 @@ type
     function CreateConnectionString:string;
     function CreateConnectionString:string;
   public
   public
     constructor Create(AOwner : TComponent); override;
     constructor Create(AOwner : TComponent); override;
+    function GetConnectionInfo(InfoType:TConnInfoType): string; override;
     property Environment:TODBCEnvironment read FEnvironment;
     property Environment:TODBCEnvironment read FEnvironment;
   published
   published
     property Driver:string read FDriver write FDriver;    // will be passed as DRIVER connection parameter
     property Driver:string read FDriver write FDriver;    // will be passed as DRIVER connection parameter
@@ -149,7 +150,7 @@ type
 implementation
 implementation
 
 
 uses
 uses
-  Math, DBConst, ctypes;
+  DBConst, ctypes;
 
 
 const
 const
   DefaultEnvironment:TODBCEnvironment = nil;
   DefaultEnvironment:TODBCEnvironment = nil;
@@ -1075,7 +1076,7 @@ var
   ColName,TypeName:string;
   ColName,TypeName:string;
   FieldType:TFieldType;
   FieldType:TFieldType;
   FieldSize:word;
   FieldSize:word;
-  AutoIncAttr: SQLINTEGER;
+  AutoIncAttr, Updatable: SQLINTEGER;
 begin
 begin
   ODBCCursor:=cursor as TODBCCursor;
   ODBCCursor:=cursor as TODBCCursor;
 
 
@@ -1181,6 +1182,7 @@ begin
     // only one column per table can have identity attr.
     // only one column per table can have identity attr.
     if (FieldType in [ftInteger,ftLargeInt]) and (AutoIncAttr=SQL_FALSE) then
     if (FieldType in [ftInteger,ftLargeInt]) and (AutoIncAttr=SQL_FALSE) then
     begin
     begin
+      AutoIncAttr:=0;
       ODBCCheckResult(
       ODBCCheckResult(
         SQLColAttribute(ODBCCursor.FSTMTHandle,     // statement handle
         SQLColAttribute(ODBCCursor.FSTMTHandle,     // statement handle
                         i,                          // column number
                         i,                          // column number
@@ -1195,6 +1197,18 @@ begin
         FieldType:=ftAutoInc;
         FieldType:=ftAutoInc;
     end;
     end;
 
 
+    Updatable:=0;
+    ODBCCheckResult(
+      SQLColAttribute(ODBCCursor.FSTMTHandle,
+                      i,
+                      SQL_DESC_UPDATABLE,
+                      nil,
+                      0,
+                      nil,
+                      @Updatable),
+      SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get updatable attribute for column %d.',[i]
+    );
+
     if FieldType=ftUnknown then // if unknown field type encountered, try finding more specific information about the ODBC SQL DataType
     if FieldType=ftUnknown then // if unknown field type encountered, try finding more specific information about the ODBC SQL DataType
     begin
     begin
       SetLength(TypeName,TypeNameDefaultLength); // also garantuees uniqueness
       SetLength(TypeName,TypeNameDefaultLength); // also garantuees uniqueness
@@ -1232,7 +1246,10 @@ begin
     end;
     end;
 
 
     // add FieldDef
     // add FieldDef
-    TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(ColName), FieldType, FieldSize, (Nullable=SQL_NO_NULLS) and (AutoIncAttr=SQL_FALSE), i);
+    with TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(ColName), FieldType, FieldSize, (Nullable=SQL_NO_NULLS) and (AutoIncAttr=SQL_FALSE), i) do
+    begin
+      if Updatable = 0{SQL_ATTR_READONLY} then Attributes := Attributes + [faReadonly];
+    end;
   end;
   end;
 end;
 end;
 
 
@@ -1412,6 +1429,32 @@ begin
     DatabaseError(SMetadataUnavailable);
     DatabaseError(SMetadataUnavailable);
 end;
 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 }
 { TODBCEnvironment }
 
 
 constructor TODBCEnvironment.Create;
 constructor TODBCEnvironment.Create;

+ 46 - 8
packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -80,6 +80,7 @@ type
     function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
     function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
   public
   public
     constructor Create(AOwner : TComponent); override;
     constructor Create(AOwner : TComponent); override;
+    function GetConnectionInfo(InfoType:TConnInfoType): string; override;
     procedure CreateDB; override;
     procedure CreateDB; override;
     procedure DropDB; override;
     procedure DropDB; override;
   published
   published
@@ -99,6 +100,7 @@ type
     Class Function DefaultLibraryName : String; override;
     Class Function DefaultLibraryName : String; override;
     Class Function LoadFunction : TLibraryLoadFunction; override;
     Class Function LoadFunction : TLibraryLoadFunction; override;
     Class Function UnLoadFunction : TLibraryUnLoadFunction; override;
     Class Function UnLoadFunction : TLibraryUnLoadFunction; override;
+    Class Function LoadedLibraryName: string; override;
   end;
   end;
 
 
 implementation
 implementation
@@ -332,9 +334,9 @@ begin
     dointernaldisconnect;
     dointernaldisconnect;
     DatabaseError(sErrConnectionFailed + ' (PostgreSQL: ' + msg + ')',self);
     DatabaseError(sErrConnectionFailed + ' (PostgreSQL: ' + msg + ')',self);
     end;
     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
+// This only works 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
   if PQparameterStatus<>nil then
-    FIntegerDatetimes := pqparameterstatus(FSQLDatabaseHandle,'integer_datetimes') = 'on';
+    FIntegerDateTimes := PQparameterStatus(FSQLDatabaseHandle,'integer_datetimes') = 'on';
 end;
 end;
 
 
 procedure TPQConnection.DoInternalDisconnect;
 procedure TPQConnection.DoInternalDisconnect;
@@ -864,7 +866,7 @@ begin
         ftDateTime, ftTime :
         ftDateTime, ftTime :
           begin
           begin
           dbl := pointer(buffer);
           dbl := pointer(buffer);
-          if FIntegerDatetimes then
+          if FIntegerDateTimes then
             dbl^ := BEtoN(pint64(CurrBuff)^) / 1000000
             dbl^ := BEtoN(pint64(CurrBuff)^) / 1000000
           else
           else
             pint64(dbl)^ := BEtoN(pint64(CurrBuff)^);
             pint64(dbl)^ := BEtoN(pint64(CurrBuff)^);
@@ -1074,11 +1076,38 @@ begin
     Result := -1;
     Result := -1;
 end;
 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 }
 { TPQConnectionDef }
 
 
 class function TPQConnectionDef.TypeName: String;
 class function TPQConnectionDef.TypeName: String;
 begin
 begin
-  Result:='PostGreSQL';
+  Result:='PostgreSQL';
 end;
 end;
 
 
 class function TPQConnectionDef.ConnectionClass: TSQLConnectionClass;
 class function TPQConnectionDef.ConnectionClass: TSQLConnectionClass;
@@ -1088,7 +1117,7 @@ end;
 
 
 class function TPQConnectionDef.Description: String;
 class function TPQConnectionDef.Description: String;
 begin
 begin
-  Result:='Connect to a PostGreSQL database directly via the client library';
+  Result:='Connect to a PostgreSQL database directly via the client library';
 end;
 end;
 
 
 class function TPQConnectionDef.DefaultLibraryName: String;
 class function TPQConnectionDef.DefaultLibraryName: String;
@@ -1096,7 +1125,7 @@ begin
   {$IfDef LinkDynamically}
   {$IfDef LinkDynamically}
   Result:=pqlib;
   Result:=pqlib;
   {$else}
   {$else}
-  result:='';
+  Result:='';
   {$endif}
   {$endif}
 end;
 end;
 
 
@@ -1105,7 +1134,7 @@ begin
   {$IfDef LinkDynamically}
   {$IfDef LinkDynamically}
   Result:=@InitialisePostgres3;
   Result:=@InitialisePostgres3;
   {$else}
   {$else}
-  result:=Nil;
+  Result:=Nil;
   {$endif}
   {$endif}
 end;
 end;
 
 
@@ -1114,7 +1143,16 @@ begin
   {$IfDef LinkDynamically}
   {$IfDef LinkDynamically}
   Result:=@ReleasePostgres3;
   Result:=@ReleasePostgres3;
   {$else}
   {$else}
-  result:=Nil;
+  Result:=Nil;
+  {$endif}
+end;
+
+class function TPQConnectionDef.LoadedLibraryName: string;
+begin
+  {$IfDef LinkDynamically}
+  Result:=Postgres3LoadedLibrary;
+  {$else}
+  Result:='';
   {$endif}
   {$endif}
 end;
 end;
 
 

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

+ 31 - 1
packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

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