/// ZEOS 7.x direct access classes for SynDB units (not DB.pas based) // - this unit is a part of the freeware Synopse framework, // licensed under a MPL/GPL/LGPL tri-license; version 1.18 unit SynDBZeos; { This file is part of Synopse framework. Synopse framework. Copyright (C) 2022 Arnaud Bouchez Synopse Informatique - https://synopse.info *** BEGIN LICENSE BLOCK ***** Version: MPL 1.1/GPL 2.0/LGPL 2.1 The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is Synopse mORMot framework. The Initial Developer of the Original Code is Arnaud Bouchez. Portions created by the Initial Developer are Copyright (C) 2022 the Initial Developer. All Rights Reserved. Contributor(s): - alexpirate - Daniel Kuettner - delphinium - EgonHugeist (Michael) - Joe (jokussoftware) Alternatively, the contents of this file may be used under the terms of either the GNU General Public License Version 2 or later (the "GPL"), or the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), in which case the provisions of the GPL or the LGPL are applicable instead of those above. If you wish to allow use of your version of this file only under the terms of either the GPL or the LGPL, and not to allow others to use your version of this file under the terms of the MPL, indicate your decision by deleting the provisions above and replace them with the notice and other provisions required by the GPL or the LGPL. If you do not delete the provisions above, a recipient may use your version of this file under the terms of any one of the MPL, the GPL or the LGPL. ***** END LICENSE BLOCK ***** } (* Note: - if you want to work as expected with SQlite3 backend (but how would need to do it, since it will be MUCH slower compared to SynDBSQlite3), you need to apply some patches for Zeos < 7.2 : function TZSQLiteCAPIPreparedStatement.ExecuteQueryPrepared: IZResultSet; begin if Not Prepared then Prepare; try if LastResultSet <> nil then LastResultSet.Close; // reset stmt LastResultSet := nil; BindInParameters; FErrorCode := FPlainDriver.Step(FStmtHandle); CheckSQLiteError(FPlainDriver, FStmtHandle, FErrorCode, nil, lcOther, ConSettings^.ConvFuncs.ZStringToRaw(SCanNotRetrieveResultsetData, ConSettings^.CTRL_CP, ConSettings^.ClientCodePage^.CP), ConSettings); if ( FErrorCode = SQLITE_ROW ) or ( FErrorCode = SQLITE_DONE) then LastResultSet := CreateResultSet(FStmtHandle, FErrorCode); Result := LastResultSet; inherited ExecuteQueryPrepared; except raise; end; end; procedure TZSQLiteResultSet.FreeHandle; var ErrorCode: Integer; begin if FFreeHandle then begin if Assigned(FStmtHandle) then ErrorCode := FPlainDriver.Finalize(FStmtHandle) else ErrorCode := SQLITE_OK; FStmtHandle := nil; CheckSQLiteError(FPlainDriver, FStmtHandle, ErrorCode, nil, lcOther, 'FINALIZE SQLite VM', ConSettings); end else begin if FStmtHandle <> nil then begin ErrorCode := FPlainDriver.reset(FStmtHandle); CheckSQLiteError(FPlainDriver, FStmtHandle, ErrorCode, nil, lcBindPrepStmt, 'Reset Prepared Stmt', ConSettings); FStmtHandle := nil; end; FErrorCode := SQLITE_DONE; end; end; ... but you should better upgrade to the latest Zeos 7.3 revision! :) See https://synopse.info/forum/viewtopic.php?pid=9146#p9146 *) {$ifdef NOSYNDBZEOS} // defined in mormot_base.lpk Lazarus package > Custom Options > Defines interface implementation {$else} {$I Zeos.inc} // define conditionals like ZEOS72UP and ENABLE_* // for best performance: tune your project options or Zeos.inc // to define USE_SYNCOMMONS and leverage best of mORMot and ZEOS ! {$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER interface uses {$ifdef MSWINDOWS} Windows, {$endif} Types, SysUtils, {$ifndef DELPHI5OROLDER} Variants, {$endif} Classes, Contnrs, // load physical providers as defined by ENABLE_* in Zeos.inc // -> you can patch your local Zeos.inc and comment these defines to // exclude database engines you don't need // or (since 7.2) you simply add the ZEOS_DISABLE_XXX defines to your // project options. The units are used but no line code will be compiled. {$if defined(ENABLE_ADO) and not defined(ZEOS_DISABLE_ADO)} ZDbcAdo, {$ifend} {$if defined(ENABLE_DBLIB) and not defined(ZEOS_DISABLE_DBLIB)} ZDbcDbLib, {$ifend} {$if defined(ENABLE_MYSQL) and not defined(ZEOS_DISABLE_MYSQL)} ZDbcMySql, {$ifend} {$if defined(ENABLE_POSTGRESQL) and not defined(ZEOS_DISABLE_POSTGRESQL)} ZDbcPostgreSql, {$ifend} {$if defined(ENABLE_INTERBASE) and not defined(ZEOS_DISABLE_INTERBASE)} ZDbcInterbase6, {$ifend} {$if defined(ENABLE_FIREBIRD) and not defined(ZEOS_DISABLE_FIREBIRD)} ZDbcFirebird, {$ifend} {$if defined(ENABLE_SQLITE) and not defined(ZEOS_DISABLE_SQLITE)} ZDbcSqLite, {$ifend} {$if defined(ENABLE_ORACLE) and not defined(ZEOS_DISABLE_ORACLE)} ZDbcOracle, {$ifend} {$if defined(ENABLE_ASA) and not defined(ZEOS_DISABLE_ASA)} ZDbcASA, {$ifend} {$if defined(ENABLE_SQLANY) and not defined(ZEOS_DISABLE_SQLANY)} ZDbcSQLAnywhere, {$ifend} {$if defined(ENABLE_POOLED) and not defined(ZEOS_DISABLE_POOLED)} ZDbcPooled, {$ifend} {$if defined(ENABLE_OLEDB) and not defined(ZEOS_DISABLE_OLEDB)} ZDbcOleDB, {$ifend} {$if defined(ENABLE_ODBC) and not defined(ZEOS_DISABLE_ODBC)} ZDbcODBCCon, {$ifend} // main ZDBC units ZCompatibility, ZVariant, {$ifndef ZEOS80UP} ZURL, {$endif ZEOS80UP} ZDbcIntfs, ZDbcResultSet, // mORMot units after ZDBC due to some name conflicts (e.g. UTF8ToString) SynCommons, SynTable, SynLog, SynDB; { -------------- ZEOS database components direct process } type /// Exception type associated to the ZEOS database components ESQLDBZEOS = class(ESQLDBException); /// implement properties shared by ZEOS connections TSQLDBZEOSConnectionProperties = class(TSQLDBConnectionPropertiesThreadSafe) protected fURL: TZURL; fStatementParams: TStrings; fDBMSName: RawUTF8; fSupportsArrayBindings: boolean; /// initialize fForeignKeys content with all foreign keys of this DB // - do nothing by now (ZEOS metadata may be used in the future) procedure GetForeignKeys; override; /// convert ZDBC field type into mORMot fieldtype function TZSQLTypeToTSQLDBFieldType(aNativeType: TZSQLType): TSQLDBFieldType; public /// initialize the properties to connect to the ZEOS engine // - aServerName shall contain the ZEOS URI, e.g: // $ zdbc:firebird-2.0://127.0.0.1:3050/model?username=sysdba;password=masterkey // $ zdbc:mysql://192.168.2.60:3306/world?username=root;password=dev // $ sqlite // i.e. '[zdbc:]PROTOCOL://HOST:PORT[/DATABASE][?paramname=value]' // - you can define the TZConnection.LibraryLocation property by setting a // '?LibLocation=...' parameter within the aServerName URL value // - or simply use TSQLDBZEOSConnectionProperties.URI() class method // - aDatabaseName, aUserID, aPassword are used if not already set as URI // in aServerName value // - you can use Protocols property to retrieve all available protocol names // - note that when run from mORMot's ORM, this class will by default // create one connection per thread, which makes some clients (e.g. // PostgreSQL) unstable and consuming a lot of resources - you should better // maintain one single connection, by setting after Create: // ! aExternalDBProperties.ThreadingMode := tmMainConnection; // or by adding 'syndb_singleconnection=true' as URI property constructor Create(const aServerName, aDatabaseName, aUserID, aPassWord: RawUTF8); override; /// initialize raw properties to connect to the ZEOS engine // - using Zeos' TZURL detailed class - see: src\core\ZURL.pas // - this gives all possibilities to add Properties before a connection is opened // - you can define the protocol by hand eg. "odbc_w"/"OleDB" and define TSQLDBDefinition // to describe the server syntax SynDB and the ORM use behind the abstract driver constructor CreateWithZURL(const aURL: TZURL; aDBMS: TSQLDBDefinition; aOwnsURL: Boolean); virtual; /// finalize properties internal structures destructor Destroy; override; /// create a new connection // - caller is responsible of freeing this instance // - this overridden method will create an TSQLDBZEOSConnection instance function NewConnection: TSQLDBConnection; override; /// retrieve the column/field layout of a specified table // - this overridden method will use ZDBC metadata to retrieve the information procedure GetFields(const aTableName: RawUTF8; out Fields: TSQLDBColumnDefineDynArray); override; /// get all table names // - this overridden method will use ZDBC metadata to retrieve the information // - PostgreSQL note: it was reported that some table names expects to be // quoted for this DB engine - and ZDBC won't do it for yourself - please // ensure you specify the correct quoted table name e.g. when you register // the external PostgreSQL table via function VirtualTableExternalRegister() procedure GetTableNames(out Tables: TRawUTF8DynArray); override; /// access to the database metadata, as retrieved by ZEOS // - returns TRUE if metadata interface has been retrieved function GetDatabaseMetadata(out meta: IZDatabaseMetadata): boolean; /// compute the ZEOS URI for a given database engine // - the optional server name can contain a port number, specified after ':' // - you can set an optional full path to the client library name, // to be completed on the left side with the executable path // - possible use may be: // ! PropsOracle := TSQLDBZEOSConnectionProperties.Create( // ! TSQLDBZEOSConnectionProperties.URI(dOracle,'','oci64\oci.dll'), // ! 'tnsname','user',pass'); // ! PropsFirebird := TSQLDBZEOSConnectionProperties.Create( // ! TSQLDBZEOSConnectionProperties.URI(dFirebird,'','Firebird\fbembed.dll'), // ! 'databasefilename','','); // ! PropsFirebird := TSQLDBZEOSConnectionProperties.Create( // ! TSQLDBZEOSConnectionProperties.URI(dFirebird,'192.168.1.10:3055', // ! 'c:\Firebird_2_5\bin\fbclient.dll',false), // ! '3camadas', 'sysdba', 'masterkey'); class function URI(aServer: TSQLDBDefinition; const aServerName: RawUTF8; const aLibraryLocation: TFileName=''; aLibraryLocationAppendExePath: boolean=true): RawUTF8; overload; /// compute the ZEOS URI for a given protocol // - if a TSQSLDBDefinition may have several protocols (e.g. MSSQL), you // can use this overloaded method to select the exact protocol to use if the // default one fixed by TSQLDBDefinition does not match your needs // - the protocol name should contain the trailing : character, e.g. // 'firebird-2.0:' if the default 'firebird-2.5:' is not correct class function URI(const aProtocol, aServerName: RawUTF8; const aLibraryLocation: TFileName=''; aLibraryLocationAppendExePath: boolean=true): RawUTF8; overload; published /// the remote DBMS name, as retrieved from ServerName, i.e. ZEOS URL property DBMSName: RawUTF8 read fDBMSName; /// direct access to the internal TZURL connection parameters property ZeosURL: TZURL read fURL; /// direct access to the internal statement parameters // - i.e. will be used by IZConnection.PrepareStatementWithParams() // - default values (set in Create method) try to achieve best permormance property ZeosStatementParams: TStrings read fStatementParams; /// if the associated ZDBC provider supports parameters array binding // - you should use the BindArray() methods only if this property is TRUE property SupportsArrayBindings: boolean read fSupportsArrayBindings; end; /// implements a connection via the ZEOS access layer TSQLDBZEOSConnection = class(TSQLDBConnectionThreadSafe) protected fDatabase: IZConnection; public /// prepare a connection to a specified ZEOS database server constructor Create(aProperties: TSQLDBConnectionProperties); override; /// connect to the specified ZEOS server // - should raise an ESQLDBZEOS on error procedure Connect; override; /// stop connection to the specified ZEOS database server // - should raise an ESQLDBZEOS on error procedure Disconnect; override; /// return TRUE if Connect has been already successfully called function IsConnected: boolean; override; /// create a new statement instance function NewStatement: TSQLDBStatement; override; /// begin a Transaction for this connection procedure StartTransaction; override; /// commit changes of a Transaction for this connection // - StartTransaction method must have been called before procedure Commit; override; /// discard changes of a Transaction for this connection // - StartTransaction method must have been called before procedure Rollback; override; /// access to the associated ZEOS connection instance property Database: IZConnection read fDatabase; end; /// implements a statement via a ZEOS database connection TSQLDBZEOSStatement = class(TSQLDBStatementWithParamsAndColumns) protected fStatement: IZPreparedStatement; fResultSet: IZResultSet; fResultInfo: IZResultSetMetaData; {$if defined(ZEOS73UP) and defined(USE_SYNCOMMONS)} fJSONComposeOptions: TZJSONComposeOptions; {$ifend} public {$if defined(ZEOS73UP) and defined(USE_SYNCOMMONS)} procedure AfterConstruction; override; {$ifend} /// Prepare an UTF-8 encoded SQL statement // - parameters marked as ? will be bound later, before ExecutePrepared call // - if ExpectResults is TRUE, then Step() and Column*() methods are available // to retrieve the data rows // - raise an ESQLDBZeos on any error procedure Prepare(const aSQL: RawUTF8; ExpectResults: boolean = false); overload; override; /// Execute a prepared SQL statement // - parameters marked as ? should have been already bound with Bind*() functions // - this implementation will also handle bound array of values (if any), // if IZDatabaseInfo.SupportsArrayBindings is true for this provider // - this overridden method will log the SQL statement if sllSQL has been // enabled in SynDBLog.Family.Level // - raise an ESQLDBZeos on any error procedure ExecutePrepared; override; {$ifdef ZEOS72UP} /// append all columns values of the current Row to a JSON stream // - will use WR.Expand to guess the expected output format // - this overriden implementation will call fReultSet methods to avoid // creating most temporary variable procedure ColumnsToJSON(WR: TJSONWriter); override; {$endif} /// gets a number of updates made by latest executed statement function UpdateCount: integer; override; /// Reset the previous prepared statement // - this overridden implementation will reset all bindings and the cursor state // - raise an ESQLDBZeos on any error procedure Reset; override; /// Access the next or first row of data from the SQL Statement result // - return true on success, with data ready to be retrieved by Column*() methods // - return false if no more row is available (e.g. if the SQL statement // is not a SELECT but an UPDATE or INSERT command) // - if SeekFirst is TRUE, will put the cursor on the first row of results // - raise an ESQLDBZeos on any error function Step(SeekFirst: boolean = false): boolean; override; /// free IZResultSet/IZResultSetMetaData when ISQLDBStatement is back in cache procedure ReleaseRows; override; /// return a Column integer value of the current Row, first Col is 0 function ColumnInt(Col: Integer): Int64; override; /// returns TRUE if the column contains NULL function ColumnNull(Col: Integer): boolean; override; /// return a Column floating point value of the current Row, first Col is 0 function ColumnDouble(Col: Integer): double; override; /// return a Column date and time value of the current Row, first Col is 0 function ColumnDateTime(Col: Integer): TDateTime; override; /// return a Column currency value of the current Row, first Col is 0 function ColumnCurrency(Col: Integer): currency; override; /// return a Column UTF-8 encoded text value of the current Row, first Col is 0 function ColumnUTF8(Col: Integer): RawUTF8; override; /// return a Column as a blob value of the current Row, first Col is 0 function ColumnBlob(Col: Integer): RawByteString; override; {$if defined(ZEOS73UP) and defined(USE_SYNCOMMONS)} public /// the ColumnsToJSON options provided by ZDBC // - jcoEndJSONObject: // cancels last comma, adds the close object bracket '}' and add's the next comma. // If not set you can continue writting some custom data into your // object json but you also have to finalize each row-object then. // - jcoMongoISODate: // formats the date,time,datetime values as mongo // ISODate("YYYY-MM-DDTHH:NN:ssZ"). Milliseconds are included. // So the values are recognized as date type by mongodb. // Otherwise mongo threads them as strings. // This option might be usefull if you export sql rows using a // json streamed file which will be used as an import-file with your mongodb // If set the options jcoDATETIME_MAGIC and jcoMilliseconds are ignored // - jcoDATETIME_MAGIC add the JSON_SQLDATE_MAGIC on top of data // before adding the ISO date,time,datetime value quoted strings // - jcoMilliseconds compose the time/datetime values with milliseconds // - jcsSkipNulls ignore null columns. So neither fieldname nor the null // value will be composed into your JSON. For real big JSON contents // it saves loads of space. e.g. if you import a JSON into a mongo cluster // you'll have a significant space difference if null's are simply ignored. property JSONComposeOptions: TZJSONComposeOptions read fJSONComposeOptions write fJSONComposeOptions default [jcoEndJSONObject]; {$ifend} end; var /// list of all available ZEOS protocols // - you have to call SetZEOSProtocols before using it, to update this // global list with all initialized ZPlain*Driver units // - to be used e.g. within ZEOS URI, as TSQLDBZEOSConnectionProperties.ServerName ZEOSProtocols: TRawUTF8DynArray; /// to be called in order to populate the global ZEOSProtocols list procedure SetZEOSProtocols; implementation {$ifdef ZEOS72UP} uses ZDbcMetadata {$IFDEF ZEOS73UP} , ZDbcProperties {$ENDIF}; {$else} const FirstDbcIndex = 1; TableNameIndex = 3; ColumnNameIndex = 4; TableColColumnTypeIndex = 5; TableColColumnTypeNameIndex = 6; TableColColumnSizeIndex = 7; TableColColumnDecimalDigitsIndex = 9; IndexInfoColColumnNameIndex = 9; {$endif} { TSQLDBZEOSConnectionProperties } constructor TSQLDBZEOSConnectionProperties.Create( const aServerName, aDatabaseName, aUserID, aPassWord: RawUTF8); const PCHARS: array[0..8] of PAnsiChar = ( 'ORACLE','FREETDS_MSSQL','MSSQL','INTERBASE','FIREBIRD','MYSQL','SQLITE','POSTGRESQL','JET'); TYPES: array[-1..high(PCHARS)] of TSQLDBDefinition = ( dDefault,dOracle,dMSSQL,dMSSQL,dFirebird,dFirebird,dMySQL,dSQLite,dPostgreSQL,dJet{e.g. ADO[JET]}); // expecting Sybase + ASA support in TSQLDBDefinition var BrakedPos: Integer; begin // return e.g. mysql://192.168.2.60:3306/world?username=root;password=dev // make syntax like "ADO[ORACLE]"/"ADO[MSSQL]:"/"ADO[JET]" etc... possible BrakedPos := PosExChar('[', aServerName); if (BrakedPos>0) and ((aServerName[Length(aServerName)]=']') or (aServerName[Length(aServerName)-1]=']')) then begin fServerName := Copy(aServerName,1,BrakedPos-1); fDBMSName := Copy(aServerName,BrakedPos+1,PosExChar(']',aServerName)-1-BrakedPos); end else fServerName := aServerName; if (fServerName<>'') and (PosExChar(':',fServerName)=0) then fServerName := fServerName+':'; if not IdemPChar(Pointer(aServerName),'ZDBC:') then fServerName := 'zdbc:'+fServerName; fURL := TZURL.Create(UTF8ToString(fServerName)); if fURL.Database='' then fURL.Database := UTF8ToString(aDatabaseName); if fURL.UserName='' then fURL.UserName := UTF8ToString(aUserID); if fURL.Password='' then fURL.Password := UTF8ToString(aPassWord); if fDBMSName = '' then StringToUTF8(fURL.Protocol,fDBMSName); CreateWithZURL(fURL, TYPES[IdemPCharArray(pointer(fDBMSName),PCHARS)], true); end; procedure TSQLDBZEOSConnectionProperties.GetForeignKeys; begin { TODO : get FOREIGN KEYS from ZEOS metadata ? } end; function TSQLDBZEOSConnectionProperties.NewConnection: TSQLDBConnection; begin result := TSQLDBZEOSConnection.Create(self); end; constructor TSQLDBZEOSConnectionProperties.CreateWithZURL(const aURL: TZURL; aDBMS: TSQLDBDefinition; aOwnsURL: Boolean); {$IFDEF ZEOS73UP}var protocol: RawUTF8;{$endif} begin // return e.g. mysql://192.168.2.60:3306/world?username=root;password=dev if aOwnsURL then fURL := aURL else fURL := TZURL.Create(aURL); fDBMS := aDBMS; {$ifndef UNICODE} fURL.Properties.Values['controls_cp'] := 'CP_UTF8'; {$endif} { Implementation/Enhancements Notes About settings below (from Michael): ConnectionProperties: Since 7.3 you should look to ZDbcProperties.pas All connection Properties including driver dependencies are listed in this file. otherwise: Make it possible to Assign Parameters on the fly e.g.: FireBird: - add custom TIL's by hand if tiNone was set. or some more custom settings: see ZDbcInterbaseUtils.pas: TransactionParams and DatabaseParams - "hard_commit=true" False by default PostgreSQL: - "oidasblob=true" - False by default notify Zeos should use Oid fields as BLob's - "CheckFieldVisibility=True/False" notify Zeos should determine temporary tables field meta informations too required for mORMot? - "NoTableInfoCache=True/False" - False by default notify Zeos it should use internal TableInfo-cache. Set the value to true to save memory ADO: 7.3up - "internal_buffer_size=X" in bytes default are 128KB this is the max size in bytes you allow Zeos to use for batch-ole array_bindings This parameter is only used if "use_ole_update_params=True" - "use_ole_update_params=True/False" default = False bypassing slow MSADO15.DLL and direct use OleDB parameters for all kind of updates including batch Note: current code is also able to handle Out/InOut params except for out/inout lob's. note: both internal_buffer_size and use_ole_update_params can be used as statement parameters as well Oracle: - "row_prefetch_size=x! in bytes this value will be send to OCI and indicates Oracle which row_prefetch_size you allow to execute a query } {$IFDEF ZEOS73UP} if fDBMS = dMSSQL then begin protocol := LowerCase(StringToUTF8(FURL.Protocol)); //EH: switch off tds support in any kind -> deprecated and our 64bit lib isn't compiled with libiconv support //users permanently run into the encoding issues which can't be resolved using the dblib tds-types: //tdsNVarchar/tdsNText is defined but will never be used by DBLIB + SQLServer) if {$IFDEF MSWINDOWS}(protocol <> 'ado') and (protocol <> 'oledb') and {$endif} (protocol <> 'odbc_w') and (protocol <> 'odbc_a') then {$IFDEF MSWINDOWS} FURL.Protocol := 'OleDB'; {$else} FURL.Protocol := 'odbc_w' {$endif} end; {$endif} inherited Create(StringToUTF8(FURL.HostName),StringToUTF8(FURL.Database),StringToUTF8(FURL.UserName),StringToUTF8(FURL.Password)); if StrToBoolDef(fURL.Properties.Values['syndb_singleconnection'],false) then ThreadingMode := tmMainConnection; fUseCache := {$ifdef ZEOS72UP}true{$else}false{$endif}; // caching disabled by default - enabled if stable enough case fDBMS of dSQLite: begin {$ifndef ZEOS72UP} fSQLCreateField[ftInt64] := ' BIGINT'; // SQLite3 INTEGER = 32bit for ZDBC! {$endif} end; dFirebird: begin if (fURL.HostName='') and // Firebird embedded (fURL.Database<>'') then begin ThreadingMode := tmMainConnection; // force SINGLE connection if not FileExists(fURL.Database) then // create local DB file if needed fURL.Properties.Add('createNewDatabase='+UTF8ToString( SQLCreateDatabase(StringToUTF8(fURL.Database)))); end; fURL.Properties.Add('codepage=UTF8'); fUseCache := true; // caching rocks with Firebird ZDBC provider :) end; dOracle, dPostgreSQL, dMySQL: begin fURL.Properties.Add('codepage=UTF8'); fUseCache := true; end; end; fStatementParams := TStringList.Create; case fDBMS of dOracle: begin {$ifndef ZEOS72UP} // fixed since 7.2up // sets OCI_ATTR_PREFETCH_ROWS on prepare a fetch // default = 100 on 7.1down // since 7.3 the option is ignored fStatementParams.Add('prefetch_count=1000'); {$else} //max mem in bytes which OCI(Server) can use for a result on Server-Side //fStatementParams.Add('row_prefetch_size=131072'); //max mem in bytes which Zeos can for batch or resultset buffers //fStatementParams.Add('internal_buffer_size=131072'); {$endif} end; dSQLite: begin {$ifdef ZEOS72UP} // new since 7.2up // Bind double values instead of ISO formated DateTime-strings //fStatementParams.Add('BindDoubleDateTimeValues=True'); {$endif} end; dMySQL: begin // use mysql real-prepared api instead of string based once // actually it's not realy faster.. just a hint: // http://dev.mysql.com/doc/refman/5.0/en/c-api-prepared-statement-problems.html //fStatementParams.Add('preferprepared=True'); // https://mariadb.com/kb/en/library/bulk-insert-row-wise-binding/ // https://mariadb.com/kb/en/library/bulk-insert-column-wise-binding/ // if you run into some mysql known issues, // since 7.3 you've to explicit unset real_prepared by //fStatementParams.Add('emulate_prepares=True'); or //fStatementParams.Add('MinExecCountBeforePrepare=-1'); end; dPostgreSQL: begin // see https://synopse.info/forum/viewtopic.php?pid=13260#p13260 fURL.Properties.Add('NoTableInfoCache=true'); {$IFDEF ZEOS73UP} //fURL.Properties.Add(DSProps_BinaryWireResultMode+'=False'); {$ENDIF} end; dMSSQL: begin fUseCache := true; fStatementParams.Add('enhanced_column_info=false'); //fStatementParams.Add('use_ole_update_params=True'); //see 'ADO' //fStatementParams.Add('internal_buffer_size=131072'); //see 'ADO' // EH: hooking a syndb bug. Void strings are not accepted by SQLServer if: // fixed-width columns are used and option ANSI_PADDING is set to !off!. StoreVoidStringAsNull := False; end; end; if fDBMS in [dOracle,dPostgreSQL,dMySQL,dMSSQL] then begin // let's set 1024KB / chunk for synopse or more? // retrieving/submitting lob's in chunks. Default is 4096Bytes / Chunk // it's depending to your local network speed e.g. bad WLAN or so // for Firebird we always using the blob-segment size fStatementParams.Add('chunk_size=1048576'); end; if fDBMS in [dPostgreSQL,dFireBird] then begin {$ifdef ZEOS72UP} // new since 7.2up // Always load the lobs? Or just on accessing them? // if you allways copy the data by fetching the row than it doesn't make sense. fStatementParams.Add('cachedlob=false'); //default = False {$endif} end; end; destructor TSQLDBZEOSConnectionProperties.Destroy; begin FreeAndNil(fURL); FreeAndNil(fStatementParams); inherited; end; procedure SetZEOSProtocols; var List: TStringList; i,j: integer; Protocols: Types.TStringDynArray; begin List := TStringList.Create; try with DriverManager.GetDrivers do for i := 0 to Count-1 do begin Protocols := (Items[i] as IZDriver).GetSupportedProtocols; for j := 0 to high(Protocols) do List.Add(Protocols[j]); end; List.Sort; StringListToRawUTF8DynArray(List,ZEOSProtocols); finally List.Free; end; end; function TSQLDBZEOSConnectionProperties.GetDatabaseMetadata(out meta: IZDatabaseMetadata): boolean; var conn: IZConnection; begin conn := (MainConnection as TSQLDBZEOSConnection).fDatabase; result := conn.UseMetadata; meta := conn.GetMetadata; if result then meta.ClearCache; // we need to retrieve the actual metadata {$ifdef ZEOS72UP} // new since 7.2up if Result and meta.GetDatabaseInfo.SupportsArrayBindings then begin case GetDBMS of dPostgreSQL: fBatchSendingAbilities := [cCreate, cDelete] // EH: array logic isn't ready 4updates yet else fBatchSendingAbilities := [cCreate, cUpdate, cDelete]; end; OnBatchInsert := nil; fSupportsArrayBindings := True; end; {$endif} end; procedure TSQLDBZEOSConnectionProperties.GetTableNames(out Tables: TRawUTF8DynArray); var meta: IZDatabaseMetadata; res: IZResultSet; TableTypes: Types.TStringDynArray; n: integer; begin if GetDatabaseMetadata(meta) then begin SetLength(TableTypes,1); TableTypes[0] := 'TABLE'; res := meta.GetTables('','','',TableTypes); n := 0; while res.Next do {$IFDEF ZEOS72UP} AddSortedRawUTF8(Tables,n,res.GetUTF8String(TableNameIndex)); {$else} AddSortedRawUTF8(Tables,n,SynUnicodeToUtf8(res.GetUnicodeString(TableNameIndex))); {$endif} SetLength(Tables,n); end else inherited; end; procedure TSQLDBZEOSConnectionProperties.GetFields( const aTableName: RawUTF8; out Fields: TSQLDBColumnDefineDynArray); var meta: IZDatabaseMetadata; res: IZResultSet; n, i: integer; Schema, TableName: RawUTF8; sSchema, sTableName: string; F: TSQLDBColumnDefine; FA: TDynArray; begin if GetDatabaseMetadata(meta) then begin SQLSplitTableName(aTableName, Schema,TableName); sSchema := UTF8ToString(Schema); { mormot does not create the Tables casesensitive but gives mixed cased strings as tablename so we normalize the identifiers to database defaults : } sTableName := meta.{$ifdef ZEOS80UP}GetIdentifierConverter{$else}GetIdentifierConvertor{$endif}. ExtractQuote(Utf8ToString(TableName)); // do not escape sTableName - https://synopse.info/forum/viewtopic.php?pid=34896#p34896 res := meta.GetColumns('',sSchema,meta.AddEscapeCharToWildcards(sTableName),''); FA.InitSpecific(TypeInfo(TSQLDBColumnDefineDynArray),Fields,djRawUTF8,@n,true); FillChar(F,sizeof(F),0); while res.Next do begin {$IFDEF ZEOS72UP} F.ColumnName := res.GetUTF8String(ColumnNameIndex); F.ColumnTypeNative := res.GetUTF8String(TableColColumnTypeNameIndex); {$else} F.ColumnName := SynUnicodeToUtf8(res.GetUnicodeString(ColumnNameIndex)); F.ColumnTypeNative := SynUnicodeToUtf8(res.GetUnicodeString(TableColColumnTypeNameIndex)); {$endif} F.ColumnType := TZSQLTypeToTSQLDBFieldType(TZSQLType(res.GetInt(TableColColumnTypeIndex))); F.ColumnLength := res.GetInt(TableColColumnSizeIndex); // for char or date types this is the maximum number of characters F.ColumnPrecision := res.GetInt(TableColColumnSizeIndex); // for numeric or decimal types this is precision F.ColumnScale := res.GetInt(TableColColumnDecimalDigitsIndex); // the number of fractional digits FA.Add(F); end; if n>0 then begin res := meta.GetIndexInfo('',sSchema,sTableName,false,true); while res.Next do begin {$IFDEF ZEOS72UP} F.ColumnName := res.GetUTF8String(IndexInfoColColumnNameIndex); {$else} F.ColumnName := SynUnicodeToUtf8(res.GetUnicodeString(IndexInfoColColumnNameIndex)); {$endif} i := FA.Find(F); if i>=0 then Fields[i].ColumnIndexed := true; end; SetLength(Fields,n); end; end; end; function TSQLDBZEOSConnectionProperties.TZSQLTypeToTSQLDBFieldType(aNativeType: TZSQLType): TSQLDBFieldType; begin case aNativeType of stBoolean, stByte, stShort, stInteger, stLong {$ifdef ZEOS72UP}, stSmall, stWord, stLongWord, stULong{$endif}: result := ftInt64; stFloat, stDouble: result := ftDouble; stBigDecimal{$ifdef ZEOS72UP}, stCurrency{$endif}: result := ftCurrency; stDate, stTime, stTimestamp: result := ftDate; stString, stUnicodeString, {$ifdef ZEOS72UP}stGUID, {$endif} stAsciiStream, stUnicodeStream: result := ftUTF8; stBytes, stBinaryStream: result := ftBlob; else raise ESQLDBZEOS.CreateUTF8('%: unexpected TZSQLType "%"', [self,GetEnumName(Typeinfo(TZSQLType),ord(aNativeType))^]); end; end; class function TSQLDBZEOSConnectionProperties.URI(aServer: TSQLDBDefinition; const aServerName: RawUTF8; const aLibraryLocation: TFileName; aLibraryLocationAppendExePath: boolean): RawUTF8; const /// ZDBC provider names corresponding to SynDB recognized SQL engines ZEOS_PROVIDER: array[TSQLDBDefinition] of RawUTF8 = ( '','','oracle:','mssql:','','mysql:','sqlite:', 'firebird:','','postgresql:','',''); begin result := URI(ZEOS_PROVIDER[aServer],aServerName, aLibraryLocation,aLibraryLocationAppendExePath); end; class function TSQLDBZEOSConnectionProperties.URI(const aProtocol,aServerName: RawUTF8; const aLibraryLocation: TFileName; aLibraryLocationAppendExePath: boolean): RawUTF8; begin // return e.g. mysql://192.168.2.60:3306/world?username=root;password=dev result := trim(aProtocol); if result='' then exit; if aServerName<>'' then result := result+'//'+aServerName; if aLibraryLocation<>'' then begin if (aServerName <> '') and (aServerName[1] = '?') then result := result+';LibLocation=' else result := result+'?LibLocation='; if aLibraryLocationAppendExePath then result := result+StringToUTF8(ExeVersion.ProgramFilePath); result := result+StringToUTF8(aLibraryLocation); end; end; { TSQLDBZEOSConnection } constructor TSQLDBZEOSConnection.Create(aProperties: TSQLDBConnectionProperties); var url: TZURL; begin inherited Create(aProperties); url := (fProperties as TSQLDBZEOSConnectionProperties).fURL; fDatabase := DriverManager.GetConnectionWithParams(url.URL,url.Properties); // EG: setup the connection transaction behavior now, not once Opened in Connect //fDatabase.SetReadOnly(false); // is default // about transactions, see https://synopse.info/forum/viewtopic.php?id=2209 //fDatabase.SetAutoCommit(true); // is default fDatabase.SetTransactionIsolation(tiReadCommitted); // will be swapped to tiSerialiable for SQLite end; procedure TSQLDBZEOSConnection.Connect; var log: ISynLog; begin if fDatabase=nil then raise ESQLDBZEOS.CreateUTF8('%.Connect() on % failed: Database=nil', [self,fProperties.ServerName]); log := SynDBLog.Enter(self, 'Connect'); if log<>nil then with (fProperties as TSQLDBZEOSConnectionProperties).fURL do log.Log(sllTrace,'Connect to % % for % at %:%',[Protocol,Database,HostName,Port]); try fDatabase.Open; if log<>nil then log.log(sllDB,'Connected to % using % %',[fProperties.ServerName, fProperties.DatabaseNameSafe,fDatabase.GetClientVersion]); inherited Connect; // notify any re-connection except on E: Exception do begin Disconnect; // clean up on fail raise; end; end; end; procedure TSQLDBZEOSConnection.Disconnect; begin try inherited Disconnect; // flush any cached statement finally if (fDatabase<>nil) and not fDatabase.IsClosed then fDatabase.Close; end; end; function TSQLDBZEOSConnection.IsConnected: boolean; begin result := Assigned(fDatabase) and not fDatabase.IsClosed; end; function TSQLDBZEOSConnection.NewStatement: TSQLDBStatement; begin if not IsConnected then Connect; result := TSQLDBZEOSStatement.Create(self); end; procedure TSQLDBZEOSConnection.StartTransaction; var log: ISynLog; begin log := SynDBLog.Enter(self,'StartTransaction'); inherited StartTransaction; {$IFDEF ZEOS73UP} fDatabase.StartTransaction; //returns the txn level {$ELSE} fDatabase.SetAutoCommit(false); {$ENDIF} end; procedure TSQLDBZEOSConnection.Commit; begin inherited Commit; try fDatabase.Commit; except inc(fTransactionCount); // the transaction is still active raise; end; {$IFNDEF ZEOS73UP} //no longer required zdbc falls back to AC automatically fDatabase.SetAutoCommit(true); {$ENDIF} end; procedure TSQLDBZEOSConnection.Rollback; begin inherited Rollback; fDatabase.Rollback; {$IFNDEF ZEOS73UP} //no longer required zdbc falls back to AC automatically fDatabase.SetAutoCommit(true); {$ENDIF} end; { TSQLDBZEOSStatement } procedure TSQLDBZEOSStatement.Prepare(const aSQL: RawUTF8; ExpectResults: boolean); begin SQLLogBegin(sllDB); if (fStatement<>nil) or (fResultSet<>nil) then raise ESQLDBZEOS.CreateUTF8('%.Prepare() shall be called once',[self]); inherited Prepare(aSQL,ExpectResults); // connect if necessary fStatement := (fConnection as TSQLDBZEOSConnection).fDatabase. PrepareStatementWithParams({$ifdef UNICODE}UTF8ToString(fSQL){$else}fSQL{$endif}, // see controls_cp=CP_UTF8 (fConnection.Properties as TSQLDBZEOSConnectionProperties).fStatementParams); SQLLogEnd; end; {$ifdef ZEOS72UP} type // see https://synopse.info/forum/viewtopic.php?pid=11946#p11946 TZeosArrayBinding = class protected // ZDBC uses pointer references to arrays -> allocated with the class fNullArray: array of TBooleanDynArray; fInt64Array: array of TInt64DynArray; fDoubleArray: array of TDoubleDynArray; fCurDynArray: array of TCurrencyDynArray; fDateDynArray: array of TDateTimeDynArray; fUTF8DynArray: array of TRawUTF8DynArray; fBlobDynArray: array of TInterfaceDynArray; fDynArraySize: array[ftInt64..ftBlob] of Integer; public constructor Create(aStatement: TSQLDBZEOSStatement); end; constructor TZeosArrayBinding.Create(aStatement: TSQLDBZEOSStatement); var p,j,n: integer; ndx: array[ftInt64..ftBlob] of integer; kind: TSQLDBFieldType; begin with aStatement do begin SetLength(fNullArray,fParamCount); for p := 0 to fParamCount-1 do if fParams[p].VType in [ftInt64..ftBlob] then inc(fDynArraySize[fParams[p].VType]); SetLength(fInt64Array,fDynArraySize[ftInt64]); SetLength(fDoubleArray,fDynArraySize[ftDouble]); SetLength(fCurDynArray,fDynArraySize[ftCurrency]); SetLength(fDateDynArray,fDynArraySize[ftDate]); SetLength(fUTF8DynArray,fDynArraySize[ftUTF8]); SetLength(fBlobDynArray,fDynArraySize[ftBlob]); fillchar(ndx,sizeof(ndx),0); for p := 0 to fParamCount-1 do begin if fParams[p].VInt64<>fParamsArrayCount then raise ESQLDBZEOS.CreateUTF8( '%.ExecutePrepared: #% parameter expected array count %, got %', [aStatement,p,fParamsArrayCount,fParams[p].VInt64]); SetLength(fNullArray[p],fParamsArrayCount); with fParams[p] do begin case VType of ftUnknown: raise ESQLDBZEOS.CreateUTF8( '%.ExecutePrepared: Unknown type array parameter #%',[aStatement,p+FirstDbcIndex]); ftNull: begin // handle null column for j := 0 to fParamsArrayCount -1 do fNullArray[p][j] := True; fStatement.SetDataArray(p+FirstDbcIndex,'',stString,vtUTF8String); end; else begin // array binding of ftInt64..ftBlob values from fParams[p].VArray[] for j := 0 to fParamsArrayCount -1 do fNullArray[p][j] := VArray[j]='null'; n := ndx[VType]; case VType of ftInt64: begin SetLength(fInt64Array[n],fParamsArrayCount); for j := 0 to fParamsArrayCount -1 do if not fNullArray[p][j] then SetInt64(pointer(VArray[j]),fInt64Array[n][j]); fStatement.SetDataArray(p+FirstDbcIndex,fInt64Array[n],stLong); end; ftDouble: begin SetLength(fDoubleArray[n],fParamsArrayCount); for j := 0 to fParamsArrayCount -1 do if not fNullArray[p][j] then fDoubleArray[n][j] := GetExtended(pointer(VArray[j])); fStatement.SetDataArray(p+FirstDbcIndex,fDoubleArray[n],stDouble); end; ftCurrency: begin SetLength(fCurDynArray[n],fParamsArrayCount); for j := 0 to fParamsArrayCount -1 do if not fNullArray[p][j] then fCurDynArray[n][j] := StrToCurrency(pointer(VArray[j])); fStatement.SetDataArray(p+FirstDbcIndex,fCurDynArray[n],stCurrency); end; ftDate: begin SetLength(fDateDynArray[n],fParamsArrayCount); for j := 0 to fParamsArrayCount -1 do if not fNullArray[p][j] then fDateDynArray[n][j] := Iso8601ToDateTimePUTF8Char( PUTF8Char(pointer(VArray[j]))+1,Length(VArray[j])-2); fStatement.SetDataArray(p+FirstDbcIndex,fDateDynArray[n],stTimestamp); end; ftUTF8: begin SetLength(fUTF8DynArray[n],fParamsArrayCount); for j := 0 to fParamsArrayCount -1 do if not fNullArray[p][j] then UnQuoteSQLStringVar(pointer(VArray[j]),fUTF8DynArray[n][j]); fStatement.SetDataArray(p+FirstDbcIndex,fUTF8DynArray[n],stString,vtUTF8String); end; ftBlob: begin SetLength(fBlobDynArray[n],fParamsArrayCount); for j := 0 to fParamsArrayCount -1 do if not fNullArray[p][j] then fBlobDynArray[n][j] := TZAbstractBlob.CreateWithData( Pointer(VArray[j]),length(VArray[j])); fStatement.SetDataArray(p+FirstDbcIndex,fBlobDynArray[n],stBinaryStream); end; end; inc(ndx[VType]); end; end; end; fStatement.SetNullArray(p+FirstDbcIndex,stBoolean,fNullArray[p]); end; for kind := low(ndx) to high(ndx) do assert(ndx[kind]=fDynArraySize[kind]); end; end; {$endif ZEOS72UP} procedure TSQLDBZEOSStatement.ExecutePrepared; var i,n: integer; Props: TSQLDBZEOSConnectionProperties; name: string; {$ifdef ZEOS72UP} arrayBinding: TZeosArrayBinding; {$endif} begin SQLLogBegin(sllSQL); inherited ExecutePrepared; // set fConnection.fLastAccessTicks if fStatement=nil then raise ESQLDBZEOS.CreateUTF8('%.ExecutePrepared() invalid call',[self]); {$ifndef ZEOS72UP} //commenting this makes it possible to seek cursor pos to 0 and use the interface again -> e.g. ReadOneByOneRate if fResultSet<>nil then raise ESQLDBZEOS.CreateUTF8('%.ExecutePrepared() miss a Reset',[self]); {$endif} // 1. bind parameters in fParams[] to fQuery.Params {$ifdef ZEOS72UP} arrayBinding := nil; if fParamsArrayCount>0 then with (fConnection.Properties as TSQLDBZEOSConnectionProperties) do if fSupportsArrayBindings then arrayBinding := TZeosArrayBinding.Create(self) else if not fExpectResults then raise ESQLDBZEOS.CreateUTF8( '%.BindArray() not supported by % provider',[self,DBMSName]); try if arrayBinding=nil then {$else} if (fParamsArrayCount>0) and not fExpectResults then raise ESQLDBZEOS.CreateUTF8('%.BindArray() not supported',[self]) else {$endif} for i := fParamCount-1 downto 0 do // EG: downto minimize memallocs with fParams[i] do begin if (Length(VArray)>0) and (fConnection.Properties.DBMS=dPostgreSQL) then begin if VType in [ftInt64,ftCurrency,ftDouble,ftUTF8] then VData := BoundArrayToJSONArray(VArray) else raise ESQLDBZEOS.CreateUTF8('%.ExecutePrepared: Invalid array type % ' + 'on bound parameter #%', [Self, ToText(VType)^, i]); VType := ftUTF8; end; case VType of ftNull: fStatement.SetNull(i+FirstDbcIndex,stUnknown); ftInt64: fStatement.SetLong(i+FirstDbcIndex,VInt64); ftDouble: fStatement.SetDouble(i+FirstDbcIndex,unaligned(PDouble(@VInt64)^)); ftCurrency: {$ifdef ZEOS72UP} fStatement.SetCurrency(i+FirstDbcIndex,PCurrency(@VInt64)^); {$else} fStatement.SetBigDecimal(i+FirstDbcIndex,PCurrency(@VInt64)^); {$endif} ftDate: fStatement.SetTimestamp(i+FirstDbcIndex,PDateTime(@VInt64)^); ftUTF8: {$ifdef ZEOS72UP} fStatement.SetUTF8String(i+FirstDbcIndex,VData); {$else} {$ifdef UNICODE} // ZWideString = SynUnicode in fact fStatement.SetString(i+FirstDbcIndex,UTF8ToSynUnicode(VData)); {$else} fStatement.SetString(i+FirstDbcIndex,VData); // see controls_cp=CP_UTF8 {$endif} {$endif} ftBlob: fStatement.SetBlob(i+FirstDbcIndex,stBinaryStream, TZAbstractBlob.CreateWithData(Pointer(VData),length(VData) {$ifndef ZEOS72UP},fStatement.GetConnection{$endif})); else raise ESQLDBZEOS.CreateUTF8('%.ExecutePrepared: Invalid type parameter #%', [self,i]); end; end; // 2. Execute query if fExpectResults then begin fColumnCount := 0; fColumn.ReHash; fCurrentRow := -1; fResultSet := fStatement.ExecuteQueryPrepared; if fResultSet=nil then begin // e.g. PRAGMA in TZSQLiteCAPIPreparedStatement.ExecuteQueryPrepared SynDBLog.Add.Log(sllWarning,'ZDBC.ExecutePrepared returned nil %',[fSQL],self); end else begin Props := fConnection.Properties as TSQLDBZEOSConnectionProperties; fResultInfo := fResultSet.GetMetadata; n := fResultInfo.GetColumnCount; fColumn.Capacity := n; for i := 0 to n-1 do begin name := fResultInfo.GetColumnLabel(i+FirstDbcIndex); if name='' then name := fResultInfo.GetColumnName(i+FirstDbcIndex); PSQLDBColumnProperty(fColumn.AddAndMakeUniqueName( // Delphi<2009: already UTF-8 encoded due to controls_cp=CP_UTF8 {$ifdef UNICODE}StringToUTF8{$endif}(name)))^.ColumnType := Props.TZSQLTypeToTSQLDBFieldType(fResultInfo.GetColumnType(i+FirstDbcIndex)); end; end; end else fStatement.ExecuteUpdatePrepared; //ExecutePrepared allways trys to determine a possible LastResultSet // 3. handle out parameters // -> TODO (fStatement is IZCallableStatement) // EH: that will propably also be supported with the normal prepared stmts // on 7.3 (base implementation in classe is ready for most drivers 01.03.2019 // but not complete!) {$ifdef ZEOS72UP} finally arrayBinding.Free; end; {$endif} SQLLogEnd; end; procedure TSQLDBZEOSStatement.Reset; begin ReleaseRows; if fStatement<>nil then fStatement.ClearParameters; inherited Reset; end; procedure TSQLDBZEOSStatement.ReleaseRows; begin if fResultSet<>nil then fResultSet.ResetCursor; inherited ReleaseRows; end; function TSQLDBZEOSStatement.Step(SeekFirst: boolean): boolean; begin if fColumnCount=0 then // no row returned result := false else if fResultSet=nil then raise ESQLDBZEOS.CreateUTF8('%.Step() invalid self',[self]) else if SeekFirst then begin result := fResultSet.First; if result then fCurrentRow := 1 else fCurrentRow := 0; end else begin result := fResultSet.Next; if result then inc(fCurrentRow); end; end; {$if defined(ZEOS73UP) and defined(USE_SYNCOMMONS)} procedure TSQLDBZEOSStatement.AfterConstruction; begin inherited; fJSONComposeOptions := [jcoEndJSONObject]; end; {$ifend} function TSQLDBZEOSStatement.ColumnBlob(Col: Integer): RawByteString; var blob: IZBlob; begin if (fResultSet=nil) or (cardinal(Col)>=cardinal(fColumnCount)) then raise ESQLDBZEOS.CreateUTF8('%.ColumnBlob(%) ResultSet=%',[self,Col,fResultSet]); blob := fResultSet.GetBlob(Col+FirstDbcIndex); if (blob=nil) or blob.IsEmpty then result := '' else result := blob.GetString; // ZAnsiString = RawByteString end; function TSQLDBZEOSStatement.ColumnCurrency(Col: Integer): currency; begin if (fResultSet=nil) or (cardinal(Col)>=cardinal(fColumnCount)) then raise ESQLDBZEOS.CreateUTF8('%.ColumnCurrency(%) ResultSet=%',[self,Col,fResultSet]); {$ifdef ZEOS72UP} result := fResultSet.GetCurrency(Col+FirstDbcIndex); {$else} result := fResultSet.GetBigDecimal(Col+FirstDbcIndex); {$endif} end; function TSQLDBZEOSStatement.ColumnDateTime(Col: Integer): TDateTime; begin if (fResultSet=nil) or (cardinal(Col)>=cardinal(fColumnCount)) then raise ESQLDBZEOS.CreateUTF8('%.ColumnDateTime(%) ResultSet=%',[self,Col,fResultSet]); result := fResultSet.GetTimestamp(Col+FirstDbcIndex); end; function TSQLDBZEOSStatement.ColumnDouble(Col: Integer): double; begin if (fResultSet=nil) or (cardinal(Col)>=cardinal(fColumnCount)) then raise ESQLDBZEOS.CreateUTF8('%.ColumnDouble(%) ResultSet=%',[self,Col,fResultSet]); result := fResultSet.GetDouble(Col+FirstDbcIndex); end; function TSQLDBZEOSStatement.ColumnInt(Col: Integer): Int64; begin if (fResultSet=nil) or (cardinal(Col)>=cardinal(fColumnCount)) then raise ESQLDBZEOS.CreateUTF8('%.ColumnInt(%) ResultSet=%',[self,Col,fResultSet]); result := fResultSet.GetLong(Col+FirstDbcIndex); end; function TSQLDBZEOSStatement.ColumnNull(Col: Integer): boolean; begin if (fResultSet=nil) or (cardinal(Col)>=cardinal(fColumnCount)) then raise ESQLDBZEOS.CreateUTF8('%.ColumnNull(%) ResultSet=%',[self,Col,fResultSet]); result := fResultSet.IsNull(Col+FirstDbcIndex); end; function TSQLDBZEOSStatement.ColumnUTF8(Col: Integer): RawUTF8; begin if (fResultSet=nil) or (cardinal(Col)>=cardinal(fColumnCount)) then raise ESQLDBZEOS.CreateUTF8('%.ColumnUTF8(%) ResultSet=%',[self,Col,fResultSet]); {$ifdef ZEOS72UP} result := fResultSet.GetUTF8String(Col+FirstDbcIndex); {$else} {$ifdef UNICODE} StringToUTF8(fResultSet.GetString(Col+FirstDbcIndex),result); {$else} result := fResultSet.GetString(Col+FirstDbcIndex); // thanks to controls_cp=CP_UTF8 {$endif} {$endif} end; function TSQLDBZEOSStatement.UpdateCount: integer; begin if fStatement<>nil then result := fStatement.GetUpdateCount else result := 0; end; {$ifdef ZEOS72UP} procedure TSQLDBZEOSStatement.ColumnsToJSON(WR: TJSONWriter); {$if not (defined(ZEOS73UP) and defined(USE_SYNCOMMONS))} var col: integer; P: PAnsiChar; Len: NativeUInt; // required by Zeos for GetPAnsiChar out param (not PtrUInt) procedure WriteIZBlob; var blob: IZBlob; raw: RawByteString; begin blob := fResultSet.GetBlob(col+FirstDbcIndex); raw := blob.GetString; WR.WrBase64(pointer(raw),length(raw),{withmagic=}true); // withMagic=true end; {$ifend} begin // take care of the layout of internal ZDBC buffers for each provider {$if defined(ZEOS73UP) and defined(USE_SYNCOMMONS)} fResultSet.ColumnsToJSON(WR,fJSONComposeOptions); {$else} if WR.Expand then WR.Add('{'); for col := 0 to fColumnCount-1 do begin if WR.Expand then WR.AddFieldName(fColumns[col].ColumnName); // add '"ColumnName":' if fResultSet.IsNull(col+FirstDbcIndex) then WR.AddShort('null') else begin case fColumns[col].ColumnType of ftNull: WR.AddShort('null'); ftInt64: if fDBMS in [dMySQL,dPostgreSQL] then begin P := fResultSet.GetPAnsiChar(col+FirstDbcIndex,Len); WR.AddNoJSONEscape(P,Len); end else WR.Add(fResultSet.GetLong(col+FirstDbcIndex)); ftDouble: if fDBMS in [dMySQL,dPostgreSQL] then begin P := fResultSet.GetPAnsiChar(col+FirstDbcIndex,Len); WR.AddNoJSONEscape(P,Len); end else WR.AddDouble(fResultSet.GetDouble(col+FirstDbcIndex)); ftCurrency: if fDBMS = dSQLite then WR.AddDouble(fResultSet.GetDouble(col+FirstDbcIndex)) else WR.AddCurr64(fResultSet.GetCurrency(col+FirstDbcIndex)); ftDate: begin WR.Add('"'); WR.AddDateTime(fResultSet.GetTimestamp(col+FirstDbcIndex),fForceDateWithMS); WR.Add('"'); end; ftUTF8: begin WR.Add('"'); if fDBMS = dMSSQL then begin P := Pointer(fResultSet.GetPWideChar(Col+FirstDbcIndex, Len)); WR.AddJSONEscapeW(Pointer(P), Len); end else begin P := fResultSet.GetPAnsiChar(col+FirstDbcIndex,Len); WR.AddJSONEscape(P,Len); end; WR.Add('"'); end; ftBlob: if fForceBlobAsNull then WR.AddShort('null') else if fDBMS in [dMySQL,dSQLite] then begin P := fResultSet.GetPAnsiChar(col+FirstDbcIndex,Len); WR.WrBase64(p,Len,true); // withMagic=true end else WriteIZBlob; else raise ESQLDBException.CreateUTF8( '%.ColumnsToJSON: invalid ColumnType(#% "%")=%', [self,col,fColumns[col].ColumnName,ord(fColumns[col].ColumnType)]); end; end; WR.Add(','); end; WR.CancelLastComma; // cancel last ',' if WR.Expand then WR.Add('}'); {$ifend} end; {$endif ZEOS72UP} initialization TSQLDBZEOSConnectionProperties.RegisterClassNameForDefinition; {$endif NOSYNDBZEOS} end.