USER
create an new function with the same idea of the procedure TQryRecInfo.Fetch logic to accommodate multiple rows:
Name it FetchAll so it will be a function that works with any TQueryRecInfo descendant and returns a TQryRecArray
Use a TQryRecArray described below as the function Result.
Iterate over all records in your query result, populating a new TQryRecInfo instance for each record.
make sure that the function can handle TQryRecInfo descendants
------------------
TQryRecArray<T: class> = class
private
FQryRecInfoList: TObjectList<T>;
FFilterSQL: string;
FDBConn: TUniConnection;
function GetCount: integer;
published
procedure Fetch(DBConn: TUniConnection; QryTxt: string);
procedure ClearFilter;
procedure AddRec(ORMRecordType: TORMRecordType; NewRec: T);
procedure ReplaceRec(Rec_Origem: T; Rec_Destino: T);
procedure RemoveRec(DelRec: T);
function Rec(Index: integer): T;
property RecCount: integer read GetCount;
property DBConn: TUniConnection read FDBConn write FDBConn;
public
property SQLFilter: string read FFilterSQL write FFilterSQL;
constructor Create;
destructor Destroy; override;
end;
------------------
unit pixel_classes;
interface
uses
System.SysUtils, Rtti, TypInfo;
{$TYPEINFO ON}
type
TZString = type string;
type
TNullValue = record
end;
TNullable<T{: record}> = record
public
Value: T;
HasValue: Boolean;
class operator Implicit(const AValue: T): TNullable<T>;
class operator Implicit(const AValue: TNullable<T>): T;
class operator Implicit(const AValue: TNullValue): TNullable<T>;
class operator Explicit(const AValue: T): TNullable<T>;
// add these...
class operator Equal(const A: TNullable<T>; const B: TNullValue): Boolean;
class operator NotEqual(const A: TNullable<T>; const B: TNullValue): Boolean;
end;
var NullValue: TNullValue;
implementation
class operator TNullable<T>.Implicit(const AValue: T): TNullable<T>;
begin
Result.Value := AValue;
Result.HasValue := True;
end;
class operator TNullable<T>.Implicit(const AValue: TNullable<T>): T;
begin
if AValue.HasValue then
Result := AValue.Value
else
Result := Default(T); // or raise an exception
end;
class operator TNullable<T>.Implicit(const AValue: TNullValue): TNullable<T>;
begin
Result.Value := Default(T);
Result.HasValue := False;
end;
class operator TNullable<T>.Explicit(const AValue: T): TNullable<T>;
begin
Result.Value := AValue;
Result.HasValue := True;
end;
class operator TNullable<T>.Equal(const A: TNullable<T>; const B: TNullValue): Boolean;
begin
Result := not A.HasValue;
end;
class operator TNullable<T>.NotEqual(const A: TNullable<T>; const B: TNullValue): Boolean;
begin
Result := A.HasValue;
end;
end.
---------------------
unit orm_utils;
{$TYPEINFO ON}
interface
uses
System.Classes, System.Generics.Collections, System.Rtti, Uni, TypInfo, DB,
SysUtils, StrUtils, DateUtils, Math, pixel_classes, pixel_utils,
System.Variants, ORM_CustomAttributes;
type
EORMUtilsException = class(Exception);
TQryRecInfo = class
private
FDirtyFields: TDictionary<string, Boolean>;
FPreviousValues: TDictionary<string, TValue>;
procedure SetInfo(Index: Integer; const Value: TValue);
public
constructor Create;
destructor Destroy; override;
procedure SetInfoNullableString(Index: Integer; const Value: TNullable<string>);
procedure SetInfoNullableInteger(Index: Integer; const Value: TNullable<Integer>);
procedure SetInfoNullableInt64(Index: Integer; const Value: TNullable<Int64>);
procedure SetInfoNullableExtended(Index: Integer; const Value: TNullable<Extended>);
procedure SetInfoNullableCurrency(Index: Integer; const Value: TNullable<Currency>);
procedure SetInfoNullableDateTime(Index: Integer; const Value: TNullable<TDateTime>);
procedure SetInfoNullableBoolean(Index: Integer; const Value: TNullable<Boolean>);
procedure SetInfoNullableVariant(Index: Integer; const Value: TNullable<Variant>);
procedure SetInfoCurrency(Index: Integer; const Value: Currency);
// Methods to handle dirty fields
function IsFieldDirty(const FieldName: string): Boolean;
procedure ClearDirtyFlags;
property DirtyFields: TDictionary<string, Boolean> read FDirtyFields;
// Methods to handle previous values
function GetPreviousValue(const FieldName: string): TValue;
procedure ClearPreviousValues;
property PreviousValues: TDictionary<string, TValue> read FPreviousValues;
/// <summary>
/// Retrieves the formatted text for a given field based on the FmtProp attribute.
/// </summary>
function GetFormattedText(const FieldName: string): string;
procedure Fetch(DBConn: TUniConnection; const QryTxt: string);
end;
function FormataInfo(info: Variant; tipo: TFormatType): string;
type
TDynRec = class(TQryRecInfo)
end;
implementation
function FormataInfo(info: Variant; tipo: TFormatType): string;
begin
if VarIsNull(info) or VarIsEmpty(info) then
Exit('');
case tipo of
tiString:
Result := VarToStr(info);
tiInteger:
Result := IntToStr(Integer(info));
tiMoney:
Result := FormatFloat(FMT_MONEY, Currency(info));
tiFloat:
Result := FloatToStr(info);
tiDate:
if VarIsType(info, [varDate, varDouble]) then
begin
if VarToDateTime(info) < EncodeDate(1900, 1, 1) then
Result := ''
else
Result := FormatDateTime('dd/mm/yyyy', VarToDateTime(info));
end
else
raise EORMUtilsException.CreateFmt('FormataInfo: Cannot treat information [%s] as tiDate.', [VarToStr(info)]);
tiDateTime:
if VarIsType(info, [varDate, varDouble]) then
begin
if VarToDateTime(info) = 0 then
Result := ''
else
Result := FormatDateTime('dd/mm/yyyy hh:mm:ss', VarToDateTime(info));
end
else
raise EORMUtilsException.CreateFmt('FormataInfo: Cannot treat information [%s] as tiDateTime.', [VarToStr(info)]);
tiBoolean:
Result := IfThen(Boolean(info), 'S', 'N');
tiByteArray:
Result := ByteArrayToHex(info);
tiNone:
Result := '';
else
raise EORMUtilsException.CreateFmt('FormataInfo: Format type [%s] not recognized.', [GetEnumName(TypeInfo(TFormatType), Integer(tipo))]);
end;
end;
{ TQryRecInfo }
constructor TQryRecInfo.Create;
begin
inherited;
FDirtyFields := TDictionary<string, Boolean>.Create;
FPreviousValues := TDictionary<string, TValue>.Create;
end;
destructor TQryRecInfo.Destroy;
begin
FDirtyFields.Free;
FPreviousValues.Free;
inherited;
end;
function TQryRecInfo.GetFormattedText(const FieldName: string): string;
var
Ctx: TRttiContext;
RttiType: TRttiType;
Prop: TRttiProperty;
Field: TRttiField;
Value: TValue;
FmtType: TFormatType;
UnderlyingType: TRttiType;
HasValueField: TRttiField;
ValueField: TRttiField;
HasValue: Boolean;
ActualValue: TValue;
Attr: TCustomAttribute;
FmtAttr: FmtPropAttribute;
begin
Result := '';
Ctx := TRttiContext.Create;
try
RttiType := Ctx.GetType(Self.ClassType);
// Find the property by name
Prop := RttiType.GetProperty(FieldName);
if not Assigned(Prop) then
raise EORMUtilsException.CreateFmt('Property "%s" not found.', [FieldName]);
// Get the value of the property
Value := Prop.GetValue(Self);
FmtType := tiNone;
// Check for FmtProp attribute on the property
for Attr in Prop.GetAttributes do
begin
if Attr is FmtPropAttribute then
begin
FmtAttr := FmtPropAttribute(Attr);
FmtType := FmtAttr.FormatType;
Break;
end;
end;
// If not found on property, check on the corresponding field
if FmtType = tiNone then
begin
Field := RttiType.GetField('_' + FieldName);
if Assigned(Field) then
begin
for Attr in Field.GetAttributes do
begin
if Attr is FmtPropAttribute then
begin
FmtAttr := FmtPropAttribute(Attr);
FmtType := FmtAttr.FormatType;
Break;
end;
end;
end;
end;
// Determine default FmtType based on property type if not set by attribute
if FmtType = tiNone then
begin
UnderlyingType := Prop.PropertyType;
// Handle TNullable<T>
if UnderlyingType.TypeKind = tkRecord then
begin
ValueField := UnderlyingType.GetField('Value');
if Assigned(ValueField) then
UnderlyingType := ValueField.FieldType;
end;
case UnderlyingType.TypeKind of
tkInteger, tkInt64:
FmtType := tiInteger;
tkFloat:
if UnderlyingType.Handle = TypeInfo(TDateTime) then
FmtType := tiDateTime
else
FmtType := tiFloat;
tkString, tkLString, tkWString, tkUString:
FmtType := tiString;
tkEnumeration:
if UnderlyingType.Handle = TypeInfo(Boolean) then
FmtType := tiBoolean
else
FmtType := tiString;
tkVariant:
FmtType := tiString;
else
FmtType := tiNone;
end;
end;
// Extract actual value from TNullable<T> if necessary
if Value.Kind = tkRecord then
begin
// Assuming TNullable<T> has 'HasValue' and 'Value' fields
UnderlyingType := Prop.PropertyType;
HasValueField := UnderlyingType.GetField('HasValue');
ValueField := UnderlyingType.GetField('Value');
if Assigned(HasValueField) and Assigned(ValueField) then
begin
HasValue := HasValueField.GetValue(Value.GetReferenceToRawData).AsBoolean;
if HasValue then
begin
ActualValue := ValueField.GetValue(Value.GetReferenceToRawData);
// Format the actual value
Result := FormataInfo(ActualValue.AsVariant, FmtType);
end
else
Result := '';
end
else
begin
// Not TNullable<T>, handle value directly
if not Value.IsEmpty then
Result := FormataInfo(Value.AsVariant, FmtType)
else
Result := '';
end;
end
else
begin
// Not a record, handle value directly
if not Value.IsEmpty then
Result := FormataInfo(Value.AsVariant, FmtType)
else
Result := '';
end;
finally
// No need to free TRttiContext as it's a record
end;
end;
procedure TQryRecInfo.Fetch(DBConn: TUniConnection; const QryTxt: string);
var
qr: TUniQuery;
Ctx: TRttiContext;
ObjType: TRttiType;
Prop: TRttiProperty;
Field: TField;
NullableFieldName: string;
begin
if not Assigned(DBConn) or Trim(QryTxt).IsEmpty then
Exit;
qr := TUniQuery.Create(nil);
try
qr.Connection := DBConn;
qr.SpecificOptions.Values['FetchAll'] := 'True';
qr.SpecificOptions.Values['CreateConnection'] := 'False';
qr.SQL.Text := QryTxt;
qr.Open;
if qr.RecordCount > 0 then
begin
Ctx := TRttiContext.Create;
try
ObjType := Ctx.GetType(Self.ClassType);
for Prop in ObjType.GetProperties do
begin
if not Prop.IsWritable then
Continue;
Field := qr.FindField(Prop.Name);
if not Assigned(Field) then
Continue;
// Handle TNullable<T> types
if Prop.PropertyType.TypeKind = tkRecord then
begin
NullableFieldName := '_' + Prop.Name;
if ObjType.GetField(NullableFieldName) = nil then
Continue;
if Prop.PropertyType.Name.StartsWith('TNullable<') then
begin
// Use RTTI to determine the generic type parameter
// This requires more advanced RTTI handling or a helper method
// For simplicity, using field type names
if Prop.PropertyType.Name = 'TNullable<System.string>' then
ObjType.GetField(NullableFieldName).SetValue(Self, TValue.From<TNullable<string>>(Field.AsString))
else if Prop.PropertyType.Name = 'TNullable<System.Integer>' then
ObjType.GetField(NullableFieldName).SetValue(Self, TValue.From<TNullable<Integer>>(Field.AsInteger))
else if Prop.PropertyType.Name = 'TNullable<System.Int64>' then
ObjType.GetField(NullableFieldName).SetValue(Self, TValue.From<TNullable<Int64>>(Field.AsLargeInt))
else if Prop.PropertyType.Name = 'TNullable<System.Extended>' then
ObjType.GetField(NullableFieldName).SetValue(Self, TValue.From<TNullable<Extended>>(Field.AsFloat))
else if Prop.PropertyType.Name = 'TNullable<System.Currency>' then
ObjType.GetField(NullableFieldName).SetValue(Self, TValue.From<TNullable<Currency>>(Field.AsCurrency))
else if Prop.PropertyType.Name = 'TNullable<System.TDateTime>' then
ObjType.GetField(NullableFieldName).SetValue(Self, TValue.From<TNullable<TDateTime>>(Field.AsDateTime))
else if Prop.PropertyType.Name = 'TNullable<System.Boolean>' then
ObjType.GetField(NullableFieldName).SetValue(Self, TValue.From<TNullable<Boolean>>(Field.AsBoolean))
else if Prop.PropertyType.Name = 'TNullable<System.Variant>' then
ObjType.GetField(NullableFieldName).SetValue(Self, TValue.From<TNullable<Variant>>(Field.Value))
else
raise EORMUtilsException.CreateFmt('Unsupported TNullable type: %s', [Prop.PropertyType.Name]);
end
else
raise EORMUtilsException.CreateFmt('Unsupported record type: %s', [Prop.PropertyType.Name]);
end
else
begin
// Handle non-nullable types
case Prop.PropertyType.TypeKind of
tkString, tkLString, tkWString, tkUString:
Prop.SetValue(Self, Field.AsString);
tkInteger:
Prop.SetValue(Self, Field.AsInteger);
tkInt64:
Prop.SetValue(Self, Field.AsLargeInt);
tkFloat:
if Prop.PropertyType.Handle = TypeInfo(Currency) then
Prop.SetValue(Self, Field.AsCurrency)
else
Prop.SetValue(Self, Field.AsFloat);
tkVariant:
Prop.SetValue(Self, TValue.FromVariant(Field.AsVariant));
tkEnumeration:
if Prop.PropertyType.Handle = TypeInfo(Boolean) then
Prop.SetValue(Self, Field.AsBoolean)
else
raise EORMUtilsException.CreateFmt('Unsupported enumeration type: %s', [Prop.PropertyType.Name]);
else
// Add additional handling for other types if necessary
end;
end;
end;
finally
// No need to free TRttiContext as it's a record
end;
end;
finally
qr.Free;
end;
end;
function TQryRecInfo.GetPreviousValue(const FieldName: string): TValue;
begin
if not FPreviousValues.TryGetValue(FieldName, Result) then
raise EORMUtilsException.CreateFmt('No previous value found for field "%s".', [FieldName]);
end;
function TQryRecInfo.IsFieldDirty(const FieldName: string): Boolean;
begin
Result := FDirtyFields.ContainsKey(FieldName);
end;
procedure TQryRecInfo.ClearDirtyFlags;
begin
FDirtyFields.Clear;
end;
procedure TQryRecInfo.ClearPreviousValues;
begin
FPreviousValues.Clear;
end;
procedure TQryRecInfo.SetInfo(Index: Integer; const Value: TValue);
var
PropName: string;
PropKind: TTypeKind;
Ctx: TRttiContext;
Prop: TRttiProperty;
Field: TRttiField;
OldValue: TValue;
begin
// Retrieve property name and kind based on index
// Assuming that the index corresponds to the property order
Ctx := TRttiContext.Create;
try
Prop := Ctx.GetType(Self.ClassType).GetProperties()[Index];
if not Assigned(Prop) then
raise EORMUtilsException.CreateFmt('Error: The index "%d" does not correspond to any property in class "%s".', [Index, ClassName]);
PropName := Prop.Name;
PropKind := Prop.PropertyType.TypeKind;
Field := Ctx.GetType(Self.ClassType).GetField('_' + PropName);
if not Assigned(Field) then
raise EORMUtilsException.CreateFmt('Error: Field "_%s" not found in class "%s".', [PropName, ClassName]);
// If the field is not yet dirty, store the previous value
if not FDirtyFields.ContainsKey(PropName) then
begin
OldValue := Field.GetValue(Self);
FPreviousValues.AddOrSetValue(PropName, OldValue);
end;
// Set the new value
Field.SetValue(Self, Value);
// Mark the property as dirty
FDirtyFields.AddOrSetValue(PropName, True);
finally
// No need to free TRttiContext as it's a record
end;
end;
procedure TQryRecInfo.SetInfoCurrency(Index: Integer; const Value: Currency);
begin
SetInfo(Index, TValue.From<Currency>(Value));
end;
procedure TQryRecInfo.SetInfoNullableBoolean(Index: Integer; const Value: TNullable<Boolean>);
begin
SetInfo(Index, TValue.From<TNullable<Boolean>>(Value));
end;
procedure TQryRecInfo.SetInfoNullableCurrency(Index: Integer; const Value: TNullable<Currency>);
begin
SetInfo(Index, TValue.From<TNullable<Currency>>(Value));
end;
procedure TQryRecInfo.SetInfoNullableDateTime(Index: Integer; const Value: TNullable<TDateTime>);
begin
SetInfo(Index, TValue.From<TNullable<TDateTime>>(Value));
end;
procedure TQryRecInfo.SetInfoNullableExtended(Index: Integer; const Value: TNullable<Extended>);
begin
SetInfo(Index, TValue.From<TNullable<Extended>>(Value));
end;
procedure TQryRecInfo.SetInfoNullableInteger(Index: Integer; const Value: TNullable<Integer>);
begin
SetInfo(Index, TValue.From<TNullable<Integer>>(Value));
end;
procedure TQryRecInfo.SetInfoNullableInt64(Index: Integer; const Value: TNullable<Int64>);
begin
SetInfo(Index, TValue.From<TNullable<Int64>>(Value));
end;
procedure TQryRecInfo.SetInfoNullableString(Index: Integer; const Value: TNullable<string>);
begin
SetInfo(Index, TValue.From<TNullable<string>>(Value));
end;
procedure TQryRecInfo.SetInfoNullableVariant(Index: Integer; const Value: TNullable<Variant>);
begin
SetInfo(Index, TValue.From<TNullable<Variant>>(Value));
end;
end.
--------------------ASSISTANT
To create the `FetchAll` function as per your requirements, we'll iterate over each record in the query result set and populate a `TQryRecInfo` instance for each record. This instance will then be added to the `TQryRecArray`.
Let's assume that `TQryRecArray` and its methods are already implemented and focus on adding the `FetchAll` function. We'll also ensure that it works with any `TQryRecInfo` descendant.
Here’s the implementation:
```pascal
uses
System.Rtti, System.SysUtils, System.Classes, System.Generics.Collections, Uni, DB;
type
TQryRecInfo = class
// Existing class implementation goes here....
end;
TQryRecArray<T: TQryRecInfo, constructor> = class
private
FQryRecInfoList: TObjectList<T>;
public
constructor Create;
destructor Destroy; override;
procedure AddRecord(Rec: T);
function FetchAll(DBConn: TUniConnection; const QryTxt: string): TQryRecArray<T>;
end;
constructor TQryRecArray<T>.Create;
begin
inherited Create;
FQryRecInfoList := TObjectList<T>.Create(True); // Owns objects
end;
destructor TQryRecArray<T>.Destroy;
begin
FQryRecInfoList.Free;
inherited;
end;
procedure TQryRecArray<T>.AddRecord(Rec: T);
begin
FQryRecInfoList.Add(Rec);
end;
function TQryRecArray<T>.FetchAll(DBConn: TUniConnection; const QryTxt: string): TQryRecArray<T>;
var
qr: TUniQuery;
Ctx: TRttiContext;
Prop: TRttiProperty;
ObjType: TRttiType;
Rec: T;
Field: TField;
begin
Result := TQryRecArray<T>.Create;
if not Assigned(DBConn) or Trim(QryTxt).IsEmpty then
Exit(Result);
qr := TUniQuery.Create(nil);
try
qr.Connection := DBConn;
qr.SQL.Text := QryTxt;
qr.Open;
Ctx := TRttiContext.Create;
ObjType := Ctx.GetType(T);
while not qr.Eof do
begin
Rec := T.Create;
for Prop in ObjType.GetProperties do
begin
if not Prop.IsWritable then
Continue;
Field := qr.FindField(Prop.Name);
if Assigned(Field) then
begin
// Populate the properties according to their respective types.
case Prop.PropertyType.TypeKind of
tkString, tkLString, tkWString, tkUString:
Prop.SetValue(Rec, Field.AsString);
tkInteger:
Prop.SetValue(Rec, Field.AsInteger);
tkInt64:
Prop.SetValue(Rec, Field.AsLargeInt);
tkFloat:
if Prop.PropertyType.Handle = TypeInfo(Currency) then
Prop.SetValue(Rec, Field.AsCurrency)
else
Prop.SetValue(Rec, Field.AsFloat);
tkVariant:
Prop.SetValue(Rec, TValue.FromVariant(Field.Value));
tkEnumeration:
if Prop.PropertyType.Handle = TypeInfo(Boolean) then
Prop.SetValue(Rec, Field.AsBoolean);
end;
end;
end;
Result.AddRecord(Rec);
qr.Next;
end;
finally
qr.Free;
end;
end;
```
### Explanation:
- **`TQryRecArray<T>`**: This generic class is assumed to manage a list of `TQryRecInfo` instances. It includes constructors and destructors to create and free the list of records.
- **`FetchAll Method`**: This method performs the following steps:
- It takes a `DBConn` and a `QryTxt` (SQL query text).
- It sets up and executes a query using `TUniQuery`.
- It iterates over the result set and creates a new object of type `T` (a `TQryRecInfo` descendant).
- For each record, it fills the properties of `T` using RTTI to find writable properties and assign field values.
- It adds each populated object to the `FQryRecInfoList`.
- **`TContext/RTTI`**: RTTI is used to get the properties of `TQryRecInfo` that correspond to fields in the result set.
Ensure that `TQryRecArray` properly manages its internal list. Additionally, each field's type-specific handling may need extension or adjustment based on all possible data types you plan to support.