diff --git a/samples/activerecord_showcase/FDConnectionConfigU.pas b/samples/activerecord_showcase/FDConnectionConfigU.pas deleted file mode 100644 index 3a92f7b77..000000000 --- a/samples/activerecord_showcase/FDConnectionConfigU.pas +++ /dev/null @@ -1,229 +0,0 @@ -unit FDConnectionConfigU; - -interface - -const - CON_DEF_NAME = 'MyConnX'; - -procedure CreateFirebirdPrivateConnDef(AIsPooled: boolean); -procedure CreateInterbasePrivateConnDef(AIsPooled: boolean); -procedure CreateMySQLPrivateConnDef(AIsPooled: boolean); -procedure CreateMSSQLServerPrivateConnDef(AIsPooled: boolean); -procedure CreatePostgresqlPrivateConnDef(AIsPooled: boolean); -procedure CreateSqlitePrivateConnDef(AIsPooled: boolean); - -implementation - -uses - System.Classes, - System.IOUtils, - FireDAC.Comp.Client, - FireDAC.Moni.Base, - FireDAC.Moni.FlatFile, - FireDAC.Stan.Intf - ; - - -var - gFlatFileMonitor: TFDMoniFlatFileClientLink = nil; - -procedure CreateMySQLPrivateConnDef(AIsPooled: boolean); -var - LParams: TStringList; -begin - { - docker run --name mariadb --detach --env MARIADB_USER=root --env MARIADB_PASSWORD=root --env MARIADB_ROOT_PASSWORD=root -p 3306:3306 mariadb:latest - docker run --name mysql -p 3306:3306 -e MYSQL_ROOT_PASSWORD=root -d mysql:oraclelinux9 --default-authentication-plugin=mysql_native_password - } - - LParams := TStringList.Create; - try - LParams.Add('Database=activerecorddb'); - LParams.Add('Protocol=TCPIP'); - LParams.Add('Server=localhost'); - LParams.Add('User_Name=root'); - LParams.Add('Password=root'); - LParams.Add('TinyIntFormat=Boolean'); { it's the default } - LParams.Add('CharacterSet=utf8mb4'); // not utf8!! - LParams.Add('MonitorBy=FlatFile'); - if AIsPooled then - begin - LParams.Add('Pooled=True'); - LParams.Add('POOL_MaximumItems=100'); - end - else - begin - LParams.Add('Pooled=False'); - end; - FDManager.AddConnectionDef(CON_DEF_NAME, 'MySQL', LParams); - finally - LParams.Free; - end; -end; - -procedure CreateMSSQLServerPrivateConnDef(AIsPooled: boolean); -var - LParams: TStringList; -begin - { - docker run -e "ACCEPT_EULA=Y" -e "SA_PASSWORD=!SA_password!" -p 1433:1433 -d mcr.microsoft.com/mssql/server:2019-latest - } - - // [ACTIVERECORDB_SQLSERVER] - // Database=activerecorddb - // OSAuthent=Yes - // Server=DANIELETETI\SQLEXPRESS - // DriverID=MSSQL - // - - LParams := TStringList.Create; - try - LParams.Add('Database=activerecorddb'); - LParams.Add('OSAuthent=No'); - LParams.Add('Server=localhost'); - LParams.Add('User_Name=sa'); - LParams.Add('Password=Daniele123!'); - if AIsPooled then - begin - LParams.Add('Pooled=True'); - LParams.Add('POOL_MaximumItems=100'); - end - else - begin - LParams.Add('Pooled=False'); - end; - FDManager.AddConnectionDef(CON_DEF_NAME, 'MSSQL', LParams); - finally - LParams.Free; - end; -end; - -procedure CreateFirebirdPrivateConnDef(AIsPooled: boolean); -var - LParams: TStringList; -begin - LParams := TStringList.Create; - try - LParams.Add('Database=' + TPath.GetFullPath(TPath.Combine('..\..', - 'data\ACTIVERECORDDB.FDB'))); - LParams.Add('Protocol=TCPIP'); - LParams.Add('Server=localhost'); - LParams.Add('User_Name=sysdba'); - LParams.Add('Password=masterkey'); - LParams.Add('CharacterSet=UTF8'); - if AIsPooled then - begin - LParams.Add('Pooled=True'); - LParams.Add('POOL_MaximumItems=100'); - end - else - begin - LParams.Add('Pooled=False'); - end; - FDManager.AddConnectionDef(CON_DEF_NAME, 'FB', LParams); - finally - LParams.Free; - end; -end; - -procedure CreateInterbasePrivateConnDef(AIsPooled: boolean); -var - LParams: TStringList; -begin - LParams := TStringList.Create; - try - LParams.Add('Database=' + TPath.GetFullPath(TPath.Combine('..\..', - 'data\ACTIVERECORDDB.IB'))); - LParams.Add('Protocol=TCPIP'); - LParams.Add('Server=localhost'); - LParams.Add('User_Name=sysdba'); - LParams.Add('Password=masterkey'); - LParams.Add('CharacterSet=UTF8'); - if AIsPooled then - begin - LParams.Add('Pooled=True'); - LParams.Add('POOL_MaximumItems=100'); - end - else - begin - LParams.Add('Pooled=False'); - end; - FDManager.AddConnectionDef(CON_DEF_NAME, 'IB', LParams); - finally - LParams.Free; - end; -end; - -procedure CreatePostgresqlPrivateConnDef(AIsPooled: boolean); -var - LParams: TStringList; -begin - LParams := TStringList.Create; - try - LParams.Add('Database=activerecorddb'); - LParams.Add('Protocol=TCPIP'); - LParams.Add('Server=localhost'); - LParams.Add('User_Name=postgres'); - LParams.Add('Password=postgres'); - LParams.Add('MonitorBy=FlatFile'); - - // https://quality.embarcadero.com/browse/RSP-19755?jql=text%20~%20%22firedac%20guid%22 - LParams.Add('GUIDEndian=Big'); - if AIsPooled then - begin - LParams.Add('Pooled=True'); - LParams.Add('POOL_MaximumItems=100'); - end - else - begin - LParams.Add('Pooled=False'); - end; - FDManager.AddConnectionDef(CON_DEF_NAME, 'PG', LParams); - finally - LParams.Free; - end; -end; - -procedure CreateSqlitePrivateConnDef(AIsPooled: boolean); -var - LParams: TStringList; - lFName: string; -begin - LParams := TStringList.Create; - try - lFName := TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), - '..\..\data\activerecorddb.db'); - LParams.Add('Database=' + lFName); - LParams.Add('StringFormat=Unicode'); - if AIsPooled then - begin - LParams.Add('Pooled=True'); - LParams.Add('POOL_MaximumItems=100'); - end - else - begin - LParams.Add('Pooled=False'); - end; - FDManager.AddConnectionDef(CON_DEF_NAME, 'SQLite', LParams); - finally - LParams.Free; - end; -end; - -initialization - -gFlatFileMonitor := TFDMoniFlatFileClientLink.Create(nil); -gFlatFileMonitor.FileColumns := [tiRefNo, tiTime, tiThreadID, tiClassName, tiObjID, tiMsgText]; -gFlatFileMonitor.EventKinds := [ - ekVendor, ekConnConnect, ekLiveCycle, ekError, ekConnTransact, - ekCmdPrepare, ekCmdExecute, ekCmdDataIn, ekCmdDataOut]; -gFlatFileMonitor.ShowTraces := False; -gFlatFileMonitor.FileAppend := False; -gFlatFileMonitor.FileName := TPath.ChangeExtension(ParamStr(0), '.trace.log'); -gFlatFileMonitor.Tracing := True; - -finalization - -gFlatFileMonitor.Free; - -end. diff --git a/samples/activerecord_showcase/bin32/libcrypto-1_1.dll b/samples/activerecord_showcase/bin32/libcrypto-1_1.dll deleted file mode 100644 index 52b476c04..000000000 Binary files a/samples/activerecord_showcase/bin32/libcrypto-1_1.dll and /dev/null differ diff --git a/samples/activerecord_showcase/bin32/libiconv-2.dll b/samples/activerecord_showcase/bin32/libiconv-2.dll deleted file mode 100644 index 5a0f41c9e..000000000 Binary files a/samples/activerecord_showcase/bin32/libiconv-2.dll and /dev/null differ diff --git a/samples/activerecord_showcase/bin32/libintl-8.dll b/samples/activerecord_showcase/bin32/libintl-8.dll deleted file mode 100644 index baf011b2a..000000000 Binary files a/samples/activerecord_showcase/bin32/libintl-8.dll and /dev/null differ diff --git a/samples/activerecord_showcase/bin32/libpq.dll b/samples/activerecord_showcase/bin32/libpq.dll deleted file mode 100644 index 1a433f464..000000000 Binary files a/samples/activerecord_showcase/bin32/libpq.dll and /dev/null differ diff --git a/samples/activerecord_showcase/bin32/libssl-1_1.dll b/samples/activerecord_showcase/bin32/libssl-1_1.dll deleted file mode 100644 index 739962422..000000000 Binary files a/samples/activerecord_showcase/bin32/libssl-1_1.dll and /dev/null differ diff --git a/samples/activerecord_showcase/bin64/libcrypto-1_1-x64.dll b/samples/activerecord_showcase/bin64/libcrypto-1_1-x64.dll deleted file mode 100644 index 3cdc54701..000000000 Binary files a/samples/activerecord_showcase/bin64/libcrypto-1_1-x64.dll and /dev/null differ diff --git a/samples/activerecord_showcase/bin64/libiconv-2.dll b/samples/activerecord_showcase/bin64/libiconv-2.dll deleted file mode 100644 index 80ae6b73d..000000000 Binary files a/samples/activerecord_showcase/bin64/libiconv-2.dll and /dev/null differ diff --git a/samples/activerecord_showcase/bin64/libintl-8.dll b/samples/activerecord_showcase/bin64/libintl-8.dll deleted file mode 100644 index f27a4344b..000000000 Binary files a/samples/activerecord_showcase/bin64/libintl-8.dll and /dev/null differ diff --git a/samples/activerecord_showcase/bin64/libpq.dll b/samples/activerecord_showcase/bin64/libpq.dll deleted file mode 100644 index f8cabd002..000000000 Binary files a/samples/activerecord_showcase/bin64/libpq.dll and /dev/null differ diff --git a/samples/activerecord_showcase/bin64/libssl-1_1-x64.dll b/samples/activerecord_showcase/bin64/libssl-1_1-x64.dll deleted file mode 100644 index a2b71f73d..000000000 Binary files a/samples/activerecord_showcase/bin64/libssl-1_1-x64.dll and /dev/null differ diff --git a/samples/activerecord_showcase/EngineChoiceFormU.dfm b/samples/unidac_activerecord_showcase/EngineChoiceFormU.dfm similarity index 100% rename from samples/activerecord_showcase/EngineChoiceFormU.dfm rename to samples/unidac_activerecord_showcase/EngineChoiceFormU.dfm diff --git a/samples/activerecord_showcase/EngineChoiceFormU.pas b/samples/unidac_activerecord_showcase/EngineChoiceFormU.pas similarity index 100% rename from samples/activerecord_showcase/EngineChoiceFormU.pas rename to samples/unidac_activerecord_showcase/EngineChoiceFormU.pas diff --git a/samples/activerecord_showcase/EntitiesU.pas b/samples/unidac_activerecord_showcase/EntitiesU.pas similarity index 99% rename from samples/activerecord_showcase/EntitiesU.pas rename to samples/unidac_activerecord_showcase/EntitiesU.pas index adf302cc5..10f9002e2 100644 --- a/samples/activerecord_showcase/EntitiesU.pas +++ b/samples/unidac_activerecord_showcase/EntitiesU.pas @@ -32,7 +32,7 @@ interface MVCFramework.ActiveRecord, System.Generics.Collections, System.Classes, - FireDAC.Stan.Param, + Data.DB, MVCFramework.Nullables; type diff --git a/samples/activerecord_showcase/MainFormU.dfm b/samples/unidac_activerecord_showcase/MainFormU.dfm similarity index 100% rename from samples/activerecord_showcase/MainFormU.dfm rename to samples/unidac_activerecord_showcase/MainFormU.dfm diff --git a/samples/activerecord_showcase/MainFormU.pas b/samples/unidac_activerecord_showcase/MainFormU.pas similarity index 98% rename from samples/activerecord_showcase/MainFormU.pas rename to samples/unidac_activerecord_showcase/MainFormU.pas index dd1207fac..2ed90e68e 100644 --- a/samples/activerecord_showcase/MainFormU.pas +++ b/samples/unidac_activerecord_showcase/MainFormU.pas @@ -1,4 +1,4 @@ -unit MainFormU; +unit MainFormU; interface @@ -13,18 +13,11 @@ interface Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, - FireDAC.Stan.Intf, - FireDAC.Stan.Option, - FireDAC.Stan.Error, - FireDAC.UI.Intf, - FireDAC.Phys.Intf, - FireDAC.Stan.Def, - FireDAC.Stan.Pool, - FireDAC.Stan.Async, - FireDAC.Phys, - FireDAC.VCLUI.Wait, + Uni, + UniDacVcl, + DBAccess, + UniProvider, Data.DB, - FireDAC.Comp.Client, MVCFramework.Nullables, MVCFramework.ActiveRecord, MVCFramework.Logger, @@ -127,7 +120,7 @@ implementation MVCFramework.DataSet.Utils, MVCFramework.RQL.Parser, System.Math, - FDConnectionConfigU, + UniDACConnectionConfigU, EngineChoiceFormU, System.Rtti; @@ -2028,12 +2021,12 @@ procedure TMainForm.btnUseExplicitConnectionClick(Sender: TObject); lCustomer: TCustomer; lID: Integer; lTestNote: string; - lConn: TFDConnection; + lConn: TUniConnection; begin Log('** Use Explicit Connection'); - lConn := TFDConnection.Create(nil); + lConn := TUniConnection.Create(nil); try - lConn.ConnectionDefName := CON_DEF_NAME; + lConn.ConnectionName := CON_DEF_NAME; lCustomer := TCustomer.Create(lConn); try Log('Entity ' + TCustomer.ClassName + ' is mapped to table ' + lCustomer.TableName); @@ -2447,37 +2440,37 @@ procedure TMainForm.FormShow(Sender: TObject); case lEngine of TRDBMSEngine.PostgreSQL: begin - FDConnectionConfigU.CreatePostgresqlPrivateConnDef(True); + UniDACConnectionConfigU.CreatePostgresqlPrivateConnDef(True); end; TRDBMSEngine.Firebird: begin - FDConnectionConfigU.CreateFirebirdPrivateConnDef(True); + UniDACConnectionConfigU.CreateFirebirdPrivateConnDef(True); end; TRDBMSEngine.Interbase: begin - FDConnectionConfigU.CreateInterbasePrivateConnDef(True); + UniDACConnectionConfigU.CreateInterbasePrivateConnDef(True); end; TRDBMSEngine.MySQL: begin - FDConnectionConfigU.CreateMySQLPrivateConnDef(True); + UniDACConnectionConfigU.CreateMySQLPrivateConnDef(True); end; TRDBMSEngine.MariaDB: begin - FDConnectionConfigU.CreateMySQLPrivateConnDef(True); + UniDACConnectionConfigU.CreateMySQLPrivateConnDef(True); end; TRDBMSEngine.SQLite: begin - FDConnectionConfigU.CreateSqlitePrivateConnDef(True); + UniDACConnectionConfigU.CreateSqlitePrivateConnDef(True); end; TRDBMSEngine.MSSQLServer: begin - FDConnectionConfigU.CreateMSSQLServerPrivateConnDef(True); + UniDACConnectionConfigU.CreateMSSQLServerPrivateConnDef(True); end; else raise Exception.Create('Unknown RDBMS'); end; - ActiveRecordConnectionsRegistry.AddDefaultConnection(FDConnectionConfigU.CON_DEF_NAME); + ActiveRecordConnectionsRegistry.AddDefaultConnection(UniDACConnectionConfigU.CON_DEF_NAME); Caption := Caption + ' (Curr Backend: ' + ActiveRecordConnectionsRegistry.GetCurrentBackend + ')'; {$IFDEF USE_SEQUENCES} Caption := Caption + ' USE_SEQUENCES'; diff --git a/samples/unidac_activerecord_showcase/UniDACConnectionConfigU.pas b/samples/unidac_activerecord_showcase/UniDACConnectionConfigU.pas new file mode 100644 index 000000000..cd5f36535 --- /dev/null +++ b/samples/unidac_activerecord_showcase/UniDACConnectionConfigU.pas @@ -0,0 +1,179 @@ +unit UniDACConnectionConfigU; + +interface + +const + CON_DEF_NAME = 'MyConnX'; + +procedure CreateFirebirdPrivateConnDef(AIsPooled: boolean); +procedure CreateInterbasePrivateConnDef(AIsPooled: boolean); +procedure CreateMySQLPrivateConnDef(AIsPooled: boolean); +procedure CreateMSSQLServerPrivateConnDef(AIsPooled: boolean); +procedure CreatePostgresqlPrivateConnDef(AIsPooled: boolean); +procedure CreateSqlitePrivateConnDef(AIsPooled: boolean); + +implementation + +uses + System.Classes, + System.IOUtils, + UniProvider, + DBAccess; + +procedure CreateMySQLPrivateConnDef(AIsPooled: boolean); +var + LParams: TStringList; +begin + LParams := TStringList.Create; + try + LParams.Add('Database=activerecorddb'); + LParams.Add('Server=localhost'); + LParams.Add('Username=root'); + LParams.Add('Password=root'); + LParams.Add('SpecificOptions.MySQL.TinyIntFormat=Boolean'); + LParams.Add('CharSet=utf8mb4'); // not utf8!! + if AIsPooled then + begin + LParams.Add('Pooling=True'); + LParams.Add('Pool.MaxPoolSize=100'); + end + else + begin + LParams.Add('Pooling=False'); + end; + UniProviderManager.GetProvider('MySQL').AddConnection(LParams, True, CON_DEF_NAME); + finally + LParams.Free; + end; +end; + +procedure CreateMSSQLServerPrivateConnDef(AIsPooled: boolean); +var + LParams: TStringList; +begin + LParams := TStringList.Create; + try + LParams.Add('Database=activerecorddb'); + LParams.Add('Server=localhost'); + LParams.Add('Username=sa'); + LParams.Add('Password=Daniele123!'); + if AIsPooled then + begin + LParams.Add('Pooling=True'); + LParams.Add('Pool.MaxPoolSize=100'); + end + else + begin + LParams.Add('Pooling=False'); + end; + UniProviderManager.GetProvider('SQLServer').AddConnection(LParams, True, CON_DEF_NAME); + finally + LParams.Free; + end; +end; + +procedure CreateFirebirdPrivateConnDef(AIsPooled: boolean); +var + LParams: TStringList; +begin + LParams := TStringList.Create; + try + LParams.Add('Database=' + TPath.GetFullPath(TPath.Combine('..\..', + 'data\ACTIVERECORDDB.FDB'))); + LParams.Add('Server=localhost'); + LParams.Add('Username=sysdba'); + LParams.Add('Password=masterkey'); + LParams.Add('CharSet=UTF8'); + if AIsPooled then + begin + LParams.Add('Pooling=True'); + LParams.Add('Pool.MaxPoolSize=100'); + end + else + begin + LParams.Add('Pooling=False'); + end; + UniProviderManager.GetProvider('Firebird').AddConnection(LParams, True, CON_DEF_NAME); + finally + LParams.Free; + end; +end; + +procedure CreateInterbasePrivateConnDef(AIsPooled: boolean); +var + LParams: TStringList; +begin + LParams := TStringList.Create; + try + LParams.Add('Database=' + TPath.GetFullPath(TPath.Combine('..\..', + 'data\ACTIVERECORDDB.IB'))); + LParams.Add('Server=localhost'); + LParams.Add('Username=sysdba'); + LParams.Add('Password=masterkey'); + LParams.Add('CharSet=UTF8'); + if AIsPooled then + begin + LParams.Add('Pooling=True'); + LParams.Add('Pool.MaxPoolSize=100'); + end + else + begin + LParams.Add('Pooling=False'); + end; + UniProviderManager.GetProvider('Interbase').AddConnection(LParams, True, CON_DEF_NAME); + finally + LParams.Free; + end; +end; + +procedure CreatePostgresqlPrivateConnDef(AIsPooled: boolean); +var + LParams: TStringList; +begin + LParams := TStringList.Create; + try + LParams.Add('Database=activerecorddb'); + LParams.Add('Server=localhost'); + LParams.Add('Username=postgres'); + LParams.Add('Password=postgres'); + if AIsPooled then + begin + LParams.Add('Pooling=True'); + LParams.Add('Pool.MaxPoolSize=100'); + end + else + begin + LParams.Add('Pooling=False'); + end; + UniProviderManager.GetProvider('PostgreSQL').AddConnection(LParams, True, CON_DEF_NAME); + finally + LParams.Free; + end; +end; + +procedure CreateSqlitePrivateConnDef(AIsPooled: boolean); +var + LParams: TStringList; + lFName: string; +begin + LParams := TStringList.Create; + try + lFName := TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), + '..\..\data\activerecorddb.db'); + LParams.Add('Database=' + lFName); + if AIsPooled then + begin + LParams.Add('Pooling=True'); + LParams.Add('Pool.MaxPoolSize=100'); + end + else + begin + LParams.Add('Pooling=False'); + end; + UniProviderManager.GetProvider('SQLite').AddConnection(LParams, True, CON_DEF_NAME); + finally + LParams.Free; + end; +end; + +end. diff --git a/samples/activerecord_showcase/activerecord_showcase.dpr b/samples/unidac_activerecord_showcase/unidac_activerecord_showcase.dpr similarity index 94% rename from samples/activerecord_showcase/activerecord_showcase.dpr rename to samples/unidac_activerecord_showcase/unidac_activerecord_showcase.dpr index d22cad061..0c38dc3d8 100644 --- a/samples/activerecord_showcase/activerecord_showcase.dpr +++ b/samples/unidac_activerecord_showcase/unidac_activerecord_showcase.dpr @@ -1,10 +1,10 @@ -program activerecord_showcase; +program unidac_activerecord_showcase; uses Vcl.Forms, MainFormU in 'MainFormU.pas' {MainForm}, EntitiesU in 'EntitiesU.pas', - FDConnectionConfigU in 'FDConnectionConfigU.pas', + UniDACConnectionConfigU in 'UniDACConnectionConfigU.pas', MVCFramework.RQL.AST2FirebirdSQL in '..\..\sources\MVCFramework.RQL.AST2FirebirdSQL.pas', MVCFramework.SQLGenerators.MySQL in '..\..\sources\MVCFramework.SQLGenerators.MySQL.pas', MVCFramework.SQLGenerators.Firebird in '..\..\sources\MVCFramework.SQLGenerators.Firebird.pas', diff --git a/samples/activerecord_showcase/activerecord_showcase.dproj b/samples/unidac_activerecord_showcase/unidac_activerecord_showcase.dproj similarity index 99% rename from samples/activerecord_showcase/activerecord_showcase.dproj rename to samples/unidac_activerecord_showcase/unidac_activerecord_showcase.dproj index 2f87dee44..f5f45e913 100644 --- a/samples/activerecord_showcase/activerecord_showcase.dproj +++ b/samples/unidac_activerecord_showcase/unidac_activerecord_showcase.dproj @@ -3,13 +3,13 @@ {F8576ED6-649F-4E28-B364-1F60687C75F2} 20.3 VCL - activerecord_showcase.dpr + unidac_activerecord_showcase.dpr True BUILD Win64 3 Application - activerecord_showcase + unidac_activerecord_showcase true @@ -67,7 +67,7 @@ $(BDS)\bin\delphi_PROJECTICON.ico $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - activerecord_showcase + unidac_activerecord_showcase 1040 CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= @@ -117,7 +117,7 @@ dfm - + @@ -156,7 +156,7 @@ - activerecord_showcase.dpr + unidac_activerecord_showcase.dpr Microsoft Office 2000 Sample Automation Server Wrapper Components diff --git a/sources/MVCFramework.ActiveRecord.pas b/sources/MVCFramework.ActiveRecord.pas index 251acaf1b..30f962042 100644 --- a/sources/MVCFramework.ActiveRecord.pas +++ b/sources/MVCFramework.ActiveRecord.pas @@ -34,13 +34,10 @@ interface System.Generics.Defaults, System.Generics.Collections, System.RTTI, - FireDAC.DApt, Data.DB, - FireDAC.Comp.Client, - FireDAC.Stan.Def, - FireDAC.Stan.Pool, - FireDAC.Stan.Async, - FireDAC.Stan.Param, + Uni, + DBAccess, + UniProvider, MVCFramework, MVCFramework.Commons, MVCFramework.RQL.Parser, @@ -83,7 +80,7 @@ TMVCActiveRecord = class; {$IF Defined(CUSTOM_MANAGED_RECORDS)} TMVCTransactionContext = record private - fConnection: TFDConnection; + fConnection: TUniConnection; public class operator Finalize(var Dest: TMVCTransactionContext); class operator Assign (var Dest: TMVCTransactionContext; const [ref] Src: TMVCTransactionContext); @@ -92,39 +89,15 @@ TMVCTransactionContext = record {$ENDIF} TMVCActiveRecordFieldOption = ( - /// - /// It's the primary key of the mapped table } - /// foPrimaryKey, - /// - /// Not written, read - similar to readonly - is updated after insert and update - /// foAutoGenerated, - /// - /// shortcut for --> Insertable := False; Updatable := False; Selectable := True; - /// foReadOnly, - /// - /// used for versioning, only one field with foVersion is allowed in class - /// foVersion, - /// - /// not included in SQL SELECT commands - /// foDoNotSelect, - /// - /// not included in SQL INSERT commands - /// foDoNotInsert, - /// - /// not included in SQL UPDATE commands - /// foDoNotUpdate ); - - - TMVCActiveRecordFieldOptions = set of TMVCActiveRecordFieldOption; TMVCEntityAction = (eaCreate, eaRetrieve, eaUpdate, eaDelete); TMVCEntityActions = set of TMVCEntityAction; @@ -306,10 +279,10 @@ TMVCTableMap = class TMVCActiveRecord = class private fChildren: TObjectList; - fConn: TFDConnection; + fConn: TUniConnection; fSQLGenerator: TMVCSQLGenerator; fRQL2SQL: TRQL2SQL; - function MapNullableTValueToParam(aValue: TValue; const aParam: TFDParam): Boolean; + function MapNullableTValueToParam(aValue: TValue; const aParam: TParam): Boolean; function GetPrimaryKeyIsAutogenerated: Boolean; procedure SetPrimaryKeyIsAutogenerated(const Value: Boolean); function GetAttributes(const AttrName: string): TValue; @@ -322,11 +295,11 @@ TMVCActiveRecord = class fTableMap: TMVCTableMap; function GetCustomTableName: String; virtual; function GetPartitionInfo: TPartitionInfo; - function GetConnection: TFDConnection; - procedure MapTValueToParam(aValue: TValue; const aParam: TFDParam); virtual; + function GetConnection: TUniConnection; + procedure MapTValueToParam(aValue: TValue; const aParam: TParam); virtual; procedure InitTableInfo(const aTableName: String); class function - CreateQuery(const Unidirectional, DirectExecute: Boolean): TFDQuery; + CreateQuery(const Unidirectional, DirectExecute: Boolean): TUniQuery; class function ExecQuery( const SQL: string; const Values: array of Variant; @@ -335,7 +308,7 @@ TMVCActiveRecord = class class function ExecQuery( const SQL: string; const Values: array of Variant; - const Connection: TFDConnection; + const Connection: TUniConnection; const Unidirectional: Boolean; const DirectExecute: Boolean) : TDataSet; overload; @@ -350,7 +323,7 @@ TMVCActiveRecord = class const SQL: string; const Values: array of Variant; const ValueTypes: array of TFieldType; - const Connection: TFDConnection; + const Connection: TUniConnection; const Unidirectional: Boolean; const DirectExecute: Boolean): TDataSet; overload; procedure FillPrimaryKey(const SequenceName: string); @@ -361,72 +334,21 @@ TMVCActiveRecord = class // load events - /// - /// Called everywhere before persist object into database - /// procedure OnValidation(const EntityAction: TMVCEntityAction); virtual; - - /// - /// Called just after load the object state from database - /// procedure OnAfterLoad; virtual; - - /// - /// Called before load the object state from database - /// procedure OnBeforeLoad; virtual; - - /// - /// Called before insert the object state to database - /// procedure OnBeforeInsert; virtual; - - /// - /// Called after insert the object state to database - /// procedure OnAfterInsert; virtual; - - /// - /// Called before update the object state to database - /// procedure OnBeforeUpdate; virtual; - - /// - /// Called after update the object state to database - /// procedure OnAfterUpdate; virtual; - - /// - /// Called before delete object from database - /// procedure OnBeforeDelete; virtual; - - /// - /// Called after delete object from database - /// procedure OnAfterDelete; virtual; - - /// - /// Called before insert or update the object to the database - /// procedure OnBeforeInsertOrUpdate; virtual; - - /// - /// Called before execute non query sql - /// procedure OnBeforeExecuteSQL(var SQL: string); virtual; - - /// - /// Called before execute query sql - /// - class procedure OnBeforeExecuteQuerySQL(var SQL: string); virtual; - - /// - /// Called after insert or update the object to the database - /// + class procedure OnBeforeExecuteQuerySQL(var SQL: string); virtual; procedure OnAfterInsertOrUpdate; virtual; - procedure MapObjectToParams(const Params: TFDParams; var Handled: Boolean); virtual; + procedure MapObjectToParams(const Params: TParams; var Handled: Boolean); virtual; procedure MapDatasetToObject(const DataSet: TDataSet; const Options: TMVCActiveRecordLoadOptions; var Handled: Boolean); virtual; @@ -441,19 +363,13 @@ TMVCActiveRecord = class public constructor Create(aLazyLoadConnection: Boolean); overload; // cannot be virtual! constructor Create; overload; virtual; - constructor Create(const Connection: TFDConnection); overload; virtual; + constructor Create(const Connection: TUniConnection); overload; virtual; destructor Destroy; override; procedure EnsureConnection; procedure Assign(ActiveRecord: TMVCActiveRecord); virtual; procedure InvalidateConnection(const ReacquireAfterInvalidate: Boolean = false); function GetBackEnd: string; - /// - /// Executes an Insert (pk is null) or an Update (pk is not null) - /// procedure Store; - /// - /// Reload the current instance from database if the primary key is not empty. - /// procedure Refresh; virtual; function CheckAction(const aEntityAction: TMVCEntityAction; const aRaiseException: Boolean = True): Boolean; @@ -495,8 +411,8 @@ TMVCActiveRecord = class write SetPrimaryKeyIsAutogenerated; class function GetScalar(const SQL: string; const Params: array of Variant): Variant; - class function CurrentConnection: TFDConnection; - class function GetConnectionByName(const ConnectionName: String): TFDConnection; + class function CurrentConnection: TUniConnection; + class function GetConnectionByName(const ConnectionName: String): TUniConnection; end; IMVCUnitOfWork = interface @@ -539,24 +455,15 @@ TMVCActiveRecordHelper = class helper for TMVCActiveRecord const RaiseExceptionIfNotFound: Boolean = True): T; overload; { Select } - /// - /// Returns a TObjectList from a SQL using variant params - /// class function Select(const SQL: string; const Params: array of Variant; const Options: TMVCActiveRecordLoadOptions = []): TObjectList; overload; - /// - /// Returns a TObjectList from a SQL using typed params - /// class function Select( const SQL: string; const Params: array of Variant; const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions = []) : TObjectList; overload; - /// - /// Returns a TMVCActiveRecordList from a SQL using typed params and class ref - /// class function Select( const MVCActiveRecordClass: TMVCActiveRecordClass; const SQL: string; @@ -564,10 +471,6 @@ TMVCActiveRecordHelper = class helper for TMVCActiveRecord const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions = []) : TMVCActiveRecordList; overload; - /// - /// Fills a TObjectList from a SQL using typed params. - /// Returns number of the records in the list (not only the selected records, but the current .Count of the list) - /// class function Select( const SQL: string; const Params: array of Variant; @@ -598,11 +501,11 @@ TMVCActiveRecordHelper = class helper for TMVCActiveRecord class function Select(const aClass: TMVCActiveRecordClass; const SQL: string; const Params: array of Variant; - const Connection: TFDConnection): TMVCActiveRecordList; overload; + const Connection: TUniConnection): TMVCActiveRecordList; overload; class function Select(const aClass: TMVCActiveRecordClass; const SQL: string; const Params: array of Variant; - const Connection: TFDConnection; const OutList: TMVCActiveRecordList): UInt32; overload; + const Connection: TUniConnection; const OutList: TMVCActiveRecordList): UInt32; overload; { SelectOne } class function SelectOne(const SQL: string; @@ -642,10 +545,6 @@ TMVCActiveRecordHelper = class helper for TMVCActiveRecord class function Where(const SQLWhere: string; const Params: array of Variant) : TObjectList; overload; - /// - /// Executes a SQL select using the SQLWhere parameter as where clause. This method is partitioning safe. - /// Returns TObjectList. - /// class function Where(const SQLWhere: string; const Params: array of Variant; const ParamTypes: array of TFieldType): TObjectList; overload; @@ -662,12 +561,12 @@ TMVCActiveRecordHelper = class helper for TMVCActiveRecord const aClass: TMVCActiveRecordClass; const SQLWhere: string; const Params: array of Variant; - const Connection: TFDConnection): TMVCActiveRecordList; overload; + const Connection: TUniConnection): TMVCActiveRecordList; overload; class function Where( const aClass: TMVCActiveRecordClass; const SQLWhere: string; const Params: array of Variant; - const Connection: TFDConnection; + const Connection: TUniConnection; const OutList: TMVCActiveRecordList): UInt32; overload; { GetXXXByWhere } @@ -786,17 +685,17 @@ TMVCEntitiesRegistry = class(TInterfacedObject, IMVCEntitiesRegistry) IMVCActiveRecordConnections = interface ['{7B87473C-1784-489F-A838-925E7DDD0DE2}'] - procedure AddConnection(const aName: string; const aConnection: TFDConnection; const Owns: Boolean = false); overload; - procedure AddDefaultConnection(const aConnection: TFDConnection; const Owns: Boolean = false); overload; + procedure AddConnection(const aName: string; const aConnection: TUniConnection; const Owns: Boolean = false); overload; + procedure AddDefaultConnection(const aConnection: TUniConnection; const Owns: Boolean = false); overload; procedure AddDefaultConnection(const aConnectionDefName: String); overload; procedure AddConnection(const aName, aConnectionDefName: String); overload; procedure RemoveConnection(const aName: string; const RaiseExceptionIfNotAvailable: Boolean = True); procedure RemoveDefaultConnection(const RaiseExceptionIfNotAvailable: Boolean = True); procedure SetCurrent(const aName: string); - function GetCurrent(const RaiseExceptionIfNotAvailable: Boolean = True): TFDConnection; + function GetCurrent(const RaiseExceptionIfNotAvailable: Boolean = True): TUniConnection; function GetCurrentConnectionName(const RaiseExceptionIfNotAvailable: Boolean = False): String; function GetCurrentBackend: string; - function GetByName(const aName: string): TFDConnection; + function GetByName(const aName: string): TUniConnection; procedure SetDefault; end; @@ -804,7 +703,7 @@ TMVCConnectionsRepository = class(TInterfacedObject, IMVCActiveRecordConnectio private type TConnHolder = class public - Connection: TFDConnection; + Connection: TUniConnection; OwnsConnection: Boolean; destructor Destroy; override; end; @@ -817,16 +716,16 @@ TConnHolder = class public constructor Create; virtual; destructor Destroy; override; - procedure AddConnection(const aName: string; const aConnection: TFDConnection; const aOwns: Boolean = false); overload; + procedure AddConnection(const aName: string; const aConnection: TUniConnection; const aOwns: Boolean = false); overload; procedure AddConnection(const aName, aConnectionDefName: String); overload; - procedure AddDefaultConnection(const aConnection: TFDConnection; const aOwns: Boolean = false); overload; + procedure AddDefaultConnection(const aConnection: TUniConnection; const aOwns: Boolean = false); overload; procedure AddDefaultConnection(const aConnectionDefName: String); overload; procedure RemoveConnection(const aName: string; const RaiseExceptionIfNotAvailable: Boolean = True); procedure RemoveDefaultConnection(const RaiseExceptionIfNotAvailable: Boolean = True); procedure SetCurrent(const aName: string); - function GetCurrent(const RaiseExceptionIfNotAvailable: Boolean = True): TFDConnection; + function GetCurrent(const RaiseExceptionIfNotAvailable: Boolean = True): TUniConnection; function GetCurrentConnectionName(const RaiseExceptionIfNotAvailable: Boolean = False): String; - function GetByName(const aName: string): TFDConnection; + function GetByName(const aName: string): TUniConnection; function GetCurrentBackend: string; procedure SetDefault; end; @@ -967,7 +866,7 @@ TMVCActiveRecordBackEnd = record SQLAnywhere = 'sqlanywhere'; Advantage = 'advantage'; Interbase = 'interbase'; - FirebirdSQL = 'firebird'; + Firebird = 'firebird'; SQLite = 'sqlite'; PostgreSQL = 'postgresql'; NexusDB = 'nexusdb'; @@ -981,7 +880,7 @@ TMVCActiveRecordBackEnd = record function ActiveRecordConnectionsRegistry: IMVCActiveRecordConnections; function ActiveRecordTableMapRegistry: IMVCActiveRecordTableMap; function ActiveRecordMappingRegistry: IMVCEntitiesRegistry; -function GetBackEndByConnection(aConnection: TFDConnection): string; +function GetBackEndByConnection(aConnection: TUniConnection): string; const OBJECT_VERSION_STARTING_VALUE = '1'; @@ -996,7 +895,6 @@ implementation MVCFramework.Logger, MVCFramework.Nullables, MVCFramework.RTTI.Utils, - FireDAC.Stan.Option, Data.FmtBcd, System.Variants, System.Math; @@ -1008,53 +906,49 @@ implementation gTableMap: IMVCActiveRecordTableMap; gTableMapLock: TObject; -function GetBackEndByConnection(aConnection: TFDConnection): string; +function GetBackEndByConnection(aConnection: TUniConnection): string; +var + lProviderName: string; begin if not aConnection.Connected then begin - aConnection.Connected := True; {required to know the backend} - end; - - case Ord(aConnection.RDBMSKind) of - 0: - Exit(TMVCActiveRecordBackEnd.Unknown); - 1: - Exit(TMVCActiveRecordBackEnd.Oracle); - 2: - Exit(TMVCActiveRecordBackEnd.MSSql); - 3: - Exit(TMVCActiveRecordBackEnd.MSAccess); - 4: - Exit(TMVCActiveRecordBackEnd.MySQL); - 5: - Exit(TMVCActiveRecordBackEnd.DB2); - 6: - Exit(TMVCActiveRecordBackEnd.SQLAnywhere); - 7: - Exit(TMVCActiveRecordBackEnd.Advantage); - 8: - Exit(TMVCActiveRecordBackEnd.Interbase); - 9: - Exit(TMVCActiveRecordBackEnd.FirebirdSQL); - 10: - Exit(TMVCActiveRecordBackEnd.SQLite); - 11: - Exit(TMVCActiveRecordBackEnd.PostgreSQL); - 12: - Exit(TMVCActiveRecordBackEnd.NexusDB); - 13: - Exit(TMVCActiveRecordBackEnd.DataSnap); - 14: - Exit(TMVCActiveRecordBackEnd.Informix); - 15: - Exit(TMVCActiveRecordBackEnd.Teradata); - 16: - Exit(TMVCActiveRecordBackEnd.MongoDB); - 17: - Exit(TMVCActiveRecordBackEnd.Other); + aConnection.Connect; + end; + lProviderName := aConnection.ProviderName; + if SameText(lProviderName, 'Oracle') then + Result := TMVCActiveRecordBackEnd.Oracle + else if SameText(lProviderName, 'SQLServer') then + Result := TMVCActiveRecordBackEnd.MSSql + else if SameText(lProviderName, 'Access') then + Result := TMVCActiveRecordBackEnd.MSAccess + else if SameText(lProviderName, 'MySQL') then + Result := TMVCActiveRecordBackEnd.MySQL + else if SameText(lProviderName, 'DB2') then + Result := TMVCActiveRecordBackEnd.DB2 + else if SameText(lProviderName, 'ASE') then + Result := TMVCActiveRecordBackEnd.SQLAnywhere + else if SameText(lProviderName, 'Advantage') then + Result := TMVCActiveRecordBackEnd.Advantage + else if SameText(lProviderName, 'Interbase') then + Result := TMVCActiveRecordBackEnd.Interbase + else if SameText(lProviderName, 'Firebird') then + Result := TMVCActiveRecordBackEnd.Firebird + else if SameText(lProviderName, 'SQLite') then + Result := TMVCActiveRecordBackEnd.SQLite + else if SameText(lProviderName, 'PostgreSQL') then + Result := TMVCActiveRecordBackEnd.PostgreSQL + else if SameText(lProviderName, 'NexusDB') then + Result := TMVCActiveRecordBackEnd.NexusDB + else if SameText(lProviderName, 'DataSnap') then + Result := TMVCActiveRecordBackEnd.DataSnap + else if SameText(lProviderName, 'Informix') then + Result := TMVCActiveRecordBackEnd.Informix + else if SameText(lProviderName, 'Teradata') then + Result := TMVCActiveRecordBackEnd.Teradata + else if SameText(lProviderName, 'MongoDB') then + Result := TMVCActiveRecordBackEnd.MongoDB else - raise EMVCActiveRecord.Create('Unknown RDBMS Kind'); - end; + Result := TMVCActiveRecordBackEnd.Other; end; function ActiveRecordConnectionsRegistry: IMVCActiveRecordConnections; @@ -1099,7 +993,7 @@ function IntToNullableInt(const Value: Integer): NullableInt32; { TConnectionsRepository } -procedure TMVCConnectionsRepository.AddConnection(const aName: string; const aConnection: TFDConnection; +procedure TMVCConnectionsRepository.AddConnection(const aName: string; const aConnection: TUniConnection; const aOwns: Boolean = false); var lName: string; @@ -1109,12 +1003,11 @@ procedure TMVCConnectionsRepository.AddConnection(const aName: string; const aCo lName := aName.ToLower; lConnKeyName := GetKeyName(lName); - { If the transaction is not started, initialize TxIsolation as ReadCommitted } if aConnection.Transaction = nil then begin - { needed for Delphi 10.4 Sydney+ } - aConnection.TxOptions.Isolation := TFDTxIsolation.xiReadCommitted; + aConnection.Transaction := TUniTransaction.Create(aConnection); end; + aConnection.Transaction.IsolationLevel := TTransactionIsolation.tiReadCommitted; fMREW.BeginWrite; try @@ -1136,7 +1029,7 @@ procedure TMVCConnectionsRepository.AddConnection(const aName: string; const aCo end; end; -procedure TMVCConnectionsRepository.AddDefaultConnection(const aConnection: TFDConnection; const aOwns: Boolean); +procedure TMVCConnectionsRepository.AddDefaultConnection(const aConnection: TUniConnection; const aOwns: Boolean); begin AddConnection('default', aConnection, aOwns); end; @@ -1144,11 +1037,11 @@ procedure TMVCConnectionsRepository.AddDefaultConnection(const aConnection: TFDC procedure TMVCConnectionsRepository.AddConnection(const aName, aConnectionDefName: String); var - lConn: TFDConnection; + lConn: TUniConnection; begin - lConn := TFDConnection.Create(nil); + lConn := TUniConnection.Create(nil); try - lConn.ConnectionDefName := aConnectionDefName; + lConn.ConnectionName := aConnectionDefName; AddConnection(aName, lConn, True); except on E: Exception do @@ -1180,7 +1073,7 @@ destructor TMVCConnectionsRepository.Destroy; inherited; end; -function TMVCConnectionsRepository.GetByName(const aName: string): TFDConnection; +function TMVCConnectionsRepository.GetByName(const aName: string): TUniConnection; var lKeyName: string; lConnHolder: TConnHolder; @@ -1194,7 +1087,8 @@ function TMVCConnectionsRepository.GetByName(const aName: string): TFDConnection if not fConnectionsDict.TryGetValue(lKeyName, lConnHolder) then raise EMVCActiveRecord.CreateFmt('Unknown connection %s', [aName]); Result := lConnHolder.Connection; - Result.Open; + if not Result.Connected then + Result.Connect; finally fMREW.EndRead; end; @@ -1226,7 +1120,7 @@ function TMVCConnectionsRepository.GetCurrentConnectionName( end; end; -function TMVCConnectionsRepository.GetCurrent(const RaiseExceptionIfNotAvailable: Boolean): TFDConnection; +function TMVCConnectionsRepository.GetCurrent(const RaiseExceptionIfNotAvailable: Boolean): TUniConnection; var lName: string; begin @@ -1377,15 +1271,14 @@ procedure TMVCActiveRecord.EnsureConnection; function TMVCActiveRecord.ExecNonQuery(const SQL: string; RefreshAutoGenerated: Boolean = false): int64; var - lQry: TFDQuery; - lPar: TFDParam; + lQry: TUniQuery; + lPar: TParam; lPair: TPair; lValue: TValue; lSQL: string; lHandled: Boolean; I: Integer; begin - { TODO -oDanieleT -cGeneral : Why not a TFDCommand? } lQry := CreateQuery(True, True); try lQry.Connection := GetConnection; @@ -1401,7 +1294,7 @@ function TMVCActiveRecord.ExecNonQuery(const SQL: string; RefreshAutoGenerated: { partitioning } for I := 0 to GetPartitionInfo.FieldNames.Count - 1 do begin - lPar := lQry.FindParam(SQLGenerator.GetParamNameForSQL(GetPartitionInfo.FieldNames[I])); + lPar := lQry.Params.FindParam(SQLGenerator.GetParamNameForSQL(GetPartitionInfo.FieldNames[I])); if lPar <> nil then begin if GetPartitionInfo.FieldTypes[I] = ftInteger then @@ -1415,22 +1308,20 @@ function TMVCActiveRecord.ExecNonQuery(const SQL: string; RefreshAutoGenerated: for lPair in fTableMap.fMap do begin - lPar := lQry.FindParam(SQLGenerator.GetParamNameForSQL(lPair.Value.FieldName)); + lPar := lQry.Params.FindParam(SQLGenerator.GetParamNameForSQL(lPair.Value.FieldName)); if (lPar <> nil) and (lpair.Value.Insertable or lpair.Value.Updatable) then begin lValue := lPair.Key.GetValue(Self); - lPar.DataTypeName := fTableMap.fMap.GetInfoByFieldName(lPair.Value.FieldName).DataTypeName; MapTValueToParam(lValue, lPar); end end; // Check if it's the primary key - lPar := lQry.FindParam(SQLGenerator.GetParamNameForSQL(fTableMap.fPrimaryKeyFieldName)); + lPar := lQry.Params.FindParam(SQLGenerator.GetParamNameForSQL(fTableMap.fPrimaryKeyFieldName)); if lPar <> nil then begin if lPar.DataType = ftUnknown then begin - { TODO -oDanieleT -cGeneral : Let's find a smarter way to do this if the engine cannot recognize parameter's datatype } lPar.DataType := GetPrimaryKeyFieldType; end; MapTValueToParam(fTableMap.fPrimaryKey.GetValue(Self), lPar); @@ -1455,7 +1346,7 @@ function TMVCActiveRecord.ExecNonQuery(const SQL: string; RefreshAutoGenerated: end else begin - lQry.ExecSQL(lSQL); + lQry.ExecSQL; end; Result := lQry.RowsAffected; finally @@ -1464,7 +1355,7 @@ function TMVCActiveRecord.ExecNonQuery(const SQL: string; RefreshAutoGenerated: end; class function TMVCActiveRecord.ExecQuery(const SQL: string; const Values: array of Variant; - const Connection: TFDConnection; const Unidirectional: Boolean; + const Connection: TUniConnection; const Unidirectional: Boolean; const DirectExecute: Boolean): TDataSet; begin Result := ExecQuery(SQL, Values, [], Connection, Unidirectional, DirectExecute); @@ -1947,8 +1838,6 @@ function TMVCActiveRecord.GetMapping: TMVCFieldsMapping; lParentType: TRttiType; lTmp: String; begin - { TODO -oDanieleT -cGeneral : Let share the mapping for instances of the same type } - { TODO -oDanieleT -cGeneral : Add NameAs in the TFieldInfo because the user needs to use the property name he see } if Length(fTableMap.fMapping) = 0 then begin if not fTableMap.fPrimaryKeyFieldName.IsEmpty then @@ -2167,8 +2056,19 @@ function TMVCActiveRecord.GetPrimaryKeyIsAutogenerated: Boolean; end; class function TMVCActiveRecord.GetScalar(const SQL: string; const Params: array of Variant): Variant; +var + lQry: TUniQuery; begin - Result := CurrentConnection.ExecSQLScalar(SQL, Params); + lQry := CreateQuery(True, True); + try + lQry.Connection := CurrentConnection; + lQry.SQL.Text := SQL; + lQry.Params.CreateParam(ftInteger, 'p1', ptInput).AsInteger := 1; + lQry.Open(SQL, Params); + Result := lQry.Fields[0].Value; + finally + lQry.Free; + end; end; function TMVCActiveRecord.GetTableName: string; @@ -2198,8 +2098,6 @@ class function TMVCActiveRecordHelper.Count(const aClass: TMVCActiveRecordClass; begin lAR := aClass.Create; try - // Up to 10.1 Berlin, here the compiler try to call the Count introduced by the class helper - // Instead of the Count() which exists in "TMVCActiveRecord" Result := lAR.InternalCount(RQL); finally lAR.Free; @@ -2309,12 +2207,12 @@ class function TMVCActiveRecordHelper.TryGetRQLQuery( end; end; -class function TMVCActiveRecord.CurrentConnection: TFDConnection; +class function TMVCActiveRecord.CurrentConnection: TUniConnection; begin Result := ActiveRecordConnectionsRegistry.GetCurrent; end; -function TMVCActiveRecord.GetConnection: TFDConnection; +function TMVCActiveRecord.GetConnection: TUniConnection; begin if fConn = nil then begin @@ -2323,7 +2221,7 @@ function TMVCActiveRecord.GetConnection: TFDConnection; Result := fConn; end; -class function TMVCActiveRecord.GetConnectionByName(const ConnectionName: String): TFDConnection; +class function TMVCActiveRecord.GetConnectionByName(const ConnectionName: String): TUniConnection; begin Result := ActiveRecordConnectionsRegistry.GetByName(ConnectionName); end; @@ -2394,12 +2292,12 @@ procedure TMVCActiveRecord.MapDatasetToObject(const DataSet: TDataSet; const Opt // do nothing end; -procedure TMVCActiveRecord.MapObjectToParams(const Params: TFDParams; var Handled: Boolean); +procedure TMVCActiveRecord.MapObjectToParams(const Params: TParams; var Handled: Boolean); begin // do nothing end; -function TMVCActiveRecord.MapNullableTValueToParam(aValue: TValue; const aParam: TFDParam): Boolean; +function TMVCActiveRecord.MapNullableTValueToParam(aValue: TValue; const aParam: TParam): Boolean; var lNullableType: TNullableType; begin @@ -2621,12 +2519,10 @@ function TMVCActiveRecord.MapNullableTValueToParam(aValue: TValue; const aParam: end; end; // case - // the nullable value contains a value, so let's call - // the "non nullable" version of this procedure MapTValueToParam(aValue, aParam); end; -procedure TMVCActiveRecord.MapTValueToParam(aValue: TValue; const aParam: TFDParam); +procedure TMVCActiveRecord.MapTValueToParam(aValue: TValue; const aParam: TParam); const MAX_STRING_PARAM_LENGTH = 1000; { Arbitrary value } var @@ -2634,7 +2530,7 @@ procedure TMVCActiveRecord.MapTValueToParam(aValue: TValue; const aParam: TFDPar lName: string; begin {$IFDEF NEXTGEN} - lName := aValue.TypeInfo.NameFld.ToString; + lName := aValue.TypeInfo.Name; {$ELSE} lName := string(aValue.TypeInfo.Name); {$ENDIF} @@ -2750,7 +2646,7 @@ procedure TMVCActiveRecord.MapTValueToParam(aValue: TValue; const aParam: TFDPar begin if aValue.TypeInfo = TypeInfo(System.Boolean) then begin - if aParam.DataTypeName.StartsWith('int', true) then + if SameText(aParam.Name, 'int') then begin aParam.AsInteger := IfThen(aValue.AsBoolean,1,0); end @@ -2792,11 +2688,7 @@ procedure TMVCActiveRecord.MapTValueToParam(aValue: TValue; const aParam: TFDPar if (aValue.AsObject <> nil) and (not aValue.IsInstanceOf(TStream)) then raise EMVCActiveRecord.CreateFmt('Unsupported reference type for param %s: %s', [aParam.Name, aValue.AsObject.ClassName]); - { .$IF Defined(SeattleOrBetter) } - // lStream := aValue.AsType(); - { .$ELSE } lStream := aValue.AsType(); - { .$ENDIF } if Assigned(lStream) then begin lStream.Position := 0; @@ -3026,7 +2918,7 @@ class function TMVCActiveRecordHelper.Select(const aClass: TMVCActiveRecordClass end; class function TMVCActiveRecordHelper.Select(const aClass: TMVCActiveRecordClass; const SQL: string; - const Params: array of Variant; const Connection: TFDConnection): TMVCActiveRecordList; + const Params: array of Variant; const Connection: TUniConnection): TMVCActiveRecordList; begin Result := TMVCActiveRecordList.Create; try @@ -3246,8 +3138,8 @@ class function TMVCActiveRecordHelper.SelectRQL(const RQL: string; const MaxR end; end; -class function TMVCActiveRecordHelper.Where(const SQLWhere: string; const Params: array of Variant; - const ParamTypes: array of TFieldType): TObjectList; +class function TMVCActiveRecordHelper.Where(const SQLWhere: string; + const Params: array of Variant; const ParamTypes: array of TFieldType): TObjectList; begin Result := TObjectList.Create(True); try @@ -3572,7 +3464,8 @@ function TMVCActiveRecord.SQLGenerator: TMVCSQLGenerator; begin if not Assigned(fSQLGenerator) then begin - GetConnection.Connected := True; + if not GetConnection.Connected then + GetConnection.Connect; lSQLGeneratorClass := TMVCSQLGeneratorRegistry.Instance.GetSQLGenerator(GetBackEnd); fSQLGenerator := lSQLGeneratorClass.Create(GetMapping, fTableMap.fDefaultRQLFilter, GetPartitionInfo); end; @@ -3699,7 +3592,7 @@ procedure TMVCActiveRecord.Update(const RaiseExceptionIfNotFound: Boolean = True class function TMVCActiveRecordHelper.Where(const aClass: TMVCActiveRecordClass; const SQLWhere: string; const Params: array of Variant; - const Connection: TFDConnection; const OutList: TMVCActiveRecordList): UInt32; + const Connection: TUniConnection; const OutList: TMVCActiveRecordList): UInt32; var lAR: TMVCActiveRecord; begin @@ -3783,7 +3676,7 @@ class function TMVCActiveRecordHelper.Where(const aClass: TMVCActiveRecordClass; end; class function TMVCActiveRecordHelper.Where(const aClass: TMVCActiveRecordClass; const SQLWhere: string; - const Params: array of Variant; const Connection: TFDConnection): TMVCActiveRecordList; + const Params: array of Variant; const Connection: TUniConnection): TMVCActiveRecordList; begin Result := TMVCActiveRecordList.Create; try @@ -4096,13 +3989,6 @@ function TMVCSQLGenerator.CreateUpdateSQL(const TableMap: TMVCTableMap; const AR GetParamNameForSQL(lPair.Value.FieldName) + ','; end; end; - { partition } -// for I := 0 to fPartitionInfo.FieldNames.Count - 1 do -// begin -// Result := Result + GetFieldNameForSQL(fPartitionInfo.FieldNames[I]) + ' = :' + -// GetParamNameForSQL(fPartitionInfo.FieldNames[I]) + ','; -// end; - { end-partitioning } Result[Length(Result)] := ' '; if not TableMap.fPrimaryKeyFieldName.IsEmpty then begin @@ -4304,7 +4190,7 @@ destructor TMVCConnectionsRepository.TConnHolder.Destroy; if OwnsConnection then begin if Connection.Connected then - Connection.Connected := false; + Connection.Disconnect; FreeAndNil(Connection); end; inherited; @@ -4332,18 +4218,18 @@ class function TMVCActiveRecord.ExecQuery( const SQL: string; const Values: array of Variant; const ValueTypes: array of TFieldType; - const Connection: TFDConnection; + const Connection: TUniConnection; const Unidirectional: Boolean; const DirectExecute: Boolean): TDataSet; var - lQry: TFDQuery; - lSQL: string; + lQry: TUniQuery; + lSQL: string; begin lQry := CreateQuery(Unidirectional, DirectExecute); try lSQL := SQL; OnBeforeExecuteQuerySQL(lSQL); - + if Connection = nil then begin lQry.Connection := ActiveRecordConnectionsRegistry.GetCurrent; @@ -4354,11 +4240,20 @@ class function TMVCActiveRecord.ExecQuery( end; if Length(ValueTypes) = 0 then begin - lQry.Open(lSQL, Values); + lQry.SQL.Text := lSQL; + for var i := 0 to High(Values) do + lQry.Params[i].Value := Values[i]; + lQry.Open; end else begin - lQry.Open(lSQL, Values, ValueTypes); + lQry.SQL.Text := lSQL; + for var i := 0 to High(Values) do + begin + lQry.Params[i].DataType := ValueTypes[i]; + lQry.Params[i].Value := Values[i]; + end; + lQry.Open; end; Result := lQry; except @@ -4678,9 +4573,6 @@ class function TPartitionInfo.BuildPartitionClause(const PartitionClause: String lPiece: String; lRQLCompiler: TRQLCompiler; begin - { - Needs to parse [MVCPartition('rating=(integer)4;classname=(string)persona')] - } if not PartitionInfoCache.TryGetValue(PartitionClause + '|' + RQLCompilerClass.ClassName, Result) then begin TMonitor.Enter(PartitionInfoCache); @@ -4749,9 +4641,6 @@ procedure TMVCTableMapRepository.AddTableMap(const AR: TMVCActiveRecord; const T fMREW.BeginWrite; try lKey := GetCacheKey(AR, TableName); - // if, due to multi-threading (and the micro-lock used in the caller), - // the tablemap definition is already in the case, I free the passed TableMap - // and return the TableMap already present in the cache. LogD(Format('ActiveRecord: Add "%s" to the metadata cache', [lKey])); {$IF Defined(RIOORBETTER)} @@ -4762,7 +4651,6 @@ procedure TMVCTableMapRepository.AddTableMap(const AR: TMVCActiveRecord; const T TableMap := fTableMapDict[lKey]; end; {$ELSE} - // https://github.com/danieleteti/delphimvcframework/issues/728 if fTableMapDict.TryGetValue(lKey, lTmpTableMap) then begin LogD(Format('ActiveRecord: Discarded new mapping - cache for "%s" already present', [lKey])); @@ -4857,12 +4745,12 @@ function TMVCTableMap.VersionValueAsInt64For(AR: TMVCActiveRecord): Int64; class function TMVCActiveRecordHelper.Select( const aClass: TMVCActiveRecordClass; const SQL: string; const Params: array of Variant; - const Connection: TFDConnection; const OutList: TMVCActiveRecordList): UInt32; + const Connection: TUniConnection; const OutList: TMVCActiveRecordList): UInt32; var lDataSet: TDataSet; lAR: TMVCActiveRecord; begin - lDataSet := ExecQuery(SQL, Params, Connection, True, False); + lDataSet := ExecQuery(SQL, Params, [], Connection, True, False); try while not lDataSet.Eof do begin @@ -4907,14 +4795,11 @@ constructor TMVCActiveRecord.Create; Create(True); end; -class function TMVCActiveRecord.CreateQuery(const Unidirectional, DirectExecute: Boolean): TFDQuery; +class function TMVCActiveRecord.CreateQuery(const Unidirectional, DirectExecute: Boolean): TUniQuery; begin - Result := TFDQuery.Create(nil); - Result.FetchOptions.Mode := TFDFetchMode.fmAll; - Result.FetchOptions.Unidirectional := Unidirectional; - Result.UpdateOptions.ReadOnly := True; - Result.UpdateOptions.RequestLive := False; - Result.ResourceOptions.DirectExecute := DirectExecute; //2023-07-12 + Result := TUniQuery.Create(nil); + Result.Unidirectional := Unidirectional; + Result.Options.DirectExecute := DirectExecute; end; { TMVCTransactionContext } @@ -4968,7 +4853,7 @@ constructor EMVCActiveRecordValidationError.Create(const PropertyName, Validatio fPropertyName := PropertyName; end; -constructor TMVCActiveRecord.Create(const Connection: TFDConnection); +constructor TMVCActiveRecord.Create(const Connection: TUniConnection); begin Create(True); fConn := Connection; diff --git a/sources/MVCFramework.ActiveRecordController.pas b/sources/MVCFramework.ActiveRecordController.pas index f7a58e037..23b671783 100644 --- a/sources/MVCFramework.ActiveRecordController.pas +++ b/sources/MVCFramework.ActiveRecordController.pas @@ -31,10 +31,6 @@ interface MVCFramework, MVCFramework.Commons, MVCFramework.ActiveRecord, - FireDAC.Stan.Def, - FireDAC.Stan.Pool, - FireDAC.Stan.Async, - FireDAC.Comp.Client, MVCFramework.RQL.Parser, System.Generics.Collections, MVCFramework.Serializer.Commons, MVCFramework.Swagger.Commons; diff --git a/sources/MVCFramework.Middleware.ActiveRecord.pas b/sources/MVCFramework.Middleware.ActiveRecord.pas index a59cb36e4..771a85299 100644 --- a/sources/MVCFramework.Middleware.ActiveRecord.pas +++ b/sources/MVCFramework.Middleware.ActiveRecord.pas @@ -75,12 +75,12 @@ TMVCActiveRecordMiddleware = class(TInterfacedObject, IMVCMiddleware) const DefaultConnectionDefName: string); overload; virtual; constructor Create( const DefaultConnectionDefName: string; - const ConnectionDefFileName: string{ = 'FDConnectionDefs.ini'}); overload; virtual; + const ConnectionDefFileName: string{ = 'ConnectionDefs.ini'}); overload; virtual; constructor Create( const DefaultConnectionDefName: string; const AdditionalARConnectionNames: TArray; const AdditionalConnectionDefNames: TArray; - const ConnectionDefFileName: string{ = 'FDConnectionDefs.ini'}); overload; virtual; + const ConnectionDefFileName: string{ = 'ConnectionDefs.ini'}); overload; virtual; end; implementation @@ -88,7 +88,8 @@ implementation uses MVCFramework.ActiveRecord, System.SyncObjs, - FireDAC.Comp.Client; + UniProvider, + Uni; var gCONNECTION_DEF_FILE_LOADED: Integer = 0; @@ -117,7 +118,7 @@ constructor TMVCActiveRecordMiddleware.Create( constructor TMVCActiveRecordMiddleware.Create( const DefaultConnectionDefName: string); begin - Create(DefaultConnectionDefName, 'FDConnectionDefs.ini'); + Create(DefaultConnectionDefName, 'ConnectionDefs.ini'); end; procedure TMVCActiveRecordMiddleware.EnsureConnection; @@ -139,21 +140,20 @@ procedure TMVCActiveRecordMiddleware.EnsureConnection; begin if not fConnectionDefFileName.IsEmpty then begin - FDManager.ConnectionDefFileAutoLoad := False; - FDManager.ConnectionDefFileName := fConnectionDefFileName; - if not FDManager.ConnectionDefFileLoaded then + UniProviderManager.ConnectionDefFileName := fConnectionDefFileName; + if not UniProviderManager.ConnectionDefFileLoaded then begin - FDManager.LoadConnectionDefFile; + UniProviderManager.LoadConnectionDefFile; end; end; //loading default connection if not fDefaultConnectionDefName.IsEmpty then begin - if not FDManager.IsConnectionDef(fDefaultConnectionDefName) then + if not UniProviderManager.IsConnectionDef(fDefaultConnectionDefName) then begin raise EMVCConfigException.CreateFmt('ConnectionDefName "%s" not found in config file "%s" - or config file not present', - [fDefaultConnectionDefName, FDManager.ActualConnectionDefFileName]); + [fDefaultConnectionDefName, UniProviderManager.ConnectionDefFileName]); end; end; @@ -168,10 +168,10 @@ procedure TMVCActiveRecordMiddleware.EnsureConnection; end; for I := 0 to fAdditionalConnectionDefNamesCount - 1 do begin - if not FDManager.IsConnectionDef(fAdditionalConnectionDefNames[I]) then + if not UniProviderManager.IsConnectionDef(fAdditionalConnectionDefNames[I]) then begin raise EMVCConfigException.CreateFmt('ConnectionDefName "%s" not found in config file "%s"', - [fAdditionalConnectionDefNames[I], FDManager.ActualConnectionDefFileName]); + [fAdditionalConnectionDefNames[I], UniProviderManager.ConnectionDefFileName]); end; end; end; diff --git a/sources/MVCFramework.FireDAC.Utils.pas b/sources/MVCFramework.UniDAC.Utils.pas similarity index 66% rename from sources/MVCFramework.FireDAC.Utils.pas rename to sources/MVCFramework.UniDAC.Utils.pas index 43d841272..372e9445e 100644 --- a/sources/MVCFramework.FireDAC.Utils.pas +++ b/sources/MVCFramework.UniDAC.Utils.pas @@ -22,37 +22,41 @@ // // *************************************************************************** } -unit MVCFramework.FireDAC.Utils; +unit MVCFramework.UniDAC.Utils; {$I dmvcframework.inc} interface uses - FireDAC.Comp.Client, FireDAC.Stan.Param, System.Rtti, JsonDataObjects, - Data.DB, FireDAC.Comp.DataSet; + Uni, + DBAccess, + VirtualTable, + System.Rtti, + JsonDataObjects, + Data.DB; type - TFireDACUtils = class sealed + TUniDACUtils = class sealed private class var CTX: TRttiContext; - class function InternalExecuteQuery(AQuery: TFDQuery; AObject: TObject; + class function InternalExecuteQuery(AQuery: TUniQuery; AObject: TObject; WithResult: boolean): Int64; public class constructor Create; class destructor Destroy; - class function ExecuteQueryNoResult(AQuery: TFDQuery; + class function ExecuteQueryNoResult(AQuery: TUniQuery; AObject: TObject): Int64; - class procedure ExecuteQuery(AQuery: TFDQuery; AObject: TObject); - class procedure ObjectToParameters(AFDParams: TFDParams; AObject: TObject; AParamPrefix: string = ''; + class procedure ExecuteQuery(AQuery: TUniQuery; AObject: TObject); + class procedure ObjectToParameters(AParams: TParams; AObject: TObject; AParamPrefix: string = ''; ASetParamTypes: boolean = True); - class procedure CreateDatasetFromMetadata(AFDMemTable: TFDCustomMemTable; AMeta: TJSONObject); + class procedure CreateDatasetFromMetadata(AVirtualTable: TVirtualTable; AMeta: TJSONObject); end; - - TFDCustomMemTableHelper = class helper for TFDCustomMemTable + + TVirtualTableHelper = class helper for TVirtualTable public procedure InitFromMetadata(const AJSONMetadata: TJSONObject); - class function CloneFrom(const FDDataSet: TFDDataSet): TFDMemTable; static; + class function CloneFrom(const ADataSet: TDataSet): TVirtualTable; static; end; implementation @@ -63,15 +67,15 @@ implementation MVCFramework.Serializer.Commons, System.SysUtils; -{ TFireDACUtils } +{ TUniDACUtils } -class constructor TFireDACUtils.Create; +class constructor TUniDACUtils.Create; begin - TFireDACUtils.CTX := TRttiContext.Create; + TUniDACUtils.CTX := TRttiContext.Create; end; -class procedure TFireDACUtils.CreateDatasetFromMetadata( - AFDMemTable: TFDCustomMemTable; AMeta: TJSONObject); +class procedure TUniDACUtils.CreateDatasetFromMetadata( + AVirtualTable: TVirtualTable; AMeta: TJSONObject); var lJArr: TJSONArray; I: Integer; @@ -82,39 +86,38 @@ class procedure TFireDACUtils.CreateDatasetFromMetadata( raise EMVCDeserializationException.Create('Invalid Metadata objects. Property [fielddefs] required.'); end; - AFDMemTable.Active := False;; - AFDMemTable.FieldDefs.Clear; + AVirtualTable.Active := False; + AVirtualTable.FieldDefs.Clear; lJArr := AMeta.A['fielddefs']; for I := 0 to lJArr.Count - 1 do begin lJObj := lJArr.Items[I].ObjectValue; - AFDMemTable.FieldDefs.Add( + AVirtualTable.FieldDefs.Add( lJObj.S['fieldname'], TFieldType(lJObj.I['datatype']), lJObj.I['size']); - { TODO -oDanieleT -cGeneral : Why don't change the display name? } - AFDMemTable.FieldDefs[I].DisplayName := lJObj.S['displayname']; + AVirtualTable.FieldDefs[I].DisplayName := lJObj.S['displayname']; end; - AFDMemTable.CreateDataset; + AVirtualTable.CreateDataSet; end; -class destructor TFireDACUtils.Destroy; +class destructor TUniDACUtils.Destroy; begin - TFireDACUtils.CTX.Free; + TUniDACUtils.CTX.Free; end; -class procedure TFireDACUtils.ExecuteQuery(AQuery: TFDQuery; AObject: TObject); +class procedure TUniDACUtils.ExecuteQuery(AQuery: TUniQuery; AObject: TObject); begin InternalExecuteQuery(AQuery, AObject, True); end; -class function TFireDACUtils.ExecuteQueryNoResult(AQuery: TFDQuery; +class function TUniDACUtils.ExecuteQueryNoResult(AQuery: TUniQuery; AObject: TObject): Int64; begin Result := InternalExecuteQuery(AQuery, AObject, False); end; -class procedure TFireDACUtils.ObjectToParameters(AFDParams: TFDParams; +class procedure TUniDACUtils.ObjectToParameters(AParams: TParams; AObject: TObject; AParamPrefix: string; ASetParamTypes: boolean); var I: Integer; @@ -134,7 +137,7 @@ class procedure TFireDACUtils.ObjectToParameters(AFDParams: TFDParams; tkInteger: Result := ftInteger; tkFloat: - begin // daniele teti 2014-05-23 + begin if AProp.PropertyType.QualifiedName = 'System.TDate' then Result := ftDate else if AProp.PropertyType.QualifiedName = 'System.TDateTime' then @@ -155,7 +158,7 @@ class procedure TFireDACUtils.ObjectToParameters(AFDParams: TFDParams; tkInterface: Result := ftInterface; tkInt64: - Result := ftLongWord; + Result := ftLargeInt; else Result := ftUnknown; end; @@ -182,26 +185,23 @@ class procedure TFireDACUtils.ObjectToParameters(AFDParams: TFDParams; end end; end; - for I := 0 to AFDParams.Count - 1 do + for I := 0 to AParams.Count - 1 do begin - pname := AFDParams[I].Name.ToLower; + pname := AParams[I].Name.ToLower; if pname.StartsWith(AParamPrefix, True) then Delete(pname, 1, PrefixLength); if Map.TryGetValue(pname, f) then begin fv := f.GetValue(AObject); - // #001: Erro ao definir parametros if ASetParamTypes then begin - AFDParams[I].DataType := KindToFieldType(fv.Kind, f); + AParams[I].DataType := KindToFieldType(fv.Kind, f); end; - // #001: FIM - // DmitryG - 2014-03-28 - AFDParams[I].Value := fv.AsVariant; + AParams[I].Value := fv.AsVariant; end else begin - AFDParams[I].Clear; + AParams[I].Clear; end; end; finally @@ -209,7 +209,7 @@ class procedure TFireDACUtils.ObjectToParameters(AFDParams: TFDParams; end end; -class function TFireDACUtils.InternalExecuteQuery(AQuery: TFDQuery; AObject: TObject; +class function TUniDACUtils.InternalExecuteQuery(AQuery: TUniQuery; AObject: TObject; WithResult: boolean): Int64; begin ObjectToParameters(AQuery.Params, AObject); @@ -223,15 +223,15 @@ class function TFireDACUtils.InternalExecuteQuery(AQuery: TFDQuery; AObject: TOb end; end; -class function TFDCustomMemTableHelper.CloneFrom(const FDDataSet: TFDDataSet): TFDMemTable; +class function TVirtualTableHelper.CloneFrom(const ADataSet: TDataSet): TVirtualTable; begin - Result := TFDMemTable.Create(nil); - TFDMemTable(Result).CloneCursor(FDDataSet); + Result := TVirtualTable.Create(nil); + Result.Assign(ADataSet); end; -procedure TFDCustomMemTableHelper.InitFromMetadata(const AJSONMetadata: TJSONObject); +procedure TVirtualTableHelper.InitFromMetadata(const AJSONMetadata: TJSONObject); begin - TFireDACUtils.CreateDatasetFromMetadata(Self, AJSONMetadata); + TUniDACUtils.CreateDatasetFromMetadata(Self, AJSONMetadata); end; end.