From 55e64f34608353775099fada175cd0ab21e07cf1 Mon Sep 17 00:00:00 2001
From: "google-labs-jules[bot]"
<161369871+google-labs-jules[bot]@users.noreply.github.com>
Date: Thu, 11 Sep 2025 10:42:46 +0000
Subject: [PATCH 01/12] feat: Add UniDAC support
This change adds support for the UniDAC database access components to the DMVC framework, mirroring the existing support for FireDAC.
A new conditional compilation symbol, `USE_UNIDAC`, has been introduced to enable the UniDAC implementation. When this symbol is defined, the framework uses UniDAC components (`TUniConnection`, `TUniQuery`, etc.) for database access.
A new sample project, `unidac_activerecord_showcase`, has been created to demonstrate and test the UniDAC integration. This sample is a modified version of the existing `activerecord_showcase` project.
The core `MVCFramework.ActiveRecord.pas` unit has been updated to include conditional code blocks that switch between FireDAC and UniDAC implementations. A new utility unit, `MVCFramework.UniDAC.Utils.pas`, has been added to provide helper functions for UniDAC.
---
packages/d120/dmvcframeworkRT.dproj | 1 +
.../EngineChoiceFormU.dfm | 114 +
.../EngineChoiceFormU.pas | 80 +
.../EntitiesU.pas | 1011 +++++++
.../MainFormU.dfm | 351 +++
.../MainFormU.pas | 2528 +++++++++++++++++
.../UniConnectionConfigU.pas | 114 +
.../unidac_activerecord_showcase.dpr | 36 +
.../unidac_activerecord_showcase.dproj | 1135 ++++++++
sources/MVCFramework.ActiveRecord.pas | 218 +-
sources/MVCFramework.UniDAC.Utils.pas | 242 ++
11 files changed, 5821 insertions(+), 9 deletions(-)
create mode 100644 samples/unidac_activerecord_showcase/EngineChoiceFormU.dfm
create mode 100644 samples/unidac_activerecord_showcase/EngineChoiceFormU.pas
create mode 100644 samples/unidac_activerecord_showcase/EntitiesU.pas
create mode 100644 samples/unidac_activerecord_showcase/MainFormU.dfm
create mode 100644 samples/unidac_activerecord_showcase/MainFormU.pas
create mode 100644 samples/unidac_activerecord_showcase/UniConnectionConfigU.pas
create mode 100644 samples/unidac_activerecord_showcase/unidac_activerecord_showcase.dpr
create mode 100644 samples/unidac_activerecord_showcase/unidac_activerecord_showcase.dproj
create mode 100644 sources/MVCFramework.UniDAC.Utils.pas
diff --git a/packages/d120/dmvcframeworkRT.dproj b/packages/d120/dmvcframeworkRT.dproj
index dc809ad9b..75fd09575 100644
--- a/packages/d120/dmvcframeworkRT.dproj
+++ b/packages/d120/dmvcframeworkRT.dproj
@@ -141,6 +141,7 @@
+
diff --git a/samples/unidac_activerecord_showcase/EngineChoiceFormU.dfm b/samples/unidac_activerecord_showcase/EngineChoiceFormU.dfm
new file mode 100644
index 000000000..32261f623
--- /dev/null
+++ b/samples/unidac_activerecord_showcase/EngineChoiceFormU.dfm
@@ -0,0 +1,114 @@
+object EngineChoiceForm: TEngineChoiceForm
+ Left = 0
+ Top = 0
+ BorderStyle = bsDialog
+ Caption = 'EngineChoiceForm'
+ ClientHeight = 281
+ ClientWidth = 490
+ Color = clWhite
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Segoe UI'
+ Font.Style = []
+ OldCreateOrder = False
+ Position = poOwnerFormCenter
+ OnCreate = FormCreate
+ PixelsPerInch = 96
+ TextHeight = 13
+ object Label1: TLabel
+ AlignWithMargins = True
+ Left = 3
+ Top = 3
+ Width = 484
+ Height = 54
+ Align = alTop
+ Alignment = taCenter
+ Caption = 'Choose one of the supported RDBMS'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -27
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ ParentFont = False
+ Layout = tlCenter
+ WordWrap = True
+ end
+ object Shape1: TShape
+ Left = 24
+ Top = 54
+ Width = 441
+ Height = 3
+ Brush.Color = clRed
+ Pen.Style = psClear
+ end
+ object Button1: TButton
+ Left = 24
+ Top = 82
+ Width = 211
+ Height = 41
+ Caption = 'PostgreSQL'
+ TabOrder = 0
+ OnClick = Button1Click
+ end
+ object Button2: TButton
+ Tag = 1
+ Left = 24
+ Top = 129
+ Width = 211
+ Height = 41
+ Caption = 'Firebird'
+ TabOrder = 1
+ OnClick = Button1Click
+ end
+ object Button3: TButton
+ Tag = 2
+ Left = 24
+ Top = 176
+ Width = 211
+ Height = 41
+ Caption = 'Interbase'
+ TabOrder = 2
+ OnClick = Button1Click
+ end
+ object Button4: TButton
+ Tag = 3
+ Left = 254
+ Top = 82
+ Width = 211
+ Height = 41
+ Caption = 'MSSQLServer'
+ TabOrder = 3
+ OnClick = Button1Click
+ end
+ object Button5: TButton
+ Tag = 4
+ Left = 254
+ Top = 129
+ Width = 211
+ Height = 41
+ Caption = 'MySQL'
+ TabOrder = 4
+ OnClick = Button1Click
+ end
+ object Button6: TButton
+ Tag = 5
+ Left = 254
+ Top = 176
+ Width = 211
+ Height = 41
+ Caption = 'MariaDB'
+ TabOrder = 5
+ OnClick = Button1Click
+ end
+ object Button7: TButton
+ Tag = 6
+ Left = 24
+ Top = 223
+ Width = 211
+ Height = 41
+ Caption = 'SQLite'
+ TabOrder = 6
+ OnClick = Button1Click
+ end
+end
diff --git a/samples/unidac_activerecord_showcase/EngineChoiceFormU.pas b/samples/unidac_activerecord_showcase/EngineChoiceFormU.pas
new file mode 100644
index 000000000..16ee11759
--- /dev/null
+++ b/samples/unidac_activerecord_showcase/EngineChoiceFormU.pas
@@ -0,0 +1,80 @@
+unit EngineChoiceFormU;
+
+interface
+
+uses
+ Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
+ Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
+
+type
+ TRDBMSEngine = (PostgreSQL, Firebird, Interbase, MSSQLServer, MySQL, MariaDB, SQLite);
+
+ TEngineChoiceForm = class(TForm)
+ Button1: TButton;
+ Label1: TLabel;
+ Button2: TButton;
+ Button3: TButton;
+ Button4: TButton;
+ Button5: TButton;
+ Button6: TButton;
+ Button7: TButton;
+ Shape1: TShape;
+ procedure Button1Click(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ private
+ fSelectedRDBMS: TRDBMSEngine;
+ function SelectedRDBMS: TRDBMSEngine;
+ public
+ class function Execute(out Engine: TRDBMSEngine): Boolean;
+ end;
+
+implementation
+
+{$R *.dfm}
+
+
+procedure TEngineChoiceForm.Button1Click(Sender: TObject);
+begin
+ fSelectedRDBMS := TRDBMSEngine(TComponent(Sender).Tag);
+ ModalResult := mrOk;
+end;
+
+class function TEngineChoiceForm.Execute(out Engine: TRDBMSEngine): Boolean;
+var
+ lFrm: TEngineChoiceForm;
+begin
+ lFrm := TEngineChoiceForm.Create(nil);
+ try
+ Result := lFrm.ShowModal = mrOk;
+ if Result then
+ begin
+ Engine := lFrm.SelectedRDBMS;
+ end;
+ finally
+ lFrm.Free;
+ end;
+end;
+
+procedure TEngineChoiceForm.FormCreate(Sender: TObject);
+begin
+ Shape1.Brush.Color := RGB($d6,$1e,$1e);
+{$IFDEF USE_SEQUENCES}
+ Button1.Enabled := False;
+ Button2.Enabled := False;
+ Button4.Enabled := False;
+ Button5.Enabled := False;
+ Button6.Enabled := False;
+ Button7.Enabled := False;
+ Caption := 'Use SEQUENCES';
+{$ELSE}
+ Button3.Enabled := False;
+ Caption := 'Use RETURNING';
+{$ENDIF}
+end;
+
+function TEngineChoiceForm.SelectedRDBMS: TRDBMSEngine;
+begin
+ Result := fSelectedRDBMS;
+end;
+
+end.
diff --git a/samples/unidac_activerecord_showcase/EntitiesU.pas b/samples/unidac_activerecord_showcase/EntitiesU.pas
new file mode 100644
index 000000000..adf302cc5
--- /dev/null
+++ b/samples/unidac_activerecord_showcase/EntitiesU.pas
@@ -0,0 +1,1011 @@
+// *************************************************************************** }
+//
+// Delphi MVC Framework
+//
+// Copyright (c) 2010-2025 Daniele Teti and the DMVCFramework Team
+//
+// https://github.com/danieleteti/delphimvcframework
+//
+// ***************************************************************************
+//
+// Licensed under the Apache License, Version 2.0 (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.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+//
+// ***************************************************************************
+
+unit EntitiesU;
+{$RTTI EXPLICIT METHODS([vcPublic, vcPublished]) FIELDS([vcPrivate, vcProtected, vcPublic, vcPublished]) PROPERTIES([vcPublic, vcPublished])}
+
+interface
+
+uses
+ MVCFramework.Serializer.Commons,
+ MVCFramework.ActiveRecord,
+ System.Generics.Collections,
+ System.Classes,
+ FireDAC.Stan.Param,
+ MVCFramework.Nullables;
+
+type
+
+ TCustomEntity = class abstract(TMVCActiveRecord)
+ protected
+ procedure OnBeforeExecuteSQL(var SQL: string); override;
+ end;
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCTable('articles')]
+ TArticle = class(TCustomEntity)
+ private
+ [MVCTableField('ID', [foPrimaryKey, foAutoGenerated])]
+ fID: NullableInt32;
+ fCodice: NullableString;
+ [MVCTableField('description')]
+ fDescrizione: string;
+ [MVCTableField('price')]
+ fPrezzo: Currency;
+ public
+ constructor Create; override;
+ destructor Destroy; override;
+ property ID: NullableInt32 read fID write fID;
+ property Code: NullableString read fCodice write fCodice;
+ property Description: string read fDescrizione write fDescrizione;
+ property Price: Currency read fPrezzo write fPrezzo;
+ end;
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCTable('articles')]
+ TWrongArticle = class(TCustomEntity)
+ private
+ [MVCTableField('ID', [foPrimaryKey, foAutoGenerated])] //One primary key (is OK)
+ fID: NullableInt32;
+ [MVCTableField('CODE', [foPrimaryKey])] // not allowed more than 1 PK
+ fCodice: NullableString;
+ [MVCTableField('description')]
+ fDescrizione: string;
+ [MVCTableField('price')]
+ fPrezzo: Currency;
+ public
+ property ID: NullableInt32 read fID write fID;
+ property Code: NullableString read fCodice write fCodice;
+ property Description: string read fDescrizione write fDescrizione;
+ property Price: Currency read fPrezzo write fPrezzo;
+ end;
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCTable('articles')]
+ TArticleWithWriteOnlyFields = class(TCustomEntity)
+ private
+{$IFNDEF USE_SEQUENCES}
+ [MVCTableField('id', [foPrimaryKey, foAutoGenerated, foReadOnly])]
+{$ELSE}
+ [MVCTableField('id', [foPrimaryKey, foAutoGenerated],
+ 'SEQ_ARTICLES_ID' { required for interbase } )]
+{$ENDIF}
+ fID: NullableInt32;
+ [MVCTableField('description', [foDoNotSelect])]
+ fDescrizione: string;
+ [MVCTableField('price', [foDoNotSelect])]
+ fPrice: Integer;
+ public
+ property ID: NullableInt32 read fID write fID;
+ property Description: string read fDescrizione write fDescrizione;
+ property Price: Integer read fPrice write fPrice;
+ end;
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCTable('articles')]
+ TArticleWithReadOnlyFields = class(TCustomEntity)
+ private
+ [MVCTableField('ID', [foPrimaryKey, foReadOnly])]
+ fID: NullableInt32;
+ fCodice: NullableString;
+ [MVCTableField('description', [foReadOnly])]
+ fDescrizione: string;
+ [MVCTableField('price', [foReadOnly])]
+ fPrezzo: Currency;
+ public
+ property ID: NullableInt32 read fID write fID;
+ property Code: NullableString read fCodice write fCodice;
+ property Description: string read fDescrizione write fDescrizione;
+ property Price: Currency read fPrezzo write fPrezzo;
+ end;
+
+ TOrder = class;
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCTable('customers')]
+ [MVCNamedSQLQuery('BestCustomers', 'select * from customers where rating >=4')]
+ [MVCNamedSQLQuery('WithRatingGtOrEqTo', 'select * from customers where rating >=?')]
+ [MVCNamedSQLQuery('RatingLessThanPar', 'select * from customers where rating < ? order by code, city desc')]
+ [MVCNamedSQLQuery('RatingEqualsToPar', 'select /*firebird*/ * from customers where rating = ? order by code, city desc', TMVCActiveRecordBackEnd.FirebirdSQL)]
+ [MVCNamedSQLQuery('RatingEqualsToPar', 'select /*postgres*/ * from customers where rating = ? order by code, city desc', TMVCActiveRecordBackEnd.PostgreSQL)]
+ [MVCNamedSQLQuery('RatingEqualsToPar', 'select /*all*/ * from customers where rating = ? order by code, city desc')]
+ [MVCNamedRQLQuery('RatingLessThanPar', 'lt(rating,%d);sort(+code,-city)')]
+ [MVCNamedRQLQuery('RatingEqualsToPar', 'eq(rating,%d);sort(+code,-city)')]
+ [MVCNamedSQLQuery('GetAllCustomers', 'select * from sp_get_customers()', TMVCActiveRecordBackEnd.PostgreSQL)]
+ TCustomer = class(TCustomEntity)
+ private
+{$IFNDEF USE_SEQUENCES}
+ [MVCTableField('id', [foPrimaryKey, foAutoGenerated])]
+{$ELSE}
+ [MVCTableField('id', [foPrimaryKey, foAutoGenerated],
+ 'SEQ_CUSTOMERS_ID' { required for interbase } )]
+{$ENDIF}
+ fID: NullableInt64;
+ [MVCTableField('code')]
+ fCode: NullableString;
+ [MVCTableField('description')]
+ fCompanyName: NullableString;
+ [MVCTableField('city')]
+ fCity: string;
+ [MVCTableField('last_contact_timestamp')]
+ fLastContact: NullableTDateTime;
+ [MVCTableField('rating')]
+ fRating: NullableInt32;
+ [MVCTableField('note')]
+ fNote: string;
+ public
+ constructor Create; override;
+ destructor Destroy; override;
+ function ToString: String; override;
+ property ID: NullableInt64 read fID write fID;
+ property Code: NullableString read fCode write fCode;
+ property CompanyName: NullableString read fCompanyName write fCompanyName;
+ property City: string read fCity write fCity;
+ property LastContact: NullableTDateTime read fLastContact write fLastContact;
+ property Rating: NullableInt32 read fRating write fRating;
+ property Note: string read fNote write fNote;
+ end;
+
+
+ TCustomerOnCustomers2 = class(TCustomer)
+ protected
+ function GetCustomTableName: String; override;
+ end;
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCTable('customers')]
+ TPartitionedCustomer = class(TCustomEntity)
+ private
+{$IFNDEF USE_SEQUENCES}
+ [MVCTableField('id', [foPrimaryKey, foAutoGenerated])]
+{$ELSE}
+ [MVCTableField('id', [foPrimaryKey, foAutoGenerated],
+ 'SEQ_CUSTOMERS_ID' { required for interbase } )]
+{$ENDIF}
+ fID: NullableInt64;
+ [MVCTableField('code')]
+ fCode: NullableString;
+ [MVCTableField('description')]
+ fCompanyName: NullableString;
+ [MVCTableField('city')]
+ fCity: string;
+ [MVCTableField('note')]
+ fNote: string;
+ public
+ function ToString: String; override;
+ property ID: NullableInt64 read fID write fID;
+ property Code: NullableString read fCode write fCode;
+ property CompanyName: NullableString read fCompanyName write fCompanyName;
+ property City: string read fCity write fCity;
+ property Note: string read fNote write fNote;
+ end;
+
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCTable('customers', 'ge(Rating,4)')]
+ TGoodCustomer = class(TCustomer)
+ end;
+
+ [MVCTable('customers')]
+ [MVCPartition('rating=(integer)1')]
+ TCustomerWithRate1 = class(TPartitionedCustomer)
+ end;
+
+
+ [MVCTable('customers')]
+ [MVCPartition('rating=(integer)2')]
+ TCustomerWithRate2 = class(TPartitionedCustomer)
+ end;
+
+
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCTable('customers', 'le(Rating,3)')]
+ TBadCustomer = class(TGoodCustomer)
+ end;
+
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCTable('customers')]
+ TCustomerWithReadOnlyFields = class(TCustomEntity)
+ private
+{$IFNDEF USE_SEQUENCES}
+ [MVCTableField('id', [foPrimaryKey, foAutoGenerated])]
+{$ELSE}
+ [MVCTableField('id', [foPrimaryKey, foAutoGenerated],
+ 'SEQ_CUSTOMERS_ID' { required for interbase } )]
+{$ENDIF}
+ fID: Integer;
+ [MVCTableField('code', [foReadOnly])]
+ fCode: string;
+ fFormattedCode: string;
+ [MVCTableField('description')]
+ fCompanyName: string;
+ [MVCTableField('city')]
+ fCity: string;
+ procedure SetFormattedCode(const Value: string);
+ public
+ property ID: Integer read fID write fID;
+ property Code: string read fCode write fCode;
+ property FormattedCode: string read fFormattedCode write SetFormattedCode;
+ property CompanyName: string read fCompanyName write fCompanyName;
+ property City: string read fCity write fCity;
+ end;
+
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCTable('customers')]
+ TCustomerWithOptions = class(TCustomEntity)
+ private
+{$IFNDEF USE_SEQUENCES}
+ [MVCTableField('id', [foPrimaryKey, foAutoGenerated])]
+{$ELSE}
+ [MVCTableField('id', [foPrimaryKey, foAutoGenerated],
+ 'SEQ_CUSTOMERS_ID' { required for interbase } )]
+{$ENDIF}
+ fID: Integer;
+ [MVCTableField('code', [foDoNotInsert, foDoNotUpdate])]
+ fCode: NullableString;
+ [MVCTableField('description', [foDoNotInsert])]
+ fCompanyName: string;
+ [MVCTableField('city', [foDoNotUpdate])]
+ fCity: string;
+ public
+ property ID: Integer read fID write fID;
+ property Code: NullableString read fCode write fCode;
+ property CompanyName: string read fCompanyName write fCompanyName;
+ property City: string read fCity write fCity;
+ end;
+
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCTable('order_details')]
+ TOrderDetail = class(TCustomEntity)
+ private
+{$IFNDEF USE_SEQUENCES}
+ [MVCTableField('id', [foPrimaryKey, foAutoGenerated])]
+{$ELSE}
+ [MVCTableField('id', [foPrimaryKey, foAutoGenerated],
+ 'SEQ_order_details_ID' { required for interbase } )]
+{$ENDIF}
+ fID: NullableInt32;
+ [MVCTableField('id_order')]
+ fOrderID: Integer;
+ [MVCTableField('id_article')]
+ fArticleID: Integer;
+ [MVCTableField('unit_price')]
+ fPrice: Currency;
+ [MVCTableField('discount')]
+ fDiscount: Integer;
+ [MVCTableField('quantity')]
+ fQuantity: Integer;
+ [MVCTableField('description')]
+ fDescription: string;
+ [MVCTableField('total')]
+ fTotal: Currency;
+ public
+ constructor Create; override;
+ destructor Destroy; override;
+ property ID: NullableInt32 read fID write fID;
+ property OrderID: Integer read fOrderID write fOrderID;
+ property ArticleID: Integer read fArticleID write fArticleID;
+ property Price: Currency read fPrice write fPrice;
+ property Discount: Integer read fDiscount write fDiscount;
+ property Quantity: Integer read fQuantity write fQuantity;
+ property Description: string read fDescription write fDescription;
+ property Total: Currency read fTotal write fTotal;
+ end;
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCTable('customers_plain')]
+ TCustomerPlain = class(TCustomEntity)
+ private
+ [MVCTableField('id', [foPrimaryKey])]
+ fID: NullableInt64;
+ [MVCTableField('code')]
+ fCode: NullableString;
+ [MVCTableField('description')]
+ fCompanyName: NullableString;
+ [MVCTableField('city')]
+ fCity: string;
+ [MVCTableField('rating')]
+ fRating: NullableInt32;
+ [MVCTableField('note')]
+ fNote: string;
+ [MVCTableField('creation_time')]
+ FCreationTime: TTime;
+ [MVCTableField('creation_date')]
+ FCreationDate: TDate;
+ public
+ property ID: NullableInt64 read fID write fID;
+ property Code: NullableString read fCode write fCode;
+ property CompanyName: NullableString read fCompanyName write fCompanyName;
+ property City: string read fCity write fCity;
+ property Rating: NullableInt32 read fRating write fRating;
+ property Note: string read fNote write fNote;
+ property CreationTime: TTime read FCreationTime write FCreationTime;
+ property CreationDate: TDate read FCreationDate write FCreationDate;
+ end;
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCTable('customers with spaces')]
+ TCustomerWithSpaces = class(TCustomEntity)
+ private
+ [MVCTableField('id with spaces', [foPrimaryKey])]
+ fID: NullableInt64;
+ [MVCTableField('code with spaces')]
+ fCode: NullableString;
+ [MVCTableField('description with spaces')]
+ fCompanyName: NullableString;
+ [MVCTableField('city with spaces')]
+ fCity: string;
+ [MVCTableField('rating with spaces')]
+ fRating: NullableInt32;
+ [MVCTableField('note with spaces')]
+ fNote: string;
+ public
+ property ID: NullableInt64 read fID write fID;
+ property Code: NullableString read fCode write fCode;
+ property CompanyName: NullableString read fCompanyName write fCompanyName;
+ property City: string read fCity write fCity;
+ property Rating: NullableInt32 read fRating write fRating;
+ property Note: string read fNote write fNote;
+ end;
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCTable('customers_with_code')]
+ TCustomerWithCode = class(TCustomEntity)
+ private
+ [MVCTableField('code', [foPrimaryKey])]
+ fCode: NullableString;
+ [MVCTableField('description')]
+ fCompanyName: NullableString;
+ [MVCTableField('city')]
+ fCity: string;
+ [MVCTableField('rating')]
+ fRating: NullableInt32;
+ [MVCTableField('note')]
+ fNote: string;
+ public
+ property Code: NullableString read fCode write fCode;
+ property CompanyName: NullableString read fCompanyName write fCompanyName;
+ property City: string read fCity write fCity;
+ property Rating: NullableInt32 read fRating write fRating;
+ property Note: string read fNote write fNote;
+ end;
+
+ [MVCTable('customers_with_code')]
+ TCustomerPlainWithClientPK = class(TCustomerWithCode)
+ protected
+ procedure OnBeforeInsert; override;
+ end;
+
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCTable('customers_with_guid')]
+ TCustomerWithGUID = class(TCustomEntity)
+ private
+ [MVCGuidSerializationDashes]
+ [MVCTableField('idguid', [foPrimaryKey])]
+ fGUID: NullableTGUID;
+ [MVCTableField('code')]
+ fCode: NullableString;
+ [MVCTableField('description')]
+ fCompanyName: NullableString;
+ [MVCTableField('city')]
+ fCity: string;
+ [MVCTableField('rating')]
+ fRating: NullableInt32;
+ [MVCTableField('note')]
+ fNote: string;
+ public
+ property GUID: NullableTGUID read fGUID write fGUID;
+ property Code: NullableString read fCode write fCode;
+ property CompanyName: NullableString read fCompanyName write fCompanyName;
+ property City: string read fCity write fCity;
+ property Rating: NullableInt32 read fRating write fRating;
+ property Note: string read fNote write fNote;
+ end;
+
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCTable('orders')]
+ TOrder = class(TCustomEntity)
+ private
+{$IFNDEF USE_SEQUENCES}
+ [MVCTableField('id', [foPrimaryKey, foAutoGenerated])]
+{$ELSE}
+ [MVCTableField('id', [foPrimaryKey, foAutoGenerated],
+ 'SEQ_ORDERS_ID' { required for interbase } )]
+{$ENDIF}
+ fID: NullableInt32;
+ [MVCTableField('id_customer')]
+ fCustomerID: Integer;
+ [MVCTableField('order_date')]
+ fOrderDate: TDate;
+ [MVCTableField('total')]
+ fTotal: Currency;
+ public
+ constructor Create; override;
+ destructor Destroy; override;
+ property ID: NullableInt32 read fID write fID;
+ property CustomerID: Integer read fCustomerID write fCustomerID;
+ property OrderDate: TDate read fOrderDate write fOrderDate;
+ property Total: Currency read fTotal write fTotal;
+ end;
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCTable('customers')]
+ TCustomerEx = class(TCustomer)
+ private
+ fOrders: TObjectList;
+ function GetOrders: TObjectList;
+ protected
+ procedure OnAfterLoad; override;
+ procedure OnAfterInsert; override;
+ public
+ destructor Destroy; override;
+ property Orders: TObjectList read GetOrders;
+ end;
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCEntityActions([eaRetrieve])]
+ [MVCNamedSQLQuery('CustomersInTheSameCity',
+ 'SELECT c.id, c.DESCRIPTION, c.city, c.code, c.rating, (SELECT count(*) - 1 FROM customers c2 WHERE c2.CITY = c.CITY) customers_in_the_same_city ' +
+ 'FROM CUSTOMERS c WHERE city IS NOT NULL AND city <> '''' ORDER BY customers_in_the_same_city')]
+ TCustomerStats = class(TCustomEntity)
+ private
+ [MVCTableField('id')]
+ fID: NullableInt64;
+ [MVCTableField('code')]
+ fCode: NullableString;
+ [MVCTableField('description')]
+ fCompanyName: NullableString;
+ [MVCTableField('city')]
+ fCity: string;
+ [MVCTableField('rating')]
+ fRating: NullableInt32;
+ [MVCTableField('customers_in_the_same_city')]
+ fCustomersInTheSameCity: Int32;
+ public
+ property ID: NullableInt64 read fID write fID;
+ property Code: NullableString read fCode write fCode;
+ property CompanyName: NullableString read fCompanyName write fCompanyName;
+ property City: string read fCity write fCity;
+ property Rating: NullableInt32 read fRating write fRating;
+ property CustomersInTheSameCity: Int32 read fCustomersInTheSameCity write fCustomersInTheSameCity;
+ end;
+
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCTable('customers')]
+ TCustomerWithLogic = class(TCustomer)
+ private
+ fIsLocatedInRome: Boolean;
+ protected
+ procedure OnAfterLoad; override;
+ procedure OnBeforeInsertOrUpdate; override;
+ procedure OnValidation(const Action: TMVCEntityAction); override;
+ public
+ property IsLocatedInRome: Boolean read fIsLocatedInRome;
+ end;
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCTable('nullables_test')]
+ TNullablesTest = class(TCustomEntity)
+ private
+ [MVCTableField('f_int2', [foPrimaryKey])]
+ ff_int2: NullableInt16;
+ [MVCTableField('f_int4')]
+ ff_int4: NullableInt32;
+ [MVCTableField('f_int8')]
+ ff_int8: NullableInt64;
+ [MVCTableField('f_date')]
+ ff_date: NullableTDate;
+ [MVCTableField('f_time')]
+ ff_time: NullableTTime;
+ [MVCTableField('f_bool')]
+ ff_bool: NullableBoolean;
+ [MVCTableField('f_datetime')]
+ ff_datetime: NullableTDateTime;
+ [MVCTableField('f_float4')]
+ ff_float4: NullableSingle;
+ [MVCTableField('f_float8')]
+ ff_float8: NullableDouble;
+ [MVCTableField('f_string')]
+ ff_string: NullableString;
+ [MVCTableField('f_currency')]
+ ff_currency: NullableCurrency;
+ [MVCTableField('f_blob')]
+ ff_blob: TStream;
+ public
+ constructor Create; override;
+ destructor Destroy; override;
+ // f_int2 int2 NULL,
+ property f_int2: NullableInt16 read ff_int2 write ff_int2;
+ // f_int4 int4 NULL,
+ property f_int4: NullableInt32 read ff_int4 write ff_int4;
+ // f_int8 int8 NULL,
+ property f_int8: NullableInt64 read ff_int8 write ff_int8;
+ // f_string varchar NULL,
+ property f_string: NullableString read ff_string write ff_string;
+ // f_bool bool NULL,
+ property f_bool: NullableBoolean read ff_bool write ff_bool;
+ // f_date date NULL,
+ property f_date: NullableTDate read ff_date write ff_date;
+ // f_time time NULL,
+ property f_time: NullableTTime read ff_time write ff_time;
+ // f_datetime timestamp NULL,
+ property f_datetime: NullableTDateTime read ff_datetime write ff_datetime;
+ // f_float4 float4 NULL,
+ property f_float4: NullableSingle read ff_float4 write ff_float4;
+ // f_float8 float8 NULL,
+ property f_float8: NullableDouble read ff_float8 write ff_float8;
+ // f_currency numeric(18,4) NULL
+ property f_currency: NullableCurrency read ff_currency write ff_currency;
+ // f_blob bytea NULL
+ property f_blob: TStream read ff_blob write ff_blob;
+ end;
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCTable('default_values_test')]
+ TDefaultValuesTest = class(TCustomEntity)
+ private
+ [MVCTableField('f_int2', [foPrimaryKey])]
+ ff_int2: NullableInt16;
+ [MVCTableField('f_int4')]
+ ff_int4: NullableInt32;
+ [MVCTableField('f_int8')]
+ ff_int8: NullableInt64;
+ [MVCTableField('f_date')]
+ ff_date: NullableTDate;
+ [MVCTableField('f_time')]
+ ff_time: NullableTTime;
+ [MVCTableField('f_bool')]
+ ff_bool: NullableBoolean;
+ [MVCTableField('f_datetime')]
+ ff_datetime: NullableTDateTime;
+ [MVCTableField('f_float4')]
+ ff_float4: NullableSingle;
+ [MVCTableField('f_float8')]
+ ff_float8: NullableDouble;
+ [MVCTableField('f_string')]
+ ff_string: NullableString;
+ [MVCTableField('f_currency')]
+ ff_currency: NullableCurrency;
+ [MVCTableField('f_blob')]
+ ff_blob: TStream;
+ public
+ constructor Create; override;
+ destructor Destroy; override;
+ // f_int2 int2 NULL,
+ property f_int2: NullableInt16 read ff_int2 write ff_int2;
+ // f_int4 int4 NULL,
+ property f_int4: NullableInt32 read ff_int4 write ff_int4;
+ // f_int8 int8 NULL,
+ property f_int8: NullableInt64 read ff_int8 write ff_int8;
+ // f_string varchar NULL,
+ property f_string: NullableString read ff_string write ff_string;
+ // f_bool bool NULL,
+ property f_bool: NullableBoolean read ff_bool write ff_bool;
+ // f_date date NULL,
+ property f_date: NullableTDate read ff_date write ff_date;
+ // f_time time NULL,
+ property f_time: NullableTTime read ff_time write ff_time;
+ // f_datetime timestamp NULL,
+ property f_datetime: NullableTDateTime read ff_datetime write ff_datetime;
+ // f_float4 float4 NULL,
+ property f_float4: NullableSingle read ff_float4 write ff_float4;
+ // f_float8 float8 NULL,
+ property f_float8: NullableDouble read ff_float8 write ff_float8;
+ // f_currency numeric(18,4) NULL
+ property f_currency: NullableCurrency read ff_currency write ff_currency;
+ // f_blob bytea NULL
+ property f_blob: TStream read ff_blob write ff_blob;
+ end;
+
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCTable('complex_types')]
+ TComplexTypesOnlyJSON = class(TCustomEntity)
+ private
+ [MVCTableField('id', [foPrimaryKey, foAutoGenerated])]
+ fID: Int64;
+ [MVCTableField('json_field', [], '', 'json')]
+ FJSON: String;
+ public
+ property ID: Int64 read fID write fID;
+ property JSON: String read FJSON write FJSON;
+ end;
+
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCTable('complex_types')]
+ TComplexTypes = class(TComplexTypesOnlyJSON)
+ private
+ [MVCTableField('jsonb_field', [], '', 'jsonb')]
+ FJSONB: String;
+ [MVCTableField('xml_field', [], '', 'xml')]
+ fXML: String;
+ public
+ property JSONB: String read FJSONB write FJSONB;
+ property XML: String read fXML write fXML;
+ end;
+
+ [MVCTable('customers')]
+ [MVCEntityActions([eaRetrieve])] //only the "R" in CRUD
+ TReadOnlyCustomer = class(TCustomer)
+
+ end;
+
+// person, employee, manager
+ [MVCTable('people')]
+ [MVCEntityActions([])] //no CRUD operations allowed for this entity
+ TAbstractPerson = class abstract(TMVCActiveRecord)
+ private
+ [MVCTableField('id', [foPrimaryKey, foAutoGenerated])]
+ fID: NullableInt64;
+ [MVCTableField('last_name')]
+ fLastName: String;
+ [MVCTableField('first_name')]
+ fFirstName: String;
+ [MVCTableField('dob')]
+ fDob: NullableTDate;
+ [MVCTableField('full_name')]
+ fFullName: NullableString;
+ [MVCTableField('is_male')]
+ fIsMale: NullableBoolean;
+ [MVCTableField('note')]
+ fNote: NullableString;
+ [MVCTableField('photo')]
+ fPhoto: TStream;
+ function GetFullName: NullableString;
+ protected
+ procedure OnBeforeInsertOrUpdate; override;
+ public
+ constructor Create; override;
+ destructor Destroy; override;
+ property ID: NullableInt64 read fID write fID;
+ property LastName: String read fLastName write fLastName;
+ property FirstName: String read fFirstName write fFirstName;
+ property Dob: NullableTDate read fDob write fDob;
+ property FullName: NullableString read GetFullName;
+ property IsMale: NullableBoolean read fIsMale write fIsMale;
+ property Note: NullableString read fNote write fNote;
+ property Photo: TStream read fPhoto write fPhoto;
+ end;
+
+
+ [MVCTable('people', 'in(person_type,["person", "employee", "manager"])')]
+ [MVCPartition('person_type=(string)person')]
+ TPerson = class(TAbstractPerson)
+
+ end;
+
+ [MVCTable('people','in(person_type,["employee", "manager"])')]
+ [MVCPartition('person_type=(string)employee')]
+ TEmployee = class(TAbstractPerson)
+ private
+ [MVCTableField('salary')]
+ fSalary: Currency;
+ public
+ property Salary: Currency read fSalary write fSalary;
+ end;
+
+ [MVCTable('people')]
+ [MVCPartition('person_type=(string)manager')]
+ TManager = class(TEmployee)
+ private
+ [MVCTableField('annual_bonus')]
+ fAnnualBonus: Currency;
+ public
+ property AnnualBonus: Currency read fAnnualBonus write fAnnualBonus;
+ end;
+
+
+ [MVCTable('integers_as_booleans')]
+ TIntegersAsBooleans = class(TMVCActiveRecord)
+ private
+ [MVCTableField('id', [foPrimaryKey, foAutoGenerated])]
+ FID: NullableInt64;
+ [MVCTableField('done_int', 'int2')]
+ FDoneAsInteger: Integer;
+ [MVCTableField('done_bool')]
+ FDoneAsBoolean: Boolean;
+ procedure SetDoneAsBoolean(const Value: Boolean);
+ procedure SetDoneAsInteger(const Value: Integer);
+ procedure SetID(const Value: NullableInt64);
+ public
+ property ID: NullableInt64 read FID write SetID;
+ property DoneAsBoolean: Boolean read FDoneAsBoolean write SetDoneAsBoolean;
+ property DoneAsInteger: Integer read FDoneAsInteger write SetDoneAsInteger;
+ end;
+
+
+ [MVCNameCase(ncLowerCase)]
+ [MVCTable('customers_with_version')]
+ TCustomerWithVersion = class(TCustomEntity)
+ private
+ [MVCTableField('id', [foPrimaryKey, foAutoGenerated])]
+ fID: NullableInt64;
+ [MVCTableField('code')]
+ fCode: NullableString;
+ [MVCTableField('description')]
+ fCompanyName: NullableString;
+ [MVCTableField('city')]
+ fCity: string;
+ [MVCTableField('rating')]
+ fRating: NullableInt32;
+ [MVCTableField('note')]
+ fNote: string;
+ [MVCTableField('objversion', [foVersion])]
+ fObjVersion: Integer;
+ public
+ function ToString: String; override;
+ property ID: NullableInt64 read fID write fID;
+ property Code: NullableString read fCode write fCode;
+ property CompanyName: NullableString read fCompanyName write fCompanyName;
+ property City: string read fCity write fCity;
+ property Rating: NullableInt32 read fRating write fRating;
+ property Note: string read fNote write fNote;
+ property ObjVersion: Integer read fObjVersion;
+ end;
+
+
+
+implementation
+
+uses
+ System.SysUtils, Data.DB, MVCFramework.Logger, System.Rtti;
+
+constructor TArticle.Create;
+begin
+ inherited Create;
+end;
+
+destructor TArticle.Destroy;
+begin
+ inherited;
+end;
+
+constructor TCustomer.Create;
+begin
+ inherited Create;
+end;
+
+destructor TCustomer.Destroy;
+begin
+
+ inherited;
+end;
+
+function TCustomer.ToString: String;
+begin
+ Result := '';
+ if PKIsNull then
+ Result := ''
+ else
+ Result := fID.ValueOrDefault.ToString;
+ Result := Format('[ID: %6s][CODE: %6s][CompanyName: %18s][City: %16s][Rating: %3d][Note: %s]',[
+ Result, fCode.ValueOrDefault, fCompanyName.ValueOrDefault, fCity, fRating.ValueOrDefault, fNote]);
+end;
+
+constructor TOrderDetail.Create;
+begin
+ inherited Create;
+end;
+
+destructor TOrderDetail.Destroy;
+begin
+ inherited;
+end;
+
+constructor TOrder.Create;
+begin
+ inherited Create;
+end;
+
+destructor TOrder.Destroy;
+begin
+ inherited;
+end;
+
+{ TCustomerEx }
+
+destructor TCustomerEx.Destroy;
+begin
+ fOrders.Free;
+ inherited;
+end;
+
+function TCustomerEx.GetOrders: TObjectList;
+begin
+ if not Assigned(fOrders) then
+ begin
+ fOrders := TObjectList.Create(True);
+ end;
+ Result := fOrders;
+end;
+
+procedure TCustomerEx.OnAfterInsert;
+begin
+ inherited;
+end;
+
+procedure TCustomerEx.OnAfterLoad;
+begin
+ inherited;
+ if Self.ID.HasValue then
+ begin
+ fOrders.Free;
+ fOrders := TMVCActiveRecord.Where('id_customer = ?', [Self.ID]);
+ end;
+end;
+
+{ TCustomerWithLogic }
+
+procedure TCustomerWithLogic.OnAfterLoad;
+begin
+ inherited;
+ fIsLocatedInRome := fCity = 'ROME';
+end;
+
+procedure TCustomerWithLogic.OnBeforeInsertOrUpdate;
+begin
+ inherited;
+ fCompanyName := fCompanyName.ValueOrDefault.ToUpper;
+ fCity := fCity.ToUpper;
+end;
+
+procedure TCustomerWithLogic.OnValidation(const Action: TMVCEntityAction);
+begin
+ inherited;
+ if fCompanyName.ValueOrDefault.IsEmpty or fCity.Trim.IsEmpty or fCode.Value.Trim.IsEmpty then
+ raise Exception.Create('CompanyName, City and Code are required');
+end;
+
+{ TCustomerWithReadOnlyFields }
+
+procedure TCustomerWithReadOnlyFields.SetFormattedCode(const Value: string);
+begin
+ fFormattedCode := Value;
+end;
+
+{ TNullablesTest }
+
+constructor TNullablesTest.Create;
+begin
+ inherited Create;
+ ff_blob := TMemoryStream.Create;
+end;
+
+destructor TNullablesTest.Destroy;
+begin
+ ff_blob.Free;
+ inherited;
+end;
+
+{ TCustomEntity }
+
+procedure TCustomEntity.OnBeforeExecuteSQL(var SQL: string);
+begin
+ inherited;
+ Log.Info(ClassName + ' | ' + SQL, 'sql_trace');
+end;
+
+{ TCustomerPlainWithClientPK }
+
+procedure TCustomerPlainWithClientPK.OnBeforeInsert;
+begin
+ inherited;
+ SetPK(TValue.From(TGUID.NewGuid.ToString.Replace('{', '').Replace('-',
+ '').Replace('}', '').Substring(0, 20)));
+end;
+
+{ TPartitionedCustomer }
+
+function TPartitionedCustomer.ToString: String;
+begin
+ Result := '';
+ if PKIsNull then
+ Result := '';
+ Result := Format('[ID: %6s][CODE: %6s][CompanyName: %18s][City: %16s][Note: %s]',[
+ Result, fCode.ValueOrDefault, fCompanyName.ValueOrDefault, fCity, fNote]);
+end;
+
+constructor TAbstractPerson.Create;
+begin
+ inherited Create;
+ fPhoto := TMemoryStream.Create;
+end;
+
+destructor TAbstractPerson.Destroy;
+begin
+ fPhoto.Free;
+ inherited;
+end;
+
+function TAbstractPerson.GetFullName: NullableString;
+begin
+ Result := fFirstName + ' ' + fLastName;
+end;
+
+procedure TAbstractPerson.OnBeforeInsertOrUpdate;
+begin
+ inherited;
+ fFullName := GetFullName;
+end;
+
+{ TIntegersAsBooleans }
+
+procedure TIntegersAsBooleans.SetDoneAsBoolean(const Value: Boolean);
+begin
+ FDoneAsBoolean := Value;
+end;
+
+procedure TIntegersAsBooleans.SetDoneAsInteger(const Value: Integer);
+begin
+ FDoneAsInteger := Value;
+end;
+
+procedure TIntegersAsBooleans.SetID(const Value: NullableInt64);
+begin
+ FID := Value;
+end;
+
+{ TDefaultValuesTest }
+
+constructor TDefaultValuesTest.Create;
+begin
+ inherited Create;
+ ff_blob := TMemoryStream.Create;
+end;
+
+destructor TDefaultValuesTest.Destroy;
+begin
+ ff_blob.Free;
+ inherited;
+end;
+
+{ TCustomerWithVersion }
+
+function TCustomerWithVersion.ToString: String;
+begin
+ Result := '';
+ if PKIsNull then
+ Result := ''
+ else
+ Result := fID.ValueOrDefault.ToString;
+ Result := Format('[ID: %6s][CODE: %6s][CompanyName: %18s][City: %16s][Rating: %3d][Note: %s][Version: %d]',[
+ Result, fCode.ValueOrDefault, fCompanyName.ValueOrDefault, fCity, fRating.ValueOrDefault, fNote, fObjVersion]);
+end;
+
+{ TCustomerOnCustomers2 }
+
+function TCustomerOnCustomers2.GetCustomTableName: String;
+begin
+ Result := 'customers2';
+end;
+
+end.
diff --git a/samples/unidac_activerecord_showcase/MainFormU.dfm b/samples/unidac_activerecord_showcase/MainFormU.dfm
new file mode 100644
index 000000000..d9cfc4fc4
--- /dev/null
+++ b/samples/unidac_activerecord_showcase/MainFormU.dfm
@@ -0,0 +1,351 @@
+object MainForm: TMainForm
+ Left = 0
+ Top = 0
+ Caption = 'TMVCActiveRecord - ShowCase'
+ ClientHeight = 698
+ ClientWidth = 1094
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ OnDestroy = FormDestroy
+ OnShow = FormShow
+ DesignSize = (
+ 1094
+ 698)
+ TextHeight = 13
+ object btnCRUD: TButton
+ Left = 8
+ Top = 8
+ Width = 121
+ Height = 33
+ Caption = 'CRUD'
+ TabOrder = 0
+ OnClick = btnCRUDClick
+ end
+ object btnSelect: TButton
+ Left = 8
+ Top = 283
+ Width = 121
+ Height = 33
+ Caption = 'Queries'
+ TabOrder = 1
+ OnClick = btnSelectClick
+ end
+ object Memo1: TMemo
+ Left = 280
+ Top = 8
+ Width = 806
+ Height = 682
+ Anchors = [akLeft, akTop, akRight, akBottom]
+ Ctl3D = True
+ DoubleBuffered = True
+ Font.Charset = ANSI_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -13
+ Font.Name = 'Consolas'
+ Font.Style = []
+ ParentCtl3D = False
+ ParentDoubleBuffered = False
+ ParentFont = False
+ ReadOnly = True
+ ScrollBars = ssBoth
+ TabOrder = 2
+ WantReturns = False
+ WordWrap = False
+ end
+ object btnRelations: TButton
+ Left = 8
+ Top = 322
+ Width = 121
+ Height = 35
+ Caption = 'Relations'
+ TabOrder = 3
+ OnClick = btnRelationsClick
+ end
+ object btnInheritance: TButton
+ Left = 8
+ Top = 363
+ Width = 121
+ Height = 34
+ Caption = 'Inheritance'
+ TabOrder = 4
+ OnClick = btnInheritanceClick
+ end
+ object btnValidation: TButton
+ Left = 8
+ Top = 403
+ Width = 121
+ Height = 34
+ Caption = 'Validation'
+ TabOrder = 5
+ OnClick = btnValidationClick
+ end
+ object btnMultiThreading: TButton
+ Left = 144
+ Top = 8
+ Width = 121
+ Height = 33
+ Caption = 'Multi Threading'
+ TabOrder = 6
+ OnClick = btnMultiThreadingClick
+ end
+ object btnRQL: TButton
+ Left = 8
+ Top = 443
+ Width = 121
+ Height = 34
+ Caption = 'RQL Query'
+ TabOrder = 7
+ OnClick = btnRQLClick
+ end
+ object btnReadOnlyFields: TButton
+ Left = 8
+ Top = 203
+ Width = 121
+ Height = 33
+ Caption = 'CRUD With R/O Field'
+ TabOrder = 8
+ OnClick = btnReadOnlyFieldsClick
+ end
+ object btnNullTest: TButton
+ Left = 144
+ Top = 47
+ Width = 121
+ Height = 33
+ Caption = 'Nullables'
+ TabOrder = 9
+ OnClick = btnNullTestClick
+ end
+ object btnCRUDNoAutoInc: TButton
+ Left = 8
+ Top = 86
+ Width = 121
+ Height = 33
+ Caption = 'CRUD (no autoinc)'
+ TabOrder = 10
+ OnClick = btnCRUDNoAutoIncClick
+ end
+ object btnCRUDWithStringPKs: TButton
+ Left = 8
+ Top = 125
+ Width = 121
+ Height = 33
+ Caption = 'CRUD (string pks)'
+ TabOrder = 11
+ OnClick = btnCRUDWithStringPKsClick
+ end
+ object btnWithSpaces: TButton
+ Left = 8
+ Top = 164
+ Width = 121
+ Height = 33
+ Caption = 'CRUD (entity with spaces)'
+ TabOrder = 12
+ WordWrap = True
+ OnClick = btnWithSpacesClick
+ end
+ object btnCountWithRQL: TButton
+ Left = 144
+ Top = 86
+ Width = 121
+ Height = 33
+ Caption = 'Count with RQL'
+ TabOrder = 13
+ OnClick = btnCountWithRQLClick
+ end
+ object btnReadAndWriteOnly: TButton
+ Left = 144
+ Top = 125
+ Width = 121
+ Height = 33
+ Caption = 'R/O, R/W'
+ TabOrder = 14
+ OnClick = btnReadAndWriteOnlyClick
+ end
+ object btnClientGeneratedPK: TButton
+ Left = 144
+ Top = 164
+ Width = 121
+ Height = 33
+ Caption = 'Client Generated PKs'
+ TabOrder = 15
+ OnClick = btnClientGeneratedPKClick
+ end
+ object btnAttributes: TButton
+ Left = 144
+ Top = 203
+ Width = 121
+ Height = 33
+ Caption = 'Attributes'
+ TabOrder = 16
+ OnClick = btnAttributesClick
+ end
+ object btnJSON_XML_Types: TButton
+ Left = 144
+ Top = 242
+ Width = 121
+ Height = 35
+ Caption = 'JSON && XML'
+ TabOrder = 17
+ OnClick = btnJSON_XML_TypesClick
+ end
+ object btnMerge: TButton
+ Left = 144
+ Top = 283
+ Width = 121
+ Height = 34
+ Caption = 'Merge'
+ TabOrder = 18
+ OnClick = btnMergeClick
+ end
+ object btnTableFilter: TButton
+ Left = 144
+ Top = 323
+ Width = 121
+ Height = 34
+ Caption = 'Table Filter'
+ TabOrder = 19
+ OnClick = btnTableFilterClick
+ end
+ object btnPartitioning: TButton
+ Left = 144
+ Top = 363
+ Width = 121
+ Height = 33
+ Caption = 'Table Partitioning'
+ TabOrder = 20
+ OnClick = btnPartitioningClick
+ end
+ object btnCRUDWithGUID: TButton
+ Left = 8
+ Top = 47
+ Width = 121
+ Height = 33
+ Caption = 'CRUD (with GUID PK)'
+ TabOrder = 21
+ OnClick = btnCRUDWithGUIDClick
+ end
+ object btnOOP: TButton
+ Left = 144
+ Top = 402
+ Width = 121
+ Height = 34
+ Caption = 'OOP with Partitioning and Filtering'
+ TabOrder = 22
+ WordWrap = True
+ OnClick = btnOOPClick
+ end
+ object btnReadOnly: TButton
+ Left = 8
+ Top = 483
+ Width = 121
+ Height = 34
+ Caption = 'Read/Only Entities'
+ TabOrder = 23
+ OnClick = btnReadOnlyClick
+ end
+ object btnSpeed: TButton
+ Left = 8
+ Top = 523
+ Width = 121
+ Height = 34
+ Caption = 'Metadata Speed Test'
+ TabOrder = 24
+ OnClick = btnSpeedClick
+ end
+ object btnRefresh: TButton
+ Left = 144
+ Top = 442
+ Width = 121
+ Height = 34
+ Caption = 'Manual Refresh'
+ TabOrder = 25
+ OnClick = btnRefreshClick
+ end
+ object btnNamedQuery: TButton
+ Left = 144
+ Top = 482
+ Width = 121
+ Height = 34
+ Caption = 'Named Query'
+ TabOrder = 26
+ OnClick = btnNamedQueryClick
+ end
+ object btnVirtualEntities: TButton
+ Left = 144
+ Top = 522
+ Width = 121
+ Height = 34
+ Caption = 'Virtual Entities'
+ TabOrder = 27
+ OnClick = btnVirtualEntitiesClick
+ end
+ object btnIntegersAsBool: TButton
+ Left = 8
+ Top = 563
+ Width = 121
+ Height = 34
+ Caption = 'Integers As Booleans'
+ TabOrder = 28
+ OnClick = btnIntegersAsBoolClick
+ end
+ object btnObjectVersion: TButton
+ Left = 8
+ Top = 603
+ Width = 121
+ Height = 34
+ Caption = 'Object Version'
+ TabOrder = 29
+ OnClick = btnObjectVersionClick
+ end
+ object btnCustomTable: TButton
+ Left = 144
+ Top = 562
+ Width = 121
+ Height = 34
+ Caption = 'Custom TableName'
+ TabOrder = 30
+ OnClick = btnCustomTableClick
+ end
+ object btnCRUDWithOptions: TButton
+ Left = 8
+ Top = 242
+ Width = 121
+ Height = 33
+ Caption = 'CRUD With Fields Opts'
+ TabOrder = 31
+ OnClick = btnCRUDWithOptionsClick
+ end
+ object btnTransaction: TButton
+ Left = 144
+ Top = 602
+ Width = 121
+ Height = 35
+ Caption = 'TransactionContext'
+ TabOrder = 32
+ OnClick = btnTransactionClick
+ end
+ object btnUseExplicitConnection: TButton
+ Left = 8
+ Top = 643
+ Width = 121
+ Height = 34
+ Caption = 'Use Explicit Connection'
+ TabOrder = 33
+ WordWrap = True
+ OnClick = btnUseExplicitConnectionClick
+ end
+ object btnErrorWith2PKs: TButton
+ Left = 144
+ Top = 643
+ Width = 121
+ Height = 34
+ Caption = 'Raise Error if More Thank One PK'
+ TabOrder = 34
+ WordWrap = True
+ OnClick = btnErrorWith2PKsClick
+ end
+end
diff --git a/samples/unidac_activerecord_showcase/MainFormU.pas b/samples/unidac_activerecord_showcase/MainFormU.pas
new file mode 100644
index 000000000..b2e412482
--- /dev/null
+++ b/samples/unidac_activerecord_showcase/MainFormU.pas
@@ -0,0 +1,2528 @@
+unit MainFormU;
+
+interface
+
+uses
+ Winapi.Windows,
+ Winapi.Messages,
+ System.SysUtils,
+ System.Variants,
+ System.Classes,
+ Vcl.Graphics,
+ Vcl.Controls,
+ Vcl.Forms,
+ Vcl.Dialogs,
+ Vcl.StdCtrls,
+ Uni,
+ DBAccess,
+ MemDS,
+ MVCFramework.Nullables,
+ MVCFramework.ActiveRecord,
+ MVCFramework.Logger,
+ System.Generics.Collections,
+ System.Diagnostics;
+
+type
+ TMainForm = class(TForm)
+ btnCRUD: TButton;
+ btnSelect: TButton;
+ Memo1: TMemo;
+ btnRelations: TButton;
+ btnInheritance: TButton;
+ btnValidation: TButton;
+ btnMultiThreading: TButton;
+ btnRQL: TButton;
+ btnReadOnlyFields: TButton;
+ btnNullTest: TButton;
+ btnCRUDNoAutoInc: TButton;
+ btnCRUDWithStringPKs: TButton;
+ btnWithSpaces: TButton;
+ btnCountWithRQL: TButton;
+ btnReadAndWriteOnly: TButton;
+ btnClientGeneratedPK: TButton;
+ btnAttributes: TButton;
+ btnJSON_XML_Types: TButton;
+ btnMerge: TButton;
+ btnTableFilter: TButton;
+ btnPartitioning: TButton;
+ btnCRUDWithGUID: TButton;
+ btnOOP: TButton;
+ btnReadOnly: TButton;
+ btnSpeed: TButton;
+ btnRefresh: TButton;
+ btnNamedQuery: TButton;
+ btnVirtualEntities: TButton;
+ btnIntegersAsBool: TButton;
+ btnObjectVersion: TButton;
+ btnCustomTable: TButton;
+ btnCRUDWithOptions: TButton;
+ btnTransaction: TButton;
+ btnUseExplicitConnection: TButton;
+ btnErrorWith2PKs: TButton;
+ procedure btnCRUDClick(Sender: TObject);
+ procedure btnInheritanceClick(Sender: TObject);
+ procedure btnMultiThreadingClick(Sender: TObject);
+ procedure btnRelationsClick(Sender: TObject);
+ procedure btnRQLClick(Sender: TObject);
+ procedure btnSelectClick(Sender: TObject);
+ procedure btnValidationClick(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure btnReadOnlyFieldsClick(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure btnNullablesClick(Sender: TObject);
+ procedure btnNullTestClick(Sender: TObject);
+ procedure btnCRUDNoAutoIncClick(Sender: TObject);
+ procedure btnCRUDWithStringPKsClick(Sender: TObject);
+ procedure btnWithSpacesClick(Sender: TObject);
+ procedure btnCountWithRQLClick(Sender: TObject);
+ procedure btnReadAndWriteOnlyClick(Sender: TObject);
+ procedure btnClientGeneratedPKClick(Sender: TObject);
+ procedure btnAttributesClick(Sender: TObject);
+ procedure btnJSON_XML_TypesClick(Sender: TObject);
+ procedure btnMergeClick(Sender: TObject);
+ procedure btnTableFilterClick(Sender: TObject);
+ procedure btnPartitioningClick(Sender: TObject);
+ procedure btnCRUDWithGUIDClick(Sender: TObject);
+ procedure btnOOPClick(Sender: TObject);
+ procedure btnReadOnlyClick(Sender: TObject);
+ procedure btnSpeedClick(Sender: TObject);
+ procedure btnRefreshClick(Sender: TObject);
+ procedure btnNamedQueryClick(Sender: TObject);
+ procedure btnVirtualEntitiesClick(Sender: TObject);
+ procedure btnIntegersAsBoolClick(Sender: TObject);
+ procedure btnObjectVersionClick(Sender: TObject);
+ procedure btnCustomTableClick(Sender: TObject);
+ procedure btnCRUDWithOptionsClick(Sender: TObject);
+ procedure btnTransactionClick(Sender: TObject);
+ procedure btnUseExplicitConnectionClick(Sender: TObject);
+ procedure btnErrorWith2PKsClick(Sender: TObject);
+ private
+ FConnection: TUniConnection;
+ procedure Log(const Value: string);
+ procedure LoadCustomers(const HowManyCustomers: Integer = 50);
+ procedure ExecutedInTransaction;
+ public
+ { Public declarations }
+ end;
+
+var
+ MainForm: TMainForm;
+
+implementation
+
+{$R *.dfm}
+
+
+uses
+ EntitiesU,
+ System.Threading,
+ MVCFramework.DataSet.Utils,
+ MVCFramework.RQL.Parser,
+ System.Math,
+ UniConnectionConfigU,
+ EngineChoiceFormU,
+ System.Rtti,
+ Data.DB;
+
+const
+ Cities: array [0 .. 4] of string = ('Rome', 'New York', 'London', 'Melbourne', 'Berlin');
+ CompanySuffix: array [0 .. 5] of string = ('Corp.', 'Inc.', 'Ltd.', 'Srl', 'SPA', 'doo');
+ Stuff: array [0 .. 4] of string = ('Burger', 'GAS', 'Motors', 'House', 'Boats');
+
+procedure TMainForm.btnAttributesClick(Sender: TObject);
+var
+ lCustomer: TCustomer;
+ lID: Integer;
+begin
+ Log('** Dynamic Properties Access');
+ lCustomer := TCustomer.Create;
+ try
+ lCustomer.Attributes['CompanyName'] := 'Google Inc.';
+ lCustomer.Attributes['City'] := 'Montain View, CA';
+ lCustomer.Attributes['Note'] := 'Hello there!';
+ lCustomer.Attributes['Code'] := 'XX123';
+ lCustomer.Attributes['Rating'] := 3;
+ lCustomer.Insert;
+ lID := lCustomer.ID;
+ Log('Just inserted Customer ' + lID.ToString);
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TMVCActiveRecord.GetByPK(lID);
+ try
+ Assert('Google Inc.' = lCustomer.Attributes['CompanyName'].AsType().Value);
+ Assert('Montain View, CA' = lCustomer.Attributes['City'].AsString);
+ Assert('XX123' = lCustomer.Attributes['Code'].AsType().Value);
+ Assert('Hello there!' = lCustomer.Attributes['Note'].AsString);
+ lCustomer.Update;
+ Log('Just updated Customer ' + lID.ToString);
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TCustomer.Create;
+ try
+ lCustomer.LoadByPK(lID);
+ lCustomer.Code.Value := '9012';
+ lCustomer.Update;
+ finally
+ lCustomer.Free;
+ end;
+end;
+
+procedure TMainForm.btnClientGeneratedPKClick(Sender: TObject);
+var
+ lCustomer: TCustomerPlainWithClientPK;
+begin
+ Log('** OnBeforeInsert and SetPK');
+ lCustomer := TCustomerPlainWithClientPK.Create();
+ try
+ lCustomer.Store;
+ finally
+ lCustomer.Free;
+ end;
+end;
+
+procedure TMainForm.btnCountWithRQLClick(Sender: TObject);
+var
+ lRQL: string;
+ lCustomer: TCustomer;
+ I: Integer;
+begin
+ Log('** TMVCActiveRecord.Count(RQL) [Just uses Filter]');
+
+ TMVCActiveRecord.DeleteAll(TCustomer);
+ for I := 1 to 30 do
+ begin
+ lCustomer := TCustomer.Create;
+ try
+ lCustomer.Code := Format('%5.5d', [TThread.CurrentThread.ThreadID, I]);
+ lCustomer.City := Cities[Random(high(Cities) + 1)];
+ lCustomer.CompanyName := Format('%s %s %s', [lCustomer.City, Stuff[Random(high(Stuff) + 1)],
+ CompanySuffix[Random(high(CompanySuffix) + 1)]]);
+ lCustomer.Note := lCustomer.CompanyName + ' is from ' + lCustomer.City;
+ lCustomer.Insert;
+ finally
+ lCustomer.Free;
+ end;
+ end;
+
+ lRQL := 'contains(city,"e")';
+ Log(lRQL + ' => ' + TMVCActiveRecord.Count(lRQL).ToString);
+
+ lRQL := 'contains(city,"e");sort(+city)';
+ Log(lRQL + ' => ' + TMVCActiveRecord.Count(lRQL).ToString);
+
+ lRQL := 'contains(city,"e");limit(1,1)';
+ Log(lRQL + ' => ' + TMVCActiveRecord.Count(lRQL).ToString);
+
+ lRQL := 'contains(city,"e");sort(+city);limit(1,1)';
+ Log(lRQL + ' => ' + TMVCActiveRecord.Count(lRQL).ToString);
+
+ lRQL := 'contains(city,"e");sort(+city);limit(0,5)';
+ Log(lRQL + ' => ' + TMVCActiveRecord.Count(lRQL).ToString);
+end;
+
+procedure TMainForm.btnCRUDClick(Sender: TObject);
+var
+ lCustomer: TCustomer;
+ lID: Integer;
+ lTestNote: string;
+begin
+ Log('** Simple CRUD test');
+ Log('There are ' + TMVCActiveRecord.Count().ToString + ' row/s for entity ' +
+ TCustomer.ClassName);
+ lCustomer := TCustomer.Create;
+ try
+ Log('Entity ' + TCustomer.ClassName + ' is mapped to table ' + lCustomer.TableName);
+ lCustomer.CompanyName := 'Google Inc.';
+ lCustomer.City := 'Montain View, CA';
+ lCustomer.Note := 'Μῆνιν ἄειδε θεὰ Πηληϊάδεω Ἀχιλῆος οὐλομένην 😁';
+ lCustomer.LastContact := Now();
+ lCustomer.Insert;
+ lID := lCustomer.ID;
+ Log('Just inserted Customer ' + lID.ToString);
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TMVCActiveRecord.GetByPK(lID);
+ try
+ Assert(not lCustomer.Code.HasValue);
+ lCustomer.Code.Value := '5678';
+ lCustomer.Note := lCustomer.Note + sLineBreak + 'Code changed to 5678 🙂';
+ lCustomer.LastContact.Clear;
+ lTestNote := lCustomer.Note;
+ lCustomer.Update;
+ Log('Just updated Customer ' + lID.ToString);
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TCustomer.Create;
+ try
+ lCustomer.LoadByPK(lID);
+ lCustomer.Code.Value := '😉9012🙂';
+ Assert(lCustomer.LastContact.IsNull);
+ lCustomer.LastContact := Now();
+ lCustomer.Update;
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TCustomer.Create;
+ try
+ lCustomer.LoadByPK(lID);
+ Assert(lCustomer.Code.Value = '😉9012🙂');
+ Assert(lCustomer.Note = lTestNote);
+ Assert(lCustomer.LastContact.HasValue);
+ lCustomer.LastContact := Now();
+ lCustomer.Update;
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TMVCActiveRecord.GetByPK(lID);
+ try
+ lCustomer.Delete;
+ Log('Just deleted Customer ' + lID.ToString);
+ finally
+ lCustomer.Free;
+ end;
+end;
+
+procedure TMainForm.btnCRUDNoAutoIncClick(Sender: TObject);
+var
+ lCustomer: TCustomerPlain;
+ lID: Integer;
+ I: Integer;
+begin
+ Log('** Simple CRUD (no autoinc) test');
+ Log('There are ' + TMVCActiveRecord.Count().ToString + ' row/s for entity ' +
+ TCustomerPlain.ClassName);
+ TMVCActiveRecord.DeleteAll(TCustomerPlain);
+ Log('Deleting all entities ' + TCustomerPlain.ClassName);
+ for I := 1 to 100 do
+ begin
+ lCustomer := TCustomerPlain.Create;
+ try
+ lCustomer.ID := I;
+ // just for test!!
+ case I mod 3 of
+ 0:
+ lCustomer.CompanyName := 'Google Inc.';
+ 1:
+ lCustomer.CompanyName := 'bit Time Professionals';
+ 2:
+ lCustomer.CompanyName := 'Walt Disney Corp.';
+ end;
+ lCustomer.City := 'Montain View, CA';
+ lCustomer.Note := 'Hello there!';
+ lCustomer.CreationTime := Time;
+ lCustomer.CreationDate := Date;
+ lCustomer.Insert;
+ lID := lCustomer.ID;
+ Log('Just inserted Customer ' + lID.ToString);
+ finally
+ lCustomer.Free;
+ end;
+ end;
+
+ Log('Now there are ' + TMVCActiveRecord.Count().ToString + ' row/s for entity ' +
+ TCustomerPlain.ClassName);
+ TMVCActiveRecord.DeleteRQL(TCustomerPlain, 'lt(id,90)');
+
+ lCustomer := TMVCActiveRecord.GetByPK(lID);
+ try
+ Assert(not lCustomer.Code.HasValue);
+ lCustomer.Code.Value := '5678';
+ lCustomer.Note := lCustomer.Note + sLineBreak + 'Code changed to 5678';
+ lCustomer.Update;
+ Log('Just updated Customer ' + lID.ToString);
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TCustomerPlain.Create;
+ try
+ lCustomer.LoadByPK(lID);
+ lCustomer.Code.Value := '9012';
+ lCustomer.Update;
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TMVCActiveRecord.GetByPK(lID);
+ try
+ lCustomer.Delete;
+ Log('Just deleted Customer ' + lID.ToString);
+ finally
+ lCustomer.Free;
+ end;
+end;
+
+procedure TMainForm.btnCRUDWithGUIDClick(Sender: TObject);
+var
+ lTestNote: string;
+ lCustWithGUID: TCustomerWithGUID;
+ lIDGUID: TGUID;
+begin
+ TMVCActiveRecord.DeleteAll(TCustomerWithGUID);
+
+ Log('** Using GUID as primary key');
+
+ lCustWithGUID := TCustomerWithGUID.Create;
+ try
+ Log('Entity ' + TCustomerWithGUID.ClassName + ' is mapped to table ' + lCustWithGUID.TableName);
+ lCustWithGUID.GUID := TGUID.NewGuid;
+ lCustWithGUID.CompanyName := 'Google Inc.';
+ lCustWithGUID.City := 'Montain View, CA';
+ lCustWithGUID.Note := 'Μῆνιν ἄειδε θεὰ Πηληϊάδεω Ἀχιλῆος οὐλομένην 😁';
+ lCustWithGUID.Insert;
+ lIDGUID := lCustWithGUID.GUID;
+ Log('Just inserted Customer With GUID ' + lIDGUID.ToString);
+ finally
+ lCustWithGUID.Free;
+ end;
+
+ lCustWithGUID := TMVCActiveRecord.GetByPK(lIDGUID);
+ try
+ Assert(not lCustWithGUID.Code.HasValue);
+ lCustWithGUID.Code.Value := '5678';
+ lCustWithGUID.Note := lCustWithGUID.Note + sLineBreak + 'Code changed to 5678 🙂';
+ lTestNote := lCustWithGUID.Note;
+ lCustWithGUID.Update;
+ Log('Just updated Customer ' + lIDGUID.ToString);
+ finally
+ lCustWithGUID.Free;
+ end;
+
+ lCustWithGUID := TCustomerWithGUID.Create;
+ try
+ lCustWithGUID.LoadByPK(lIDGUID);
+ lCustWithGUID.Code.Value := '😉9012🙂';
+ lCustWithGUID.Update;
+
+ lCustWithGUID.GUID := TGUID.NewGuid;
+ lCustWithGUID.Insert;
+ finally
+ lCustWithGUID.Free;
+ end;
+
+
+
+ lCustWithGUID := TMVCActiveRecord.GetByPK(lIDGUID);
+ try
+ lCustWithGUID.Delete;
+ Log('Just deleted Customer ' + lIDGUID.ToString);
+ finally
+ lCustWithGUID.Free;
+ end;
+end;
+
+procedure TMainForm.btnCRUDWithOptionsClick(Sender: TObject);
+var
+ lCustomer: TCustomerWithOptions;
+ lID: Integer;
+begin
+ Log('** CRUD test with fields options');
+ lCustomer := TCustomerWithOptions.Create;
+ try
+ {
+ 'Code' will not be persisted on table because defined as 'foReadOnly'
+ }
+ lCustomer.Code := '1234'; // "Code" will be skipped in insert and in update as well
+ lCustomer.CompanyName := 'Google Inc.'; // "CompanyName" will be skipped in insert
+ lCustomer.City := 'Montain View, CA'; // "City" will be skipped in update
+ lCustomer.Insert;
+ lID := lCustomer.ID;
+ Log('Just inserted Customer ' + lID.ToString + ' with fields options');
+ finally
+ lCustomer.Free;
+ end;
+
+ //let's check that code is empty
+ lCustomer := TMVCActiveRecord.GetByPK(lID);
+ try
+ Assert(lCustomer.Code.IsNull); // it's null
+ Assert(lCustomer.CompanyName.IsEmpty); //empty string
+ Assert(lCustomer.City = 'Montain View, CA'); //inserted
+
+ lCustomer.Code := '1234'; // "Code" will be skipped in insert and in update as well
+ lCustomer.CompanyName := 'Google Inc.'; // "CompanyName" will be saved
+ lCustomer.City := 'Via Roma 10, ITALY'; // "City" will be skipped in update
+ lCustomer.Update;
+ finally
+ lCustomer.Free;
+ end;
+
+ //let's check
+ lCustomer := TMVCActiveRecord.GetByPK(lID);
+ try
+ Assert(lCustomer.Code.IsNull); // it's null
+ Assert(lCustomer.CompanyName = 'Google Inc.'); //correctly updated
+ Assert(lCustomer.City = 'Montain View, CA'); // not updated, mantains old value
+ finally
+ lCustomer.Free;
+ end;
+
+ {
+ //if underlying field is not null, it is loaded as usual
+ TMVCActiveRecord.CurrentConnection.ExecSQL('update customers set code = ''XYZ'' where id = ?', [lID]);
+ lCustomer := TMVCActiveRecord.GetByPK(lID);
+ try
+ Assert('XYZ' = lCustomer.Code);
+ lCustomer.CompanyName := lCustomer.CompanyName + ' changed!';
+ lCustomer.Code := 'this code will not be saved';
+ lCustomer.Update; //do not save field "code"
+ Log('Just updated Customer ' + lID.ToString);
+ finally
+ lCustomer.Free;
+ end;
+
+ //but being foReadOnly is not updated
+ lCustomer := TMVCActiveRecord.GetByPK(lID);
+ try
+ Assert('XYZ' = lCustomer.Code);
+ lCustomer.Delete;
+ Log('Just deleted Customer ' + lID.ToString + ' with a R/O field');
+ finally
+ lCustomer.Free;
+ end;
+ }
+end;
+
+procedure TMainForm.btnCRUDWithStringPKsClick(Sender: TObject);
+var
+ lCustomer: TCustomerWithCode;
+ lCode: string;
+ I: Integer;
+begin
+ Log('** Simple CRUD (with string pks) test');
+ Log('There are ' + TMVCActiveRecord.Count().ToString + ' row/s for entity ' +
+ TCustomerWithCode.ClassName);
+ TMVCActiveRecord.DeleteAll(TCustomerWithCode);
+ Log('Deleting all entities ' + TCustomerWithCode.ClassName);
+ for I := 1 to 100 do
+ begin
+ lCustomer := TCustomerWithCode.Create;
+ try
+ lCustomer.Code := I.ToString.PadLeft(4, '0');
+ // just for test!!
+ case I mod 3 of
+ 0:
+ lCustomer.CompanyName := 'Google Inc.';
+ 1:
+ lCustomer.CompanyName := 'bit Time Professionals';
+ 2:
+ lCustomer.CompanyName := 'Walt Disney Corp.';
+ end;
+ lCustomer.City := 'Montain View, CA';
+ lCustomer.Note := 'Hello there!';
+ lCustomer.Insert;
+ lCode := lCustomer.Code.Value;
+ Log('Just inserted Customer ' + lCode);
+ finally
+ lCustomer.Free;
+ end;
+ end;
+
+ Log('Now there are ' + TMVCActiveRecord.Count().ToString + ' row/s for entity '
+ + TCustomerPlain.ClassName);
+ TMVCActiveRecord.DeleteRQL(TCustomerWithCode, 'lt(code,"0090")');
+
+ lCustomer := TMVCActiveRecord.GetByPK(lCode);
+ try
+ Assert(lCustomer.Code.HasValue);
+ lCustomer.Note := lCustomer.Note + sLineBreak + 'Note changed!';
+ lCustomer.Update;
+ Log('Just updated Customer ' + lCode);
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TCustomerWithCode.Create;
+ try
+ lCustomer.LoadByPK(lCode);
+ lCustomer.CompanyName := 'My New Company!';
+ lCustomer.Update;
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TMVCActiveRecord.GetByPK(lCode);
+ try
+ lCustomer.Delete;
+ Log('Just deleted Customer ' + lCode);
+ finally
+ lCustomer.Free;
+ end;
+end;
+
+procedure TMainForm.btnCustomTableClick(Sender: TObject);
+var
+ lCustomer: TCustomerOnCustomers2;
+ lID: Integer;
+ lTestNote: string;
+begin
+ Log('** Simple CRUD test using a custom tablename (defined in GetCustomTableName)');
+ Log('There are ' + TMVCActiveRecord.Count().ToString + ' row/s for entity ' +
+ TCustomerOnCustomers2.ClassName);
+ lCustomer := TCustomerOnCustomers2.Create;
+ try
+ Log('Entity ' + TCustomerOnCustomers2.ClassName + ' is mapped to table ' + lCustomer.TableName);
+ lCustomer.CompanyName := 'Google Inc.';
+ lCustomer.City := 'Montain View, CA';
+ lCustomer.Note := 'Μῆνιν ἄειδε θεὰ Πηληϊάδεω Ἀχιλῆος οὐλομένην 😁';
+ lCustomer.Insert;
+ lID := lCustomer.ID;
+ Log('Just inserted Customer ' + lID.ToString);
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TMVCActiveRecord.GetByPK(lID);
+ try
+ Assert(not lCustomer.Code.HasValue);
+ lCustomer.Code.Value := '5678';
+ lCustomer.Note := lCustomer.Note + sLineBreak + 'Code changed to 5678 🙂';
+ lTestNote := lCustomer.Note;
+ lCustomer.Update;
+ Log('Just updated Customer ' + lID.ToString);
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TCustomerOnCustomers2.Create;
+ try
+ lCustomer.LoadByPK(lID);
+ lCustomer.Code.Value := '😉9012🙂';
+ lCustomer.Update;
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TCustomerOnCustomers2.Create;
+ try
+ lCustomer.LoadByPK(lID);
+ Assert(lCustomer.Code.Value = '😉9012🙂');
+ Assert(lCustomer.Note = lTestNote);
+ lCustomer.Update;
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TMVCActiveRecord.GetByPK(lID);
+ try
+ lCustomer.Delete;
+ Log('Just deleted Customer ' + lID.ToString);
+ finally
+ lCustomer.Free;
+ end;
+
+ // Overwriting constructor (useful for TMVCActiveRecordController)
+ var lConC2 := TCustomerOnCustomers2.Create;
+ try
+ Log('Entity ' + TCustomer.ClassName + ' is mapped to table ' + lConC2.TableName);
+ lConC2.CompanyName := 'Google Inc.';
+ lConC2.City := 'Montain View, CA';
+ lConC2.Note := 'Μῆνιν ἄειδε θεὰ Πηληϊάδεω Ἀχιλῆος οὐλομένην 😁';
+ lConC2.Insert;
+ lID := lConC2.ID;
+ Log('Just inserted Customer ' + lID.ToString + ' on customers2');
+ finally
+ lConC2.Free;
+ end;
+
+ lConC2 := TMVCActiveRecord.GetByPK(lID);
+ try
+ Log('Entity ' + TCustomer.ClassName + ' is mapped to table ' + lConC2.TableName);
+ lConC2.CompanyName := 'Google Inc.';
+ lConC2.City := 'Montain View, CA';
+ lConC2.Note := 'Μῆνιν ἄειδε θεὰ Πηληϊάδεω Ἀχιλῆος οὐλομένην 😁';
+ lConC2.Insert;
+ lID := lConC2.ID;
+ Log('Just inserted Customer ' + lID.ToString + ' on customers2');
+ finally
+ lConC2.Free;
+ end;
+
+
+end;
+
+procedure TMainForm.btnErrorWith2PKsClick(Sender: TObject);
+var
+ lWrongArticle: TWrongArticle;
+begin
+ Log('** Error if entoty defines more than one PK field');
+ lWrongArticle := TWrongArticle.Create;
+ try
+ lWrongArticle.LoadByPK(1);
+ finally
+ lWrongArticle.Free;
+ end;
+end;
+
+procedure TMainForm.btnInheritanceClick(Sender: TObject);
+var
+ lCustomerEx: TCustomerEx;
+begin
+ Log('** Inheritace test');
+ lCustomerEx := TCustomerEx.Create;
+ try
+ lCustomerEx.LoadByPK(1);
+ finally
+ lCustomerEx.Free;
+ end;
+end;
+
+procedure TMainForm.btnIntegersAsBoolClick(Sender: TObject);
+begin
+ Log('** Bool as Integer');
+ Log(' Only in the mapping layer it is possibile to map an integer field used ');
+ Log(' as boolean with values (0,1) as a boolean property');
+ Log(' --> (False is stored as 0, True is stored as 1) <--');
+ TMVCActiveRecord.DeleteAll(TIntegersAsBooleans);
+
+ for var I := 0 to 1 do
+ begin
+ for var b := False to True do
+ begin
+ var lTest1 := TIntegersAsBooleans.Create;
+ try
+ lTest1.DoneAsBoolean := b;
+ lTest1.DoneAsInteger := I;
+ lTest1.Store;
+ finally
+ lTest1.Free;
+ end;
+ end;
+ end;
+
+ { ** WARNING **
+ While mapping layer recognize a boolean stored as integer, queries must still
+ use the actual type (integer) instead of the mapped types}
+ Assert(2 = TMVCActiveRecord.Count('eq(doneasboolean,true)'));
+ Assert(2 = TMVCActiveRecord.Count('eq(doneasinteger,1)')); {the boolean attribute as integer}
+ Assert(1 = TMVCActiveRecord.Count('and(eq(doneasboolean,true),eq(doneasinteger,1))'));
+ Assert(1 = TMVCActiveRecord.Count('and(eq(doneasboolean,false),eq(doneasinteger,0))'));
+
+ var lList := TMVCActiveRecord.SelectRQL('sort(+id)', 10);
+ try
+ Assert(lList.Count = 4);
+ var lIdx := 0;
+ for var I := 0 to 1 do
+ begin
+ for var b := False to True do
+ begin
+ Assert(b = lList[lIdx].DoneAsBoolean);
+ Assert(I = lList[lIdx].DoneAsInteger);
+ Inc(lIdx);
+ end;
+ end;
+ finally
+ lList.Free;
+ end;
+end;
+
+procedure TMainForm.btnJSON_XML_TypesClick(Sender: TObject);
+var
+ lCTypes: TComplexTypes;
+ lCTypeJSON: TComplexTypesOnlyJSON;
+ lID: Int64;
+begin
+ //mysql and mariadb don't support XML data type.
+ //postgresql supports json, jsonb and xml
+
+ TMVCActiveRecord.DeleteAll(TComplexTypes);
+
+ if (ActiveRecordConnectionsRegistry.GetCurrentBackend = 'mysql') or
+ (ActiveRecordConnectionsRegistry.GetCurrentBackend = 'mariadb') then
+ begin
+ Log('mysql/mariadb support JSON');
+ lCTypeJSON := TComplexTypesOnlyJSON.Create;
+ try
+ lCTypeJSON.JSON := '{"field_type":"json"}';
+ lCTypeJSON.Insert;
+ lID := lCTypeJSON.ID;
+ finally
+ lCTypeJSON.Free;
+ end;
+
+ lCTypeJSON := TMVCActiveRecord.GetByPK(lID);
+ try
+ lCTypeJSON.JSON := '{"field_type":"json", "updated": true}';
+ lCTypeJSON.Update;
+ finally
+ lCTypeJSON.Free;
+ end;
+
+ Log('Executing ==> JSON_VALUE(json_field, ''$.updated'') = true');
+ lCTypeJSON := TMVCActiveRecord.GetFirstByWhere('JSON_VALUE(json_field, ''$.updated'') = true', []);
+ try
+ Log('JSON ==> ' + lCTypeJSON.JSON);
+ finally
+ lCTypeJSON.Free;
+ end;
+ end;
+
+ if ActiveRecordConnectionsRegistry.GetCurrentBackend = 'postgresql' then
+ begin
+ Log('postgresql supports JSON, JSONB and XML');
+ lCTypes := TComplexTypes.Create;
+ try
+ lCTypes.JSON := '{"field_type":"json"}';
+ lCTypes.JSONB := '{"field_type":"jsonb"}';
+ lCTypes.XML := 'xml';
+ lCTypes.Insert;
+ lID := lCTypes.ID;
+ finally
+ lCTypes.Free;
+ end;
+
+ lCTypes := TMVCActiveRecord.GetByPK(lID);
+ try
+ lCTypes.JSON := '{"field_type":"json", "updated": true}';
+ lCTypes.JSONB := '{"field_type":"jsonb", "updated": true}';
+ lCTypes.XML := 'xml';
+ lCTypes.Update;
+ finally
+ lCTypes.Free;
+ end;
+
+ Log('Executing ==> (jsonb_field ->> ''updated'')::bool = true');
+ lCTypes := TMVCActiveRecord.GetFirstByWhere('(jsonb_field ->> ''updated'')::bool = true', []);
+ try
+ Log('JSON ==> ' + lCTypes.JSON);
+ finally
+ lCTypes.Free;
+ end;
+ end;
+end;
+
+procedure TMainForm.btnMergeClick(Sender: TObject);
+var
+ lCustomer: TCustomer;
+ lCustomers: TObjectList;
+ lCustomersChanges: TObjectList;
+begin
+ Log('** IMVCMultiExecutor demo');
+ TMVCActiveRecord.DeleteAll(TCustomer);
+ LoadCustomers;
+ lCustomers := TMVCActiveRecord.SelectRQL('eq(rating,1)', 1000);
+ try
+ lCustomersChanges := TObjectList.Create(True);
+ try
+ //these 2 customers will be updated
+ lCustomer := TCustomer.Create;
+ lCustomersChanges.Add(lCustomer);
+ lCustomer.ID := lCustomers[0].ID;
+ lCustomer.Code := 'C8765';
+ lCustomer.CompanyName := '(changed) Company1';
+ lCustomer.City := '(changed) City';
+ lCustomer.Rating := 1;
+
+ lCustomer := TCustomer.Create;
+ lCustomersChanges.Add(lCustomer);
+ lCustomer.ID := lCustomers[1].ID;
+ lCustomer.Code := lCustomers[1].Code;
+ lCustomer.CompanyName := '(changed) Company2';
+ lCustomer.City := '(changed) City';
+ lCustomer.Rating := 1;
+
+
+ //these 2 customer will be created
+ lCustomer := TCustomer.Create;
+ lCustomersChanges.Add(lCustomer);
+ lCustomer.Code := 'C9898';
+ lCustomer.CompanyName := '(new) Company3';
+ lCustomer.City := '(new) New City2';
+ lCustomer.Rating := 1;
+
+ lCustomer := TCustomer.Create;
+ lCustomersChanges.Add(lCustomer);
+ lCustomer.Code := 'C2343';
+ lCustomer.CompanyName := '(new) Company4';
+ lCustomer.City := '(new) New City2';
+ lCustomer.Rating := 1;
+
+ //all the other customers will be deleted
+
+ //calculate the unit-of-work to merge the lists
+ var lUOW := TMVCActiveRecord.Merge(lCustomers, lCustomersChanges);
+ //apply the UnitOfWork
+ lUOW.Apply(
+ procedure (const Customer: TCustomer; const EntityAction: TMVCEntityAction; var Handled: Boolean)
+ begin
+ Handled := False; //set it to true to execute action manually
+ case EntityAction of
+ eaCreate: Log('Inserting Customer : ' + Customer.ToString);
+ eaUpdate: Log('Updating Customer : ' + Customer.ToString);
+ eaDelete: Log('Deleting Customer : ' + Customer.ToString);
+ end;
+ end);
+
+
+ finally
+ lCustomersChanges.Free;
+ end;
+ finally
+ lCustomers.Free;
+ end;
+
+ lCustomers := TMVCActiveRecord.SelectRQL('eq(rating,1)', 1000);
+ try
+ Assert(lCustomers.Count = 4, 'Expected 4 customers, got ' + lCustomers.Count.ToString);
+ finally
+ lCustomers.Free;
+ end;
+end;
+
+procedure TMainForm.btnMultiThreadingClick(Sender: TObject);
+var
+ lTasks: TArray;
+ lProc: TProc;
+begin
+ Log('** Multithreading test');
+ TMVCActiveRecord.DeleteRQL(TCustomer,
+ 'in(City,["Rome","New York","London","Melbourne","Berlin"])');
+
+ lProc := procedure
+ var
+ lCustomer: TCustomer;
+ I: Integer;
+ begin
+ ActiveRecordConnectionsRegistry.AddDefaultConnection(FConnection);
+ try
+ lCustomer := TCustomer.Create;
+ try
+ for I := 1 to 50 do
+ begin
+ lCustomer.ID.Clear;
+ lCustomer.Code := Format('%5.5d', [TThread.CurrentThread.ThreadID, I]);
+ lCustomer.City := Cities[Random(high(Cities) + 1)];
+ lCustomer.CompanyName :=
+ Format('%s %s %s', [lCustomer.City, Stuff[Random(high(Stuff) + 1)],
+ CompanySuffix[Random(high(CompanySuffix) + 1)]]);
+ lCustomer.Note := lCustomer.CompanyName + ' is from ' + lCustomer.City;
+ lCustomer.Insert;
+ end;
+ finally
+ lCustomer.Free;
+ end;
+ finally
+ ActiveRecordConnectionsRegistry.RemoveDefaultConnection;
+ end;
+ end;
+
+ lTasks := [
+ TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc),
+ TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc),
+ TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc),
+ TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc),
+ TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc)
+ ];
+ TTask.WaitForAll(lTasks);
+
+ ShowMessage('Just inserted ' + TMVCActiveRecord.Count(TCustomer,
+ 'in(City,["Rome","New York","London","Melbourne","Berlin"])').ToString + ' records by ' + Length(lTasks).ToString + ' threads');
+end;
+
+procedure TMainForm.btnNamedQueryClick(Sender: TObject);
+begin
+ Log('** Named SQL Query');
+
+ LoadCustomers(10);
+
+ Log('QuerySQL: BestCustomers');
+ var lCustomers := TMVCActiveRecord.SelectByNamedQuery('BestCustomers', [], []);
+ try
+ for var lCustomer in lCustomers do
+ begin
+ Log(Format('%4d - %8.5s - %s', [lCustomer.ID.ValueOrDefault, lCustomer.Code.ValueOrDefault,
+ lCustomer.CompanyName.ValueOrDefault]));
+ end;
+ finally
+ lCustomers.Free;
+ end;
+
+ Log('QuerySQL: WithRatingGtOrEqTo');
+ lCustomers := TMVCActiveRecord.SelectByNamedQuery('WithRatingGtOrEqTo', [4], [ftInteger]);
+ try
+ for var lCustomer in lCustomers do
+ begin
+ Log(Format('%4d - %8.5s - %s', [lCustomer.ID.ValueOrDefault, lCustomer.Code.ValueOrDefault,
+ lCustomer.CompanyName.ValueOrDefault]));
+ end;
+ finally
+ lCustomers.Free;
+ end;
+
+ Log('QuerySQL: RatingLessThanPar');
+ lCustomers := TMVCActiveRecord.SelectByNamedQuery('RatingLessThanPar', [4], [ftInteger]);
+ try
+ for var lCustomer in lCustomers do
+ begin
+ Log(Format('%4d - %8.5s - %s', [lCustomer.ID.ValueOrDefault, lCustomer.Code.ValueOrDefault,
+ lCustomer.CompanyName.ValueOrDefault]));
+ end;
+ finally
+ lCustomers.Free;
+ end;
+
+ Log('QuerySQL: RatingLessThanPar (using classref)');
+ var lCustomersList := TMVCActiveRecord.SelectByNamedQuery(TCustomer, 'RatingLessThanPar', [4], [ftInteger], []);
+ try
+ for var lCustomer in TObjectList(lCustomersList) do
+ begin
+ Log(Format('%4d - %8.5s - %s', [lCustomer.ID.ValueOrDefault, lCustomer.Code.ValueOrDefault,
+ lCustomer.CompanyName.ValueOrDefault]));
+ end;
+ finally
+ lCustomersList.Free;
+ end;
+
+
+ Log('QuerySQL: RatingEqualsToPar');
+ lCustomers := TMVCActiveRecord.SelectByNamedQuery('RatingEqualsToPar', [3], [ftInteger]);
+ try
+ for var lCustomer in lCustomers do
+ begin
+ Log(Format('%4d - %8.5s - %s', [lCustomer.ID.ValueOrDefault, lCustomer.Code.ValueOrDefault,
+ lCustomer.CompanyName.ValueOrDefault]));
+ end;
+ finally
+ lCustomers.Free;
+ end;
+
+
+ var lTmpSQLQueryWithName: TSQLQueryWithName;
+ if TMVCActiveRecord.TryGetSQLQuery('GetAllCustomers', lTmpSQLQueryWithName) then
+ begin
+ Log('QuerySQL: Stored Procedure "GetAllCustomers"');
+ lCustomers := TMVCActiveRecord.SelectByNamedQuery('GetAllCustomers', [], [], [loIgnoreNotExistentFields]);
+ try
+ for var lCustomer in lCustomers do
+ begin
+ Log(Format('%4d - %8.5s - %s', [lCustomer.ID.ValueOrDefault, lCustomer.Code.ValueOrDefault,
+ lCustomer.CompanyName.ValueOrDefault]));
+ end;
+ finally
+ lCustomers.Free;
+ end;
+ end;
+
+ Log('** Named RQL Query');
+ Log('QueryRQL: RatingLessThanPar');
+ lCustomers := TMVCActiveRecord.SelectRQLByNamedQuery('RatingLessThanPar', [4], 1000);
+ try
+ for var lCustomer in lCustomers do
+ begin
+ Log(Format('%4d - %8.5s - %s', [lCustomer.ID.ValueOrDefault, lCustomer.Code.ValueOrDefault,
+ lCustomer.CompanyName.ValueOrDefault]));
+ end;
+ finally
+ lCustomers.Free;
+ end;
+
+ Log('QueryRQL: RatingLessThanPar (using classref)');
+ lCustomersList := TMVCActiveRecord.SelectRQLByNamedQuery(TCustomer, 'RatingLessThanPar', [4], 1000);
+ try
+ for var lCustomer in TObjectList(lCustomersList) do
+ begin
+ Log(Format('%4d - %8.5s - %s', [lCustomer.ID.ValueOrDefault, lCustomer.Code.ValueOrDefault,
+ lCustomer.CompanyName.ValueOrDefault]));
+ end;
+ finally
+ lCustomersList.Free;
+ end;
+
+ Log('QueryRQL: RatingEqualsToPar');
+ lCustomers := TMVCActiveRecord.SelectRQLByNamedQuery('RatingEqualsToPar', [3], 1000);
+ try
+ for var lCustomer in lCustomers do
+ begin
+ Log(Format('%4d - %8.5s - %s', [lCustomer.ID.ValueOrDefault, lCustomer.Code.ValueOrDefault,
+ lCustomer.CompanyName.ValueOrDefault]));
+ end;
+ finally
+ lCustomers.Free;
+ end;
+
+ //RatingLessThanPar
+ var lTmpRQLQueryWithName: TRQLQueryWithName;
+ if TMVCActiveRecord.TryGetRQLQuery('RatingLessThanPar', lTmpRQLQueryWithName) then
+ begin
+ Log(Format('"%s" RQLQuery is available with text: %s', [lTmpRQLQueryWithName.Name, lTmpRQLQueryWithName.RQLText]));
+ end
+ else
+ begin
+ Log(Format('"%s" RQLQuery is not available', ['RatingLessThanPar']));
+ end;
+end;
+
+procedure TMainForm.btnNullablesClick(Sender: TObject);
+var
+ lCustomer: TCustomer;
+ lID: Integer;
+begin
+ Log('** Nullables Test');
+ Log('There are ' + TMVCActiveRecord.Count().ToString + ' row/s for entity ' +
+ TCustomer.ClassName);
+ lCustomer := TCustomer.Create;
+ try
+ lCustomer.CompanyName := 'Google Inc.';
+ lCustomer.City := 'Montain View, CA';
+ lCustomer.Note := 'Hello there!';
+ lCustomer.Insert;
+ lID := lCustomer.ID;
+ Assert(not lCustomer.Code.HasValue);
+ Log('Just inserted Customer ' + lID.ToString);
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TMVCActiveRecord.GetByPK(lID);
+ try
+ Assert(not lCustomer.Code.HasValue);
+ Assert(not lCustomer.Rating.HasValue);
+ Assert(lCustomer.Rating.ValueOrDefault = 0);
+ lCustomer.Code.Value := '5678';
+ lCustomer.Rating.Value := 3;
+ Assert(lCustomer.Code.HasValue);
+ lCustomer.Note := lCustomer.Note + sLineBreak + 'Code changed to 5678';
+ lCustomer.Update;
+ Assert(lCustomer.Code.HasValue);
+ Assert(lCustomer.Rating.HasValue);
+ Log('Just updated Customer ' + lID.ToString);
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TMVCActiveRecord.GetByPK(lID);
+ try
+ Assert(lCustomer.Code.HasValue);
+ Assert(lCustomer.Rating.HasValue);
+ Assert(lCustomer.Code.ValueOrDefault = '5678');
+ Assert(lCustomer.Rating.ValueOrDefault = 3);
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TCustomer.Create;
+ try
+ lCustomer.LoadByPK(lID);
+ lCustomer.Code.Value := '9012';
+ lCustomer.Update;
+ finally
+ lCustomer.Free;
+ end;
+end;
+
+procedure TMainForm.btnNullTestClick(Sender: TObject);
+var
+ lTest: TNullablesTest;
+ lCustomer: TCustomer;
+ lID: Integer;
+begin
+ Log('** Nullables Test');
+ TMVCActiveRecord.DeleteAll(TNullablesTest);
+
+ lTest := TNullablesTest.Create();
+ try
+ lTest.f_int2 := 2;
+ lTest.f_int4 := 4;
+ lTest.f_int8 := 8;
+ with TStreamWriter.Create(lTest.f_blob) do
+ try
+ write('Hello World');
+ finally
+ Free;
+ end;
+ lTest.Insert;
+ Log('Inserting nulls');
+ finally
+ lTest.Free;
+ end;
+
+ Log('Loading records with nulls');
+ lTest := TMVCActiveRecord.GetFirstByWhere('f_int2 = ?', [2]);
+ try
+ Assert(lTest.f_int2.HasValue);
+ Assert(lTest.f_int4.HasValue);
+ Assert(lTest.f_int8.HasValue);
+ Assert(not lTest.f_string.HasValue);
+ Assert(not lTest.f_bool.HasValue);
+ Assert(not lTest.f_date.HasValue);
+ Assert(not lTest.f_time.HasValue);
+ Assert(not lTest.f_datetime.HasValue);
+ Assert(not lTest.f_float4.HasValue);
+ Assert(not lTest.f_float8.HasValue);
+ Assert(not lTest.f_bool.HasValue);
+ Assert(Assigned(lTest));
+ lTest.f_int4 := lTest.f_int4.Value + 4;
+ lTest.f_int8 := lTest.f_int8.Value + 8;
+ lTest.f_blob.Size := 0;
+ lTest.Update;
+ finally
+ lTest.Free;
+ end;
+
+ lTest := TMVCActiveRecord.GetFirstByWhere('f_int2 = ?', [2]);
+ try
+ Assert(lTest.f_int2.ValueOrDefault = 2);
+ Assert(lTest.f_int4.ValueOrDefault = 8);
+ Assert(lTest.f_int8.ValueOrDefault = 16);
+ Assert(not lTest.f_string.HasValue);
+ Assert(not lTest.f_bool.HasValue);
+ Assert(not lTest.f_date.HasValue);
+ Assert(not lTest.f_time.HasValue);
+ Assert(not lTest.f_datetime.HasValue);
+ Assert(not lTest.f_float4.HasValue);
+ Assert(not lTest.f_float8.HasValue);
+ Assert(not lTest.f_bool.HasValue);
+ Assert(lTest.f_blob.Size = 0, 'Blob contains a value when should not');
+ TMVCActiveRecord.DeleteRQL(TNullablesTest, 'eq(f_int2,2)');
+ finally
+ lTest.Free;
+ end;
+
+ Assert(TMVCActiveRecord.GetFirstByWhere('f_int2 = 2', [], False) = nil);
+
+ lTest := TNullablesTest.Create;
+ try
+ lTest.f_int2 := 2;
+ lTest.f_int4 := 4;
+ lTest.f_int8 := 8;
+ lTest.f_string := 'Hello World';
+ lTest.f_bool := True;
+ lTest.f_date := EncodeDate(2020, 02, 01);
+ lTest.f_time := EncodeTime(12, 24, 36, 0);
+ lTest.f_datetime := Now;
+ lTest.f_float4 := 1234.5678;
+ lTest.f_float8 := 12345678901234567890.0123456789;
+ lTest.f_currency := 1234567890.1234;
+ lTest.Insert;
+ finally
+ lTest.Free;
+ end;
+
+ Log('There are ' + TMVCActiveRecord.Count().ToString + ' row/s for entity ' +
+ TCustomer.ClassName);
+ lCustomer := TCustomer.Create;
+ try
+ lCustomer.CompanyName := 'Google Inc.';
+ lCustomer.City := 'Montain View, CA';
+ lCustomer.Note := 'Hello there!';
+ lCustomer.Insert;
+ lID := lCustomer.ID;
+ Assert(not lCustomer.Code.HasValue);
+ Log('Just inserted Customer ' + lID.ToString);
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TMVCActiveRecord.GetByPK(lID);
+ try
+ Assert(not lCustomer.Code.HasValue);
+ Assert(not lCustomer.Rating.HasValue);
+ Assert(lCustomer.Rating.ValueOrDefault = 0);
+ lCustomer.Code.Value := '5678';
+ lCustomer.Rating.Value := 3;
+ Assert(lCustomer.Code.HasValue);
+ lCustomer.Note := lCustomer.Note + sLineBreak + 'Code changed to 5678';
+ lCustomer.Update;
+ Assert(lCustomer.Code.HasValue);
+ Assert(lCustomer.Rating.HasValue);
+ Log('Just updated Customer ' + lID.ToString + ' with nulls');
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TMVCActiveRecord.GetByPK(lID);
+ try
+ Assert(lCustomer.Code.HasValue);
+ Assert(lCustomer.Rating.HasValue);
+ Assert(lCustomer.Code.ValueOrDefault = '5678');
+ Assert(lCustomer.Rating.ValueOrDefault = 3);
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TCustomer.Create;
+ try
+ lCustomer.LoadByPK(lID);
+ lCustomer.Code.Value := '9012';
+ lCustomer.Update;
+ finally
+ lCustomer.Free;
+ end;
+
+end;
+
+procedure TMainForm.btnPartitioningClick(Sender: TObject);
+var
+ lCust1: TCustomerWithRate1;
+ lCust2: TCustomerWithRate2;
+ lList: TObjectList;
+begin
+ Log('** Partitioning Test');
+ TMVCActiveRecord.DeleteAll(TCustomerWithRate1);
+ Assert(TMVCActiveRecord.Count(TCustomerWithRate1) = 0);
+ TMVCActiveRecord.DeleteAll(TCustomerWithRate2);
+ Assert(TMVCActiveRecord.Count(TCustomerWithRate2) = 0);
+ lCust1 := TCustomerWithRate1.Create;
+ try
+ lCust1.City := 'Rome';
+ lCust1.Code := '123';
+ lCust1.Store;
+ finally
+ lCust1.Free;
+ end;
+ lCust2 := TCustomerWithRate2.Create;
+ try
+ lCust2.City := 'Rome';
+ lCust2.Code := '456';
+ lCust2.Store;
+ Assert(TMVCActiveRecord.GetByPK(lCust2.ID, False) = nil);
+ finally
+ lCust2.Free;
+ end;
+
+ lList := TMVCActiveRecord.SelectRQL('eq(city,"Rome")',-1);
+ try
+ Assert(lList.Count = 1);
+ Assert(lList[0].Code = '123');
+ finally
+ lList.Free;
+ end;
+
+ Log('Retriving only TCustomerWithRate1');
+ Assert(TMVCActiveRecord.Count(TCustomerWithRate1) = 1);
+ Assert(TMVCActiveRecord.Count(TCustomerWithRate1, 'eq(code,"xxx")') = 0);
+ Log('Retriving only TCustomerWithRate2');
+ Assert(TMVCActiveRecord.Count(TCustomerWithRate2) = 1);
+ Assert(TMVCActiveRecord.Count(TCustomerWithRate2, 'eq(code,"xxx")') = 0);
+end;
+
+procedure TMainForm.btnReadAndWriteOnlyClick(Sender: TObject);
+var
+ lArtWO, lArtWO2: TArticleWithWriteOnlyFields;
+ lArtRO: TArticleWithReadOnlyFields;
+ lID: NullableInt32;
+ lArt: TArticle;
+begin
+ lArtWO := TArticleWithWriteOnlyFields.Create();
+ try
+ lArtWO.Description := 'Description1';
+ lArtWO.Price := 12;
+ lArtWO.Insert;
+ Log('Stored TArticleWithWriteOnlyFields');
+ lID := lArtWO.ID;
+
+ lArt := TMVCActiveRecord.GetByPK(lID);
+ try
+ Assert(lArtWO.Description = lArt.Description);
+ Assert(lArtWO.Price = lArt.Price);
+ Log('Check Stored version of TArticleWithWriteOnlyFields');
+
+ Log('Reading data using TArticleWithReadOnlyFields');
+ lArtRO := TMVCActiveRecord.GetByPK(lID);
+ try
+ Assert(lArtRO.Description = lArt.Description);
+ Assert(lArtRO.Price = lArt.Price);
+ Log('Check Read data of TArticleWithWriteOnlyFields using TArticleWithReadOnlyFields');
+ finally
+ lArtRO.Free;
+ end;
+
+ Log('Reading data using TArticleWithWriteOnlyFields (???)');
+ lArtWO2 := TMVCActiveRecord.GetByPK(lID);
+ try
+ Assert(lArtWO2.ID.ValueOrDefault = lID.ValueOrDefault);
+ Assert(lArtWO2.Description = '');
+ Assert(lArtWO2.Price = 0);
+ finally
+ lArtWO2.Free;
+ end;
+ finally
+ lArt.Free;
+ end;
+
+ lArtRO := TArticleWithReadOnlyFields.Create();
+ try
+ lArtRO.Description := 'Description1';
+ lArtRO.Price := 12;
+ ShowMessage('Now an exception will be raised...');
+ lArtRO.Insert; // exception here :-)
+ finally
+ lArtRO.Free;
+ end;
+
+ finally
+ lArtWO.Free;
+ end;
+end;
+
+procedure TMainForm.btnReadOnlyClick(Sender: TObject);
+begin
+ var lROCustomer := TMVCActiveRecord.GetFirstByWhere('',[]);
+ try
+ lROCustomer.Code := '1234';
+ ShowMessage('An exception is going to be raised');
+ lROCustomer.Update();
+ finally
+ lROCustomer.Free;
+ end;
+end;
+
+procedure TMainForm.btnRelationsClick(Sender: TObject);
+var
+ lCustomer: TCustomerEx;
+ lOrder: TOrder;
+ lOrderRows: TObjectList;
+ lOrderRow: TOrderDetail;
+ lOrderDetail: TOrderDetail;
+ I: Integer;
+ j: Integer;
+begin
+ Log('** Relations test');
+ TMVCActiveRecord.DeleteAll(TCustomerEx);
+
+ lCustomer := TCustomerEx.Create;
+ try
+ lCustomer.Code := '001';
+ lCustomer.CompanyName := 'Google Inc.';
+ lCustomer.Insert;
+ for I := 1 to 3 do
+ begin
+ lCustomer.Orders.Add(TOrder.Create);
+ lCustomer.Orders.Last.CustomerID := lCustomer.ID;
+ lCustomer.Orders.Last.OrderDate := EncodeDate(2018, 5 + I, 20 + I);
+ lCustomer.Orders.Last.Total := I * 3;
+ lCustomer.Orders.Last.Insert;
+
+ for j := 1 to 4 do
+ begin
+ lOrderDetail := TOrderDetail.Create;
+ try
+ lOrderDetail.OrderID := lCustomer.Orders.Last.ID;
+ lOrderDetail.ArticleID := j;
+ lOrderDetail.Price := Random(j * 10);
+ lOrderDetail.Discount := j;
+ lOrderDetail.Quantity := j * 2;
+ lOrderDetail.Description := 'MY PRODUCT ' + I.ToString + '/' + j.ToString;
+ lOrderDetail.Total := j * j * j;
+ lOrderDetail.Insert;
+ finally
+ lOrderDetail.Free;
+ end;
+ end;
+ end;
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TMVCActiveRecord.GetOneByWhere('Code = ?', ['001']);
+ try
+ Log(lCustomer.CompanyName);
+ for lOrder in lCustomer.Orders do
+ begin
+ Log(Format(' %5.5d - %s - %m', [lOrder.ID.Value, datetostr(lOrder.OrderDate), lOrder.Total]));
+ lOrderRows := TMVCActiveRecord.Where('id_order = ?', [lOrder.ID]);
+ try
+ for lOrderRow in lOrderRows do
+ begin
+ Log(Format(' %-20s - %4d - %m', [lOrderRow.Description, lOrderRow.Quantity,
+ lOrder.Total]));
+ end;
+ Log('');
+ finally
+ lOrderRows.Free;
+ end;
+ end;
+ finally
+ lCustomer.Free;
+ end;
+end;
+
+procedure TMainForm.btnRQLClick(Sender: TObject);
+var
+ lList: TMVCActiveRecordList;
+ lItem: TMVCActiveRecord;
+ lCustomer: TCustomer;
+ lCustList: TObjectList;
+ lRecCount: Integer;
+const
+ cRQL1 = 'in(City,["Rome","London"]);sort(+code);limit(0,50)';
+ cRQL2 = 'and(eq(City,"Rome"),or(contains(CompanyName,"GAS"),contains(CompanyName,"Motors")))';
+begin
+ LoadCustomers;
+
+ Log('** RQL Queries Test');
+ Log('>> RQL Query (1) - ' + cRQL1);
+ lList := TMVCActiveRecord.SelectRQL(TCustomer, cRQL1, 20);
+ try
+ Log(lList.Count.ToString + ' record/s found');
+ for lItem in lList do
+ begin
+ lCustomer := TCustomer(lItem);
+ Log(Format('%5s - %s (%s)', [lCustomer.Code.ValueOrDefault,
+ lCustomer.CompanyName.ValueOrDefault, lCustomer.City]));
+ end;
+ finally
+ lList.Free;
+ end;
+
+ Log('>> RQL Query (2) - ' + cRQL2);
+ lCustList := TMVCActiveRecord.SelectRQL(cRQL2, 20);
+ try
+ Log(lCustList.Count.ToString + ' record/s found');
+ for lCustomer in lCustList do
+ begin
+ Log(Format('%5s - %s (%s)', [lCustomer.Code.ValueOrDefault,
+ lCustomer.CompanyName.ValueOrDefault, lCustomer.City]));
+ end;
+ finally
+ lCustList.Free;
+ end;
+
+ Log('**RQL Query (3) - ' + cRQL2);
+ lList := TMVCActiveRecord.SelectRQL(TCustomer, cRQL2, 20);
+ try
+ Log(lList.Count.ToString + ' record/s found');
+ for lItem in lList do
+ begin
+ lCustomer := TCustomer(lItem);
+ Log(Format('%5s - %s (%s)', [lCustomer.Code.ValueOrDefault,
+ lCustomer.CompanyName.ValueOrDefault, lCustomer.City]));
+ end;
+ finally
+ lList.Free;
+ end;
+
+ Log('**RQL Query (4) - with limit 20');
+ lList := TMVCActiveRecord.SelectRQL(TCustomer, '', 20);
+ try
+ Log(lList.Count.ToString + ' record/s found');
+ Assert(lList.Count = 20);
+ finally
+ lList.Free;
+ end;
+
+ Log('**RQL Query (5) - sort by code with limit 20');
+ lList := TMVCActiveRecord.SelectRQL(TCustomer, 'sort(+code)', 20);
+ try
+ Log(lList.Count.ToString + ' record/s found');
+ Assert(lList.Count = 20);
+ finally
+ lList.Free;
+ end;
+
+ Log('**RQL Query (6) - with limit 10');
+ lList := TMVCActiveRecord.SelectRQL(TCustomer, '', 10);
+ try
+ Log(lList.Count.ToString + ' record/s found');
+ Assert(lList.Count = 10);
+ finally
+ lList.Free;
+ end;
+
+ Log('**RQL Query (7) - with limit 1');
+ lList := TMVCActiveRecord.SelectRQL(TCustomer, '', 1);
+ try
+ Log(lList.Count.ToString + ' record/s found');
+ Assert(lList.Count = 1);
+ finally
+ lList.Free;
+ end;
+
+ Log('**RQL Query (8) - with limit 0');
+ lList := TMVCActiveRecord.SelectRQL(TCustomer, '', 0);
+ try
+ Log(lList.Count.ToString + ' record/s found');
+ Assert(lList.Count = 0);
+ finally
+ lList.Free;
+ end;
+
+
+ //******************************************************
+ // Using "Load" methods ********************************
+ //******************************************************
+ Log('*************************************************');
+ Log('** RQL Queries Test (using "Load" style methods)');
+ Log('*************************************************');
+ Log('>> RQL Query (1) - ' + cRQL1);
+ lList := TMVCActiveRecordList.Create;
+ try
+ TMVCActiveRecord.SelectRQL(TCustomer, cRQL1, 20, lList);
+ Log(lList.Count.ToString + ' record/s found');
+ for lItem in lList do
+ begin
+ lCustomer := TCustomer(lItem);
+ Log(Format('%5s - %s (%s)', [lCustomer.Code.ValueOrDefault,
+ lCustomer.CompanyName.ValueOrDefault, lCustomer.City]));
+ end;
+ finally
+ lList.Free;
+ end;
+
+ Log('>> RQL Query (2) - ' + cRQL2);
+ lCustList := TObjectList.Create;
+ try
+ lRecCount := TMVCActiveRecord.SelectRQL(cRQL2, 20, lCustList);
+ Log(lRecCount.ToString + ' record/s found');
+ for lCustomer in lCustList do
+ begin
+ Log(Format('%5s - %s (%s)', [lCustomer.Code.ValueOrDefault,
+ lCustomer.CompanyName.ValueOrDefault, lCustomer.City]));
+ end;
+ finally
+ lCustList.Free;
+ end;
+
+ Log('**RQL Query (3) - ' + cRQL2);
+ lList := TMVCActiveRecordList.Create;
+ try
+ lRecCount := TMVCActiveRecord.SelectRQL(TCustomer, cRQL2, 20, lList);
+ Log(lRecCount.ToString + ' record/s found');
+ for lItem in lList do
+ begin
+ lCustomer := TCustomer(lItem);
+ Log(Format('%5s - %s (%s)', [lCustomer.Code.ValueOrDefault,
+ lCustomer.CompanyName.ValueOrDefault, lCustomer.City]));
+ end;
+ finally
+ lList.Free;
+ end;
+
+ Log('**RQL Query (4) - with limit 20');
+ lList := TMVCActiveRecordList.Create;
+ try
+ lRecCount := TMVCActiveRecord.SelectRQL(TCustomer, '', 20, lList);
+ Log(lRecCount.ToString + ' record/s found');
+ Assert(lRecCount = 20);
+ Assert(lList.Count = lRecCount);
+ finally
+ lList.Free;
+ end;
+
+ Log('**RQL Query (5) - sort by code with limit 20');
+ lList := TMVCActiveRecordList.Create;
+ try
+ lRecCount := TMVCActiveRecord.SelectRQL(TCustomer, 'sort(+code)', 20, lList);
+ Log(lRecCount.ToString + ' record/s found');
+ Assert(lRecCount = lList.Count);
+ Assert(lList.Count = 20);
+ finally
+ lList.Free;
+ end;
+
+ Log('**RQL Query (6) - with limit 10');
+ lList := TMVCActiveRecordList.Create;
+ try
+ lRecCount := TMVCActiveRecord.SelectRQL(TCustomer, '', 10, lList);
+ Log(lList.Count.ToString + ' record/s found');
+ Assert(lRecCount = lList.Count);
+ Assert(lList.Count = 10);
+ finally
+ lList.Free;
+ end;
+
+ Log('**RQL Query (7) - with limit 1');
+ lList := TMVCActiveRecordList.Create;
+ try
+ lRecCount := TMVCActiveRecord.SelectRQL(TCustomer, '', 1, lList);
+ Log(lList.Count.ToString + ' record/s found');
+ Assert(lList.Count = 1);
+ Assert(lRecCount = lList.Count);
+ finally
+ lList.Free;
+ end;
+
+ Log('**RQL Query (8) - with limit 0');
+ lList := TMVCActiveRecordList.Create;
+ try
+ lRecCount := TMVCActiveRecord.SelectRQL(TCustomer, '', 0, lList);
+ Log(lList.Count.ToString + ' record/s found');
+ Assert(lList.Count = 0);
+ Assert(lRecCount = lList.Count);
+ finally
+ lList.Free;
+ end;
+
+
+
+end;
+
+procedure TMainForm.btnSelectClick(Sender: TObject);
+var
+ lCustomers: TObjectList;
+ lCustomer: TCustomer;
+ lDS: TDataSet;
+ lID: NullableInt64;
+begin
+ Log('** Query SQL');
+ // Bypassing the RQL parser you can use DBMS-specific features or just joining your tables.
+ // This is just a sample, you can do the "select" also using the RQL engine
+ if ActiveRecordConnectionsRegistry.GetCurrentBackend = 'firebird' then
+ lCustomers := TMVCActiveRecord.Select
+ ('SELECT * FROM customers WHERE description CONTAINING ?', ['google'])
+ else if ActiveRecordConnectionsRegistry.GetCurrentBackend = 'mysql' then
+ lCustomers := TMVCActiveRecord.Select
+ ('SELECT * FROM customers WHERE description LIKE ''%google%''', [])
+ else if ActiveRecordConnectionsRegistry.GetCurrentBackend = 'postgresql' then
+ lCustomers := TMVCActiveRecord.Select
+ ('SELECT * FROM customers WHERE description ILIKE ''%google%''', [])
+ else if ActiveRecordConnectionsRegistry.GetCurrentBackend = 'sqlite' then
+ lCustomers := TMVCActiveRecord.Select
+ ('SELECT * FROM customers WHERE description LIKE ''%google%''', [])
+ else if ActiveRecordConnectionsRegistry.GetCurrentBackend = 'interbase' then
+ lCustomers := TMVCActiveRecord.Select
+ ('SELECT * FROM customers WHERE description LIKE ''%google%''', [])
+ else if ActiveRecordConnectionsRegistry.GetCurrentBackend = 'mssql' then
+ lCustomers := TMVCActiveRecord.Select
+ ('SELECT * FROM customers WHERE description LIKE ''%google%''', [])
+ else
+ raise Exception.Create('Unsupported backend: ' +
+ ActiveRecordConnectionsRegistry.GetCurrentBackend);
+
+ try
+ for lCustomer in lCustomers do
+ begin
+ Log(Format('%4d - %8.5s - %s', [lCustomer.ID.ValueOrDefault, lCustomer.Code.ValueOrDefault,
+ lCustomer.CompanyName.ValueOrDefault]));
+ end;
+ finally
+ lCustomers.Free;
+ end;
+
+ LoadCustomers;
+
+ Log('** Query SQL returning DataSet');
+ lDS := TMVCActiveRecord.SelectDataSet('SELECT * FROM customers', [], True);
+ try
+ while not lDS.Eof do
+ begin
+ Log(Format('%8.5s - %s', [lDS.FieldByName('code').AsString, lDS.FieldByName('description')
+ .AsString]));
+ lDS.Next;
+ end;
+ finally
+ lDS.Free;
+ end;
+
+ lDS := TMVCActiveRecord.SelectDataSet
+ ('SELECT * FROM orders o join customers c on c.id = o.id_customer where o.order_date >= ?',
+ [Date - 5000], [ftDate]);
+ try
+ while not lDS.Eof do
+ begin
+ Log(Format('OrderDate: %12s - Customer: %s',
+ [datetostr(lDS.FieldByName('order_date').AsDateTime), lDS.FieldByName('description')
+ .AsString]));
+ lDS.Next;
+ end;
+ finally
+ lDS.Free;
+ end;
+
+ lDS := TMVCActiveRecord.SelectDataSet
+ ('SELECT * FROM orders o left join customers c on c.id = o.id_customer where o.order_date >= ? and c.id > ?',
+ [Date - 5000, 1], [ftDate]);
+ try
+ while not lDS.Eof do
+ begin
+ Log(Format('OrderDate: %12s - Customer: %s',
+ [datetostr(lDS.FieldByName('order_date').AsDateTime), lDS.FieldByName('description')
+ .AsString]));
+ lDS.Next;
+ end;
+ finally
+ lDS.Free;
+ end;
+
+ Log('** GetFirstByWhere');
+ lCustomer := TMVCActiveRecord.GetFirstByWhere('id > ?', [1]);
+ try
+ Log(Format('%8.5s - %s', [lCustomer.Code.ValueOrDefault,
+ lCustomer.CompanyName.ValueOrDefault]));
+ lID := lCustomer.ID;
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TMVCActiveRecord.GetFirstByWhere('id > ?', [1], [ftInteger]);
+ try
+ Log(Format('%8.5s - %s', [lCustomer.Code.ValueOrDefault,
+ lCustomer.CompanyName.ValueOrDefault]));
+ lID := lCustomer.ID;
+ finally
+ lCustomer.Free;
+ end;
+
+ Log('** GetOneByWhere');
+ lCustomer := TMVCActiveRecord.GetOneByWhere('id = ?', [lID.Value]);
+ try
+ Log(Format('%8.5s - %s', [lCustomer.Code.ValueOrDefault,
+ lCustomer.CompanyName.ValueOrDefault]));
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TMVCActiveRecord.GetOneByWhere('id = ?', [lID.Value], [ftInteger]);
+ try
+ Log(Format('%8.5s - %s', [lCustomer.Code.ValueOrDefault,
+ lCustomer.CompanyName.ValueOrDefault]));
+ finally
+ lCustomer.Free;
+ end;
+
+end;
+
+procedure TMainForm.btnSpeedClick(Sender: TObject);
+var
+ I: Integer;
+ lCustomers: TArray;
+ lSW: TStopWatch;
+ lElapsedMS: UInt32;
+const
+ INSTANCES_COUNT = 2000000;
+begin
+ TMVCActiveRecord.DeleteAll(TCustomer);
+ SetLength(lCustomers, INSTANCES_COUNT);
+ lSW := TStopwatch.StartNew;
+ for I := 0 to INSTANCES_COUNT - 1 do
+ begin
+ lCustomers[I] := TCustomer.Create;
+ end;
+ lElapsedMS := lSW.ElapsedMilliseconds;
+ Log(Format('Created %s TCustomer instances in %d ms',
+ [FormatFloat('###,###,###', INSTANCES_COUNT), lElapsedMS]));
+ for I := 0 to INSTANCES_COUNT - 1 do
+ begin
+ lCustomers[I].Free;
+ end;
+end;
+
+procedure TMainForm.btnTableFilterClick(Sender: TObject);
+var
+ i: Integer;
+ lIDOfABadCustomer: Int64;
+ lIDOfAGoodCustomer: Int64;
+ lHowMany: Int64;
+ lCust: TMVCActiveRecord;
+ Customer: TCustomer;
+ lCustomer: TCustomer;
+ lCustomer1: TCustomer;
+ lNotAGoodCustomer: TCustomer;
+ lThisShouldBeNil: TCustomer;
+ lAGoodCustomer: TCustomer;
+ lThisShouldNotBeNil: TCustomer;
+ lGoodCustomers: TObjectList;
+ lGoodCustomers2: TMVCActiveRecordList;
+begin
+ Log('**Table Filtering');
+ Log('Deleting only best customers...');
+ lIDOfABadCustomer := -1;
+ lIDOfAGoodCustomer := -1;
+ TMVCActiveRecord.DeleteAll(TGoodCustomer);
+ Log('Inserting some customers');
+ for i := 1 to 5 do
+ begin
+ Customer := TCustomer.Create();
+ try
+ Customer.Code := I.ToString;
+ Customer.Rating := I;
+ Customer.Store;
+ if i = 1 then
+ begin
+ lIDOfABadCustomer := Customer.ID.Value;
+ end;
+ if i = 5 then
+ begin
+ lIDOfAGoodCustomer := Customer.ID.Value;
+ end;
+ finally
+ Customer.Free;
+ end;
+ end;
+
+ Log('Retrieving only best customers...');
+ lGoodCustomers := TMVCActiveRecord.SelectRQL('sort(+rating)',10);
+ try
+ Assert(lGoodCustomers.Count = 2); { only rating >= 4}
+ for lCust in lGoodCustomers do
+ begin
+ Log(lCust.ToString);
+ end;
+ finally
+ lGoodCustomers.Free;
+ end;
+
+ Log('How many "best customers" we have?');
+ lHowMany := TMVCActiveRecord.Count;
+ Log(Format('We have %d best customers', [lHowMany]));
+
+ Log('How many "best customers" with rating = 5 we have?');
+ lHowMany := TMVCActiveRecord.Count('eq(rating,5)');
+ Log(Format('We have %d best customers with rating = 5', [lHowMany]));
+
+ Log('Retrieving only best customers...');
+ lGoodCustomers2 := TMVCActiveRecord.SelectRQL(TGoodCustomer, '', -1);
+ try
+ Assert(lGoodCustomers2.Count = 2); { only rating >= 4}
+ for lCust in lGoodCustomers2 do
+ begin
+ Log(lCust.ToString);
+ end;
+ finally
+ lGoodCustomers2.Free;
+ end;
+
+ Log('Retrieving only best customers ordered by company name...');
+ lGoodCustomers := TMVCActiveRecord.SelectRQL('sort(+CompanyName)',10);
+ try
+ Assert(lGoodCustomers.Count = 2); { only rating >= 4}
+ for lCust in lGoodCustomers do
+ begin
+ Log(lCust.ToString);
+ end;
+ finally
+ lGoodCustomers.Free;
+ end;
+
+
+ Log('Retrieving only worst customers...');
+
+ lNotAGoodCustomer := TMVCActiveRecord.SelectOneByRQL('eq(rating,1)', True);
+ try
+ lThisShouldBeNil := TMVCActiveRecord.GetByPK(lNotAGoodCustomer.ID, False);
+ Assert(lThisShouldBeNil = nil);
+ finally
+ lNotAGoodCustomer.Free;
+ end;
+
+ lAGoodCustomer := TMVCActiveRecord.SelectOneByRQL('eq(rating,5)', True);
+ try
+ lThisShouldNotBeNil := TMVCActiveRecord.GetByPK(lAGoodCustomer.ID, False);
+ try
+ Assert(lThisShouldNotBeNil <> nil);
+ Log(lThisShouldNotBeNil.ToString);
+ finally
+ lThisShouldNotBeNil.Free;
+ end;
+ finally
+ lAGoodCustomer.Free;
+ end;
+
+ Log('Promoting a customer...');
+ lCustomer := TBadCustomer.Create;
+ try
+ lCustomer.LoadByPK(lIDOfABadCustomer);
+ lCustomer.Rating := 5;
+ lCustomer.Store;
+ Assert(not lCustomer.LoadByPK(lIDOfABadCustomer)); {this customer is not "bad" anymore}
+ finally
+ lCustomer.Free;
+ end;
+
+ Log('Demote a customer...');
+ lCustomer1 := TGoodCustomer.Create;
+ try
+ lCustomer1.LoadByPK(lIDOfAGoodCustomer);
+ lCustomer1.Rating := 1;
+ lCustomer1.Store;
+ Assert(not lCustomer1.LoadByPK(lIDOfAGoodCustomer)); {this customer is not "good" anymore}
+ finally
+ lCustomer1.Free;
+ end;
+end;
+
+procedure TMainForm.btnTransactionClick(Sender: TObject);
+begin
+ Log('# TransactionContext');
+
+ // Test 0
+ ExecutedInTransaction;
+
+ // Test 1
+// try
+// begin var Ctx := TMVCActiveRecord.UseTransactionContext;
+// TMVCActiveRecord.GetByPK(-1); // will raise EMVCActiveRecordNotFound
+// end;
+// except
+// on E: Exception do
+// begin
+// Log(Format('#1 - TransactionContext caught %s (automatic rollback)', [E.ClassName]));
+// end;
+// end;
+
+
+ // Test 2
+// try
+// begin var Ctx := TMVCActiveRecord.UseTransactionContext;
+// var S := Ctx; // will raise EMVCActiveRecordTransactionContext
+// end;
+// except
+// on E: Exception do
+// begin
+// Log(Format('#2 - TransactionContext caught %s (automatic rollback)', [E.ClassName]));
+// end;
+// end;
+
+
+ // Test 3
+ begin var Ctx := TMVCActiveRecord.UseTransactionContext;
+
+ var lCustID: NullableInt64 := nil;
+
+ var lCustomer := TCustomer.Create;
+ try
+ lCustomer.CompanyName := 'Transaction Inc.';
+ lCustomer.LastContact := Now();
+ lCustomer.Store;
+ var lOrder := TOrder.Create;
+ try
+ lOrder.CustomerID := lCustomer.ID; // << link
+ lOrder.OrderDate := Date();
+ lOrder.Store;
+
+ var lOrderItem := TOrderDetail.Create;
+ try
+ lOrderItem.OrderID := lOrder.ID; // << link
+ var lAllArticles := TMVCActiveRecord.All;
+ try
+ lOrderItem.ArticleID := lAllArticles.First.ID.Value; // << link
+ finally
+ lAllArticles.Free;
+ end;
+ lOrderItem.Price := 10;
+ lOrderItem.Quantity := 2;
+ lOrderItem.Store;
+ finally
+ lOrderItem.Free;
+ end;
+ finally
+ lOrder.Free;
+ end;
+ finally
+ lCustomer.Free;
+ end;
+ Log('#3 - TransactionContext automatically committed changes (because no exceptions have been raised within the TransactionContext)');
+ end;
+
+end;
+
+procedure TMainForm.btnUseExplicitConnectionClick(Sender: TObject);
+var
+ lCustomer: TCustomer;
+ lID: Integer;
+ lTestNote: string;
+ lConn: TUniConnection;
+begin
+ Log('** Use Explicit Connection');
+ lConn := TUniConnection.Create(nil);
+ try
+ lConn.ConnectionName := CON_DEF_NAME;
+ lCustomer := TCustomer.Create(lConn);
+ try
+ Log('Entity ' + TCustomer.ClassName + ' is mapped to table ' + lCustomer.TableName);
+ lCustomer.CompanyName := 'Google Inc.';
+ lCustomer.City := 'Montain View, CA';
+ lCustomer.Note := 'Μῆνιν ἄειδε θεὰ Πηληϊάδεω Ἀχιλῆος οὐλομένην 😁';
+ lCustomer.LastContact := Now();
+ lCustomer.Insert;
+ lID := lCustomer.ID;
+ Log('Just inserted Customer ' + lID.ToString);
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TCustomer.Create(lConn);
+ try
+ lCustomer.LoadByPK(lID);
+ Assert(not lCustomer.Code.HasValue);
+ lCustomer.Code.Value := '5678';
+ lCustomer.Note := lCustomer.Note + sLineBreak + 'Code changed to 5678 🙂';
+ lCustomer.LastContact.Clear;
+ lTestNote := lCustomer.Note;
+ lCustomer.Update;
+ Log('Just updated Customer ' + lID.ToString);
+ finally
+ lCustomer.Free;
+ end;
+ finally
+ lConn.Free;
+ end;
+end;
+
+procedure TMainForm.btnReadOnlyFieldsClick(Sender: TObject);
+var
+ lCustomer: TCustomerWithReadOnlyFields;
+ lID: Integer;
+begin
+ Log('** CRUD test with read-only fields');
+ lCustomer := TCustomerWithReadOnlyFields.Create;
+ try
+ {
+ 'Code' will not be persisted on table because defined as 'foReadOnly'
+ }
+ lCustomer.Code := '1234';
+ lCustomer.CompanyName := 'Google Inc.';
+ lCustomer.City := 'Montain View, CA';
+ lCustomer.Insert;
+ lID := lCustomer.ID;
+ Log('Just inserted Customer ' + lID.ToString + ' with a R/O field');
+ finally
+ lCustomer.Free;
+ end;
+
+ //let's check that code is empty
+ lCustomer := TMVCActiveRecord.GetByPK(lID);
+ try
+ Assert(lCustomer.Code.IsEmpty);
+ finally
+ lCustomer.Free;
+ end;
+
+ //if underlying field is not null, it is loaded as usual
+ TMVCActiveRecord.CurrentConnection.ExecSQL('update customers set code = ''XYZ'' where id = ?', [lID]);
+ lCustomer := TMVCActiveRecord.GetByPK(lID);
+ try
+ Assert('XYZ' = lCustomer.Code);
+ lCustomer.CompanyName := lCustomer.CompanyName + ' changed!';
+ lCustomer.Code := 'this code will not be saved';
+ lCustomer.Update; //do not save field "code"
+ Log('Just updated Customer ' + lID.ToString);
+ finally
+ lCustomer.Free;
+ end;
+
+ //but being foReadOnly is not updated
+ lCustomer := TMVCActiveRecord.GetByPK(lID);
+ try
+ Assert('XYZ' = lCustomer.Code);
+ lCustomer.Delete;
+ Log('Just deleted Customer ' + lID.ToString + ' with a R/O field');
+ finally
+ lCustomer.Free;
+ end;
+end;
+
+procedure TMainForm.btnRefreshClick(Sender: TObject);
+var
+ lCustomer: TCustomer;
+ lID: Integer;
+begin
+ Log('** Refresh test');
+ lCustomer := TCustomer.Create;
+ try
+ Log('Entity ' + TCustomer.ClassName + ' is mapped to table ' + lCustomer.TableName);
+ lCustomer.CompanyName := 'Google Inc.';
+ lCustomer.City := 'Montain View, CA';
+ lCustomer.Note := 'Μῆνιν ἄειδε θεὰ Πηληϊάδεω Ἀχιλῆος οὐλομένην 😁';
+ lCustomer.Insert;
+ Assert('Montain View, CA' = lCustomer.City);
+ Assert('Μῆνιν ἄειδε θεὰ Πηληϊάδεω Ἀχιλῆος οὐλομένην 😁' = lCustomer.Note);
+ lCustomer.City := '';
+ lCustomer.Note := '';
+ Log('Refreshing the customer');
+ lCustomer.Refresh;
+ Assert('Montain View, CA' = lCustomer.City);
+ Assert('Μῆνιν ἄειδε θεὰ Πηληϊάδεω Ἀχιλῆος οὐλομένην 😁' = lCustomer.Note);
+ lID := lCustomer.ID;
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TCustomer.Create;
+ try
+ Log('Loading customer using Refresh');
+ lCustomer.ID := lID;
+ lCustomer.Refresh;
+ Assert('Montain View, CA' = lCustomer.City);
+ Assert('Μῆνιν ἄειδε θεὰ Πηληϊάδεω Ἀχιλῆος οὐλομένην 😁' = lCustomer.Note);
+ finally
+ lCustomer.Free;
+ end;
+end;
+
+procedure TMainForm.btnValidationClick(Sender: TObject);
+var
+ lCustomer: TCustomerWithLogic;
+ lID: Integer;
+begin
+ Log('** Validation test (some exceptions will be raised)');
+
+ lCustomer := TCustomerWithLogic.Create;
+ try
+ lCustomer.Code := '1234';
+ lCustomer.CompanyName := 'bit Time Professionals';
+ lCustomer.City := 'Rome';
+ lCustomer.Insert;
+ lID := lCustomer.ID;
+ finally
+ lCustomer.Free;
+ end;
+
+ ShowMessage('Try to update a customer with empty "CODE" (an exception will be raised)');
+
+ lCustomer := TMVCActiveRecord.GetByPK(lID);
+ try
+ Log(lCustomer.CompanyName + ' => IsLocatedInRome: ' +
+ BoolToStr(lCustomer.IsLocatedInRome, True));
+ lCustomer.Code := '';
+ lCustomer.Update; // raise exception
+ finally
+ lCustomer.Free;
+ end;
+end;
+
+procedure TMainForm.btnVirtualEntitiesClick(Sender: TObject);
+begin
+ var lCustStats := TMVCActiveRecord.SelectByNamedQuery('CustomersInTheSameCity', [], []);
+ try
+ for var lCustomer in lCustStats do
+ begin
+ Log(Format('%4d - %8.5s - %s - (%d other customers in the same city)', [
+ lCustomer.ID.ValueOrDefault,
+ lCustomer.Code.ValueOrDefault,
+ lCustomer.CompanyName.ValueOrDefault,
+ lCustomer.CustomersInTheSameCity
+ ]));
+ end;
+ finally
+ lCustStats.Free;
+ end;
+end;
+
+procedure TMainForm.btnWithSpacesClick(Sender: TObject);
+var
+ lCustomer: TCustomerWithSpaces;
+ lID: Integer;
+ I: Integer;
+ cRQL1: string;
+ lList: TMVCActiveRecordList;
+ lItem: TMVCActiveRecord;
+begin
+ Log('** Simple CRUD (table and fields with spaces) test');
+ Log('There are ' + TMVCActiveRecord.Count().ToString + ' row/s for entity ' +
+ TCustomerWithSpaces.ClassName);
+ TMVCActiveRecord.DeleteAll(TCustomerWithSpaces);
+ Log('Deleting all entities ' + TCustomerWithSpaces.ClassName);
+ for I := 1 to 100 do
+ begin
+ lCustomer := TCustomerWithSpaces.Create;
+ try
+ lID := I;
+ lCustomer.ID := lID;
+ // just for test!!
+ case I mod 3 of
+ 0:
+ lCustomer.CompanyName := 'Google Inc.';
+ 1:
+ lCustomer.CompanyName := 'bit Time Professionals';
+ 2:
+ lCustomer.CompanyName := 'Walt Disney Corp.';
+ end;
+ lCustomer.City := 'Montain View, CA';
+ lCustomer.Note := 'Hello there!';
+ lCustomer.Insert;
+ Log('Just inserted Customer ' + lID.ToString);
+ finally
+ lCustomer.Free;
+ end;
+ end;
+
+ Log('Now there are ' + TMVCActiveRecord.Count().ToString +
+ ' row/s for entity ' + TCustomerWithSpaces.ClassName);
+ Log('Deleting using RQL...');
+ TMVCActiveRecord.DeleteRQL(TCustomerWithSpaces, 'lt(id,80)');
+ Log('Now there are ' + TMVCActiveRecord.Count().ToString +
+ ' row/s for entity ' + TCustomerWithSpaces.ClassName);
+
+ // gets the last inserted customer
+ lCustomer := TMVCActiveRecord.GetByPK(lID);
+ try
+ Assert(not lCustomer.Code.HasValue);
+ lCustomer.Code.Value := '5678';
+ lCustomer.Note := lCustomer.Note + sLineBreak + 'Code changed to 5678';
+ lCustomer.Update;
+ Log('Just updated Customer ' + lID.ToString);
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TCustomerWithSpaces.Create;
+ try
+ lCustomer.LoadByPK(lID);
+ lCustomer.Code.Value := '9012';
+ lCustomer.Update;
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TMVCActiveRecord.GetByPK(lID);
+ try
+ lCustomer.Delete;
+ Log('Just deleted Customer ' + lID.ToString);
+ finally
+ lCustomer.Free;
+ end;
+
+ cRQL1 := 'eq(CompanyName,"Google Inc.")';
+ Log('>> RQL Query (customers with spaces) - ' + cRQL1);
+ lList := TMVCActiveRecord.SelectRQL(TCustomerWithSpaces, cRQL1, 20);
+ try
+ Log(lList.Count.ToString + ' record/s found');
+ for lItem in lList do
+ begin
+ lCustomer := TCustomerWithSpaces(lItem);
+ Log(Format('%5s - %s (%s)', [lCustomer.Code.ValueOrDefault,
+ lCustomer.CompanyName.ValueOrDefault, lCustomer.City]));
+ end;
+ finally
+ lList.Free;
+ end;
+end;
+
+procedure TMainForm.ExecutedInTransaction;
+begin
+ var tx := TMVCActiveRecord.UseTransactionContext;
+ var lCustomer := TCustomer.Create;
+ try
+ lCustomer.CompanyName := 'Transaction Inc.';
+ lCustomer.LastContact := Now();
+ lCustomer.Insert;
+ finally
+ lCustomer.Free;
+ end;
+ Log('#4 - TransactionContext automatically committed changes (because no exceptions have been raised within the TransactionContext)');
+end;
+
+procedure TMainForm.btnObjectVersionClick(Sender: TObject);
+begin
+ var lID: NullableInt64;
+ var lCust := TCustomerWithVersion.Create();
+ try
+ Log('Entity ' + TCustomerWithVersion.ClassName + ' is mapped to table ' + lCust.TableName);
+ lCust.CompanyName := 'Google Inc.';
+ lCust.City := 'Montain View, CA';
+ lCust.Note := 'Μῆνιν ἄειδε θεὰ Πηληϊάδεω Ἀχιλῆος οὐλομένην 😁';
+ lCust.Insert;
+ lID := lCust.ID;
+ Log('Just inserted CustomerWithVersion with ID = ' + lID.ValueOrDefault.ToString + ' and version = ' + lCust.ObjVersion.ToString);
+ finally
+ lCust.Free;
+ end;
+
+ lCust := TMVCActiveRecord.GetByPK(lID);
+ try
+ lCust.CompanyName := 'Alphabet Inc.';
+ lCust.Store;
+ Log('Just updated CustomerWithVersion with ID = ' + lID.ValueOrDefault.ToString + ' and version = ' + lCust.ObjVersion.ToString);
+ finally
+ lCust.Free;
+ end;
+
+
+ ShowMessage('Now we are going to create a logical conflict - an exception will be raised and no data will be lost');
+
+ // Let's load 2 instances
+ var lCust1 := TMVCActiveRecord.GetByPK(lID);
+ try
+ var lCust2 := TMVCActiveRecord.GetByPK(lID);
+ try
+ //User1
+ lCust1.CompanyName := 'MyCompany';
+ lCust1.Store; //save the first version
+ //User1 - end
+
+ //User2
+ lCust2.Rating := 4;
+ lCust2.Store; //save another version starting from an older version - exception
+ //User2 - end
+ finally
+ lCust2.Free;
+ end;
+ finally
+ lCust1.Free;
+ end;
+end;
+
+procedure TMainForm.btnOOPClick(Sender: TObject);
+begin
+ Log('** OOP with ActiveRecord (person, employee, manager)');
+ TMVCActiveRecord.DeleteAll(TPerson);
+
+ var lPerson := TPerson.Create;
+ try
+ lPerson.FirstName := 'Reed';
+ lPerson.LastName := 'Richards';
+ lPerson.Dob := EncodeDate(1985,11,4);
+ lPerson.IsMale := True;
+ lPerson.Store;
+ finally
+ lPerson.Free;
+ end;
+
+ var lEmployee := TEmployee.Create;
+ try
+ lEmployee.FirstName := 'Peter';
+ lEmployee.LastName := 'Parker';
+ lEmployee.Dob := EncodeDate(1985,11,4);
+ lEmployee.IsMale := True;
+ lEmployee.Salary := 2100;
+ lEmployee.Store;
+ finally
+ lEmployee.Free;
+ end;
+
+ lEmployee := TEmployee.Create;
+ try
+ lEmployee.FirstName := 'Sue';
+ lEmployee.LastName := 'Storm';
+ lEmployee.Dob := EncodeDate(1975,10,14);
+ lEmployee.IsMale := False;
+ lEmployee.Salary := 2200;
+ lEmployee.Store;
+ finally
+ lEmployee.Free;
+ end;
+
+ var lManager := TManager.Create;
+ try
+ lManager.FirstName := 'Bruce';
+ lManager.LastName := 'Banner';
+ lManager.Dob := EncodeDate(1975,11,4);
+ lManager.IsMale := True;
+ lManager.Salary := 2800;
+ lManager.AnnualBonus := 5000;
+ lManager.Store;
+ finally
+ lManager.Free;
+ end;
+
+ var lPeople := TMVCActiveRecord.All;
+ try
+ Assert(lPeople.Count = 4);
+ finally
+ lPeople.Free;
+ end;
+
+ var lEmployees := TMVCActiveRecord.All;
+ try
+ Assert(lEmployees.Count = 3);
+ finally
+ lEmployees.Free;
+ end;
+end;
+
+procedure TMainForm.FormDestroy(Sender: TObject);
+begin
+ if Assigned(FConnection) then
+ ActiveRecordConnectionsRegistry.RemoveDefaultConnection(False);
+ FConnection.Free;
+end;
+
+procedure TMainForm.FormShow(Sender: TObject);
+var
+ lEngine: TRDBMSEngine;
+ lFoundIndex: Integer;
+ lFound: Boolean;
+begin
+ if not TEngineChoiceForm.Execute(lEngine) then
+ begin
+ Close;
+ Exit;
+ end;
+ FConnection := TUniConnection.Create(Self);
+ case lEngine of
+ TRDBMSEngine.PostgreSQL:
+ begin
+ UniConnectionConfigU.CreatePostgresqlPrivateConn(FConnection, True);
+ end;
+ TRDBMSEngine.Firebird:
+ begin
+ UniConnectionConfigU.CreateFirebirdPrivateConn(FConnection, True);
+ end;
+ TRDBMSEngine.Interbase:
+ begin
+ UniConnectionConfigU.CreateInterbasePrivateConn(FConnection, True);
+ end;
+ TRDBMSEngine.MySQL:
+ begin
+ UniConnectionConfigU.CreateMySQLPrivateConn(FConnection, True);
+ end;
+ TRDBMSEngine.MariaDB:
+ begin
+ UniConnectionConfigU.CreateMySQLPrivateConn(FConnection, True);
+ end;
+ TRDBMSEngine.SQLite:
+ begin
+ UniConnectionConfigU.CreateSqlitePrivateConn(FConnection, True);
+ end;
+ TRDBMSEngine.MSSQLServer:
+ begin
+ UniConnectionConfigU.CreateMSSQLServerPrivateConn(FConnection, True);
+ end;
+ else
+ raise Exception.Create('Unknown RDBMS');
+ end;
+
+ ActiveRecordConnectionsRegistry.AddDefaultConnection(FConnection);
+ Caption := Caption + ' (Curr Backend: ' + ActiveRecordConnectionsRegistry.GetCurrentBackend + ')';
+{$IFDEF USE_SEQUENCES}
+ Caption := Caption + ' USE_SEQUENCES';
+{$ELSE}
+ Caption := Caption + ' WITHOUT SEQUENCES';
+{$ENDIF}
+ btnWithSpaces.Enabled := (ActiveRecordConnectionsRegistry.GetCurrentBackend = 'postgresql') or
+ (ActiveRecordConnectionsRegistry.GetCurrentBackend = 'firebird') or
+ (ActiveRecordConnectionsRegistry.GetCurrentBackend = 'interbase') or
+ (ActiveRecordConnectionsRegistry.GetCurrentBackend = 'mysql') or
+ (ActiveRecordConnectionsRegistry.GetCurrentBackend = 'mariadb') or
+ (ActiveRecordConnectionsRegistry.GetCurrentBackend = 'sqlite');
+
+ Caption := Caption + ' | ' + ActiveRecordConnectionsRegistry.GetCurrentBackend;
+ lFound := TArray.BinarySearch(['mariadb', 'mysql', 'postgresql'], ActiveRecordConnectionsRegistry.GetCurrentBackend, lFoundIndex);
+ btnJSON_XML_Types.Enabled := lFound;
+ btnJSON_XML_Types.Caption := 'JSON';
+ if 'postgresql' = ActiveRecordConnectionsRegistry.GetCurrentBackend then
+ begin
+ btnJSON_XML_Types.Caption := btnJSON_XML_Types.Caption + ', JSONB & XML';
+ end;
+end;
+
+procedure TMainForm.LoadCustomers(const HowManyCustomers: Integer = 50);
+var
+ lCustomer: TCustomer;
+ I: Integer;
+begin
+ TMVCActiveRecord.DeleteAll(TCustomer);
+ for I := 1 to HowManyCustomers do
+ begin
+ lCustomer := TCustomer.Create;
+ try
+ lCustomer.CompanyName := Stuff[Random(4)] + ' ' + CompanySuffix[Random(5)];
+ lCustomer.Code := Random(100).ToString.PadLeft(5, '0');
+ lCustomer.City := Cities[Random(4)];
+ lCustomer.Rating := I mod 6;
+ lCustomer.Note := Stuff[Random(4)];
+ lCustomer.Insert;
+ finally
+ lCustomer.Free;
+ end;
+ end;
+end;
+
+procedure TMainForm.Log(const Value: string);
+begin
+ Memo1.Lines.Add(Value);
+ Memo1.Update;
+end;
+
+end.
diff --git a/samples/unidac_activerecord_showcase/UniConnectionConfigU.pas b/samples/unidac_activerecord_showcase/UniConnectionConfigU.pas
new file mode 100644
index 000000000..ac85c573c
--- /dev/null
+++ b/samples/unidac_activerecord_showcase/UniConnectionConfigU.pas
@@ -0,0 +1,114 @@
+unit UniConnectionConfigU;
+
+interface
+
+uses
+ Uni,
+ DBAccess;
+
+const
+ CON_DEF_NAME = 'MyConnX';
+
+procedure CreateFirebirdPrivateConn(AConnection: TUniConnection; AIsPooled: boolean);
+procedure CreateInterbasePrivateConn(AConnection: TUniConnection; AIsPooled: boolean);
+procedure CreateMySQLPrivateConn(AConnection: TUniConnection; AIsPooled: boolean);
+procedure CreateMSSQLServerPrivateConn(AConnection: TUniConnection; AIsPooled: boolean);
+procedure CreatePostgresqlPrivateConn(AConnection: TUniConnection; AIsPooled: boolean);
+procedure CreateSqlitePrivateConn(AConnection: TUniConnection; AIsPooled: boolean);
+
+implementation
+
+uses
+ System.Classes,
+ System.IOUtils,
+ SysUtils;
+
+procedure CreateMySQLPrivateConn(AConnection: TUniConnection; AIsPooled: boolean);
+begin
+ AConnection.ProviderName := 'MySQL';
+ AConnection.Database := 'activerecorddb';
+ AConnection.Server := 'localhost';
+ AConnection.Username := 'root';
+ AConnection.Password := 'root';
+ AConnection.SpecificOptions.Values['TinyIntFormat'] := 'Boolean';
+ AConnection.SpecificOptions.Values['CharacterSet'] := 'utf8mb4';
+ AConnection.Pooling := AIsPooled;
+ if AIsPooled then
+ begin
+ AConnection.PoolMaxSize := 100;
+ end;
+end;
+
+procedure CreateMSSQLServerPrivateConn(AConnection: TUniConnection; AIsPooled: boolean);
+begin
+ AConnection.ProviderName := 'SQLServer';
+ AConnection.Database := 'activerecorddb';
+ AConnection.Server := 'localhost';
+ AConnection.Username := 'sa';
+ AConnection.Password := 'Daniele123!';
+ AConnection.Pooling := AIsPooled;
+ if AIsPooled then
+ begin
+ AConnection.PoolMaxSize := 100;
+ end;
+end;
+
+procedure CreateFirebirdPrivateConn(AConnection: TUniConnection; AIsPooled: boolean);
+begin
+ AConnection.ProviderName := 'InterBase';
+ AConnection.Database := TPath.GetFullPath(TPath.Combine('..\..', 'data\ACTIVERECORDDB.FDB'));
+ AConnection.Server := 'localhost';
+ AConnection.Username := 'sysdba';
+ AConnection.Password := 'masterkey';
+ AConnection.SpecificOptions.Values['CharacterSet'] := 'UTF8';
+ AConnection.Pooling := AIsPooled;
+ if AIsPooled then
+ begin
+ AConnection.PoolMaxSize := 100;
+ end;
+end;
+
+procedure CreateInterbasePrivateConn(AConnection: TUniConnection; AIsPooled: boolean);
+begin
+ AConnection.ProviderName := 'InterBase';
+ AConnection.Database := TPath.GetFullPath(TPath.Combine('..\..', 'data\ACTIVERECORDDB.IB'));
+ AConnection.Server := 'localhost';
+ AConnection.Username := 'sysdba';
+ AConnection.Password := 'masterkey';
+ AConnection.SpecificOptions.Values['CharacterSet'] := 'UTF8';
+ AConnection.Pooling := AIsPooled;
+ if AIsPooled then
+ begin
+ AConnection.PoolMaxSize := 100;
+ end;
+end;
+
+procedure CreatePostgresqlPrivateConn(AConnection: TUniConnection; AIsPooled: boolean);
+begin
+ AConnection.ProviderName := 'PostgreSQL';
+ AConnection.Database := 'activerecorddb';
+ AConnection.Server := 'localhost';
+ AConnection.Username := 'postgres';
+ AConnection.Password := 'postgres';
+ AConnection.Pooling := AIsPooled;
+ if AIsPooled then
+ begin
+ AConnection.PoolMaxSize := 100;
+ end;
+end;
+
+procedure CreateSqlitePrivateConn(AConnection: TUniConnection; AIsPooled: boolean);
+var
+ lFName: string;
+begin
+ lFName := TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), '..\..\data\activerecorddb.db');
+ AConnection.ProviderName := 'SQLite';
+ AConnection.Database := lFName;
+ AConnection.Pooling := AIsPooled;
+ if AIsPooled then
+ begin
+ AConnection.PoolMaxSize := 100;
+ end;
+end;
+
+end.
diff --git a/samples/unidac_activerecord_showcase/unidac_activerecord_showcase.dpr b/samples/unidac_activerecord_showcase/unidac_activerecord_showcase.dpr
new file mode 100644
index 000000000..b170914e2
--- /dev/null
+++ b/samples/unidac_activerecord_showcase/unidac_activerecord_showcase.dpr
@@ -0,0 +1,36 @@
+program activerecord_showcase;
+
+uses
+ Vcl.Forms,
+ MainFormU in 'MainFormU.pas' {MainForm},
+ EntitiesU in 'EntitiesU.pas',
+ UniConnectionConfigU in 'UniConnectionConfigU.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',
+ MVCFramework.RQL.AST2MySQL in '..\..\sources\MVCFramework.RQL.AST2MySQL.pas',
+ MVCFramework.RQL.AST2InterbaseSQL in '..\..\sources\MVCFramework.RQL.AST2InterbaseSQL.pas',
+ MVCFramework.RQL.AST2PostgreSQL in '..\..\sources\MVCFramework.RQL.AST2PostgreSQL.pas',
+ MVCFramework.SQLGenerators.PostgreSQL in '..\..\sources\MVCFramework.SQLGenerators.PostgreSQL.pas',
+ MVCFramework.RQL.AST2MSSQL in '..\..\sources\MVCFramework.RQL.AST2MSSQL.pas',
+ MVCFramework.RQL.Parser in '..\..\sources\MVCFramework.RQL.Parser.pas',
+ MVCFramework.SQLGenerators.Sqlite in '..\..\sources\MVCFramework.SQLGenerators.Sqlite.pas',
+ MVCFramework.RQL.AST2SQLite in '..\..\sources\MVCFramework.RQL.AST2SQLite.pas',
+ MVCFramework.SQLGenerators.MSSQL in '..\..\sources\MVCFramework.SQLGenerators.MSSQL.pas',
+ EngineChoiceFormU in 'EngineChoiceFormU.pas' {EngineChoiceForm},
+ MVCFramework.SQLGenerators.Interbase in '..\..\sources\MVCFramework.SQLGenerators.Interbase.pas',
+ MVCFramework.ActiveRecord in '..\..\sources\MVCFramework.ActiveRecord.pas',
+ MVCFramework.Nullables in '..\..\sources\MVCFramework.Nullables.pas',
+ MVCFramework.Serializer.JsonDataObjects in '..\..\sources\MVCFramework.Serializer.JsonDataObjects.pas';
+
+{$R *.res}
+
+
+begin
+ ReportMemoryLeaksOnShutdown := True;
+ Application.Initialize;
+ Application.MainFormOnTaskbar := True;
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+
+end.
diff --git a/samples/unidac_activerecord_showcase/unidac_activerecord_showcase.dproj b/samples/unidac_activerecord_showcase/unidac_activerecord_showcase.dproj
new file mode 100644
index 000000000..dafe63166
--- /dev/null
+++ b/samples/unidac_activerecord_showcase/unidac_activerecord_showcase.dproj
@@ -0,0 +1,1135 @@
+
+
+ {F8576ED6-649F-4E28-B364-1F60687C75F2}
+ 20.3
+ VCL
+ unidac_activerecord_showcase.dpr
+ True
+ BUILD
+ Win64
+ 3
+ Application
+ unidac_activerecord_showcase
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Cfg_2
+ true
+ true
+
+
+ true
+ Cfg_2
+ true
+ true
+
+
+ true
+ Cfg_2
+ true
+ true
+
+
+ true
+ Cfg_1
+ true
+ true
+ true
+
+
+ .\$(Platform)\$(Config)
+ bin
+ false
+ false
+ false
+ false
+ false
+ RESTComponents;emsclientfiredac;DataSnapFireDAC;FireDACIBDriver;emsclient;FireDACCommon;RESTBackendComponents;soapserver;CloudService;FireDACCommonDriver;inet;FireDAC;FireDACSqliteDriver;soaprtl;soapmidas;$(DCC_UsePackage)
+ System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)
+ $(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
+ 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=
+
+
+ vclactnband;vclFireDAC;tethering;svnui;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;svn;DBXOracleDriver;inetdb;VirtualTreesDR;RaizeComponentsVcl;emsedge;RaizeComponentsVclDb;fmx;fmxdae;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;DataSnapCommon;DataSnapConnectors;VCLRESTComponents;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;DataSnapClient;bindcompdbx;IndyIPCommon;vcl;DBXSybaseASEDriver;IndyIPServer;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;emshosting;FireDACPgDriver;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;DbxCommonDriver;DataSnapServer;xmlrtl;DataSnapNativeClient;fmxobj;vclwinx;FireDACDSDriver;rtl;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;inetdbxpress;$(DCC_UsePackage);pp;$(DCC_UsePackage)
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ 1033
+ $(BDS)\bin\default_app.manifest
+ none
+ bin32
+
+
+ DBXSqliteDriver;fmxase;DBXDb2Driver;DBXInterBaseDriver;OverbyteIcsD102Run;vclactnband;vclFireDAC;tethering;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;DBXOracleDriver;inetdb;VirtualTreesDR;RaizeComponentsVcl;emsedge;RaizeComponentsVclDb;fmx;fmxdae;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;DataSnapCommon;DataSnapConnectors;VCLRESTComponents;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;DataSnapClient;bindcompdbx;IndyIPCommon;vcl;DBXSybaseASEDriver;IndyIPServer;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;emshosting;FireDACPgDriver;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;DbxCommonDriver;DataSnapServer;xmlrtl;DataSnapNativeClient;fmxobj;vclwinx;FireDACDSDriver;rtl;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;inetdbxpress;FireDACMongoDBDriver;DataSnapServerMidas;$(DCC_UsePackage)
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)
+ Debug
+ true
+ 1033
+ $(BDS)\bin\default_app.manifest
+ bin64
+ none
+
+
+ true
+ 1033
+ true
+ none
+
+
+ PerMonitorV2
+ true
+ 1033
+
+
+ true
+ 1033
+ true
+ USE_SEQUENCES;$(DCC_Define)
+
+
+
+ MainSource
+
+
+
+ dfm
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dfm
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Cfg_2
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Application
+
+
+
+ activerecord_showcase.dpr
+
+
+ Microsoft Office 2000 Sample Automation Server Wrapper Components
+ Microsoft Office XP Sample Automation Server Wrapper Components
+
+
+
+
+
+
+
+
+
+
+ 1
+
+
+ Contents\MacOS
+ 1
+
+
+ 0
+
+
+
+
+ res\xml
+ 1
+
+
+ res\xml
+ 1
+
+
+
+
+ library\lib\armeabi
+ 1
+
+
+ library\lib\armeabi
+ 1
+
+
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+
+
+ library\lib\mips
+ 1
+
+
+ library\lib\mips
+ 1
+
+
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+ library\lib\arm64-v8a
+ 1
+
+
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+
+
+ res\drawable
+ 1
+
+
+ res\drawable
+ 1
+
+
+
+
+ res\drawable-anydpi-v21
+ 1
+
+
+ res\drawable-anydpi-v21
+ 1
+
+
+
+
+ res\values
+ 1
+
+
+ res\values
+ 1
+
+
+
+
+ res\values-v21
+ 1
+
+
+ res\values-v21
+ 1
+
+
+
+
+ res\values-v31
+ 1
+
+
+ res\values-v31
+ 1
+
+
+
+
+ res\values-v35
+ 1
+
+
+ res\values-v35
+ 1
+
+
+
+
+ res\drawable-anydpi-v26
+ 1
+
+
+ res\drawable-anydpi-v26
+ 1
+
+
+
+
+ res\drawable
+ 1
+
+
+ res\drawable
+ 1
+
+
+
+
+ res\drawable
+ 1
+
+
+ res\drawable
+ 1
+
+
+
+
+ res\drawable
+ 1
+
+
+ res\drawable
+ 1
+
+
+
+
+ res\drawable-anydpi-v33
+ 1
+
+
+ res\drawable-anydpi-v33
+ 1
+
+
+
+
+ res\values
+ 1
+
+
+ res\values
+ 1
+
+
+
+
+ res\values-night-v21
+ 1
+
+
+ res\values-night-v21
+ 1
+
+
+
+
+ res\drawable
+ 1
+
+
+ res\drawable
+ 1
+
+
+
+
+ res\drawable-xxhdpi
+ 1
+
+
+ res\drawable-xxhdpi
+ 1
+
+
+
+
+ res\drawable-xxxhdpi
+ 1
+
+
+ res\drawable-xxxhdpi
+ 1
+
+
+
+
+ res\drawable-ldpi
+ 1
+
+
+ res\drawable-ldpi
+ 1
+
+
+
+
+ res\drawable-mdpi
+ 1
+
+
+ res\drawable-mdpi
+ 1
+
+
+
+
+ res\drawable-hdpi
+ 1
+
+
+ res\drawable-hdpi
+ 1
+
+
+
+
+ res\drawable-xhdpi
+ 1
+
+
+ res\drawable-xhdpi
+ 1
+
+
+
+
+ res\drawable-mdpi
+ 1
+
+
+ res\drawable-mdpi
+ 1
+
+
+
+
+ res\drawable-hdpi
+ 1
+
+
+ res\drawable-hdpi
+ 1
+
+
+
+
+ res\drawable-xhdpi
+ 1
+
+
+ res\drawable-xhdpi
+ 1
+
+
+
+
+ res\drawable-xxhdpi
+ 1
+
+
+ res\drawable-xxhdpi
+ 1
+
+
+
+
+ res\drawable-xxxhdpi
+ 1
+
+
+ res\drawable-xxxhdpi
+ 1
+
+
+
+
+ res\drawable-small
+ 1
+
+
+ res\drawable-small
+ 1
+
+
+
+
+ res\drawable-normal
+ 1
+
+
+ res\drawable-normal
+ 1
+
+
+
+
+ res\drawable-large
+ 1
+
+
+ res\drawable-large
+ 1
+
+
+
+
+ res\drawable-xlarge
+ 1
+
+
+ res\drawable-xlarge
+ 1
+
+
+
+
+ res\values
+ 1
+
+
+ res\values
+ 1
+
+
+
+
+ res\drawable-anydpi-v24
+ 1
+
+
+ res\drawable-anydpi-v24
+ 1
+
+
+
+
+ res\drawable
+ 1
+
+
+ res\drawable
+ 1
+
+
+
+
+ res\drawable-night-anydpi-v21
+ 1
+
+
+ res\drawable-night-anydpi-v21
+ 1
+
+
+
+
+ res\drawable-anydpi-v31
+ 1
+
+
+ res\drawable-anydpi-v31
+ 1
+
+
+
+
+ res\drawable-night-anydpi-v31
+ 1
+
+
+ res\drawable-night-anydpi-v31
+ 1
+
+
+
+
+ 1
+
+
+ Contents\MacOS
+ 1
+
+
+ 0
+
+
+
+
+ Contents\MacOS
+ 1
+ .framework
+
+
+ Contents\MacOS
+ 1
+ .framework
+
+
+ Contents\MacOS
+ 1
+ .framework
+
+
+ 0
+
+
+
+
+ 1
+ .dylib
+
+
+ 1
+ .dylib
+
+
+ 1
+ .dylib
+
+
+ Contents\MacOS
+ 1
+ .dylib
+
+
+ Contents\MacOS
+ 1
+ .dylib
+
+
+ Contents\MacOS
+ 1
+ .dylib
+
+
+ 0
+ .dll;.bpl
+
+
+
+
+ 1
+ .dylib
+
+
+ 1
+ .dylib
+
+
+ 1
+ .dylib
+
+
+ Contents\MacOS
+ 1
+ .dylib
+
+
+ Contents\MacOS
+ 1
+ .dylib
+
+
+ Contents\MacOS
+ 1
+ .dylib
+
+
+ 0
+ .bpl
+
+
+
+
+ 0
+
+
+ 0
+
+
+ 0
+
+
+ 0
+
+
+ 0
+
+
+ Contents\Resources\StartUp\
+ 0
+
+
+ Contents\Resources\StartUp\
+ 0
+
+
+ Contents\Resources\StartUp\
+ 0
+
+
+ 0
+
+
+
+
+ 1
+
+
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
+ 1
+
+
+ ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
+ 1
+
+
+
+
+ ..\
+ 1
+
+
+ ..\
+ 1
+
+
+ ..\
+ 1
+
+
+
+
+ Contents
+ 1
+
+
+ Contents
+ 1
+
+
+ Contents
+ 1
+
+
+
+
+ Contents\Resources
+ 1
+
+
+ Contents\Resources
+ 1
+
+
+ Contents\Resources
+ 1
+
+
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+ library\lib\arm64-v8a
+ 1
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+ Contents\MacOS
+ 1
+
+
+ Contents\MacOS
+ 1
+
+
+ Contents\MacOS
+ 1
+
+
+ 0
+
+
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
+ 1
+
+
+ ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
+ 1
+
+
+ ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
+ 1
+
+
+
+
+ ..\
+ 1
+
+
+ ..\
+ 1
+
+
+ ..\
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen
+ 64
+
+
+ ..\$(PROJECTNAME).launchscreen
+ 64
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ Assets
+ 1
+
+
+ Assets
+ 1
+
+
+
+
+ Assets
+ 1
+
+
+ Assets
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ True
+ True
+
+
+ 12
+
+
+
+
+
diff --git a/sources/MVCFramework.ActiveRecord.pas b/sources/MVCFramework.ActiveRecord.pas
index 251acaf1b..3f4235d84 100644
--- a/sources/MVCFramework.ActiveRecord.pas
+++ b/sources/MVCFramework.ActiveRecord.pas
@@ -34,6 +34,7 @@ interface
System.Generics.Defaults,
System.Generics.Collections,
System.RTTI,
+{$IFDEF USE_FIREDAC}
FireDAC.DApt,
Data.DB,
FireDAC.Comp.Client,
@@ -41,6 +42,13 @@ interface
FireDAC.Stan.Pool,
FireDAC.Stan.Async,
FireDAC.Stan.Param,
+{$ENDIF}
+{$IFDEF USE_UNIDAC}
+ Uni,
+ DBAccess,
+ MemDS,
+ Data.DB,
+{$ENDIF}
MVCFramework,
MVCFramework.Commons,
MVCFramework.RQL.Parser,
@@ -83,7 +91,12 @@ TMVCActiveRecord = class;
{$IF Defined(CUSTOM_MANAGED_RECORDS)}
TMVCTransactionContext = record
private
+ {$IFDEF USE_FIREDAC}
fConnection: TFDConnection;
+ {$ENDIF}
+ {$IFDEF USE_UNIDAC}
+ fConnection: TUniConnection;
+ {$ENDIF}
public
class operator Finalize(var Dest: TMVCTransactionContext);
class operator Assign (var Dest: TMVCTransactionContext; const [ref] Src: TMVCTransactionContext);
@@ -306,10 +319,20 @@ TMVCTableMap = class
TMVCActiveRecord = class
private
fChildren: TObjectList;
+ {$IFDEF USE_FIREDAC}
fConn: TFDConnection;
+ {$ENDIF}
+ {$IFDEF USE_UNIDAC}
+ fConn: TUniConnection;
+ {$ENDIF}
fSQLGenerator: TMVCSQLGenerator;
fRQL2SQL: TRQL2SQL;
+ {$IFDEF USE_FIREDAC}
function MapNullableTValueToParam(aValue: TValue; const aParam: TFDParam): Boolean;
+ {$ENDIF}
+ {$IFDEF USE_UNIDAC}
+ function MapNullableTValueToParam(aValue: TValue; const aParam: TParam): Boolean;
+ {$ENDIF}
function GetPrimaryKeyIsAutogenerated: Boolean;
procedure SetPrimaryKeyIsAutogenerated(const Value: Boolean);
function GetAttributes(const AttrName: string): TValue;
@@ -322,22 +345,44 @@ TMVCActiveRecord = class
fTableMap: TMVCTableMap;
function GetCustomTableName: String; virtual;
function GetPartitionInfo: TPartitionInfo;
+ {$IFDEF USE_FIREDAC}
function GetConnection: TFDConnection;
procedure MapTValueToParam(aValue: TValue; const aParam: TFDParam); virtual;
+ {$ENDIF}
+ {$IFDEF USE_UNIDAC}
+ function GetConnection: TUniConnection;
+ procedure MapTValueToParam(aValue: TValue; const aParam: TParam); virtual;
+ {$ENDIF}
procedure InitTableInfo(const aTableName: String);
+ {$IFDEF USE_FIREDAC}
class function
CreateQuery(const Unidirectional, DirectExecute: Boolean): TFDQuery;
+ {$ENDIF}
+ {$IFDEF USE_UNIDAC}
+ class function
+ CreateQuery(const Unidirectional, DirectExecute: Boolean): TUniQuery;
+ {$ENDIF}
class function ExecQuery(
const SQL: string;
const Values: array of Variant;
const Unidirectional: Boolean;
const DirectExecute: Boolean): TDataSet; overload;
+ {$IFDEF USE_FIREDAC}
class function ExecQuery(
const SQL: string;
const Values: array of Variant;
const Connection: TFDConnection;
const Unidirectional: Boolean;
const DirectExecute: Boolean)
+ {$ENDIF}
+ {$IFDEF USE_UNIDAC}
+ class function ExecQuery(
+ const SQL: string;
+ const Values: array of Variant;
+ const Connection: TUniConnection;
+ const Unidirectional: Boolean;
+ const DirectExecute: Boolean)
+ {$ENDIF}
: TDataSet; overload;
class function ExecQuery(
const SQL: string;
@@ -350,7 +395,12 @@ TMVCActiveRecord = class
const SQL: string;
const Values: array of Variant;
const ValueTypes: array of TFieldType;
+ {$IFDEF USE_FIREDAC}
const Connection: TFDConnection;
+ {$ENDIF}
+ {$IFDEF USE_UNIDAC}
+ const Connection: TUniConnection;
+ {$ENDIF}
const Unidirectional: Boolean;
const DirectExecute: Boolean): TDataSet; overload;
procedure FillPrimaryKey(const SequenceName: string);
@@ -425,8 +475,12 @@ TMVCActiveRecord = class
/// Called after insert or update the object to the database
///
procedure OnAfterInsertOrUpdate; virtual;
-
+ {$IFDEF USE_FIREDAC}
procedure MapObjectToParams(const Params: TFDParams; var Handled: Boolean); virtual;
+ {$ENDIF}
+ {$IFDEF USE_UNIDAC}
+ procedure MapObjectToParams(const Params: TParams; var Handled: Boolean); virtual;
+ {$ENDIF}
procedure MapDatasetToObject(const DataSet: TDataSet; const Options: TMVCActiveRecordLoadOptions;
var Handled: Boolean); virtual;
@@ -441,7 +495,12 @@ TMVCActiveRecord = class
public
constructor Create(aLazyLoadConnection: Boolean); overload; // cannot be virtual!
constructor Create; overload; virtual;
+ {$IFDEF USE_FIREDAC}
constructor Create(const Connection: TFDConnection); overload; virtual;
+ {$ENDIF}
+ {$IFDEF USE_UNIDAC}
+ constructor Create(const Connection: TUniConnection); overload; virtual;
+ {$ENDIF}
destructor Destroy; override;
procedure EnsureConnection;
procedure Assign(ActiveRecord: TMVCActiveRecord); virtual;
@@ -495,8 +554,14 @@ TMVCActiveRecord = class
write SetPrimaryKeyIsAutogenerated;
class function GetScalar(const SQL: string; const Params: array of Variant): Variant;
+ {$IFDEF USE_FIREDAC}
class function CurrentConnection: TFDConnection;
class function GetConnectionByName(const ConnectionName: String): TFDConnection;
+ {$ENDIF}
+ {$IFDEF USE_UNIDAC}
+ class function CurrentConnection: TUniConnection;
+ class function GetConnectionByName(const ConnectionName: String): TUniConnection;
+ {$ENDIF}
end;
IMVCUnitOfWork = interface
@@ -786,17 +851,25 @@ TMVCEntitiesRegistry = class(TInterfacedObject, IMVCEntitiesRegistry)
IMVCActiveRecordConnections = interface
['{7B87473C-1784-489F-A838-925E7DDD0DE2}']
+ {$IFDEF USE_FIREDAC}
procedure AddConnection(const aName: string; const aConnection: TFDConnection; const Owns: Boolean = false); overload;
procedure AddDefaultConnection(const aConnection: TFDConnection; const Owns: Boolean = false); overload;
+ function GetCurrent(const RaiseExceptionIfNotAvailable: Boolean = True): TFDConnection;
+ function GetByName(const aName: string): TFDConnection;
+ {$ENDIF}
+ {$IFDEF USE_UNIDAC}
+ procedure AddConnection(const aName: string; const aConnection: TUniConnection; const Owns: Boolean = false); overload;
+ procedure AddDefaultConnection(const aConnection: TUniConnection; const Owns: Boolean = false); overload;
+ function GetCurrent(const RaiseExceptionIfNotAvailable: Boolean = True): TUniConnection;
+ function GetByName(const aName: string): TUniConnection;
+ {$ENDIF}
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 GetCurrentConnectionName(const RaiseExceptionIfNotAvailable: Boolean = False): String;
function GetCurrentBackend: string;
- function GetByName(const aName: string): TFDConnection;
procedure SetDefault;
end;
@@ -804,7 +877,12 @@ TMVCConnectionsRepository = class(TInterfacedObject, IMVCActiveRecordConnectio
private type
TConnHolder = class
public
+ {$IFDEF USE_FIREDAC}
Connection: TFDConnection;
+ {$ENDIF}
+ {$IFDEF USE_UNIDAC}
+ Connection: TUniConnection;
+ {$ENDIF}
OwnsConnection: Boolean;
destructor Destroy; override;
end;
@@ -817,16 +895,24 @@ TConnHolder = class
public
constructor Create; virtual;
destructor Destroy; override;
+ {$IFDEF USE_FIREDAC}
procedure AddConnection(const aName: string; const aConnection: TFDConnection; const aOwns: Boolean = false); overload;
- procedure AddConnection(const aName, aConnectionDefName: String); overload;
procedure AddDefaultConnection(const aConnection: TFDConnection; const aOwns: Boolean = false); overload;
+ function GetCurrent(const RaiseExceptionIfNotAvailable: Boolean = True): TFDConnection;
+ function GetByName(const aName: string): TFDConnection;
+ {$ENDIF}
+ {$IFDEF USE_UNIDAC}
+ procedure AddConnection(const aName: string; const aConnection: TUniConnection; const aOwns: Boolean = false); overload;
+ procedure AddDefaultConnection(const aConnection: TUniConnection; const aOwns: Boolean = false); overload;
+ function GetCurrent(const RaiseExceptionIfNotAvailable: Boolean = True): TUniConnection;
+ function GetByName(const aName: string): TUniConnection;
+ {$ENDIF}
+ procedure AddConnection(const aName, aConnectionDefName: String); 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 GetCurrentConnectionName(const RaiseExceptionIfNotAvailable: Boolean = False): String;
- function GetByName(const aName: string): TFDConnection;
function GetCurrentBackend: string;
procedure SetDefault;
end;
@@ -1008,13 +1094,20 @@ implementation
gTableMap: IMVCActiveRecordTableMap;
gTableMapLock: TObject;
+{$IFDEF USE_FIREDAC}
function GetBackEndByConnection(aConnection: TFDConnection): string;
begin
if not aConnection.Connected then
+{$ENDIF}
+{$IFDEF USE_UNIDAC}
+function GetBackEndByConnection(aConnection: TUniConnection): string;
+begin
+ if not aConnection.Connected then
+{$ENDIF}
begin
aConnection.Connected := True; {required to know the backend}
end;
-
+ {$IFDEF USE_FIREDAC}
case Ord(aConnection.RDBMSKind) of
0:
Exit(TMVCActiveRecordBackEnd.Unknown);
@@ -1055,6 +1148,10 @@ function GetBackEndByConnection(aConnection: TFDConnection): string;
else
raise EMVCActiveRecord.Create('Unknown RDBMS Kind');
end;
+ {$ENDIF}
+ {$IFDEF USE_UNIDAC}
+ Result := aConnection.ProviderName;
+ {$ENDIF}
end;
function ActiveRecordConnectionsRegistry: IMVCActiveRecordConnections;
@@ -1099,9 +1196,16 @@ function IntToNullableInt(const Value: Integer): NullableInt32;
{ TConnectionsRepository }
+{$IFDEF USE_FIREDAC}
procedure TMVCConnectionsRepository.AddConnection(const aName: string; const aConnection: TFDConnection;
const aOwns: Boolean = false);
var
+{$ENDIF}
+{$IFDEF USE_UNIDAC}
+procedure TMVCConnectionsRepository.AddConnection(const aName: string; const aConnection: TUniConnection;
+ const aOwns: Boolean = false);
+var
+{$ENDIF}
lName: string;
lConnKeyName: string;
lConnHolder: TConnHolder;
@@ -1136,10 +1240,19 @@ procedure TMVCConnectionsRepository.AddConnection(const aName: string; const aCo
end;
end;
+{$IFDEF USE_FIREDAC}
procedure TMVCConnectionsRepository.AddDefaultConnection(const aConnection: TFDConnection; const aOwns: Boolean);
begin
AddConnection('default', aConnection, aOwns);
end;
+{$ENDIF}
+
+{$IFDEF USE_UNIDAC}
+procedure TMVCConnectionsRepository.AddDefaultConnection(const aConnection: TUniConnection; const aOwns: Boolean);
+begin
+ AddConnection('default', aConnection, aOwns);
+end;
+{$ENDIF}
procedure TMVCConnectionsRepository.AddConnection(const aName,
aConnectionDefName: String);
@@ -1226,9 +1339,23 @@ function TMVCConnectionsRepository.GetCurrentConnectionName(
end;
end;
+{$IFDEF USE_FIREDAC}
+{$IFDEF USE_FIREDAC}
function TMVCConnectionsRepository.GetCurrent(const RaiseExceptionIfNotAvailable: Boolean): TFDConnection;
var
lName: string;
+{$ENDIF}
+{$IFDEF USE_UNIDAC}
+function TMVCConnectionsRepository.GetCurrent(const RaiseExceptionIfNotAvailable: Boolean): TUniConnection;
+var
+ lName: string;
+{$ENDIF}
+{$ENDIF}
+{$IFDEF USE_UNIDAC}
+function TMVCConnectionsRepository.GetByName(const aName: string): TUniConnection;
+var
+ lKeyName: string;
+{$ENDIF}
begin
{$IF not Defined(TokyoOrBetter)}
Result := nil;
@@ -2394,14 +2521,29 @@ procedure TMVCActiveRecord.MapDatasetToObject(const DataSet: TDataSet; const Opt
// do nothing
end;
+{$IFDEF USE_FIREDAC}
procedure TMVCActiveRecord.MapObjectToParams(const Params: TFDParams; var Handled: Boolean);
begin
// do nothing
end;
+{$ENDIF}
+{$IFDEF USE_UNIDAC}
+procedure TMVCActiveRecord.MapObjectToParams(const Params: TParams; var Handled: Boolean);
+begin
+ // do nothing
+end;
+{$ENDIF}
+{$IFDEF USE_FIREDAC}
function TMVCActiveRecord.MapNullableTValueToParam(aValue: TValue; const aParam: TFDParam): Boolean;
var
lNullableType: TNullableType;
+{$ENDIF}
+{$IFDEF USE_UNIDAC}
+function TMVCActiveRecord.MapNullableTValueToParam(aValue: TValue; const aParam: TParam): Boolean;
+var
+ lNullableType: TNullableType;
+{$ENDIF}
begin
Assert(aValue.Kind = tkRecord);
Result := True;
@@ -2626,9 +2768,16 @@ function TMVCActiveRecord.MapNullableTValueToParam(aValue: TValue; const aParam:
MapTValueToParam(aValue, aParam);
end;
+{$IFDEF USE_FIREDAC}
procedure TMVCActiveRecord.MapTValueToParam(aValue: TValue; const aParam: TFDParam);
const
MAX_STRING_PARAM_LENGTH = 1000; { Arbitrary value }
+{$ENDIF}
+{$IFDEF USE_UNIDAC}
+procedure TMVCActiveRecord.MapTValueToParam(aValue: TValue; const aParam: TParam);
+const
+ MAX_STRING_PARAM_LENGTH = 1000; { Arbitrary value }
+{$ENDIF}
var
lStream: TStream;
lName: string;
@@ -4328,6 +4477,7 @@ procedure EMVCActiveRecordNotFound.AfterConstruction;
FHTTPStatusCode := http_status.NotFound;
end;
+{$IFDEF USE_FIREDAC}
class function TMVCActiveRecord.ExecQuery(
const SQL: string;
const Values: array of Variant;
@@ -4337,13 +4487,13 @@ class function TMVCActiveRecord.ExecQuery(
const DirectExecute: Boolean): TDataSet;
var
lQry: TFDQuery;
- lSQL: string;
+ lSQL: string;
begin
lQry := CreateQuery(Unidirectional, DirectExecute);
try
lSQL := SQL;
OnBeforeExecuteQuerySQL(lSQL);
-
+
if Connection = nil then
begin
lQry.Connection := ActiveRecordConnectionsRegistry.GetCurrent;
@@ -4366,6 +4516,45 @@ class function TMVCActiveRecord.ExecQuery(
raise;
end;
end;
+{$ENDIF}
+{$IFDEF USE_UNIDAC}
+class function TMVCActiveRecord.ExecQuery(
+ const SQL: string;
+ const Values: array of Variant;
+ const ValueTypes: array of TFieldType;
+ const Connection: TUniConnection;
+ const Unidirectional: Boolean;
+ const DirectExecute: Boolean): TDataSet;
+var
+ lQry: TUniQuery;
+ lSQL: string;
+begin
+ lQry := CreateQuery(Unidirectional, DirectExecute);
+ try
+ lSQL := SQL;
+ OnBeforeExecuteQuerySQL(lSQL);
+
+ if Connection = nil then
+ begin
+ lQry.Connection := ActiveRecordConnectionsRegistry.GetCurrent;
+ end
+ else
+ begin
+ lQry.Connection := Connection;
+ end;
+ lQry.SQL.Text := lSQL;
+ for var i := 0 to High(Values) do
+ begin
+ lQry.Params[i].Value := Values[i];
+ end;
+ lQry.Open;
+ Result := lQry;
+ except
+ lQry.Free;
+ raise;
+ end;
+end;
+{$ENDIF}
class function TMVCActiveRecord.ExecQuery(const SQL: string; const Values: array of Variant;
const ValueTypes: array of TFieldType; const Unidirectional: Boolean; const DirectExecute: Boolean): TDataSet;
@@ -4907,6 +5096,7 @@ constructor TMVCActiveRecord.Create;
Create(True);
end;
+{$IFDEF USE_FIREDAC}
class function TMVCActiveRecord.CreateQuery(const Unidirectional, DirectExecute: Boolean): TFDQuery;
begin
Result := TFDQuery.Create(nil);
@@ -4916,6 +5106,16 @@ class function TMVCActiveRecord.CreateQuery(const Unidirectional, DirectExecute:
Result.UpdateOptions.RequestLive := False;
Result.ResourceOptions.DirectExecute := DirectExecute; //2023-07-12
end;
+{$ENDIF}
+
+{$IFDEF USE_UNIDAC}
+class function TMVCActiveRecord.CreateQuery(const Unidirectional, DirectExecute: Boolean): TUniQuery;
+begin
+ Result := TUniQuery.Create(nil);
+ Result.Unidirectional := Unidirectional;
+ Result.Options.DirectExecute := DirectExecute;
+end;
+{$ENDIF}
{ TMVCTransactionContext }
diff --git a/sources/MVCFramework.UniDAC.Utils.pas b/sources/MVCFramework.UniDAC.Utils.pas
new file mode 100644
index 000000000..e3df72e97
--- /dev/null
+++ b/sources/MVCFramework.UniDAC.Utils.pas
@@ -0,0 +1,242 @@
+// ***************************************************************************
+//
+// Delphi MVC Framework
+//
+// Copyright (c) 2010-2025 Daniele Teti and the DMVCFramework Team
+//
+// https://github.com/danieleteti/delphimvcframework
+//
+// ***************************************************************************
+//
+// Licensed under the Apache License, Version 2.0 (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.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+//
+// *************************************************************************** }
+
+unit MVCFramework.UniDAC.Utils;
+
+{$I dmvcframework.inc}
+
+interface
+
+uses
+ Uni,
+ MemDS,
+ VirtualTable,
+ System.Rtti,
+ JsonDataObjects,
+ Data.DB;
+
+type
+ TUniDACUtils = class sealed
+ private
+ class var CTX: TRttiContext;
+ class function InternalExecuteQuery(AQuery: TUniQuery; AObject: TObject;
+ WithResult: boolean): Int64;
+ public
+ class constructor Create;
+ class destructor Destroy;
+ class function ExecuteQueryNoResult(AQuery: TUniQuery;
+ AObject: TObject): Int64;
+ class procedure ExecuteQuery(AQuery: TUniQuery; AObject: TObject);
+ class procedure ObjectToParameters(AParams: TParams; AObject: TObject; AParamPrefix: string = '';
+ ASetParamTypes: boolean = True);
+ class procedure CreateDatasetFromMetadata(AMemTable: TCustomUniDataSet; AMeta: TJSONObject);
+ end;
+
+ TCustomUniDataSetHelper = class helper for TCustomUniDataSet
+ public
+ procedure InitFromMetadata(const AJSONMetadata: TJSONObject);
+ class function CloneFrom(const ADataSet: TDataSet): TCustomUniDataSet; static;
+ end;
+
+implementation
+
+uses
+ System.Generics.Collections,
+ System.Classes,
+ MVCFramework.Serializer.Commons,
+ System.SysUtils;
+
+{ TUniDACUtils }
+
+class constructor TUniDACUtils.Create;
+begin
+ TUniDACUtils.CTX := TRttiContext.Create;
+end;
+
+class procedure TUniDACUtils.CreateDatasetFromMetadata(
+ AMemTable: TCustomUniDataSet; AMeta: TJSONObject);
+var
+ lJArr: TJSONArray;
+ I: Integer;
+ lJObj: TJSONObject;
+begin
+ if AMeta.IsNull('fielddefs') then
+ begin
+ raise EMVCDeserializationException.Create('Invalid Metadata objects. Property [fielddefs] required.');
+ end;
+
+ AMemTable.Active := False;
+ AMemTable.FieldDefs.Clear;
+ lJArr := AMeta.A['fielddefs'];
+ for I := 0 to lJArr.Count - 1 do
+ begin
+ lJObj := lJArr.Items[I].ObjectValue;
+ AMemTable.FieldDefs.Add(
+ lJObj.S['fieldname'],
+ TFieldType(lJObj.I['datatype']),
+ lJObj.I['size']);
+ AMemTable.FieldDefs[I].DisplayName := lJObj.S['displayname'];
+ end;
+ AMemTable.CreateDataSet;
+end;
+
+class destructor TUniDACUtils.Destroy;
+begin
+ TUniDACUtils.CTX.Free;
+end;
+
+class procedure TUniDACUtils.ExecuteQuery(AQuery: TUniQuery; AObject: TObject);
+begin
+ InternalExecuteQuery(AQuery, AObject, True);
+end;
+
+class function TUniDACUtils.ExecuteQueryNoResult(AQuery: TUniQuery;
+ AObject: TObject): Int64;
+begin
+ Result := InternalExecuteQuery(AQuery, AObject, False);
+end;
+
+class procedure TUniDACUtils.ObjectToParameters(AParams: TParams;
+ AObject: TObject; AParamPrefix: string; ASetParamTypes: boolean);
+var
+ I: Integer;
+ pname: string;
+ _rttiType: TRttiType;
+ obj_fields: TArray;
+ obj_field: TRttiProperty;
+ obj_field_attr: MVCColumnAttribute;
+ Map: TObjectDictionary;
+ f: TRttiProperty;
+ fv: TValue;
+ PrefixLength: Integer;
+
+ function KindToFieldType(AKind: TTypeKind; AProp: TRttiProperty): TFieldType;
+ begin
+ case AKind of
+ tkInteger:
+ Result := ftInteger;
+ tkFloat:
+ begin
+ if AProp.PropertyType.QualifiedName = 'System.TDate' then
+ Result := ftDate
+ else if AProp.PropertyType.QualifiedName = 'System.TDateTime' then
+ Result := ftDateTime
+ else if AProp.PropertyType.QualifiedName = 'System.TTime' then
+ Result := ftTime
+ else
+ Result := ftFloat;
+ end;
+ tkChar, tkString:
+ Result := ftString;
+ tkWChar, tkUString, tkLString, tkWString:
+ Result := ftWideString;
+ tkVariant:
+ Result := ftVariant;
+ tkArray:
+ Result := ftArray;
+ tkInterface:
+ Result := ftInterface;
+ tkInt64:
+ Result := ftLongWord;
+ else
+ Result := ftUnknown;
+ end;
+ end;
+
+begin
+ PrefixLength := Length(AParamPrefix);
+ Map := TObjectDictionary.Create;
+ try
+ if Assigned(AObject) then
+ begin
+ _rttiType := CTX.GetType(AObject.ClassType);
+ obj_fields := _rttiType.GetProperties;
+ for obj_field in obj_fields do
+ begin
+ if TMVCSerializerHelper.HasAttribute(obj_field, obj_field_attr) then
+ begin
+ Map.Add(MVCColumnAttribute(obj_field_attr).FieldName.ToLower,
+ obj_field);
+ end
+ else
+ begin
+ Map.Add(obj_field.Name.ToLower, obj_field);
+ end
+ end;
+ end;
+ for I := 0 to AParams.Count - 1 do
+ begin
+ 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);
+ if ASetParamTypes then
+ begin
+ AParams[I].DataType := KindToFieldType(fv.Kind, f);
+ end;
+ AParams[I].Value := fv.AsVariant;
+ end
+ else
+ begin
+ AParams[I].Clear;
+ end;
+ end;
+ finally
+ Map.Free;
+ end;
+end;
+
+class function TUniDACUtils.InternalExecuteQuery(AQuery: TUniQuery; AObject: TObject;
+ WithResult: boolean): Int64;
+begin
+ ObjectToParameters(AQuery.Params, AObject);
+ Result := 0;
+ if WithResult then
+ AQuery.Open
+ else
+ begin
+ AQuery.ExecSQL;
+ Result := AQuery.RowsAffected;
+ end;
+end;
+
+{ TCustomUniDataSetHelper }
+
+class function TCustomUniDataSetHelper.CloneFrom(const ADataSet: TDataSet): TCustomUniDataSet;
+var
+ LUniMemDataSet: TUniMemDataSet;
+begin
+ LUniMemDataSet := TUniMemDataSet.Create(nil);
+ LUniMemDataSet.CopyFrom(ADataSet);
+ Result := LUniMemDataSet;
+end;
+
+procedure TCustomUniDataSetHelper.InitFromMetadata(const AJSONMetadata: TJSONObject);
+begin
+ TUniDACUtils.CreateDatasetFromMetadata(Self, AJSONMetadata);
+end;
+
+end.
From 4710323d3e7dd49434d09cfb9d8996d072a58066 Mon Sep 17 00:00:00 2001
From: "google-labs-jules[bot]"
<161369871+google-labs-jules[bot]@users.noreply.github.com>
Date: Thu, 11 Sep 2025 12:24:33 +0000
Subject: [PATCH 02/12] feat: Add UniDAC support
This change adds support for the UniDAC database access components to the DMVC framework, mirroring the existing support for FireDAC.
A new conditional compilation symbol, `USE_UNIDAC`, has been introduced to enable the UniDAC implementation. When this symbol is defined, the framework uses UniDAC components (`TUniConnection`, `TUniQuery`, etc.) for database access.
A new sample project, `unidac_activerecord_showcase`, has been created to demonstrate and test the UniDAC integration. This sample is a modified version of the existing `activerecord_showcase` project.
The core `MVCFramework.ActiveRecord.pas` unit has been updated to include conditional code blocks that switch between FireDAC and UniDAC implementations. A new utility unit, `MVCFramework.UniDAC.Utils.pas`, has been added to provide helper functions for UniDAC.
---
sources/MVCFramework.ActiveRecord.pas | 35 ++++++++++++++++++++++++---
sources/dmvcframework.inc | 11 ++++++++-
2 files changed, 41 insertions(+), 5 deletions(-)
diff --git a/sources/MVCFramework.ActiveRecord.pas b/sources/MVCFramework.ActiveRecord.pas
index 3f4235d84..e8e133799 100644
--- a/sources/MVCFramework.ActiveRecord.pas
+++ b/sources/MVCFramework.ActiveRecord.pas
@@ -34,9 +34,9 @@ interface
System.Generics.Defaults,
System.Generics.Collections,
System.RTTI,
+ Data.DB,
{$IFDEF USE_FIREDAC}
FireDAC.DApt,
- Data.DB,
FireDAC.Comp.Client,
FireDAC.Stan.Def,
FireDAC.Stan.Pool,
@@ -47,7 +47,6 @@ interface
Uni,
DBAccess,
MemDS,
- Data.DB,
{$ENDIF}
MVCFramework,
MVCFramework.Commons,
@@ -1217,7 +1216,12 @@ procedure TMVCConnectionsRepository.AddConnection(const aName: string; const aCo
if aConnection.Transaction = nil then
begin
{ needed for Delphi 10.4 Sydney+ }
+ {$IFDEF USE_FIREDAC}
aConnection.TxOptions.Isolation := TFDTxIsolation.xiReadCommitted;
+ {$ENDIF}
+ {$IFDEF USE_UNIDAC}
+ aConnection.TxOptions.Isolation := xilReadCommitted;
+ {$ENDIF}
end;
fMREW.BeginWrite;
@@ -1257,12 +1261,25 @@ procedure TMVCConnectionsRepository.AddDefaultConnection(const aConnection: TUni
procedure TMVCConnectionsRepository.AddConnection(const aName,
aConnectionDefName: String);
var
+ {$IFDEF USE_FIREDAC}
lConn: TFDConnection;
+ {$ENDIF}
+ {$IFDEF USE_UNIDAC}
+ lConn: TUniConnection;
+ {$ENDIF}
begin
+ {$IFDEF USE_FIREDAC}
lConn := TFDConnection.Create(nil);
try
lConn.ConnectionDefName := aConnectionDefName;
AddConnection(aName, lConn, True);
+ {$ENDIF}
+ {$IFDEF USE_UNIDAC}
+ lConn := TUniConnection.Create(nil);
+ try
+ lConn.ConnectionName := aConnectionDefName;
+ AddConnection(aName, lConn, True);
+ {$ENDIF}
except
on E: Exception do
begin
@@ -4528,6 +4545,7 @@ class function TMVCActiveRecord.ExecQuery(
var
lQry: TUniQuery;
lSQL: string;
+ I: Integer;
begin
lQry := CreateQuery(Unidirectional, DirectExecute);
try
@@ -4543,9 +4561,13 @@ class function TMVCActiveRecord.ExecQuery(
lQry.Connection := Connection;
end;
lQry.SQL.Text := lSQL;
- for var i := 0 to High(Values) do
+ for I := 0 to High(Values) do
begin
- lQry.Params[i].Value := Values[i];
+ lQry.Params[I].Value := Values[I];
+ if I < Length(ValueTypes) then
+ begin
+ lQry.Params[I].DataType := ValueTypes[I];
+ end;
end;
lQry.Open;
Result := lQry;
@@ -4559,7 +4581,12 @@ class function TMVCActiveRecord.ExecQuery(
class function TMVCActiveRecord.ExecQuery(const SQL: string; const Values: array of Variant;
const ValueTypes: array of TFieldType; const Unidirectional: Boolean; const DirectExecute: Boolean): TDataSet;
begin
+ {$IFDEF USE_FIREDAC}
+ Result := ExecQuery(SQL, Values, ValueTypes, nil, Unidirectional, DirectExecute);
+ {$ENDIF}
+ {$IFDEF USE_UNIDAC}
Result := ExecQuery(SQL, Values, ValueTypes, nil, Unidirectional, DirectExecute);
+ {$ENDIF}
end;
{ TFieldsMap }
diff --git a/sources/dmvcframework.inc b/sources/dmvcframework.inc
index df087a15e..8977e4231 100644
--- a/sources/dmvcframework.inc
+++ b/sources/dmvcframework.inc
@@ -90,7 +90,16 @@ DelphiMVCFramework is compatible with Delphi 10.0 or better
{$DEFINE WEBAPACHEHTTP}
{$ENDIF}
{$ENDIF}
-{$DEFINE USEFIREDAC}
+
+{$IFNDEF USE_UNIDAC}
+ {$DEFINE USE_FIREDAC}
+{$ENDIF}
+
+{$IFDEF USE_FIREDAC}
+ {$IFDEF USE_UNIDAC}
+ {$FATAL 'Cannot use both FireDAC and UniDAC at the same time'}
+ {$ENDIF}
+{$ENDIF}
{$IF Defined(SYDNEYORBETTER)}
{$DEFINE CUSTOM_MANAGED_RECORDS}
From bd40a9786af65971d29cc82ac68015b3785d2b2b Mon Sep 17 00:00:00 2001
From: "google-labs-jules[bot]"
<161369871+google-labs-jules[bot]@users.noreply.github.com>
Date: Thu, 11 Sep 2025 12:52:49 +0000
Subject: [PATCH 03/12] feat: Add UniDAC support
This change adds support for the UniDAC database access components to the DMVC framework, mirroring the existing support for FireDAC.
A new conditional compilation symbol, `USE_UNIDAC`, has been introduced to enable the UniDAC implementation. When this symbol is defined, the framework uses UniDAC components (`TUniConnection`, `TUniQuery`, etc.) for database access.
A new sample project, `unidac_activerecord_showcase`, has been created to demonstrate and test the UniDAC integration. This sample is a modified version of the existing `activerecord_showcase` project.
The core `MVCFramework.ActiveRecord.pas` unit has been updated to include conditional code blocks that switch between FireDAC and UniDAC implementations. A new utility unit, `MVCFramework.UniDAC.Utils.pas`, has been added to provide helper functions for UniDAC.
---
sources/MVCFramework.ActiveRecord.pas | 155 ++++++++++++++++++++++++++
1 file changed, 155 insertions(+)
diff --git a/sources/MVCFramework.ActiveRecord.pas b/sources/MVCFramework.ActiveRecord.pas
index e8e133799..a66f13b74 100644
--- a/sources/MVCFramework.ActiveRecord.pas
+++ b/sources/MVCFramework.ActiveRecord.pas
@@ -660,6 +660,7 @@ TMVCActiveRecordHelper = class helper for TMVCActiveRecord
const Params: array of Variant)
: TMVCActiveRecordList; overload;
+ {$IFDEF USE_FIREDAC}
class function Select(const aClass: TMVCActiveRecordClass; const SQL: string;
const Params: array of Variant;
const Connection: TFDConnection): TMVCActiveRecordList; overload;
@@ -667,6 +668,16 @@ TMVCActiveRecordHelper = class helper for TMVCActiveRecord
class function Select(const aClass: TMVCActiveRecordClass; const SQL: string;
const Params: array of Variant;
const Connection: TFDConnection; const OutList: TMVCActiveRecordList): UInt32; overload;
+ {$ENDIF}
+ {$IFDEF USE_UNIDAC}
+ class function Select(const aClass: TMVCActiveRecordClass; const SQL: string;
+ const Params: array of Variant;
+ const Connection: TUniConnection): TMVCActiveRecordList; overload;
+
+ class function Select(const aClass: TMVCActiveRecordClass; const SQL: string;
+ const Params: array of Variant;
+ const Connection: TUniConnection; const OutList: TMVCActiveRecordList): UInt32; overload;
+ {$ENDIF}
{ SelectOne }
class function SelectOne(const SQL: string;
@@ -717,6 +728,7 @@ TMVCActiveRecordHelper = class helper for TMVCActiveRecord
const Params: array of Variant;
const ParamTypes: array of TFieldType;
const OutList: TObjectList): UInt32; overload;
+ {$IFDEF USE_FIREDAC}
class function Where(
const aClass: TMVCActiveRecordClass;
const SQLWhere: string;
@@ -733,6 +745,20 @@ TMVCActiveRecordHelper = class helper for TMVCActiveRecord
const Params: array of Variant;
const Connection: TFDConnection;
const OutList: TMVCActiveRecordList): UInt32; overload;
+ {$ENDIF}
+ {$IFDEF USE_UNIDAC}
+ class function Where(
+ const aClass: TMVCActiveRecordClass;
+ const SQLWhere: string;
+ const Params: array of Variant;
+ const Connection: TUniConnection): TMVCActiveRecordList; overload;
+ class function Where(
+ const aClass: TMVCActiveRecordClass;
+ const SQLWhere: string;
+ const Params: array of Variant;
+ const Connection: TUniConnection;
+ const OutList: TMVCActiveRecordList): UInt32; overload;
+ {$ENDIF}
{ GetXXXByWhere }
class function GetOneByWhere(const SQLWhere: string;
@@ -1519,11 +1545,21 @@ procedure TMVCActiveRecord.EnsureConnection;
GetConnection;
end;
+{$IFDEF USE_FIREDAC}
+{$IFDEF USE_FIREDAC}
function TMVCActiveRecord.ExecNonQuery(const SQL: string; RefreshAutoGenerated: Boolean = false): int64;
var
lQry: TFDQuery;
lPar: TFDParam;
lPair: TPair;
+{$ENDIF}
+{$IFDEF USE_UNIDAC}
+function TMVCActiveRecord.ExecNonQuery(const SQL: string; RefreshAutoGenerated: Boolean = false): int64;
+var
+ lQry: TUniQuery;
+ lPar: TParam;
+ lPair: TPair;
+{$ENDIF}
lValue: TValue;
lSQL: string;
lHandled: Boolean;
@@ -1606,6 +1642,94 @@ function TMVCActiveRecord.ExecNonQuery(const SQL: string; RefreshAutoGenerated:
lQry.Free;
end;
end;
+{$ENDIF}
+{$IFDEF USE_UNIDAC}
+function TMVCActiveRecord.ExecNonQuery(const SQL: string; RefreshAutoGenerated: Boolean = false): int64;
+var
+ lQry: TUniQuery;
+ lPar: TParam;
+ lPair: TPair;
+ lValue: TValue;
+ lSQL: string;
+ lHandled: Boolean;
+ I: Integer;
+begin
+ lQry := CreateQuery(True, True);
+ try
+ lQry.Connection := GetConnection;
+ lSQL := SQL;
+ OnBeforeExecuteSQL(lSQL);
+ lQry.SQL.Text := lSQL;
+
+ lHandled := false;
+
+ MapObjectToParams(lQry.Params, lHandled);
+ if not lHandled then
+ begin
+ { partitioning }
+ for I := 0 to GetPartitionInfo.FieldNames.Count - 1 do
+ begin
+ lPar := lQry.Params.FindParam(SQLGenerator.GetParamNameForSQL(GetPartitionInfo.FieldNames[I]));
+ if lPar <> nil then
+ begin
+ if GetPartitionInfo.FieldTypes[I] = ftInteger then
+ lValue := StrToInt(GetPartitionInfo.FieldValues[I])
+ else
+ lValue := GetPartitionInfo.FieldValues[I];
+ MapTValueToParam(lValue, lPar);
+ end
+ end;
+ { end-partitioning }
+
+ for lPair in fTableMap.fMap do
+ begin
+ 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.DataType := ftUnknown; //fTableMap.fMap.GetInfoByFieldName(lPair.Value.FieldName).DataTypeName;
+ MapTValueToParam(lValue, lPar);
+ end
+ end;
+
+ // Check if it's the primary key
+ lPar := lQry.Params.FindParam(SQLGenerator.GetParamNameForSQL(fTableMap.fPrimaryKeyFieldName));
+ if lPar <> nil then
+ begin
+ if lPar.DataType = ftUnknown then
+ begin
+ lPar.DataType := GetPrimaryKeyFieldType;
+ end;
+ MapTValueToParam(fTableMap.fPrimaryKey.GetValue(Self), lPar);
+ end;
+ end;
+
+ if RefreshAutoGenerated and (TMVCActiveRecordFieldOption.foAutoGenerated in fTableMap.fPrimaryKeyOptions) and
+ fTableMap.fPrimaryKeySequenceName.IsEmpty then
+ begin
+ lValue := fTableMap.fPrimaryKey.GetValue(Self);
+ lQry.Open;
+
+ if (lValue.Kind = tkRecord) then
+ begin
+ MapDataSetFieldToNullableRTTIField(lValue, lQry.Fields[0], fTableMap.fPrimaryKey, Self);
+ end
+ else
+ begin
+ lValue := lQry.FieldByName(fTableMap.fPrimaryKeyFieldName).AsInteger;
+ fTableMap.fPrimaryKey.SetValue(Self, lValue);
+ end;
+ end
+ else
+ begin
+ lQry.ExecSQL;
+ end;
+ Result := lQry.RowsAffected;
+ finally
+ lQry.Free;
+ end;
+end;
+{$ENDIF}
class function TMVCActiveRecord.ExecQuery(const SQL: string; const Values: array of Variant;
const Connection: TFDConnection; const Unidirectional: Boolean;
@@ -2453,6 +2577,7 @@ class function TMVCActiveRecordHelper.TryGetRQLQuery(
end;
end;
+{$IFDEF USE_FIREDAC}
class function TMVCActiveRecord.CurrentConnection: TFDConnection;
begin
Result := ActiveRecordConnectionsRegistry.GetCurrent;
@@ -2471,6 +2596,27 @@ class function TMVCActiveRecord.GetConnectionByName(const ConnectionName: String
begin
Result := ActiveRecordConnectionsRegistry.GetByName(ConnectionName);
end;
+{$ENDIF}
+{$IFDEF USE_UNIDAC}
+class function TMVCActiveRecord.CurrentConnection: TUniConnection;
+begin
+ Result := ActiveRecordConnectionsRegistry.GetCurrent;
+end;
+
+function TMVCActiveRecord.GetConnection: TUniConnection;
+begin
+ if fConn = nil then
+ begin
+ fConn := ActiveRecordConnectionsRegistry.GetCurrent;
+ end;
+ Result := fConn;
+end;
+
+class function TMVCActiveRecord.GetConnectionByName(const ConnectionName: String): TUniConnection;
+begin
+ Result := ActiveRecordConnectionsRegistry.GetByName(ConnectionName);
+end;
+{$ENDIF}
function TMVCActiveRecord.GetCustomTableName: String;
begin
@@ -5195,11 +5341,20 @@ constructor EMVCActiveRecordValidationError.Create(const PropertyName, Validatio
fPropertyName := PropertyName;
end;
+{$IFDEF USE_FIREDAC}
constructor TMVCActiveRecord.Create(const Connection: TFDConnection);
begin
Create(True);
fConn := Connection;
end;
+{$ENDIF}
+{$IFDEF USE_UNIDAC}
+constructor TMVCActiveRecord.Create(const Connection: TUniConnection);
+begin
+ Create(True);
+ fConn := Connection;
+end;
+{$ENDIF}
class function TMVCActiveRecordHelper.LoadFromDataSet(const DataSet: TDataSet;
const Options: TMVCActiveRecordLoadOptions): TObjectList;
From c92c5831ad2283da5afd51228dc74c66d737fc92 Mon Sep 17 00:00:00 2001
From: "google-labs-jules[bot]"
<161369871+google-labs-jules[bot]@users.noreply.github.com>
Date: Thu, 11 Sep 2025 17:11:10 +0000
Subject: [PATCH 04/12] feat: Add initial UniDAC support for ActiveRecord
This commit introduces the initial, work-in-progress implementation for UniDAC support in the ActiveRecord component.
Key changes include:
- Refactoring of MVCFramework.ActiveRecord.pas to introduce a TMVCActiveRecordBase class.
- Addition of a new MVCFramework.ActiveRecord.UniDAC.pas unit for the UniDAC-specific implementation.
- Creation of a new MVCFramework.UniDAC.Utils.pas unit.
- A new sample project, unidac_activerecord_showcase, to demonstrate usage.
Note: This implementation is currently incomplete and is not expected to compile. It is being committed to a feature branch to allow for collaborative testing and diagnosis of the remaining issues.
---
.../EntitiesU.pas | 3 +-
.../MainFormU.pas | 4 +-
.../unidac_activerecord_showcase.dpr | 47 +-
.../unidac_activerecord_showcase.dproj | 2 +-
sources/MVCFramework.ActiveRecord.UniDAC.pas | 648 ++++++++++++++++++
sources/MVCFramework.ActiveRecord.pas | 566 ++-------------
6 files changed, 749 insertions(+), 521 deletions(-)
create mode 100644 sources/MVCFramework.ActiveRecord.UniDAC.pas
diff --git a/samples/unidac_activerecord_showcase/EntitiesU.pas b/samples/unidac_activerecord_showcase/EntitiesU.pas
index adf302cc5..e64242f08 100644
--- a/samples/unidac_activerecord_showcase/EntitiesU.pas
+++ b/samples/unidac_activerecord_showcase/EntitiesU.pas
@@ -29,10 +29,9 @@ interface
uses
MVCFramework.Serializer.Commons,
- MVCFramework.ActiveRecord,
+ MVCFramework.ActiveRecord.UniDAC,
System.Generics.Collections,
System.Classes,
- FireDAC.Stan.Param,
MVCFramework.Nullables;
type
diff --git a/samples/unidac_activerecord_showcase/MainFormU.pas b/samples/unidac_activerecord_showcase/MainFormU.pas
index b2e412482..bb524124a 100644
--- a/samples/unidac_activerecord_showcase/MainFormU.pas
+++ b/samples/unidac_activerecord_showcase/MainFormU.pas
@@ -17,7 +17,7 @@ interface
DBAccess,
MemDS,
MVCFramework.Nullables,
- MVCFramework.ActiveRecord,
+ MVCFramework.ActiveRecord.UniDAC,
MVCFramework.Logger,
System.Generics.Collections,
System.Diagnostics;
@@ -116,7 +116,7 @@ implementation
uses
EntitiesU,
System.Threading,
- MVCFramework.DataSet.Utils,
+ MVCFramework.UniDAC.Utils,
MVCFramework.RQL.Parser,
System.Math,
UniConnectionConfigU,
diff --git a/samples/unidac_activerecord_showcase/unidac_activerecord_showcase.dpr b/samples/unidac_activerecord_showcase/unidac_activerecord_showcase.dpr
index b170914e2..281d3a221 100644
--- a/samples/unidac_activerecord_showcase/unidac_activerecord_showcase.dpr
+++ b/samples/unidac_activerecord_showcase/unidac_activerecord_showcase.dpr
@@ -1,36 +1,49 @@
-program activerecord_showcase;
+program unidac_activerecord_showcase;
uses
Vcl.Forms,
MainFormU in 'MainFormU.pas' {MainForm},
EntitiesU in 'EntitiesU.pas',
- UniConnectionConfigU in 'UniConnectionConfigU.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',
- MVCFramework.RQL.AST2MySQL in '..\..\sources\MVCFramework.RQL.AST2MySQL.pas',
- MVCFramework.RQL.AST2InterbaseSQL in '..\..\sources\MVCFramework.RQL.AST2InterbaseSQL.pas',
- MVCFramework.RQL.AST2PostgreSQL in '..\..\sources\MVCFramework.RQL.AST2PostgreSQL.pas',
- MVCFramework.SQLGenerators.PostgreSQL in '..\..\sources\MVCFramework.SQLGenerators.PostgreSQL.pas',
- MVCFramework.RQL.AST2MSSQL in '..\..\sources\MVCFramework.RQL.AST2MSSQL.pas',
+ MVCFramework.ActiveRecord.UniDAC in '..\..\sources\MVCFramework.ActiveRecord.UniDAC.pas',
+ MVCFramework.ActiveRecord in '..\..\sources\MVCFramework.ActiveRecord.pas',
+ MVCFramework.Commons in '..\..\sources\MVCFramework.Commons.pas',
MVCFramework.RQL.Parser in '..\..\sources\MVCFramework.RQL.Parser.pas',
- MVCFramework.SQLGenerators.Sqlite in '..\..\sources\MVCFramework.SQLGenerators.Sqlite.pas',
- MVCFramework.RQL.AST2SQLite in '..\..\sources\MVCFramework.RQL.AST2SQLite.pas',
+ MVCFramework.RQL.AST in '..\..\sources\MVCFramework.RQL.AST.pas',
+ MVCFramework.RQL.Token in '..\..\sources\MVCFramework.RQL.Token.pas',
+ MVCFramework.SQLGenerators.Interfaces in '..\..\sources\MVCFramework.SQLGenerators.Interfaces.pas',
+ MVCFramework.SQLGenerators.Factory in '..\..\sources\MVCFramework.SQLGenerators.Factory.pas',
MVCFramework.SQLGenerators.MSSQL in '..\..\sources\MVCFramework.SQLGenerators.MSSQL.pas',
- EngineChoiceFormU in 'EngineChoiceFormU.pas' {EngineChoiceForm},
+ MVCFramework.SQLGenerators.MySQL in '..\..\sources\MVCFramework.SQLGenerators.MySQL.pas',
+ MVCFramework.SQLGenerators.PostgreSQL in '..\..\sources\MVCFramework.SQLGenerators.PostgreSQL.pas',
+ MVCFramework.SQLGenerators.Firebird in '..\..\sources\MVCFramework.SQLGenerators.Firebird.pas',
+ MVCFramework.SQLGenerators.SQLite in '..\..\sources\MVCFramework.SQLGenerators.SQLite.pas',
MVCFramework.SQLGenerators.Interbase in '..\..\sources\MVCFramework.SQLGenerators.Interbase.pas',
- MVCFramework.ActiveRecord in '..\..\sources\MVCFramework.ActiveRecord.pas',
MVCFramework.Nullables in '..\..\sources\MVCFramework.Nullables.pas',
- MVCFramework.Serializer.JsonDataObjects in '..\..\sources\MVCFramework.Serializer.JsonDataObjects.pas';
+ MVCFramework.Log.Logger in '..\..\sources\MVCFramework.Log.Logger.pas',
+ MVCFramework.Log.Appenders.File in '..\..\sources\MVCFramework.Log.Appenders.File.pas',
+ MVCFramework.Log.Appenders.Console in '..\..\sources\MVCFramework.Log.Appenders.Console.pas',
+ MVCFramework.Log.Appenders.OutputDebugString in '..\..\sources\MVCFramework.Log.Appenders.OutputDebugString.pas',
+ MVCFramework.DuckTyping in '..\..\sources\MVCFramework.DuckTyping.pas',
+ MVCFramework.Helpers.JSON in '..\..\sources\MVCFramework.Helpers.JSON.pas',
+ MVCFramework.Serializer.Defaults in '..\..\sources\MVCFramework.Serializer.Defaults.pas',
+ MVCFramework.Serializer.Intf in '..\..\sources\MVCFramework.Serializer.Intf.pas',
+ MVCFramework.Serializer.JsonDataObjects in '..\..\sources\MVCFramework.Serializer.JsonDataObjects.pas',
+ MVCFramework.ActiveRecord.Intf in '..\..\sources\MVCFramework.ActiveRecord.Intf.pas',
+ MVCFramework.ActiveRecord.Mapper in '..\..\sources\MVCFramework.ActiveRecord.Mapper.pas',
+ MVCFramework.ActiveRecord.Stub in '..\..\sources\MVCFramework.ActiveRecord.Stub.pas',
+ MVCFramework.ActiveRecord.ConnectionManager in '..\..\sources\MVCFramework.ActiveRecord.ConnectionManager.pas',
+ MVCFramework.ActiveRecord.Cache in '..\..\sources\MVCFramework.ActiveRecord.Cache.pas',
+ MVCFramework.UniDAC.Utils in '..\..\sources\MVCFramework.UniDAC.Utils.pas',
+ UniConnectionConfigU in 'UniConnectionConfigU.pas',
+ EngineChoiceFormU in 'EngineChoiceFormU.pas' {EngineChoiceForm};
{$R *.res}
-
begin
ReportMemoryLeaksOnShutdown := True;
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TMainForm, MainForm);
+ Application.CreateForm(TEngineChoiceForm, EngineChoiceForm);
Application.Run;
-
end.
diff --git a/samples/unidac_activerecord_showcase/unidac_activerecord_showcase.dproj b/samples/unidac_activerecord_showcase/unidac_activerecord_showcase.dproj
index dafe63166..dc682cd61 100644
--- a/samples/unidac_activerecord_showcase/unidac_activerecord_showcase.dproj
+++ b/samples/unidac_activerecord_showcase/unidac_activerecord_showcase.dproj
@@ -135,7 +135,7 @@
dfm
-
+
diff --git a/sources/MVCFramework.ActiveRecord.UniDAC.pas b/sources/MVCFramework.ActiveRecord.UniDAC.pas
new file mode 100644
index 000000000..e3fe21eaf
--- /dev/null
+++ b/sources/MVCFramework.ActiveRecord.UniDAC.pas
@@ -0,0 +1,648 @@
+// *************************************************************************** }
+//
+// Delphi MVC Framework
+//
+// Copyright (c) 2010-2025 Daniele Teti and the DMVCFramework Team
+//
+// https://github.com/danieleteti/delphimvcframework
+//
+// ***************************************************************************
+//
+// Licensed under the Apache License, Version 2.0 (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.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+//
+// ***************************************************************************
+
+unit MVCFramework.ActiveRecord.UniDAC;
+
+{$I dmvcframework.inc}
+
+
+interface
+
+uses
+ System.SysUtils,
+ System.Generics.Defaults,
+ System.Generics.Collections,
+ System.RTTI,
+ Data.DB,
+ Uni,
+ DBAccess,
+ MemDS,
+ MVCFramework,
+ MVCFramework.Commons,
+ MVCFramework.RQL.Parser,
+ MVCFramework.Cache,
+ MVCFramework.Serializer.Intf,
+ MVCFramework.Serializer.Commons,
+ System.SyncObjs,
+ System.TypInfo,
+ MVCFramework.ActiveRecord;
+
+type
+ TMVCActiveRecordUniDAC = class(TMVCActiveRecordBase)
+ private
+ fConn: TUniConnection;
+ function MapNullableTValueToParam(aValue: TValue; const aParam: TParam): Boolean;
+ protected
+ function GetConnection: TUniConnection;
+ procedure MapTValueToParam(aValue: TValue; const aParam: TParam); virtual;
+ class function CreateQuery(const Unidirectional, DirectExecute: Boolean): TUniQuery;
+ class function ExecQuery(
+ const SQL: string;
+ const Values: array of Variant;
+ const Unidirectional: Boolean;
+ const DirectExecute: Boolean): TDataSet; overload;
+ class function ExecQuery(
+ const SQL: string;
+ const Values: array of Variant;
+ const Connection: TUniConnection;
+ const Unidirectional: Boolean;
+ const DirectExecute: Boolean)
+ : TDataSet; overload;
+ class function ExecQuery(
+ const SQL: string;
+ const Values: array of Variant;
+ const ValueTypes: array of TFieldType;
+ const Unidirectional: Boolean;
+ const DirectExecute: Boolean)
+ : TDataSet; overload;
+ class function ExecQuery(
+ const SQL: string;
+ const Values: array of Variant;
+ const ValueTypes: array of TFieldType;
+ const Connection: TUniConnection;
+ const Unidirectional: Boolean;
+ const DirectExecute: Boolean): TDataSet; overload;
+ procedure MapObjectToParams(const Params: TParams; var Handled: Boolean); virtual;
+ public
+ constructor Create(const Connection: TUniConnection); overload;
+ class function CurrentConnection: TUniConnection;
+ class function GetConnectionByName(const ConnectionName: String): TUniConnection;
+ end;
+
+ TMVCActiveRecord = class(TMVCActiveRecordUniDAC)
+ end;
+
+implementation
+
+uses
+ System.IOUtils,
+ System.Classes,
+ MVCFramework.DataSet.Utils,
+ MVCFramework.Logger,
+ MVCFramework.Nullables,
+ MVCFramework.RTTI.Utils,
+ System.Variants,
+ System.Math;
+
+{ TMVCActiveRecordUniDAC }
+
+constructor TMVCActiveRecordUniDAC.Create(const Connection: TUniConnection);
+begin
+ Create(True);
+ fConn := Connection;
+end;
+
+class function TMVCActiveRecordUniDAC.CreateQuery(const Unidirectional,
+ DirectExecute: Boolean): TUniQuery;
+begin
+ Result := TUniQuery.Create(nil);
+ Result.Unidirectional := Unidirectional;
+ Result.Options.DirectExecute := DirectExecute;
+end;
+
+class function TMVCActiveRecordUniDAC.CurrentConnection: TUniConnection;
+begin
+ Result := ActiveRecordConnectionsRegistry.GetCurrent as TUniConnection;
+end;
+
+class function TMVCActiveRecordUniDAC.ExecQuery(const SQL: string;
+ const Values: array of Variant; const Unidirectional,
+ DirectExecute: Boolean): TDataSet;
+begin
+ Result := ExecQuery(SQL, Values, [], nil, Unidirectional, DirectExecute);
+end;
+
+class function TMVCActiveRecordUniDAC.ExecQuery(const SQL: string;
+ const Values: array of Variant; const Connection: TUniConnection;
+ const Unidirectional, DirectExecute: Boolean): TDataSet;
+begin
+ Result := ExecQuery(SQL, Values, [], Connection, Unidirectional, DirectExecute);
+end;
+
+class function TMVCActiveRecordUniDAC.ExecQuery(const SQL: string;
+ const Values: array of Variant; const ValueTypes: array of TFieldType;
+ const Unidirectional, DirectExecute: Boolean): TDataSet;
+begin
+ Result := ExecQuery(SQL, Values, ValueTypes, nil, Unidirectional, DirectExecute);
+end;
+
+class function TMVCActiveRecordUniDAC.ExecQuery(const SQL: string;
+ const Values: array of Variant; const ValueTypes: array of TFieldType;
+ const Connection: TUniConnection; const Unidirectional,
+ DirectExecute: Boolean): TDataSet;
+var
+ lQry: TUniQuery;
+ lSQL: string;
+ I: Integer;
+begin
+ lQry := CreateQuery(Unidirectional, DirectExecute);
+ try
+ lSQL := SQL;
+ OnBeforeExecuteQuerySQL(lSQL);
+
+ if Connection = nil then
+ begin
+ lQry.Connection := ActiveRecordConnectionsRegistry.GetCurrent as TUniConnection;
+ end
+ else
+ begin
+ lQry.Connection := Connection;
+ end;
+ lQry.SQL.Text := lSQL;
+ for I := 0 to High(Values) do
+ begin
+ lQry.Params[I].Value := Values[I];
+ if I < Length(ValueTypes) then
+ begin
+ lQry.Params[I].DataType := ValueTypes[I];
+ end;
+ end;
+ lQry.Open;
+ Result := lQry;
+ except
+ lQry.Free;
+ raise;
+ end;
+end;
+
+function TMVCActiveRecordUniDAC.GetConnection: TUniConnection;
+begin
+ if fConn = nil then
+ begin
+ fConn := ActiveRecordConnectionsRegistry.GetCurrent as TUniConnection;
+ end;
+ Result := fConn;
+end;
+
+class function TMVCActiveRecordUniDAC.GetConnectionByName(
+ const ConnectionName: String): TUniConnection;
+begin
+ Result := ActiveRecordConnectionsRegistry.GetByName(ConnectionName) as TUniConnection;
+end;
+
+procedure TMVCActiveRecordUniDAC.MapObjectToParams(const Params: TParams;
+ var Handled: Boolean);
+begin
+ // do nothing
+end;
+
+function TMVCActiveRecordUniDAC.MapNullableTValueToParam(aValue: TValue;
+ const aParam: TParam): Boolean;
+var
+ lNullableType: TNullableType;
+begin
+ Assert(aValue.Kind = tkRecord);
+ Result := True;
+ lNullableType := GetNullableType(aValue.TypeInfo);
+ case lNullableType of
+ ntInvalidNullableType:
+ begin
+ Exit(False);
+ end;
+ ntNullableString:
+ begin
+ if not aValue.AsType().HasValue then
+ begin
+ aParam.DataType := ftString;
+ aParam.Clear;
+ Exit(True);
+ end
+ else
+ begin
+ aValue := aValue.AsType().Value;
+ end;
+ end;
+ ntNullableCurrency:
+ begin
+ if not aValue.AsType().HasValue then
+ begin
+ aParam.DataType := TFieldType.ftCurrency;
+ aParam.Clear;
+ Exit(True);
+ end
+ else
+ begin
+ aValue := aValue.AsType().Value;
+ end;
+ end;
+ ntNullableBoolean:
+ begin
+ if not aValue.AsType().HasValue then
+ begin
+ aParam.DataType := ftBoolean;
+ aParam.Clear;
+ Exit(True);
+ end
+ else
+ begin
+ aValue := TValue.From(aValue.AsType().Value);
+ end;
+ end;
+ ntNullableTDate:
+ begin
+ if not aValue.AsType().HasValue then
+ begin
+ aParam.DataType := ftDate;
+ aParam.Clear;
+ Exit(True);
+ end
+ else
+ begin
+ aValue := TValue.From(aValue.AsType().Value);
+ end;
+ end;
+ ntNullableTTime:
+ begin
+ if not aValue.AsType().HasValue then
+ begin
+ aParam.DataType := ftTime;
+ aParam.Clear;
+ Exit(True);
+ end
+ else
+ begin
+ aValue := TValue.From(aValue.AsType().Value);
+ end;
+ end;
+ ntNullableTDateTime:
+ begin
+ if not aValue.AsType().HasValue then
+ begin
+ aParam.DataType := ftDateTime;
+ aParam.Clear;
+ Exit(True);
+ end
+ else
+ begin
+ aValue := TValue.From(aValue.AsType().Value);
+ end;
+ end;
+ ntNullableSingle:
+ begin
+ if not aValue.AsType().HasValue then
+ begin
+ aParam.DataType := TFieldType.ftSingle;
+ aParam.Clear;
+ Exit(True);
+ end
+ else
+ begin
+ aValue := aValue.AsType().Value;
+ end;
+ end;
+ ntNullableDouble:
+ begin
+ if not aValue.AsType().HasValue then
+ begin
+ aParam.DataType := TFieldType.ftFloat;
+ aParam.Clear;
+ Exit(True);
+ end
+ else
+ begin
+ aValue := aValue.AsType().Value;
+ end;
+ end;
+ ntNullableExtended:
+ begin
+ if not aValue.AsType().HasValue then
+ begin
+ aParam.DataType := TFieldType.ftExtended;
+ aParam.Clear;
+ Exit(True);
+ end
+ else
+ begin
+ aValue := aValue.AsType().Value;
+ end;
+ end;
+ ntNullableInt16:
+ begin
+ if not aValue.AsType().HasValue then
+ begin
+ aParam.DataType := ftInteger;
+ aParam.Clear;
+ Exit(True);
+ end
+ else
+ begin
+ aValue := aValue.AsType().Value;
+ end;
+ end;
+ ntNullableUInt16:
+ begin
+ if not aValue.AsType().HasValue then
+ begin
+ aParam.DataType := ftInteger;
+ aParam.Clear;
+ Exit(True);
+ end
+ else
+ begin
+ aValue := aValue.AsType().Value;
+ end;
+ end;
+ ntNullableInt32:
+ begin
+ if not aValue.AsType().HasValue then
+ begin
+ aParam.DataType := ftInteger;
+ aParam.Clear;
+ Exit(True);
+ end
+ else
+ begin
+ aValue := aValue.AsType().Value;
+ end;
+ end;
+ ntNullableUInt32:
+ begin
+ if not aValue.AsType().HasValue then
+ begin
+ aParam.DataType := ftInteger;
+ aParam.Clear;
+ Exit(True);
+ end
+ else
+ begin
+ aValue := aValue.AsType().Value;
+ end;
+ end;
+ ntNullableInt64:
+ begin
+ if not aValue.AsType().HasValue then
+ begin
+ aParam.DataType := ftLargeInt;
+ aParam.Clear;
+ Exit(True);
+ end
+ else
+ begin
+ aValue := aValue.AsType().Value;
+ end;
+ end;
+ ntNullableUInt64:
+ begin
+ if not aValue.AsType().HasValue then
+ begin
+ aParam.DataType := ftLargeInt;
+ aParam.Clear;
+ Exit(True);
+ end
+ else
+ begin
+ aValue := aValue.AsType().Value;
+ end;
+ end;
+ ntNullableTGUID:
+ begin
+ if not aValue.AsType().HasValue then
+ begin
+ aParam.DataType := TFieldType.ftGuid;
+ aParam.Clear;
+ Exit(True);
+ end
+ else
+ begin
+ aValue := TValue.From(aValue.AsType().Value);
+ end;
+ 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 TMVCActiveRecordUniDAC.MapTValueToParam(aValue: TValue;
+ const aParam: TParam);
+const
+ MAX_STRING_PARAM_LENGTH = 1000; { Arbitrary value }
+var
+ lStream: TStream;
+ lName: string;
+begin
+{$IFDEF NEXTGEN}
+ lName := aValue.TypeInfo.NameFld.ToString;
+{$ELSE}
+ lName := string(aValue.TypeInfo.Name);
+{$ENDIF}
+ if (lName.StartsWith('Nullable', True) and (aValue.TypeInfo.Kind = tkRecord)) then
+ begin
+ if MapNullableTValueToParam(aValue, aParam) then
+ begin
+ Exit;
+ end;
+ end;
+
+ case aValue.TypeInfo.Kind of
+ tkUString:
+ begin
+ case aParam.DataType of
+ ftUnknown, ftWideString:
+ begin
+ if aValue.AsString.Length > MAX_STRING_PARAM_LENGTH then
+ begin
+ aParam.AsWideMemo := aValue.AsString;
+ end
+ else
+ begin
+ aParam.AsWideString := aValue.AsString;
+ end;
+ end;
+ ftString:
+ begin
+ if aValue.AsString.Length > MAX_STRING_PARAM_LENGTH then
+ begin
+ aParam.AsMemo := AnsiString(aValue.AsString);
+ end
+ else
+ begin
+ aParam.AsString := aValue.AsString;
+ end;
+ end;
+ ftWideMemo:
+ begin
+ aParam.AsWideMemo := aValue.AsString;
+ end;
+ ftMemo:
+ begin
+ aParam.AsMemo := AnsiString(aValue.AsString);
+ end;
+ else
+ begin
+ raise EMVCActiveRecord.CreateFmt('Invalid parameter type for (tkUString) [%s]', [lName]);
+ end;
+ end;
+ end;
+ tkString:
+ begin
+ case aParam.DataType of
+ ftUnknown, ftWideString:
+ begin
+ if aValue.AsString.Length > MAX_STRING_PARAM_LENGTH then
+ begin
+ aParam.AsWideMemo := aValue.AsString;
+ end
+ else
+ begin
+ aParam.AsWideString := aValue.AsString;
+ end;
+ end;
+ ftString:
+ begin
+ if aValue.AsString.Length > MAX_STRING_PARAM_LENGTH then
+ begin
+ aParam.AsMemo := AnsiString(aValue.AsString);
+ end
+ else
+ begin
+ aParam.AsString := aValue.AsString;
+ end;
+ end;
+ ftWideMemo:
+ begin
+ aParam.AsWideMemo := aValue.AsString;
+ end;
+ ftMemo:
+ begin
+ aParam.AsMemo := AnsiString(aValue.AsString);
+ end;
+ else
+ begin
+ raise EMVCActiveRecord.CreateFmt('Invalid parameter type for (tkString) [%s]', [lName]);
+ end;
+ end;
+ end;
+{$IF Defined(SeattleOrBetter)}
+ tkWideString:
+ begin
+ if aValue.AsString.Length > MAX_STRING_PARAM_LENGTH then
+ begin
+ aParam.AsWideMemo := aValue.AsString;
+ end
+ else
+ begin
+ aParam.AsWideString := aValue.AsString;
+ end
+ end;
+{$ENDIF}
+ tkInt64:
+ begin
+ aParam.AsLargeInt := aValue.AsInt64;
+ end;
+ tkInteger:
+ begin
+ aParam.AsInteger := aValue.AsInteger;
+ end;
+ tkEnumeration:
+ begin
+ if aValue.TypeInfo = TypeInfo(System.Boolean) then
+ begin
+ if aParam.DataTypeName.StartsWith('int', true) then
+ begin
+ aParam.AsInteger := IfThen(aValue.AsBoolean,1,0);
+ end
+ else
+ begin
+ aParam.AsBoolean := aValue.AsBoolean;
+ end;
+ end
+ else
+ begin
+ aParam.AsInteger := aValue.AsOrdinal;
+ end;
+ end;
+ tkFloat:
+ begin
+ if lName = 'TDate' then
+ begin
+ aParam.AsDate := Trunc(aValue.AsExtended);
+ end
+ else if lName = 'TDateTime' then
+ begin
+ aParam.AsDateTime := aValue.AsExtended;
+ end
+ else if lName = 'TTime' then
+ begin
+ aParam.AsTime := aValue.AsExtended;
+ end
+ else if lName = 'Currency' then
+ begin
+ aParam.AsCurrency := aValue.AsCurrency;
+ end
+ else
+ begin
+ aParam.AsFloat := aValue.AsExtended;
+ end;
+ end;
+ tkClass:
+ begin
+ 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]);
+ lStream := aValue.AsType();
+ if Assigned(lStream) then
+ begin
+ lStream.Position := 0;
+ aParam.LoadFromStream(lStream, ftBlob);
+ end
+ else
+ begin
+ aParam.DataType := TFieldType.ftBlob;
+ aParam.Clear;
+ end;
+ end;
+ tkRecord:
+ begin
+ if aValue.TypeInfo = TypeInfo(TGuid) then
+ begin
+ if SQLGenerator.HasNativeUUID then
+ begin
+ aParam.AsGuid := aValue.AsType
+ end
+ else
+ begin
+ aParam.AsString := GUIDToString(aValue.AsType);
+ end;
+ end
+ else if aValue.TypeInfo = TypeInfo(NullableTGUID) then
+ begin
+ if aValue.AsType.HasValue then
+ aParam.AsGuid := aValue.AsType.Value
+ else
+ aParam.Clear();
+ end
+ else
+ begin
+ raise EMVCActiveRecord.CreateFmt('Unsupported Record TypeKind (%d) for param %s',
+ [Ord(aValue.TypeInfo.Kind), aParam.Name]);
+ end;
+ end;
+ else
+ raise EMVCActiveRecord.CreateFmt('Unsupported TypeKind (%d) for param %s', [Ord(aValue.TypeInfo.Kind), aParam.Name]);
+ end;
+end;
+
+end.
diff --git a/sources/MVCFramework.ActiveRecord.pas b/sources/MVCFramework.ActiveRecord.pas
index a66f13b74..f574c21c6 100644
--- a/sources/MVCFramework.ActiveRecord.pas
+++ b/sources/MVCFramework.ActiveRecord.pas
@@ -84,8 +84,12 @@ EMVCActiveRecordTransactionContext = class(EMVCActiveRecord)
end;
- TMVCActiveRecordClass = class of TMVCActiveRecord;
+ TMVCActiveRecordBase = class;
+ TMVCActiveRecordBaseClass = class of TMVCActiveRecordBase;
+
TMVCActiveRecord = class;
+ TMVCActiveRecordClass = class of TMVCActiveRecord;
+
{$IF Defined(CUSTOM_MANAGED_RECORDS)}
TMVCTransactionContext = record
@@ -279,7 +283,7 @@ TPartitionInfo = class
class function BuildPartitionClause(const PartitionClause: String; const RQLCompilerClass: TRQLCompilerClass): TPartitionInfo;
end;
- TMVCActiveRecordList = class(TObjectList)
+ TMVCActiveRecordList = class(TObjectList)
public
constructor Create; virtual;
end;
@@ -312,174 +316,47 @@ TMVCTableMap = class
public
constructor Create;
destructor Destroy; override;
- function VersionValueAsInt64For(AR: TMVCActiveRecord): Int64; //inline;
+ function VersionValueAsInt64For(AR: TMVCActiveRecordBase): Int64; //inline;
end;
- TMVCActiveRecord = class
+ TMVCActiveRecordBase = class
private
fChildren: TObjectList;
- {$IFDEF USE_FIREDAC}
- fConn: TFDConnection;
- {$ENDIF}
- {$IFDEF USE_UNIDAC}
- fConn: TUniConnection;
- {$ENDIF}
fSQLGenerator: TMVCSQLGenerator;
fRQL2SQL: TRQL2SQL;
- {$IFDEF USE_FIREDAC}
- function MapNullableTValueToParam(aValue: TValue; const aParam: TFDParam): Boolean;
- {$ENDIF}
- {$IFDEF USE_UNIDAC}
- function MapNullableTValueToParam(aValue: TValue; const aParam: TParam): Boolean;
- {$ENDIF}
function GetPrimaryKeyIsAutogenerated: Boolean;
procedure SetPrimaryKeyIsAutogenerated(const Value: Boolean);
function GetAttributes(const AttrName: string): TValue;
procedure SetAttributes(const AttrName: string; const Value: TValue);
function GetTableName: string;
- procedure AdvanceVersioning(const TableMap: TMVCTableMap; const ARInstance: TMVCActiveRecord);
- procedure SetInitialObjVersion(const TableMap: TMVCTableMap; const ARInstance: TMVCActiveRecord);
+ procedure AdvanceVersioning(const TableMap: TMVCTableMap; const ARInstance: TMVCActiveRecordBase);
+ procedure SetInitialObjVersion(const TableMap: TMVCTableMap; const ARInstance: TMVCActiveRecordBase);
protected
fBackendDriver: string;
fTableMap: TMVCTableMap;
function GetCustomTableName: String; virtual;
function GetPartitionInfo: TPartitionInfo;
- {$IFDEF USE_FIREDAC}
- function GetConnection: TFDConnection;
- procedure MapTValueToParam(aValue: TValue; const aParam: TFDParam); virtual;
- {$ENDIF}
- {$IFDEF USE_UNIDAC}
- function GetConnection: TUniConnection;
- procedure MapTValueToParam(aValue: TValue; const aParam: TParam); virtual;
- {$ENDIF}
procedure InitTableInfo(const aTableName: String);
- {$IFDEF USE_FIREDAC}
- class function
- CreateQuery(const Unidirectional, DirectExecute: Boolean): TFDQuery;
- {$ENDIF}
- {$IFDEF USE_UNIDAC}
- class function
- CreateQuery(const Unidirectional, DirectExecute: Boolean): TUniQuery;
- {$ENDIF}
- class function ExecQuery(
- const SQL: string;
- const Values: array of Variant;
- const Unidirectional: Boolean;
- const DirectExecute: Boolean): TDataSet; overload;
- {$IFDEF USE_FIREDAC}
- class function ExecQuery(
- const SQL: string;
- const Values: array of Variant;
- const Connection: TFDConnection;
- const Unidirectional: Boolean;
- const DirectExecute: Boolean)
- {$ENDIF}
- {$IFDEF USE_UNIDAC}
- class function ExecQuery(
- const SQL: string;
- const Values: array of Variant;
- const Connection: TUniConnection;
- const Unidirectional: Boolean;
- const DirectExecute: Boolean)
- {$ENDIF}
- : TDataSet; overload;
- class function ExecQuery(
- const SQL: string;
- const Values: array of Variant;
- const ValueTypes: array of TFieldType;
- const Unidirectional: Boolean;
- const DirectExecute: Boolean)
- : TDataSet; overload;
- class function ExecQuery(
- const SQL: string;
- const Values: array of Variant;
- const ValueTypes: array of TFieldType;
- {$IFDEF USE_FIREDAC}
- const Connection: TFDConnection;
- {$ENDIF}
- {$IFDEF USE_UNIDAC}
- const Connection: TUniConnection;
- {$ENDIF}
- const Unidirectional: Boolean;
- const DirectExecute: Boolean): TDataSet; overload;
procedure FillPrimaryKey(const SequenceName: string);
function ExecNonQuery(const SQL: string; RefreshAutoGenerated: Boolean = false): Int64;
overload;
- class function GetByPK(aActiveRecord: TMVCActiveRecord; const aValue: string; const aFieldType: TFieldType;
- const RaiseExceptionIfNotFound: Boolean): TMVCActiveRecord; overload;
-
+ class function GetByPK(aActiveRecord: TMVCActiveRecordBase; const aValue: string; const aFieldType: TFieldType;
+ const RaiseExceptionIfNotFound: Boolean): TMVCActiveRecordBase; overload;
// 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;
- {$IFDEF USE_FIREDAC}
- procedure MapObjectToParams(const Params: TFDParams; var Handled: Boolean); virtual;
- {$ENDIF}
- {$IFDEF USE_UNIDAC}
- procedure MapObjectToParams(const Params: TParams; var Handled: Boolean); virtual;
- {$ENDIF}
procedure MapDatasetToObject(const DataSet: TDataSet; const Options: TMVCActiveRecordLoadOptions;
var Handled: Boolean); virtual;
@@ -494,24 +371,12 @@ TMVCActiveRecord = class
public
constructor Create(aLazyLoadConnection: Boolean); overload; // cannot be virtual!
constructor Create; overload; virtual;
- {$IFDEF USE_FIREDAC}
- constructor Create(const Connection: TFDConnection); overload; virtual;
- {$ENDIF}
- {$IFDEF USE_UNIDAC}
- constructor Create(const Connection: TUniConnection); overload; virtual;
- {$ENDIF}
destructor Destroy; override;
procedure EnsureConnection;
- procedure Assign(ActiveRecord: TMVCActiveRecord); virtual;
+ procedure Assign(ActiveRecord: TMVCActiveRecordBase); 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;
@@ -553,16 +418,51 @@ TMVCActiveRecord = class
write SetPrimaryKeyIsAutogenerated;
class function GetScalar(const SQL: string; const Params: array of Variant): Variant;
- {$IFDEF USE_FIREDAC}
+ end;
+
+ TMVCActiveRecord = class(TMVCActiveRecordBase)
+ private
+ fConn: TFDConnection;
+ function MapNullableTValueToParam(aValue: TValue; const aParam: TFDParam): Boolean;
+ protected
+ function GetConnection: TFDConnection;
+ procedure MapTValueToParam(aValue: TValue; const aParam: TFDParam); virtual;
+ class function CreateQuery(const Unidirectional, DirectExecute: Boolean): TFDQuery;
+ class function ExecQuery(
+ const SQL: string;
+ const Values: array of Variant;
+ const Unidirectional: Boolean;
+ const DirectExecute: Boolean): TDataSet; overload;
+ class function ExecQuery(
+ const SQL: string;
+ const Values: array of Variant;
+ const Connection: TFDConnection;
+ const Unidirectional: Boolean;
+ const DirectExecute: Boolean)
+ : TDataSet; overload;
+ class function ExecQuery(
+ const SQL: string;
+ const Values: array of Variant;
+ const ValueTypes: array of TFieldType;
+ const Unidirectional: Boolean;
+ const DirectExecute: Boolean)
+ : TDataSet; overload;
+ class function ExecQuery(
+ const SQL: string;
+ const Values: array of Variant;
+ const ValueTypes: array of TFieldType;
+ const Connection: TFDConnection;
+ const Unidirectional: Boolean;
+ const DirectExecute: Boolean): TDataSet; overload;
+ procedure MapObjectToParams(const Params: TFDParams; var Handled: Boolean); virtual;
+ public
+ constructor Create(const Connection: TFDConnection); overload;
class function CurrentConnection: TFDConnection;
class function GetConnectionByName(const ConnectionName: String): TFDConnection;
- {$ENDIF}
- {$IFDEF USE_UNIDAC}
- class function CurrentConnection: TUniConnection;
- class function GetConnectionByName(const ConnectionName: String): TUniConnection;
- {$ENDIF}
end;
+ TMVCActiveRecordClass = class of TMVCActiveRecord;
+
IMVCUnitOfWork = interface
['{68B55DD3-57F6-4CC0-A4DE-BFDE7C3AA287}']
procedure RegisterDelete(const Value: T); overload;
@@ -603,24 +503,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;
@@ -628,10 +519,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;
@@ -660,7 +547,6 @@ TMVCActiveRecordHelper = class helper for TMVCActiveRecord
const Params: array of Variant)
: TMVCActiveRecordList; overload;
- {$IFDEF USE_FIREDAC}
class function Select(const aClass: TMVCActiveRecordClass; const SQL: string;
const Params: array of Variant;
const Connection: TFDConnection): TMVCActiveRecordList; overload;
@@ -668,16 +554,6 @@ TMVCActiveRecordHelper = class helper for TMVCActiveRecord
class function Select(const aClass: TMVCActiveRecordClass; const SQL: string;
const Params: array of Variant;
const Connection: TFDConnection; const OutList: TMVCActiveRecordList): UInt32; overload;
- {$ENDIF}
- {$IFDEF USE_UNIDAC}
- class function Select(const aClass: TMVCActiveRecordClass; const SQL: string;
- const Params: array of Variant;
- const Connection: TUniConnection): TMVCActiveRecordList; overload;
-
- class function Select(const aClass: TMVCActiveRecordClass; const SQL: string;
- const Params: array of Variant;
- const Connection: TUniConnection; const OutList: TMVCActiveRecordList): UInt32; overload;
- {$ENDIF}
{ SelectOne }
class function SelectOne(const SQL: string;
@@ -717,10 +593,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;
@@ -728,7 +600,6 @@ TMVCActiveRecordHelper = class helper for TMVCActiveRecord
const Params: array of Variant;
const ParamTypes: array of TFieldType;
const OutList: TObjectList): UInt32; overload;
- {$IFDEF USE_FIREDAC}
class function Where(
const aClass: TMVCActiveRecordClass;
const SQLWhere: string;
@@ -745,20 +616,6 @@ TMVCActiveRecordHelper = class helper for TMVCActiveRecord
const Params: array of Variant;
const Connection: TFDConnection;
const OutList: TMVCActiveRecordList): UInt32; overload;
- {$ENDIF}
- {$IFDEF USE_UNIDAC}
- class function Where(
- const aClass: TMVCActiveRecordClass;
- const SQLWhere: string;
- const Params: array of Variant;
- const Connection: TUniConnection): TMVCActiveRecordList; overload;
- class function Where(
- const aClass: TMVCActiveRecordClass;
- const SQLWhere: string;
- const Params: array of Variant;
- const Connection: TUniConnection;
- const OutList: TMVCActiveRecordList): UInt32; overload;
- {$ENDIF}
{ GetXXXByWhere }
class function GetOneByWhere(const SQLWhere: string;
@@ -876,25 +733,17 @@ TMVCEntitiesRegistry = class(TInterfacedObject, IMVCEntitiesRegistry)
IMVCActiveRecordConnections = interface
['{7B87473C-1784-489F-A838-925E7DDD0DE2}']
- {$IFDEF USE_FIREDAC}
procedure AddConnection(const aName: string; const aConnection: TFDConnection; const Owns: Boolean = false); overload;
procedure AddDefaultConnection(const aConnection: TFDConnection; const Owns: Boolean = false); overload;
- function GetCurrent(const RaiseExceptionIfNotAvailable: Boolean = True): TFDConnection;
- function GetByName(const aName: string): TFDConnection;
- {$ENDIF}
- {$IFDEF USE_UNIDAC}
- procedure AddConnection(const aName: string; const aConnection: TUniConnection; const Owns: Boolean = false); overload;
- procedure AddDefaultConnection(const aConnection: TUniConnection; const Owns: Boolean = false); overload;
- function GetCurrent(const RaiseExceptionIfNotAvailable: Boolean = True): TUniConnection;
- function GetByName(const aName: string): TUniConnection;
- {$ENDIF}
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 GetCurrentConnectionName(const RaiseExceptionIfNotAvailable: Boolean = False): String;
function GetCurrentBackend: string;
+ function GetByName(const aName: string): TFDConnection;
procedure SetDefault;
end;
@@ -902,12 +751,7 @@ TMVCConnectionsRepository = class(TInterfacedObject, IMVCActiveRecordConnectio
private type
TConnHolder = class
public
- {$IFDEF USE_FIREDAC}
Connection: TFDConnection;
- {$ENDIF}
- {$IFDEF USE_UNIDAC}
- Connection: TUniConnection;
- {$ENDIF}
OwnsConnection: Boolean;
destructor Destroy; override;
end;
@@ -920,24 +764,16 @@ TConnHolder = class
public
constructor Create; virtual;
destructor Destroy; override;
- {$IFDEF USE_FIREDAC}
procedure AddConnection(const aName: string; const aConnection: TFDConnection; const aOwns: Boolean = false); overload;
- procedure AddDefaultConnection(const aConnection: TFDConnection; const aOwns: Boolean = false); overload;
- function GetCurrent(const RaiseExceptionIfNotAvailable: Boolean = True): TFDConnection;
- function GetByName(const aName: string): TFDConnection;
- {$ENDIF}
- {$IFDEF USE_UNIDAC}
- procedure AddConnection(const aName: string; const aConnection: TUniConnection; const aOwns: Boolean = false); overload;
- procedure AddDefaultConnection(const aConnection: TUniConnection; const aOwns: Boolean = false); overload;
- function GetCurrent(const RaiseExceptionIfNotAvailable: Boolean = True): TUniConnection;
- function GetByName(const aName: string): TUniConnection;
- {$ENDIF}
procedure AddConnection(const aName, aConnectionDefName: String); overload;
+ procedure AddDefaultConnection(const aConnection: TFDConnection; 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 GetCurrentConnectionName(const RaiseExceptionIfNotAvailable: Boolean = False): String;
+ function GetByName(const aName: string): TFDConnection;
function GetCurrentBackend: string;
procedure SetDefault;
end;
@@ -1037,7 +873,7 @@ TMVCSQLGeneratorRegistry = class sealed
function GetSQLGenerator(const aBackend: string): TMVCSQLGeneratorClass;
end;
- TMVCUnitOfWork = class(TInterfacedObject, IMVCUnitOfWork, IMVCMultiExecutor)
+ TMVCUnitOfWork = class(TInterfacedObject, IMVCUnitOfWork, IMVCMultiExecutor)
private
fListToDelete: TObjectList;
fListToUpdate: TObjectList;
@@ -1055,7 +891,7 @@ TMVCUnitOfWork = class(TInterfacedObject, IMVCUnitOfWork<
procedure UnregisterInsert(const Value: T);
// events
- procedure DoItemApplyAction(const Obj: TMVCActiveRecord; const EntityAction: TMVCEntityAction;
+ procedure DoItemApplyAction(const Obj: TMVCActiveRecordFireDAC; const EntityAction: TMVCEntityAction;
const ItemApplyAction: TMVCItemApplyAction; var Handled: Boolean);
class function KeyExistsInt(const NewList: TObjectList; const KeyValue: Integer; out Index: Integer): Boolean;
@@ -1066,6 +902,9 @@ TMVCUnitOfWork = class(TInterfacedObject, IMVCUnitOfWork<
destructor Destroy; override;
end;
+ TMVCActiveRecord = class(TMVCActiveRecordFireDAC)
+ end;
+
TMVCActiveRecordBackEnd = record
public
const
@@ -1119,20 +958,13 @@ implementation
gTableMap: IMVCActiveRecordTableMap;
gTableMapLock: TObject;
-{$IFDEF USE_FIREDAC}
function GetBackEndByConnection(aConnection: TFDConnection): string;
begin
if not aConnection.Connected then
-{$ENDIF}
-{$IFDEF USE_UNIDAC}
-function GetBackEndByConnection(aConnection: TUniConnection): string;
-begin
- if not aConnection.Connected then
-{$ENDIF}
begin
aConnection.Connected := True; {required to know the backend}
end;
- {$IFDEF USE_FIREDAC}
+
case Ord(aConnection.RDBMSKind) of
0:
Exit(TMVCActiveRecordBackEnd.Unknown);
@@ -1173,10 +1005,6 @@ function GetBackEndByConnection(aConnection: TUniConnection): string;
else
raise EMVCActiveRecord.Create('Unknown RDBMS Kind');
end;
- {$ENDIF}
- {$IFDEF USE_UNIDAC}
- Result := aConnection.ProviderName;
- {$ENDIF}
end;
function ActiveRecordConnectionsRegistry: IMVCActiveRecordConnections;
@@ -1221,16 +1049,9 @@ function IntToNullableInt(const Value: Integer): NullableInt32;
{ TConnectionsRepository }
-{$IFDEF USE_FIREDAC}
procedure TMVCConnectionsRepository.AddConnection(const aName: string; const aConnection: TFDConnection;
const aOwns: Boolean = false);
var
-{$ENDIF}
-{$IFDEF USE_UNIDAC}
-procedure TMVCConnectionsRepository.AddConnection(const aName: string; const aConnection: TUniConnection;
- const aOwns: Boolean = false);
-var
-{$ENDIF}
lName: string;
lConnKeyName: string;
lConnHolder: TConnHolder;
@@ -1242,12 +1063,7 @@ procedure TMVCConnectionsRepository.AddConnection(const aName: string; const aCo
if aConnection.Transaction = nil then
begin
{ needed for Delphi 10.4 Sydney+ }
- {$IFDEF USE_FIREDAC}
aConnection.TxOptions.Isolation := TFDTxIsolation.xiReadCommitted;
- {$ENDIF}
- {$IFDEF USE_UNIDAC}
- aConnection.TxOptions.Isolation := xilReadCommitted;
- {$ENDIF}
end;
fMREW.BeginWrite;
@@ -1270,42 +1086,20 @@ procedure TMVCConnectionsRepository.AddConnection(const aName: string; const aCo
end;
end;
-{$IFDEF USE_FIREDAC}
procedure TMVCConnectionsRepository.AddDefaultConnection(const aConnection: TFDConnection; const aOwns: Boolean);
begin
AddConnection('default', aConnection, aOwns);
end;
-{$ENDIF}
-
-{$IFDEF USE_UNIDAC}
-procedure TMVCConnectionsRepository.AddDefaultConnection(const aConnection: TUniConnection; const aOwns: Boolean);
-begin
- AddConnection('default', aConnection, aOwns);
-end;
-{$ENDIF}
procedure TMVCConnectionsRepository.AddConnection(const aName,
aConnectionDefName: String);
var
- {$IFDEF USE_FIREDAC}
lConn: TFDConnection;
- {$ENDIF}
- {$IFDEF USE_UNIDAC}
- lConn: TUniConnection;
- {$ENDIF}
begin
- {$IFDEF USE_FIREDAC}
lConn := TFDConnection.Create(nil);
try
lConn.ConnectionDefName := aConnectionDefName;
AddConnection(aName, lConn, True);
- {$ENDIF}
- {$IFDEF USE_UNIDAC}
- lConn := TUniConnection.Create(nil);
- try
- lConn.ConnectionName := aConnectionDefName;
- AddConnection(aName, lConn, True);
- {$ENDIF}
except
on E: Exception do
begin
@@ -1382,23 +1176,9 @@ function TMVCConnectionsRepository.GetCurrentConnectionName(
end;
end;
-{$IFDEF USE_FIREDAC}
-{$IFDEF USE_FIREDAC}
function TMVCConnectionsRepository.GetCurrent(const RaiseExceptionIfNotAvailable: Boolean): TFDConnection;
var
lName: string;
-{$ENDIF}
-{$IFDEF USE_UNIDAC}
-function TMVCConnectionsRepository.GetCurrent(const RaiseExceptionIfNotAvailable: Boolean): TUniConnection;
-var
- lName: string;
-{$ENDIF}
-{$ENDIF}
-{$IFDEF USE_UNIDAC}
-function TMVCConnectionsRepository.GetByName(const aName: string): TUniConnection;
-var
- lKeyName: string;
-{$ENDIF}
begin
{$IF not Defined(TokyoOrBetter)}
Result := nil;
@@ -1545,21 +1325,11 @@ procedure TMVCActiveRecord.EnsureConnection;
GetConnection;
end;
-{$IFDEF USE_FIREDAC}
-{$IFDEF USE_FIREDAC}
function TMVCActiveRecord.ExecNonQuery(const SQL: string; RefreshAutoGenerated: Boolean = false): int64;
var
lQry: TFDQuery;
lPar: TFDParam;
lPair: TPair;
-{$ENDIF}
-{$IFDEF USE_UNIDAC}
-function TMVCActiveRecord.ExecNonQuery(const SQL: string; RefreshAutoGenerated: Boolean = false): int64;
-var
- lQry: TUniQuery;
- lPar: TParam;
- lPair: TPair;
-{$ENDIF}
lValue: TValue;
lSQL: string;
lHandled: Boolean;
@@ -1642,94 +1412,6 @@ function TMVCActiveRecord.ExecNonQuery(const SQL: string; RefreshAutoGenerated:
lQry.Free;
end;
end;
-{$ENDIF}
-{$IFDEF USE_UNIDAC}
-function TMVCActiveRecord.ExecNonQuery(const SQL: string; RefreshAutoGenerated: Boolean = false): int64;
-var
- lQry: TUniQuery;
- lPar: TParam;
- lPair: TPair;
- lValue: TValue;
- lSQL: string;
- lHandled: Boolean;
- I: Integer;
-begin
- lQry := CreateQuery(True, True);
- try
- lQry.Connection := GetConnection;
- lSQL := SQL;
- OnBeforeExecuteSQL(lSQL);
- lQry.SQL.Text := lSQL;
-
- lHandled := false;
-
- MapObjectToParams(lQry.Params, lHandled);
- if not lHandled then
- begin
- { partitioning }
- for I := 0 to GetPartitionInfo.FieldNames.Count - 1 do
- begin
- lPar := lQry.Params.FindParam(SQLGenerator.GetParamNameForSQL(GetPartitionInfo.FieldNames[I]));
- if lPar <> nil then
- begin
- if GetPartitionInfo.FieldTypes[I] = ftInteger then
- lValue := StrToInt(GetPartitionInfo.FieldValues[I])
- else
- lValue := GetPartitionInfo.FieldValues[I];
- MapTValueToParam(lValue, lPar);
- end
- end;
- { end-partitioning }
-
- for lPair in fTableMap.fMap do
- begin
- 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.DataType := ftUnknown; //fTableMap.fMap.GetInfoByFieldName(lPair.Value.FieldName).DataTypeName;
- MapTValueToParam(lValue, lPar);
- end
- end;
-
- // Check if it's the primary key
- lPar := lQry.Params.FindParam(SQLGenerator.GetParamNameForSQL(fTableMap.fPrimaryKeyFieldName));
- if lPar <> nil then
- begin
- if lPar.DataType = ftUnknown then
- begin
- lPar.DataType := GetPrimaryKeyFieldType;
- end;
- MapTValueToParam(fTableMap.fPrimaryKey.GetValue(Self), lPar);
- end;
- end;
-
- if RefreshAutoGenerated and (TMVCActiveRecordFieldOption.foAutoGenerated in fTableMap.fPrimaryKeyOptions) and
- fTableMap.fPrimaryKeySequenceName.IsEmpty then
- begin
- lValue := fTableMap.fPrimaryKey.GetValue(Self);
- lQry.Open;
-
- if (lValue.Kind = tkRecord) then
- begin
- MapDataSetFieldToNullableRTTIField(lValue, lQry.Fields[0], fTableMap.fPrimaryKey, Self);
- end
- else
- begin
- lValue := lQry.FieldByName(fTableMap.fPrimaryKeyFieldName).AsInteger;
- fTableMap.fPrimaryKey.SetValue(Self, lValue);
- end;
- end
- else
- begin
- lQry.ExecSQL;
- end;
- Result := lQry.RowsAffected;
- finally
- lQry.Free;
- end;
-end;
-{$ENDIF}
class function TMVCActiveRecord.ExecQuery(const SQL: string; const Values: array of Variant;
const Connection: TFDConnection; const Unidirectional: Boolean;
@@ -2577,7 +2259,6 @@ class function TMVCActiveRecordHelper.TryGetRQLQuery(
end;
end;
-{$IFDEF USE_FIREDAC}
class function TMVCActiveRecord.CurrentConnection: TFDConnection;
begin
Result := ActiveRecordConnectionsRegistry.GetCurrent;
@@ -2596,27 +2277,6 @@ class function TMVCActiveRecord.GetConnectionByName(const ConnectionName: String
begin
Result := ActiveRecordConnectionsRegistry.GetByName(ConnectionName);
end;
-{$ENDIF}
-{$IFDEF USE_UNIDAC}
-class function TMVCActiveRecord.CurrentConnection: TUniConnection;
-begin
- Result := ActiveRecordConnectionsRegistry.GetCurrent;
-end;
-
-function TMVCActiveRecord.GetConnection: TUniConnection;
-begin
- if fConn = nil then
- begin
- fConn := ActiveRecordConnectionsRegistry.GetCurrent;
- end;
- Result := fConn;
-end;
-
-class function TMVCActiveRecord.GetConnectionByName(const ConnectionName: String): TUniConnection;
-begin
- Result := ActiveRecordConnectionsRegistry.GetByName(ConnectionName);
-end;
-{$ENDIF}
function TMVCActiveRecord.GetCustomTableName: String;
begin
@@ -2684,29 +2344,14 @@ procedure TMVCActiveRecord.MapDatasetToObject(const DataSet: TDataSet; const Opt
// do nothing
end;
-{$IFDEF USE_FIREDAC}
procedure TMVCActiveRecord.MapObjectToParams(const Params: TFDParams; var Handled: Boolean);
begin
// do nothing
end;
-{$ENDIF}
-{$IFDEF USE_UNIDAC}
-procedure TMVCActiveRecord.MapObjectToParams(const Params: TParams; var Handled: Boolean);
-begin
- // do nothing
-end;
-{$ENDIF}
-{$IFDEF USE_FIREDAC}
function TMVCActiveRecord.MapNullableTValueToParam(aValue: TValue; const aParam: TFDParam): Boolean;
var
lNullableType: TNullableType;
-{$ENDIF}
-{$IFDEF USE_UNIDAC}
-function TMVCActiveRecord.MapNullableTValueToParam(aValue: TValue; const aParam: TParam): Boolean;
-var
- lNullableType: TNullableType;
-{$ENDIF}
begin
Assert(aValue.Kind = tkRecord);
Result := True;
@@ -2931,16 +2576,9 @@ function TMVCActiveRecord.MapNullableTValueToParam(aValue: TValue; const aParam:
MapTValueToParam(aValue, aParam);
end;
-{$IFDEF USE_FIREDAC}
procedure TMVCActiveRecord.MapTValueToParam(aValue: TValue; const aParam: TFDParam);
const
MAX_STRING_PARAM_LENGTH = 1000; { Arbitrary value }
-{$ENDIF}
-{$IFDEF USE_UNIDAC}
-procedure TMVCActiveRecord.MapTValueToParam(aValue: TValue; const aParam: TParam);
-const
- MAX_STRING_PARAM_LENGTH = 1000; { Arbitrary value }
-{$ENDIF}
var
lStream: TStream;
lName: string;
@@ -4640,7 +4278,6 @@ procedure EMVCActiveRecordNotFound.AfterConstruction;
FHTTPStatusCode := http_status.NotFound;
end;
-{$IFDEF USE_FIREDAC}
class function TMVCActiveRecord.ExecQuery(
const SQL: string;
const Values: array of Variant;
@@ -4679,60 +4316,11 @@ class function TMVCActiveRecord.ExecQuery(
raise;
end;
end;
-{$ENDIF}
-{$IFDEF USE_UNIDAC}
-class function TMVCActiveRecord.ExecQuery(
- const SQL: string;
- const Values: array of Variant;
- const ValueTypes: array of TFieldType;
- const Connection: TUniConnection;
- const Unidirectional: Boolean;
- const DirectExecute: Boolean): TDataSet;
-var
- lQry: TUniQuery;
- lSQL: string;
- I: Integer;
-begin
- lQry := CreateQuery(Unidirectional, DirectExecute);
- try
- lSQL := SQL;
- OnBeforeExecuteQuerySQL(lSQL);
-
- if Connection = nil then
- begin
- lQry.Connection := ActiveRecordConnectionsRegistry.GetCurrent;
- end
- else
- begin
- lQry.Connection := Connection;
- end;
- lQry.SQL.Text := lSQL;
- for I := 0 to High(Values) do
- begin
- lQry.Params[I].Value := Values[I];
- if I < Length(ValueTypes) then
- begin
- lQry.Params[I].DataType := ValueTypes[I];
- end;
- end;
- lQry.Open;
- Result := lQry;
- except
- lQry.Free;
- raise;
- end;
-end;
-{$ENDIF}
class function TMVCActiveRecord.ExecQuery(const SQL: string; const Values: array of Variant;
const ValueTypes: array of TFieldType; const Unidirectional: Boolean; const DirectExecute: Boolean): TDataSet;
begin
- {$IFDEF USE_FIREDAC}
Result := ExecQuery(SQL, Values, ValueTypes, nil, Unidirectional, DirectExecute);
- {$ENDIF}
- {$IFDEF USE_UNIDAC}
- Result := ExecQuery(SQL, Values, ValueTypes, nil, Unidirectional, DirectExecute);
- {$ENDIF}
end;
{ TFieldsMap }
@@ -4856,7 +4444,7 @@ destructor TMVCUnitOfWork.Destroy;
inherited;
end;
-procedure TMVCUnitOfWork.DoItemApplyAction(const Obj: TMVCActiveRecord; const EntityAction: TMVCEntityAction;
+procedure TMVCUnitOfWork.DoItemApplyAction(const Obj: TMVCActiveRecordFireDAC; const EntityAction: TMVCEntityAction;
const ItemApplyAction: TMVCItemApplyAction; var Handled: Boolean);
begin
if Assigned(ItemApplyAction) then
@@ -5269,7 +4857,6 @@ constructor TMVCActiveRecord.Create;
Create(True);
end;
-{$IFDEF USE_FIREDAC}
class function TMVCActiveRecord.CreateQuery(const Unidirectional, DirectExecute: Boolean): TFDQuery;
begin
Result := TFDQuery.Create(nil);
@@ -5279,16 +4866,6 @@ class function TMVCActiveRecord.CreateQuery(const Unidirectional, DirectExecute:
Result.UpdateOptions.RequestLive := False;
Result.ResourceOptions.DirectExecute := DirectExecute; //2023-07-12
end;
-{$ENDIF}
-
-{$IFDEF USE_UNIDAC}
-class function TMVCActiveRecord.CreateQuery(const Unidirectional, DirectExecute: Boolean): TUniQuery;
-begin
- Result := TUniQuery.Create(nil);
- Result.Unidirectional := Unidirectional;
- Result.Options.DirectExecute := DirectExecute;
-end;
-{$ENDIF}
{ TMVCTransactionContext }
@@ -5341,20 +4918,11 @@ constructor EMVCActiveRecordValidationError.Create(const PropertyName, Validatio
fPropertyName := PropertyName;
end;
-{$IFDEF USE_FIREDAC}
constructor TMVCActiveRecord.Create(const Connection: TFDConnection);
begin
Create(True);
fConn := Connection;
end;
-{$ENDIF}
-{$IFDEF USE_UNIDAC}
-constructor TMVCActiveRecord.Create(const Connection: TUniConnection);
-begin
- Create(True);
- fConn := Connection;
-end;
-{$ENDIF}
class function TMVCActiveRecordHelper.LoadFromDataSet(const DataSet: TDataSet;
const Options: TMVCActiveRecordLoadOptions): TObjectList;
From 4be251f5732f49a71fb8fa0c19177b257ae00b03 Mon Sep 17 00:00:00 2001
From: "google-labs-jules[bot]"
<161369871+google-labs-jules[bot]@users.noreply.github.com>
Date: Thu, 11 Sep 2025 17:37:08 +0000
Subject: [PATCH 05/12] fix: Correct ActiveRecord refactoring and fix
compilation errors
This commit fixes the issues identified in the previous code review and compilation attempt.
The main changes are:
- Completed the refactoring of `MVCFramework.ActiveRecord.pas`. The unit now has a clean separation between the generic `TMVCActiveRecordBase` and the FireDAC-specific implementation, which is wrapped in `{$IFDEF USE_FIREDAC}`.
- Corrected all generic constraints (e.g., for `TMVCUnitOfWork`) to use `TMVCActiveRecordBase`, making them DAC-agnostic.
- Removed duplicated type declarations and fixed other syntax errors that were causing compilation to fail.
---
sources/MVCFramework.ActiveRecord.pas | 1476 ++++++-------------------
1 file changed, 342 insertions(+), 1134 deletions(-)
diff --git a/sources/MVCFramework.ActiveRecord.pas b/sources/MVCFramework.ActiveRecord.pas
index f574c21c6..b455ce036 100644
--- a/sources/MVCFramework.ActiveRecord.pas
+++ b/sources/MVCFramework.ActiveRecord.pas
@@ -42,11 +42,6 @@ interface
FireDAC.Stan.Pool,
FireDAC.Stan.Async,
FireDAC.Stan.Param,
-{$ENDIF}
-{$IFDEF USE_UNIDAC}
- Uni,
- DBAccess,
- MemDS,
{$ENDIF}
MVCFramework,
MVCFramework.Commons,
@@ -98,7 +93,7 @@ TMVCTransactionContext = record
fConnection: TFDConnection;
{$ENDIF}
{$IFDEF USE_UNIDAC}
- fConnection: TUniConnection;
+ fConnection: TObject; //TUniConnection;
{$ENDIF}
public
class operator Finalize(var Dest: TMVCTransactionContext);
@@ -108,39 +103,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;
@@ -319,7 +290,7 @@ TMVCTableMap = class
function VersionValueAsInt64For(AR: TMVCActiveRecordBase): Int64; //inline;
end;
- TMVCActiveRecordBase = class
+ TMVCActiveRecordBase = class abstract
private
fChildren: TObjectList;
fSQLGenerator: TMVCSQLGenerator;
@@ -420,50 +391,7 @@ TMVCActiveRecordBase = class
class function GetScalar(const SQL: string; const Params: array of Variant): Variant;
end;
- TMVCActiveRecord = class(TMVCActiveRecordBase)
- private
- fConn: TFDConnection;
- function MapNullableTValueToParam(aValue: TValue; const aParam: TFDParam): Boolean;
- protected
- function GetConnection: TFDConnection;
- procedure MapTValueToParam(aValue: TValue; const aParam: TFDParam); virtual;
- class function CreateQuery(const Unidirectional, DirectExecute: Boolean): TFDQuery;
- class function ExecQuery(
- const SQL: string;
- const Values: array of Variant;
- const Unidirectional: Boolean;
- const DirectExecute: Boolean): TDataSet; overload;
- class function ExecQuery(
- const SQL: string;
- const Values: array of Variant;
- const Connection: TFDConnection;
- const Unidirectional: Boolean;
- const DirectExecute: Boolean)
- : TDataSet; overload;
- class function ExecQuery(
- const SQL: string;
- const Values: array of Variant;
- const ValueTypes: array of TFieldType;
- const Unidirectional: Boolean;
- const DirectExecute: Boolean)
- : TDataSet; overload;
- class function ExecQuery(
- const SQL: string;
- const Values: array of Variant;
- const ValueTypes: array of TFieldType;
- const Connection: TFDConnection;
- const Unidirectional: Boolean;
- const DirectExecute: Boolean): TDataSet; overload;
- procedure MapObjectToParams(const Params: TFDParams; var Handled: Boolean); virtual;
- public
- constructor Create(const Connection: TFDConnection); overload;
- class function CurrentConnection: TFDConnection;
- class function GetConnectionByName(const ConnectionName: String): TFDConnection;
- end;
-
- TMVCActiveRecordClass = class of TMVCActiveRecord;
-
- IMVCUnitOfWork = interface
+ IMVCUnitOfWork = interface
['{68B55DD3-57F6-4CC0-A4DE-BFDE7C3AA287}']
procedure RegisterDelete(const Value: T); overload;
procedure RegisterDelete(const Enumerable: TEnumerable); overload;
@@ -474,93 +402,94 @@ TMVCActiveRecordClass = class of TMVCActiveRecord;
procedure UnregisterInsert(const Value: T);
end;
- TMVCItemApplyAction = reference to procedure(const Obj: T;
+ TMVCItemApplyAction = reference to procedure(const Obj: T;
const EntityAction: TMVCEntityAction; var Handled: Boolean);
TMergeModeItem = (mmInsert, mmUpdate, mmDelete);
TMergeMode = set of TMergeModeItem;
- IMVCMultiExecutor = interface
+ IMVCMultiExecutor = interface
['{C815246B-19CA-4F6C-AA67-8E491F809340}']
procedure Apply(const ItemApplyAction: TMVCItemApplyAction = nil);
end;
- TMVCActiveRecordHelper = class helper for TMVCActiveRecord
+ TMVCActiveRecordHelper = class helper for TMVCActiveRecordBase
{ GetByPK }
- class function GetByPK(const aClass: TMVCActiveRecordClass; const aValue: Int64;
- const RaiseExceptionIfNotFound: Boolean = True): TMVCActiveRecord; overload;
- class function GetByPK(const aClass: TMVCActiveRecordClass; const aValue: string;
- const RaiseExceptionIfNotFound: Boolean = True): TMVCActiveRecord; overload;
- class function GetByPK(const aClass: TMVCActiveRecordClass; const aValue: TGuid;
- const RaiseExceptionIfNotFound: Boolean = True): TMVCActiveRecord; overload;
- class function GetByPK(const aValue: string; const aFieldType: TFieldType;
+ class function GetByPK(const aClass: TMVCActiveRecordBaseClass; const aValue: Int64;
+ const RaiseExceptionIfNotFound: Boolean = True): TMVCActiveRecordBase; overload;
+ class function GetByPK(const aClass: TMVCActiveRecordBaseClass; const aValue: string;
+ const RaiseExceptionIfNotFound: Boolean = True): TMVCActiveRecordBase; overload;
+ class function GetByPK(const aClass: TMVCActiveRecordBaseClass; const aValue: TGuid;
+ const RaiseExceptionIfNotFound: Boolean = True): TMVCActiveRecordBase; overload;
+ class function GetByPK(const aValue: string; const aFieldType: TFieldType;
const RaiseExceptionIfNotFound: Boolean): T; overload;
- class function GetByPK(const aValue: Int64;
+ class function GetByPK(const aValue: Int64;
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
- class function GetByPK(const aValue: string;
+ class function GetByPK(const aValue: string;
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
- class function GetByPK(const aValue: TGuid;
+ class function GetByPK(const aValue: TGuid;
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
{ Select }
- class function Select(const SQL: string;
+ class function Select(const SQL: string;
const Params: array of Variant;
const Options: TMVCActiveRecordLoadOptions = []): TObjectList