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;
     blobbuf      : tbufblobfield;
     NullMask     : pbyte;
-    li           : longint;
-    StoreReadOnly: boolean;
     ABookmark    : PBufBookmark;
 
 begin
@@ -2227,16 +2225,7 @@ begin
     begin
     if assigned(FAutoIncField) then
       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);
       end;
 

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

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

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

@@ -1756,6 +1756,22 @@ type
     property OnMasterDisable: TNotifyEvent read FOnMasterDisable write FOnMasterDisable;
   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 }
 
   TDataChangeEvent = procedure(Sender: TObject; Field: TField) of object;
@@ -1796,7 +1812,7 @@ type
     property OnUpdateData: TNotifyEvent read FOnUpdateData write FOnUpdateData;
   end;
 
- { TDBDataset }
+  { TDBDataset }
 
   TDBDatasetClass = Class of TDBDataset;
   TDBDataset = Class(TDataset)
@@ -1813,7 +1829,7 @@ type
       Property Transaction : TDBTransaction Read FTransaction Write SetTransaction;
     end;
 
- { TDBTransaction }
+  { TDBTransaction }
 
   TDBTransactionClass = Class of TDBTransaction;
   TDBTransaction = Class(TComponent)
@@ -1848,7 +1864,7 @@ type
     property Active : boolean read FActive write setactive;
   end;
 
-    { TCustomConnection }
+  { TCustomConnection }
 
   TLoginEvent = procedure(Sender: TObject; Username, Password: string) of object;
 
@@ -1947,20 +1963,6 @@ type
   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
   FieldTypetoVariantMap : array[TFieldType] of Integer = (varError, varOleStr, varSmallint,
     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
   Inherited Create(AOWner);
   SetDataType(ftAutoInc);
-  FReadOnly:=True;
-  FProviderFlags:=FProviderFlags-[pfInUpdate];
 end;
 
 Procedure TAutoIncField.SetAsLongint(AValue : Longint);
@@ -1760,8 +1758,8 @@ begin
   // Some databases allows insertion of explicit values into identity columns
   // (some of them also allows (some not) updating identity columns)
   // 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;
 end;
 

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

@@ -93,7 +93,7 @@ type
   public
     constructor Create(AOwner: TComponent); 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
     function Connect:boolean;
     //Disconnect from service manager. Done automatically when destroying component
@@ -158,7 +158,7 @@ type
     property Port: word read FPort write FPort default 3050;
     //Protocol used to connect to service manager. One of:
     //IBSPLOCAL: Host and port ignored
-    //IBSPTCPIP: Connectoct to Host:Port
+    //IBSPTCPIP: Connect to Host:Port
     //IBSPNETBEUI: Connect to \\Host\
     //IBSPNAMEDPIPE: Connect to //Host/
     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;
   public
     constructor Create(AOwner : TComponent); override;
+    function GetConnectionInfo(InfoType:TConnInfoType): string; override;
     procedure CreateDB; override;
     procedure DropDB; override;
     //property TDS:integer read Ftds;
@@ -138,11 +139,15 @@ type
     Class Function TypeName : String; override;
     Class Function ConnectionClass : TSQLConnectionClass; 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;
 
   { TSybaseConnectionDef }
 
-  TSybaseConnectionDef = Class(TConnectionDef)
+  TSybaseConnectionDef = Class(TMSSQLConnectionDef)
     Class Function TypeName : String; override;
     Class Function ConnectionClass : TSQLConnectionClass; 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
     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
         ftBCD,
         ftFmtBCD: Precision := col.Precision;
@@ -885,6 +891,22 @@ begin
   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 }
 
@@ -903,6 +925,26 @@ begin
    Result:='Connect to MS SQL Server via Microsoft client library or via FreeTDS db-lib';
 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 }
 

+ 34 - 1
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);

+ 46 - 3
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;
@@ -1075,7 +1076,7 @@ var
   ColName,TypeName:string;
   FieldType:TFieldType;
   FieldSize:word;
-  AutoIncAttr: SQLINTEGER;
+  AutoIncAttr, Updatable: SQLINTEGER;
 begin
   ODBCCursor:=cursor as TODBCCursor;
 
@@ -1181,6 +1182,7 @@ begin
     // only one column per table can have identity attr.
     if (FieldType in [ftInteger,ftLargeInt]) and (AutoIncAttr=SQL_FALSE) then
     begin
+      AutoIncAttr:=0;
       ODBCCheckResult(
         SQLColAttribute(ODBCCursor.FSTMTHandle,     // statement handle
                         i,                          // column number
@@ -1195,6 +1197,18 @@ begin
         FieldType:=ftAutoInc;
     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
     begin
       SetLength(TypeName,TypeNameDefaultLength); // also garantuees uniqueness
@@ -1232,7 +1246,10 @@ begin
     end;
 
     // 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;
 
@@ -1412,6 +1429,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;

+ 46 - 8
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
@@ -332,9 +334,9 @@ begin
     dointernaldisconnect;
     DatabaseError(sErrConnectionFailed + ' (PostgreSQL: ' + msg + ')',self);
     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
-    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;
 

+ 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);
      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
@@ -1619,7 +1633,7 @@ var FieldNamesQuoteChars : TQuoteChars;
       begin
       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 + '",';
       end;
 
@@ -1642,7 +1656,7 @@ var FieldNamesQuoteChars : TQuoteChars;
     sql_values := '';
     for x := 0 to Fields.Count -1 do
       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
         sql_fields := sql_fields + FieldNamesQuoteChars[0] + fields[x].FieldName + FieldNamesQuoteChars[1] + ',';
         sql_values := sql_values + ':"' + fields[x].FieldName + '",';
@@ -2258,6 +2272,11 @@ begin
   Result:=Nil;
 end;
 
+class function TConnectionDef.LoadedLibraryName: string;
+begin
+  Result:='';
+end;
+
 procedure TConnectionDef.ApplyParams(Params: TStrings;
   AConnection: TSQLConnection);
 begin

+ 31 - 1
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);