Daniele Teti 2023-08-08 14:31:23 +02:00
parent 4a27f8b64d
commit c201c916cb
4 changed files with 403 additions and 275 deletions

View File

@ -245,6 +245,8 @@ Congratulations to Daniele Teti and all the staff for the excellent work!" -- Ma
- ⚡ Wizard updated to be dotEnv aware
- ⚡ Added "Load Style" methods to `TMVCActiveRecord` as suggested by https://github.com/danieleteti/delphimvcframework/issues/675
- ⚡ Better error message in case of serialization of `TArray<TObject>`
- ⚡ Improved serialization of `TObjectList<TDataSet>` (however `ObjectDict` is still the preferred way to serialize multiple datasets).

View File

@ -2,62 +2,49 @@ object MainForm: TMainForm
Left = 0
Top = 0
Caption = 'TMVCActiveRecord - ShowCase'
ClientHeight = 1423
ClientWidth = 2760
ClientHeight = 569
ClientWidth = 1104
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -28
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 240
DesignSize = (
2760
1423)
TextHeight = 34
1104
569)
TextHeight = 13
object btnCRUD: TButton
Left = 20
Top = 20
Width = 303
Height = 83
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 8
Top = 8
Width = 121
Height = 33
Caption = 'CRUD'
TabOrder = 0
OnClick = btnCRUDClick
end
object btnSelect: TButton
Left = 20
Top = 605
Width = 303
Height = 83
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 8
Top = 242
Width = 121
Height = 33
Caption = 'Queries'
TabOrder = 1
OnClick = btnSelectClick
end
object Memo1: TMemo
Left = 700
Top = 20
Width = 2040
Height = 1383
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 280
Top = 8
Width = 816
Height = 553
Anchors = [akLeft, akTop, akRight, akBottom]
Ctl3D = True
DoubleBuffered = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -33
Font.Height = -13
Font.Name = 'Consolas'
Font.Style = []
ParentCtl3D = False
@ -68,306 +55,214 @@ object MainForm: TMainForm
TabOrder = 2
WantReturns = False
WordWrap = False
ExplicitWidth = 2020
ExplicitHeight = 1381
ExplicitWidth = 812
ExplicitHeight = 552
end
object btnRelations: TButton
Left = 20
Top = 703
Width = 303
Height = 87
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 8
Top = 281
Width = 121
Height = 35
Caption = 'Relations'
TabOrder = 3
OnClick = btnRelationsClick
end
object btnInheritance: TButton
Left = 20
Top = 805
Width = 303
Height = 85
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 8
Top = 322
Width = 121
Height = 34
Caption = 'Inheritance'
TabOrder = 4
OnClick = btnInheritanceClick
end
object btnValidation: TButton
Left = 20
Top = 905
Width = 303
Height = 85
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 8
Top = 362
Width = 121
Height = 34
Caption = 'Validation'
TabOrder = 5
OnClick = btnValidationClick
end
object btnMultiThreading: TButton
Left = 360
Top = 20
Width = 303
Height = 83
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 144
Top = 8
Width = 121
Height = 33
Caption = 'Multi Threading'
TabOrder = 6
OnClick = btnMultiThreadingClick
end
object btnRQL: TButton
Left = 20
Top = 1005
Width = 303
Height = 85
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 8
Top = 402
Width = 121
Height = 34
Caption = 'RQL Query'
TabOrder = 7
OnClick = btnRQLClick
end
object btnReadOnlyFields: TButton
Left = 20
Top = 508
Width = 303
Height = 82
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 8
Top = 203
Width = 121
Height = 33
Caption = 'CRUD With R/O Field'
TabOrder = 8
OnClick = btnReadOnlyFieldsClick
end
object btnNullTest: TButton
Left = 360
Top = 118
Width = 303
Height = 82
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 144
Top = 47
Width = 121
Height = 33
Caption = 'Nullables'
TabOrder = 9
OnClick = btnNullTestClick
end
object btnCRUDNoAutoInc: TButton
Left = 20
Top = 215
Width = 303
Height = 83
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 8
Top = 86
Width = 121
Height = 33
Caption = 'CRUD (no autoinc)'
TabOrder = 10
OnClick = btnCRUDNoAutoIncClick
end
object btnCRUDWithStringPKs: TButton
Left = 20
Top = 313
Width = 303
Height = 82
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 8
Top = 125
Width = 121
Height = 33
Caption = 'CRUD (string pks)'
TabOrder = 11
OnClick = btnCRUDWithStringPKsClick
end
object btnWithSpaces: TButton
Left = 20
Top = 410
Width = 303
Height = 83
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 8
Top = 164
Width = 121
Height = 33
Caption = 'CRUD (entity with spaces)'
TabOrder = 12
WordWrap = True
OnClick = btnWithSpacesClick
end
object btnCountWithRQL: TButton
Left = 360
Top = 215
Width = 303
Height = 83
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 144
Top = 86
Width = 121
Height = 33
Caption = 'Count with RQL'
TabOrder = 13
OnClick = btnCountWithRQLClick
end
object btnReadAndWriteOnly: TButton
Left = 360
Top = 313
Width = 303
Height = 82
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 144
Top = 125
Width = 121
Height = 33
Caption = 'R/O, R/W'
TabOrder = 14
OnClick = btnReadAndWriteOnlyClick
end
object btnClientGeneratedPK: TButton
Left = 360
Top = 410
Width = 303
Height = 83
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 144
Top = 164
Width = 121
Height = 33
Caption = 'Client Generated PKs'
TabOrder = 15
OnClick = btnClientGeneratedPKClick
end
object btnAttributes: TButton
Left = 360
Top = 508
Width = 303
Height = 82
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 144
Top = 203
Width = 121
Height = 33
Caption = 'Attributes'
TabOrder = 16
OnClick = btnAttributesClick
end
object btnJSON_XML_Types: TButton
Left = 360
Top = 605
Width = 303
Height = 88
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 144
Top = 242
Width = 121
Height = 35
Caption = 'JSON && XML'
TabOrder = 17
OnClick = btnJSON_XML_TypesClick
end
object btnMerge: TButton
Left = 360
Top = 708
Width = 303
Height = 85
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 144
Top = 283
Width = 121
Height = 34
Caption = 'Merge'
TabOrder = 18
OnClick = btnMergeClick
end
object btnTableFilter: TButton
Left = 360
Top = 808
Width = 303
Height = 85
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 144
Top = 323
Width = 121
Height = 34
Caption = 'Table Filter'
TabOrder = 19
OnClick = btnTableFilterClick
end
object btnPartitioning: TButton
Left = 360
Top = 908
Width = 303
Height = 82
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 144
Top = 363
Width = 121
Height = 33
Caption = 'Table Partitioning'
TabOrder = 20
OnClick = btnPartitioningClick
end
object btnCRUDWithGUID: TButton
Left = 20
Top = 118
Width = 303
Height = 82
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 8
Top = 47
Width = 121
Height = 33
Caption = 'CRUD (with GUID PK)'
TabOrder = 21
OnClick = btnCRUDWithGUIDClick
end
object btnOOP: TButton
Left = 360
Top = 1005
Width = 303
Height = 85
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
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 = 20
Top = 1105
Width = 303
Height = 85
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 8
Top = 442
Width = 121
Height = 34
Caption = 'Read/Only Entities'
TabOrder = 23
OnClick = btnReadOnlyClick
end
object btnSpeed: TButton
Left = 20
Top = 1205
Width = 303
Height = 85
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 8
Top = 482
Width = 121
Height = 34
Caption = 'Metadata Speed Test'
TabOrder = 24
OnClick = btnSpeedClick
end
object btnRefresh: TButton
Left = 360
Top = 1105
Width = 303
Height = 85
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Left = 144
Top = 442
Width = 121
Height = 34
Caption = 'Manual Refresh'
TabOrder = 25
OnClick = btnRefreshClick

View File

@ -1040,6 +1040,7 @@ var
lItem: TMVCActiveRecord;
lCustomer: TCustomer;
lCustList: TObjectList<TCustomer>;
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")))';
@ -1133,6 +1134,114 @@ begin
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<TCustomer>.Create;
try
lRecCount := TMVCActiveRecord.SelectRQL<TCustomer>(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) - <empty> 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) - <empty> 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) - <empty> 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) - <empty> 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) - <empty> 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);

View File

@ -333,7 +333,9 @@ type
function InternalCount(const RQL: string): int64;
function InternalSelectRQL(const RQL: string; const MaxRecordCount: Integer)
: TMVCActiveRecordList;
: TMVCActiveRecordList; overload;
function InternalSelectRQL(const RQL: string; const MaxRecordCount: Integer;
const OutList: TMVCActiveRecordList): UInt32; overload;
public
constructor Create(aLazyLoadConnection: Boolean); overload;
{ cannot be virtual! }
@ -392,18 +394,33 @@ type
class function Select(const aClass: TMVCActiveRecordClass; const SQL: string;
const Params: array of Variant;
const Connection: TFDConnection): TMVCActiveRecordList; overload;
class function Select(const aClass: TMVCActiveRecordClass; const SQL: string;
const Params: array of Variant;
const Connection: TFDConnection; const OutList: TMVCActiveRecordList): UInt32; overload;
class function SelectRQL(const aClass: TMVCActiveRecordClass; const RQL: string;
const MaxRecordCount: Integer)
: TMVCActiveRecordList; overload;
class function SelectRQL(const aClass: TMVCActiveRecordClass; const RQL: string;
const MaxRecordCount: Integer; const OutList: TMVCActiveRecordList): UInt32; overload;
class function DeleteRQL(const aClass: TMVCActiveRecordClass; const RQL: string): int64;
function SelectRQL(const RQL: string; const MaxRecordCount: Integer)
: TMVCActiveRecordList; overload;
class function Where(const aClass: TMVCActiveRecordClass; const SQLWhere: string;
class function Where(
const aClass: TMVCActiveRecordClass;
const SQLWhere: string;
const Params: array of Variant)
: TMVCActiveRecordList; overload;
class function Where(const aClass: TMVCActiveRecordClass; const SQLWhere: string;
class function Where(
const aClass: TMVCActiveRecordClass;
const SQLWhere: string;
const Params: array of Variant;
const Connection: TFDConnection): TMVCActiveRecordList; overload;
class function Where(
const aClass: TMVCActiveRecordClass;
const SQLWhere: string;
const Params: array of Variant;
const Connection: TFDConnection;
const OutList: TMVCActiveRecordList): UInt32; overload;
class function All(const aClass: TMVCActiveRecordClass): TObjectList<TMVCActiveRecord>;
overload;
class function DeleteAll(const aClass: TMVCActiveRecordClass): int64; overload;
@ -451,13 +468,27 @@ type
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
class function GetByPK<T: TMVCActiveRecord, constructor>(const aValue: TGuid;
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
/// <summary>
/// Returns a TObjectList<TMVCActiveRecord> from a SQL using variant params
/// </summary>
class function Select<T: TMVCActiveRecord, constructor>(const SQL: string;
const Params: array of Variant;
const Options: TMVCActiveRecordLoadOptions = []): TObjectList<T>; overload;
/// <summary>
/// Returns a TObjectList<TMVCActiveRecord> from a SQL using typed params
/// </summary>
class function Select<T: TMVCActiveRecord, constructor>(const SQL: string;
const Params: array of Variant;
const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions = [])
: TObjectList<T>; overload;
/// <summary>
/// Fills a TObjectList<TMVCActiveRecord> 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)
/// </summary>
class function Select<T: TMVCActiveRecord, constructor>(const SQL: string; const Params: array of Variant;
const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions;
const OutList: TObjectList<T>): UInt32; overload;
class function SelectOne<T: TMVCActiveRecord, constructor>(const SQL: string;
const Params: array of Variant;
const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions = [];
@ -468,6 +499,8 @@ type
class function SelectRQL<T: constructor, TMVCActiveRecord>(const RQL: string;
const MaxRecordCount: Integer)
: TObjectList<T>; overload;
class function SelectRQL<T: constructor, TMVCActiveRecord>(const RQL: string;
const MaxRecordCount: Integer; const OutList: TObjectList<T>): UInt32; overload;
class function SelectOneByRQL<T: constructor, TMVCActiveRecord>(const RQL: string;
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
class function All<T: TMVCActiveRecord, constructor>: TObjectList<T>; overload;
@ -483,6 +516,10 @@ type
class function Where<T: TMVCActiveRecord, constructor>(const SQLWhere: string;
const Params: array of Variant;
const ParamTypes: array of TFieldType): TObjectList<T>; overload;
class function Where<T: TMVCActiveRecord, constructor>(const SQLWhere: string;
const Params: array of Variant;
const ParamTypes: array of TFieldType;
const OutList: TObjectList<T>): UInt32; overload;
class function GetOneByWhere<T: TMVCActiveRecord, constructor>(const SQLWhere: string;
const Params: array of Variant; const RaiseExceptionIfNotFound: Boolean = True): T; overload;
class function GetOneByWhere<T: TMVCActiveRecord, constructor>(const SQLWhere: string;
@ -1419,6 +1456,16 @@ begin
Result := GetScalar(lSQL, []);
end;
function TMVCActiveRecord.InternalSelectRQL(const RQL: string;
const MaxRecordCount: Integer; const OutList: TMVCActiveRecordList): UInt32;
var
lSQL: string;
begin
lSQL := SQLGenerator.CreateSQLWhereByRQL(RQL, GetMapping, True, false, MaxRecordCount);
LogD(Format('RQL [%s] => SQL [%s]', [RQL, lSQL]));
Result := Where(TMVCActiveRecordClass(Self.ClassType), lSQL, [], nil, OutList);
end;
function TMVCActiveRecord.InternalSelectRQL(const RQL: string; const MaxRecordCount: Integer): TMVCActiveRecordList;
var
lSQL: string;
@ -1657,6 +1704,52 @@ begin
end;
end;
class function TMVCActiveRecordHelper.SelectRQL<T>(const RQL: string;
const MaxRecordCount: Integer; const OutList: TObjectList<T>): UInt32;
var
lAR: TMVCActiveRecord;
lSQL: string;
begin
lAR := T.Create;
try
lSQL := lAR.SQLGenerator.CreateSQLWhereByRQL(RQL, lAR.GetMapping, MaxRecordCount > -1, false, MaxRecordCount).Trim;
lSQL := TMVCSQLGenerator.RemoveInitialWhereKeyword(lSQL);
Result := Where<T>(lSQL, [], [], OutList);
finally
lAR.Free;
end;
end;
class function TMVCActiveRecordHelper.Where<T>(const SQLWhere: string;
const Params: array of Variant; const ParamTypes: array of TFieldType;
const OutList: TObjectList<T>): UInt32;
var
lAR: TMVCActiveRecord;
lFilter: string;
begin
lAR := T.Create;
try
lFilter := lAR.SQLGenerator.GetDefaultSQLFilter(True);
if SQLWhere.Trim.IsEmpty() or SQLWhere.Trim.StartsWith('/*limit*/') or SQLWhere.Trim.StartsWith('/*sort*/') then
begin
Result := Select<T>(lAR.GenerateSelectSQL + lFilter + SQLWhere, Params, ParamTypes, [], OutList);
end
else
begin
if lFilter.IsEmpty then
begin
Result := Select<T>(lAR.GenerateSelectSQL + ' WHERE ' + SQLWhere, Params, ParamTypes, [], OutList);
end
else
begin
Result := Select<T>(lAR.GenerateSelectSQL + lFilter + ' AND ' + SQLWhere, Params, ParamTypes, [], OutList);
end;
end;
finally
lAR.Free;
end;
end;
function TMVCActiveRecord.GetPartitionInfo: TPartitionInfo;
var
lRQLCompilerClass: TRQLCompilerClass;
@ -2454,29 +2547,14 @@ end;
class function TMVCActiveRecord.Select(const aClass: TMVCActiveRecordClass; const SQL: string;
const Params: array of Variant; const Connection: TFDConnection): TMVCActiveRecordList;
var
lDataSet: TDataSet;
lAR: TMVCActiveRecord;
begin
Result := TMVCActiveRecordList.Create;
try
lDataSet := ExecQuery(SQL, Params, Connection, True, False);
try
while not lDataSet.Eof do
begin
lAR := aClass.Create;
Result.Add(lAR);
lAR.LoadByDataset(lDataSet);
lDataSet.Next;
end;
finally
lDataSet.Free;
end;
Select(aClass, SQL, Params, Connection, Result);
except
Result.Free;
raise;
end;
end;
class function TMVCActiveRecord.SelectDataSet(const SQL: string; const Params: array of Variant;
@ -2502,6 +2580,41 @@ begin
Result := InternalSelectRQL(RQL, MaxRecordCount);
end;
class function TMVCActiveRecord.SelectRQL(const aClass: TMVCActiveRecordClass;
const RQL: string; const MaxRecordCount: Integer;
const OutList: TMVCActiveRecordList): UInt32;
var
lAR: TMVCActiveRecord;
begin
lAR := aClass.Create(True);
try
Result := lAR.InternalSelectRQL(RQL, MaxRecordCount, OutList);
finally
lAR.Free;
end;
end;
class function TMVCActiveRecordHelper.Select<T>(const SQL: string; const Params: array of Variant;
const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions; const OutList: TObjectList<T>): UInt32;
var
lDataSet: TDataSet;
lAR: TMVCActiveRecord;
begin
lDataSet := ExecQuery(SQL, Params, ParamTypes, True, False);
try
while not lDataSet.Eof do
begin
lAR := T.Create;
OutList.Add(lAR);
lAR.LoadByDataset(lDataSet, Options);
lDataSet.Next;
end;
Result := OutList.Count;
finally
lDataSet.Free;
end;
end;
class function TMVCActiveRecordHelper.Select<T>(const SQL: string; const Params: array of Variant;
const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions): TObjectList<T>;
var
@ -2511,18 +2624,7 @@ var
begin
Result := TObjectList<T>.Create(True);
try
lDataSet := ExecQuery(SQL, Params, ParamTypes, True, False);
try
while not lDataSet.Eof do
begin
lAR := T.Create;
Result.Add(lAR);
lAR.LoadByDataset(lDataSet, Options);
lDataSet.Next;
end;
finally
lDataSet.Free;
end;
Select<T>(SQL, Params, ParamTypes, Options, Result);
except
Result.Free;
raise;
@ -2581,28 +2683,13 @@ end;
class function TMVCActiveRecordHelper.Where<T>(const SQLWhere: string; const Params: array of Variant;
const ParamTypes: array of TFieldType): TObjectList<T>;
var
lAR: TMVCActiveRecord;
lFilter: string;
begin
lAR := T.Create;
Result := TObjectList<T>.Create(True);
try
lFilter := lAR.SQLGenerator.GetDefaultSQLFilter(True);
if SQLWhere.Trim.IsEmpty() or SQLWhere.Trim.StartsWith('/*limit*/') or SQLWhere.Trim.StartsWith('/*sort*/') then
begin
Result := Select<T>(lAR.GenerateSelectSQL + lFilter + SQLWhere, Params, ParamTypes)
end
else
begin
if lFilter.IsEmpty then
Result := Select<T>(lAR.GenerateSelectSQL + ' WHERE ' + SQLWhere, Params, ParamTypes)
else
begin
Result := Select<T>(lAR.GenerateSelectSQL + lFilter + ' AND ' + SQLWhere, Params, ParamTypes);
end;
end;
finally
lAR.Free;
Where<T>(SQLWhere, Params, ParamTypes, Result);
except
Result.Free;
raise;
end;
end;
@ -3000,6 +3087,20 @@ begin
OnAfterInsertOrUpdate;
end;
class function TMVCActiveRecord.Where(const aClass: TMVCActiveRecordClass;
const SQLWhere: string; const Params: array of Variant;
const Connection: TFDConnection; const OutList: TMVCActiveRecordList): UInt32;
var
lAR: TMVCActiveRecord;
begin
lAR := aClass.Create;
try
Result := Select(aClass, lAR.GenerateSelectSQL + SQLWhere, Params, Connection, OutList);
finally
lAR.Free;
end;
end;
procedure TMVCActiveRecord.AddChildren(const ChildObject: TObject);
begin
if fChildren = nil then
@ -3051,14 +3152,13 @@ end;
class function TMVCActiveRecord.Where(const aClass: TMVCActiveRecordClass; const SQLWhere: string;
const Params: array of Variant; const Connection: TFDConnection): TMVCActiveRecordList;
var
lAR: TMVCActiveRecord;
begin
lAR := aClass.Create;
Result := TMVCActiveRecordList.Create;
try
Result := Select(aClass, lAR.GenerateSelectSQL + SQLWhere, Params, Connection);
finally
lAR.Free;
Where(aClass, SQLWhere, Params, Connection, Result);
except
Result.Free;
raise;
end;
end;
@ -4063,6 +4163,28 @@ begin
inherited;
end;
class function TMVCActiveRecord.Select(const aClass: TMVCActiveRecordClass;
const SQL: string; const Params: array of Variant;
const Connection: TFDConnection; const OutList: TMVCActiveRecordList): UInt32;
var
lDataSet: TDataSet;
lAR: TMVCActiveRecord;
begin
lDataSet := ExecQuery(SQL, Params, Connection, True, False);
try
while not lDataSet.Eof do
begin
lAR := aClass.Create;
OutList.Add(lAR);
lAR.LoadByDataset(lDataSet);
lDataSet.Next;
end;
Result := OutList.Count;
finally
lDataSet.Free;
end;
end;
initialization
gConnectionsLock := TObject.Create;