I want to extend the code so each field keeps a Custom Attribute FmtProp(TFormatType) text formatting option.
The class TQryRecInfo need to have a function so, when the Custom Attribute FmtProp is defined, it forces the use of the specified formatting. If FmtProp is not defined, then it is assumed the default formatting for that property DataType.
In the TEmployeeProject, for example:

EmployeeProject.ProjectDate:= EncodeDateTime(2024,02,01,01,02,03,0);
WriteLn(EmployeeProject.GetFormattedText('ProjectDate')) should show "01/02/2024"

and

EmployeeProject.ProjectStartMoment:= EncodeDateTime(2023,12,25,10,15,50,0);
WriteLn(EmployeeProject.GetFormattedText('ProjectStartMoment')) should show "25/12/2023 10:15:50"

and

EmployeeProject.DepartmentID:= 27;
WriteLn(EmployeeProject.GetFormattedText('DepartmentID'))  should show "27" // No FmtProp, uses default


As an additional question, would it be possible avoid typing errors on the parameter of GetFormattedText? That's to avoid runtime errors that we eventually get from inexistent properties

When you show the modified code, don't leave code gaps inside modified methods.


type
  TEmployeeProject = class(TQryRecInfo)
  private
    [Table('employees'), PrimaryKey, RefColumn('emp_id')]
    _EmployeeID: TNullable<Integer>;
    [Table('employees'), PrimaryKey, RefColumn('dept_id')]
    _DepartmentID: TNullable<Integer>;
    [Table('employees'), RefColumn('emp_name')]
    _EmployeeName: TNullable<String>;
    [Table('projects'), PrimaryKey, RefColumn('proj_id')]
    _ProjectID: TNullable<Integer>;
    [Table('projects'), RefColumn('proj_name')]
    _ProjectName: TNullable<String>;
    [Table('projects'), RefColumn('proj_budget')]
    _ProjectBudget: TNullable<Currency>;
    [Table('projects'), RefColumn('proj_date'), FmtProp(tiDate)]
    _ProjectDate: TNullable<TDateTime>;
    [Table('projects'), RefColumn('proj_starttime'), FmtProp(tiDateTime)]
    _ProjectStartMoment: TNullable<TDateTime>;

  published
    property EmployeeID: TNullable<Integer> index 0 read _EmployeeID write Set_Info_NullableInteger;
    property DepartmentID: TNullable<Integer> index 1 read _DepartmentID write Set_Info_NullableInteger;
    property EmployeeName: TNullable<String> index 2 read _EmployeeName write Set_Info_NullableString;
    property ProjectID: TNullable<Integer> index 3 read _ProjectID write Set_Info_NullableInteger;
    property ProjectName: TNullable<String> index 4 read _ProjectName write Set_Info_NullableString;
    property ProjectBudget: TNullable<Currency> index 5 read _ProjectBudget write Set_Info_NullableCurrency;
    property ProjectDate: TNullable<TDateTime> index 6 read _ProjectDate write Set_Info_NullableDateTime;
    property ProjectStartMoment: TNullable<TDateTime> index 7 read _ProjectStartMoment write Set_Info_NullableDateTime;
  end;


--------------------

unit formgerenc_Classes;

{$TYPEINFO ON}

interface

uses
  orm_utils, pixel_classes;

type
  TProspect = class(TQryRecInfo)
  private
    _ID: TNullable<Integer>;
    _Nome: TNullable<string>;
  published
    property ID: TNullable<Integer> index 0 read _ID write Set_Info_NullableInteger;
    property Nome: TNullable<string> index 1 read _Nome write Set_Info_NullableString;
  end;

type
  TEmployeeProject = class(TQryRecInfo)
  private
    [Table('employees'), PrimaryKey, RefColumn('emp_id')]
    _EmployeeID: TNullable<Integer>;
    [Table('employees'), PrimaryKey, RefColumn('dept_id')]
    _DepartmentID: TNullable<Integer>;
    [Table('employees'), RefColumn('emp_name')]
    _EmployeeName: TNullable<String>;
    [Table('projects'), PrimaryKey, RefColumn('proj_id')]
    _ProjectID: TNullable<Integer>;
    [Table('projects'), RefColumn('proj_name')]
    _ProjectName: TNullable<String>;
    [Table('projects'), RefColumn('proj_budget')]
    _ProjectBudget: TNullable<Currency>;
  published
    property EmployeeID: TNullable<Integer> index 0 read _EmployeeID write Set_Info_NullableInteger;
    property DepartmentID: TNullable<Integer> index 1 read _DepartmentID write Set_Info_NullableInteger;
    property EmployeeName: TNullable<String> index 2 read _EmployeeName write Set_Info_NullableString;
    property ProjectID: TNullable<Integer> index 3 read _ProjectID write Set_Info_NullableInteger;
    property ProjectName: TNullable<String> index 4 read _ProjectName write Set_Info_NullableString;
    property ProjectBudget: TNullable<Currency> index 5 read _ProjectBudget write Set_Info_NullableCurrency;
  end;

implementation

end.

-----------------------------

unit orm_utils;

{$TYPEINFO ON}

interface

uses
  Classes, System.Generics.Collections, System.Generics.Defaults,
  Rtti, TypInfo, SysUtils, StrUtils, DateUtils, Math, pixel_classes, pixel_utils,
  System.Variants;

type
  TQryRecInfo = class
  private
    FDirtyFields: TDictionary<string, Boolean>;
    FPreviousValues: TDictionary<string, TValue>;
    procedure Set_Info(Index: integer; const Value: TValue);
  public
    constructor Create;
    destructor Destroy; override;

    procedure Set_Info_NullableString(Index: integer; const Value: TNullable<string>);
    procedure Set_Info_NullableInteger(Index: integer; const Value: TNullable<Integer>);
    procedure Set_Info_NullableInt64(Index: integer; const Value: TNullable<Int64>);
    procedure Set_Info_NullableExtended(Index: integer; const Value: TNullable<Extended>);
    procedure Set_Info_NullableCurrency(Index: integer; const Value: TNullable<Currency>);
    procedure Set_Info_NullableDateTime(Index: integer; const Value: TNullable<TDateTime>);
    procedure Set_Info_NullableBoolean(Index: integer; const Value: TNullable<Boolean>);
    procedure Set_Info_NullableVariant(Index: integer; const Value: TNullable<Variant>);

    // 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;
  end;

implementation

function FormataInfo(info: Variant; tipo: TFormatType): string;
begin
 // info:= System.Variants.Null;
 if VarIsNull(info) or VarIsEmpty(info) then Exit(EMPTYSTRING);

 if VarType(info) = varUString then
 begin
  case tipo of
   tiInteger: Exit(PegaInt(info).ToString);
   tiMoney: Exit(FormatFloat(FMT_MONEY, GetMoney(info)));
   tiFloat: Exit(FloatToStr(PegaFloat(info)));
   tiDate: Exit(FormatDateTime('dd/mm/yyyy', PegaData(info)));
   tiDateTime: Exit(FormatDateTime('dd/mm/yyyy hh:mm:ss', PegaDataHora(info)));
   tiBoolean: Exit(IIF(info, 'S', 'N'));
   tiByteArray: Exit(ByteArrayToHex(info));
  end;
 end;

 case tipo of
  tiString: Result:= VarToStr(info);
  tiInteger: Result:= integer(info).ToString;
  tiMoney: Result:= FormatFloat(FMT_MONEY, Currency(info));
  tiFloat: Result:= FloatToStr(info);
  tiBoolean: Result:= string(IIF(Boolean(info), 'S', 'N'));
  tiByteArray: Result:= string(ByteArrayToHex(info));
  tiDate:
   begin
    if VarType(info) in [varDate, varDouble] then
    begin
     if info = 0 then Exit(EMPTYSTRING)
     else if VarToDateTime(info) < EncodeDate(1900, 1, 1) then Exit(EMPTYSTRING)
     else Exit(FormatDateTime('dd/mm/yyyy', VarToDateTime(info)));
    end
    else raise Exception.Create('FormataInfo: A informação [' + VarToStr(info) + '] não pode ser tratada como tiDate');
   end;
  tiDateTime:
   begin
    if VarType(info) in [varDate, varDouble] then
    begin
     if info = 0 then Exit(EMPTYSTRING)
     else Exit(FormatDateTime('dd/mm/yyyy hh:mm:ss', VarToDateTime(info)));
    end
    else raise Exception.Create('FormataInfo: A informação [' + VarToStr(info) + '] não pode ser tratada como tiDateTime');
   end;
  else raise Exception.Create('FormataInfo: o  [' + GetEnumName(TypeInfo(TContentType), integer(tipo)) + '] não foi encontrado');
 end;
end;

function GetPropNameAndField(Cls: TClass; PropIndex: integer; var PropName: string; var PropKind: TTypeKind): Boolean;
var
  Ctx: TRttiContext;
  Prop: TRttiProperty;
begin
  PropName := '';
  Ctx := TRttiContext.Create;
  for Prop in Ctx.GetType(Cls).GetProperties do
  begin
    if (Prop as TRttiInstanceProperty).Index = PropIndex then
    begin
      PropName := Prop.Name;
      PropKind := Prop.PropertyType.TypeKind;
      Break;
    end;
  end;
  Result := (PropName <> '');
end;

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;

procedure TQryRecInfo.Set_Info(Index: integer; const Value: TValue);
var
  PropName: string;
  PropKind: TTypeKind;
  Ctx: TRttiContext;
  Field: TRttiField;
  OldValue: TValue;
begin
  if not GetPropNameAndField(Self.ClassType, Index, PropName, PropKind) then
    raise Exception.Create('Error: The index "' + Index.ToString + '" does not exist in class "' + ClassType.ClassName + '"');

  Ctx := TRttiContext.Create;
  Field := Ctx.GetType(Self.ClassType).GetField('_' + PropName);
  if Assigned(Field) then
  begin
    // 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);
  end
  else
    raise Exception.Create('Error: Field "_' + PropName + '" not found.');
end;

procedure TQryRecInfo.Set_Info_NullableString(Index: integer; const Value: TNullable<string>);
begin
  Set_Info(Index, TValue.From<TNullable<string>>(Value));
end;

procedure TQryRecInfo.Set_Info_NullableInteger(Index: integer; const Value: TNullable<Integer>);
begin
  Set_Info(Index, TValue.From<TNullable<Integer>>(Value));
end;

procedure TQryRecInfo.Set_Info_NullableInt64(Index: integer; const Value: TNullable<Int64>);
begin
  Set_Info(Index, TValue.From<TNullable<Int64>>(Value));
end;

procedure TQryRecInfo.Set_Info_NullableExtended(Index: integer; const Value: TNullable<Extended>);
begin
  Set_Info(Index, TValue.From<TNullable<Extended>>(Value));
end;

procedure TQryRecInfo.Set_Info_NullableCurrency(Index: integer; const Value: TNullable<Currency>);
begin
  Set_Info(Index, TValue.From<TNullable<Currency>>(Value));
end;

procedure TQryRecInfo.Set_Info_NullableDateTime(Index: integer; const Value: TNullable<TDateTime>);
begin
  Set_Info(Index, TValue.From<TNullable<TDateTime>>(Value));
end;

procedure TQryRecInfo.Set_Info_NullableBoolean(Index: integer; const Value: TNullable<Boolean>);
begin
  Set_Info(Index, TValue.From<TNullable<Boolean>>(Value));
end;

procedure TQryRecInfo.Set_Info_NullableVariant(Index: integer; const Value: TNullable<Variant>);
begin
  Set_Info(Index, TValue.From<TNullable<Variant>>(Value));
end;

// Method to check if a field is dirty
function TQryRecInfo.IsFieldDirty(const FieldName: string): Boolean;
begin
  Result := FDirtyFields.ContainsKey(FieldName);
end;

// Method to clear all dirty flags
procedure TQryRecInfo.ClearDirtyFlags;
begin
  FDirtyFields.Clear;
end;

// Method to get the previous value of a property
function TQryRecInfo.GetPreviousValue(const FieldName: string): TValue;
begin
  if FPreviousValues.TryGetValue(FieldName, Result) then
    Exit;
  // Return some default value or raise exception if not found
  raise Exception.CreateFmt('No previous value found for field "%s".', [FieldName]);
end;

// Method to clear previous values
procedure TQryRecInfo.ClearPreviousValues;
begin
  FPreviousValues.Clear;
end;

end.

--------------------------

unit pixel_classes;

interface

uses
 System.SysUtils, Rtti, TypInfo;

{$TYPEINFO ON}

type
 TPixelUtils = class
  published
   class procedure CopyObject<T: class>(ASourceObject, ATargetObject: T);
   class function ObjectCopyFrom<T: class>(ASourceObject: T): T;
   class function EnumerationToString<T: record>(Value: T): string;
   class function StringToEnumeration<T: record>(const S: string): T;
 end;

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;

{ // exemplo de uso do TNullable

  var v: TNullable<Integer>;

  v := NullValue;
  v:= 98;

  if v = NullValue then begin
    showmessage('é null');
  end;

  if v <> NullValue then begin
    showmessage('é: '+IntToStr(v));
  end;

}

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 SQLParserEnhanced;

interface

uses
  System.Classes, System.SysUtils, System.Generics.Collections, System.RegularExpressions, Uni, System.StrUtils, Data.DB;

type
  /// <summary>
  /// Represents information about a column in the SQL query.
  /// </summary>
  TColumnInfo = class
  private
    FFullName: string;
    FRealSchemaName: string;
    FRealTableName: string;
    FReferencedTableColumn: string;
    FQueryColumnAlias: string;
    FIsPKColumn: Boolean;
    FDataType: TFieldType;
  public
    property FullName: string read FFullName write FFullName;
    property RealSchemaName: string read FRealSchemaName write FRealSchemaName;
    property RealTableName: string read FRealTableName write FRealTableName;
    property ReferencedTableColumn: string read FReferencedTableColumn write FReferencedTableColumn;
    property QueryColumnAlias: string read FQueryColumnAlias write FQueryColumnAlias;
    property IsPKColumn: Boolean read FIsPKColumn write FIsPKColumn;
    property DataType: TFieldType read FDataType write FDataType;
  end;

  /// <summary>
  /// Represents information about a table used in the SQL query.
  /// </summary>
  TTableInfo = class
  private
    FSchemaName: string;
    FTableName: string;
    FAlias: string;
  public
    /// <summary>
    /// Schema name of the table.
    /// </summary>
    property SchemaName: string read FSchemaName write FSchemaName;

    /// <summary>
    /// Name of the table.
    /// </summary>
    property TableName: string read FTableName write FTableName;

    /// <summary>
    /// Alias of the table as defined in the query.
    /// </summary>
    property Alias: string read FAlias write FAlias;
  end;

  /// <summary>
  /// Parses SQL SELECT statements to extract table and column information.
  /// </summary>
  TSQLParser = class
  private
    FSQLText: string;
    FTables: TObjectList<TTableInfo>;
    FColumns: TObjectList<TColumnInfo>;
    FConnection: TUniConnection;
    FPrimaryKeys: TDictionary<string, TList<string>>;
    FTableColumns: TDictionary<string, TList<string>>; // Cache for table columns

    procedure Parse;
    procedure ParseFromClause;
    procedure ParseSelectClause;
    function SplitSelectColumns(const SelectClause: string): TArray<string>;
    function IsExpression(const S: string): Boolean;
    function IsClauseKeyword(const Token: string): Boolean;
    function GetTableInfoByAliasOrName(const AliasOrName: string): TTableInfo;
    function IsJoinType(const Token: string): Boolean;
    procedure CheckPrimaryKeys; // Checks if columns are primary keys
    procedure FillPrimaryKeyDictionary; // Fills the primary key dictionary
    function GetTableColumnNames(const SchemaName, TableName: string): TList<string>; // Get column names for a table
    function IsReservedWord(const Token: string; const ReservedWords: array of string): Boolean;
  public
    procedure AssignDataTypesToColumns;
    /// <summary>
    /// Initializes a new instance of the TSQLParser class.
    /// </summary>
    /// <param name="SQLText">The SQL query text to parse.</param>
    /// <param name="AConnection">The database connection used to retrieve schema information.</param>
    constructor Create(const SQLText: string; AConnection: TUniConnection);
    /// <summary>
    /// Frees all resources used by the TSQLParser instance.
    /// </summary>
    destructor Destroy; override;

    /// <summary>
    /// Gets the list of tables parsed from the SQL query.
    /// </summary>
    property Tables: TObjectList<TTableInfo> read FTables;

    /// <summary>
    /// Gets the list of columns parsed from the SQL query.
    /// </summary>
    property Columns: TObjectList<TColumnInfo> read FColumns;
  end;

implementation

{ TSQLParser }

constructor TSQLParser.Create(const SQLText: string; AConnection: TUniConnection);
begin
  inherited Create;
  FSQLText := SQLText;
  FConnection := AConnection; // Store the provided database connection
  FTables := TObjectList<TTableInfo>.Create(True); // Owns objects
  FColumns := TObjectList<TColumnInfo>.Create(True); // Owns objects
  FPrimaryKeys := TDictionary<string, TList<string>>.Create;
  FTableColumns := TDictionary<string, TList<string>>.Create;
  Parse;
  FillPrimaryKeyDictionary; // After parsing, fill the primary key dictionary
  CheckPrimaryKeys; // Then check for primary key columns using the cache
  AssignDataTypesToColumns; // Assign data types to columns
end;

destructor TSQLParser.Destroy;
var
  ColumnsList: TList<string>;
begin
  // Free the lists inside the dictionaries
  for ColumnsList in FPrimaryKeys.Values do
    ColumnsList.Free;
  FPrimaryKeys.Free;

  for ColumnsList in FTableColumns.Values do
    ColumnsList.Free;
  FTableColumns.Free;

  FTables.Free;
  FColumns.Free;
  inherited;
end;

procedure TSQLParser.Parse;
begin
  ParseFromClause;
  ParseSelectClause;
end;

procedure TSQLParser.AssignDataTypesToColumns;
var
  Query: TUniQuery;
  Field: TField;
  ColumnInfo: TColumnInfo;
  FieldName: string;
begin
  Query := TUniQuery.Create(nil);
  try
    Query.Connection := FConnection;
    Query.SQL.Text := FSQLText;
    try
      Query.Open;
      // Iterate over fields to get field types
      for Field in Query.Fields do
      begin
        FieldName := Field.FieldName;
        // Try to find matching ColumnInfo by QueryColumnAlias or FullName
        for ColumnInfo in FColumns do
        begin
          if SameText(ColumnInfo.QueryColumnAlias, FieldName) or
             SameText(ColumnInfo.FullName, FieldName) or
             SameText(ColumnInfo.ReferencedTableColumn, FieldName) then
          begin
            ColumnInfo.DataType := Field.DataType;
            Break;
          end;
        end;
      end;
      Query.Close;
    except
      on E: Exception do
      begin
        // Handle exception, e.g., log error message
        // Optionally set DataType to ftUnknown for all columns
        for ColumnInfo in FColumns do
          ColumnInfo.DataType := ftUnknown;
      end;
    end;
  finally
    Query.Free;
  end;
end;

function TSQLParser.IsClauseKeyword(const Token: string): Boolean;
const
  ClauseKeywords: array[0..10] of string = (
    'WHERE', 'GROUP BY', 'HAVING', 'ORDER BY', 'LIMIT',
    'OFFSET', 'UNION', 'INTERSECT', 'EXCEPT', 'EXISTS', ';'
  );
var
  Keyword: string;
begin
  Result := False;
  for Keyword in ClauseKeywords do
  begin
    if SameText(Token, Keyword) then
      Exit(True);
  end;
end;

procedure TSQLParser.ParseFromClause;
var
  FromMatch, NextClauseMatch: TMatch;
  FromPos, NextClausePos: Integer;
  FromClause: string;
  Tokens: TArray<string>;
  i: Integer;
  Token: string;
  TableInfo: TTableInfo;
  NextToken: string;
  RemainingText: string;
begin
  // Find position of FROM
  FromMatch := TRegEx.Match(FSQLText, '\bFROM\b', [roIgnoreCase]);
  if not FromMatch.Success then Exit; // No FROM clause found
  FromPos := FromMatch.Index + FromMatch.Length;

  // Extract the text after FROM
  RemainingText := Copy(FSQLText, FromPos + 1, MaxInt).Trim;

  // Find position of the next clause (e.g., WHERE, GROUP BY, etc.) in RemainingText
  NextClauseMatch := TRegEx.Match(RemainingText, '\b(WHERE|GROUP BY|HAVING|ORDER BY|LIMIT|OFFSET|UNION|INTERSECT|EXCEPT|EXISTS|;)\b', [roIgnoreCase]);
  if NextClauseMatch.Success then
    NextClausePos := NextClauseMatch.Index
  else
    NextClausePos := Length(RemainingText) + 1; // No next clause found

  // Extract FROM clause
  FromClause := Copy(RemainingText, 1, NextClausePos - 1).Trim;

  // Split the FROM clause into tokens using spaces and commas, considering possible quoted identifiers
  Tokens := TRegEx.Split(FromClause, '\s+|,(?![^()]*\))'); // Split on spaces or commas not within parentheses

  i := 0;
  while i < Length(Tokens) do
  begin
    Token := Trim(Tokens[i]);
    if Token = '' then
    begin
      Inc(i);
      Continue;
    end;

    if IsJoinType(Token) or SameText(Token, 'JOIN') then
    begin
      // Skip join type and 'JOIN' keyword
      Inc(i);
      Continue;
    end
    else if SameText(Token, 'ON') then
    begin
      // Skip tokens until the next 'JOIN' or clause keyword
      Inc(i);
      while (i < Length(Tokens)) and not (IsJoinType(Tokens[i]) or SameText(Tokens[i], 'JOIN') or IsClauseKeyword(Tokens[i])) do
        Inc(i);
      Continue;
    end
    else if SameText(Token, 'USING') then
    begin
      // Skip tokens within 'USING (...)'
      Inc(i);
      while (i < Length(Tokens)) and not (Tokens[i].Contains(')')) do
        Inc(i);
      Inc(i); // Skip the token with ')'
      Continue;
    end
    else
    begin
      // Process table name (may include schema)
      TableInfo := TTableInfo.Create;

      // Check for schema.table format, considering possible quoted identifiers
      if Pos('.', Token) > 0 then
      begin
        var DotPos := LastDelimiter('.', Token);
        TableInfo.SchemaName := Copy(Token, 1, DotPos - 1).Trim(['"', '`']);
        TableInfo.TableName := Copy(Token, DotPos + 1, Length(Token)).Trim(['"', '`']);
      end
      else
      begin
        TableInfo.SchemaName := FConnection.Database; // Assume default schema
        TableInfo.TableName := Token.Trim(['"', '`']);
      end;

      // Check for alias
      if (i + 1) < Length(Tokens) then
      begin
        NextToken := Tokens[i + 1];
        if SameText(NextToken, 'AS') then
        begin
          // Alias after 'AS' keyword
          if (i + 2) < Length(Tokens) then
          begin
            TableInfo.Alias := Tokens[i + 2].Trim(['"', '`']);
            i := i + 2; // skip 'AS' and the alias
          end
          else
          begin
            // 'AS' without alias - skip 'AS'
            i := i + 1;
          end;
        end
        else if not (IsJoinType(NextToken) or SameText(NextToken, 'JOIN') or SameText(NextToken, 'ON')
          or SameText(NextToken, 'USING') or IsClauseKeyword(NextToken)) then
        begin
          // Alias without 'AS'
          TableInfo.Alias := NextToken.Trim(['"', '`']);
          Inc(i); // move to the alias
        end;
      end;

      FTables.Add(TableInfo);

      Inc(i); // move to the next token after processing
    end;
  end;
end;

function TSQLParser.SplitSelectColumns(const SelectClause: string): TArray<string>;
var
  i: Integer;
  c: Char;
  InSingleQuote, InDoubleQuote: Boolean;
  ParenthesisDepth: Integer;
  CurrentColumn: string;
  ColumnsList: TList<string>;
begin
  InSingleQuote := False;
  InDoubleQuote := False;
  ParenthesisDepth := 0;
  CurrentColumn := '';
  ColumnsList := TList<string>.Create;
  try
    i := 1;
    while i <= Length(SelectClause) do
    begin
      c := SelectClause[i];
      if (c = '''') and not InDoubleQuote then
      begin
        InSingleQuote := not InSingleQuote;
        CurrentColumn := CurrentColumn + c;
      end
      else if (c = '"') and not InSingleQuote then
      begin
        InDoubleQuote := not InDoubleQuote;
        CurrentColumn := CurrentColumn + c;
      end
      else if not InSingleQuote and not InDoubleQuote then
      begin
        if c = '(' then
        begin
          Inc(ParenthesisDepth);
          CurrentColumn := CurrentColumn + c;
        end
        else if c = ')' then
        begin
          Dec(ParenthesisDepth);
          CurrentColumn := CurrentColumn + c;
        end
        else if (c = ',') and (ParenthesisDepth = 0) then
        begin
          // Column separator
          ColumnsList.Add(Trim(CurrentColumn));
          CurrentColumn := '';
        end
        else
        begin
          CurrentColumn := CurrentColumn + c;
        end
      end
      else
      begin
        // Inside quotes
        CurrentColumn := CurrentColumn + c;
      end;
      Inc(i);
    end;
    // After the loop, add the last column
    if CurrentColumn.Trim <> '' then
      ColumnsList.Add(Trim(CurrentColumn));
    Result := ColumnsList.ToArray;
  finally
    ColumnsList.Free;
  end;
end;

procedure TSQLParser.ParseSelectClause;
var
  SelectMatch, FromMatch: TMatch;
  SelectClause: string;
  ColumnsStr: string;
  ColumnList: TArray<string>;
  ColumnStr: string;
  ColumnInfo: TColumnInfo;
  Regex: TRegEx;
  Match: TMatch;
  TableAliasOrName: string;
  ColumnName: string;
  TableInfo: TTableInfo;
  ReservedWords: array of string;
  Tokens: TArray<string>;
  i: Integer;
  SelectPos, FromPos: Integer;
  SelectLength: Integer;
begin
  // Find position of SELECT and FROM
  SelectMatch := TRegEx.Match(FSQLText, '\bSELECT\b', [roIgnoreCase]);
  FromMatch := TRegEx.Match(FSQLText, '\bFROM\b', [roIgnoreCase]);

  if (not SelectMatch.Success) or (not FromMatch.Success) then Exit;

  SelectPos := SelectMatch.Index + SelectMatch.Length;
  FromPos := FromMatch.Index;

  // Extract the SELECT clause content
  SelectLength := FromPos - SelectPos;
  if SelectLength <= 0 then Exit;
  SelectClause := Copy(FSQLText, SelectPos + 1, SelectLength - 1).Trim;

  // List of reserved words that may appear after SELECT
  ReservedWords := ['ALL', 'DISTINCT', 'DISTINCTROW', 'HIGH_PRIORITY', 'STRAIGHT_JOIN',
                    'SQL_SMALL_RESULT', 'SQL_BIG_RESULT', 'SQL_BUFFER_RESULT', 'SQL_CACHE',
                    'SQL_NO_CACHE', 'SQL_CALC_FOUND_ROWS'];

  // Split the SelectClause into tokens to check for reserved words at the beginning
  Tokens := TRegEx.Split(SelectClause, '\s+');
  i := 0;
  // Skip reserved words at the beginning
  while (i < Length(Tokens)) and IsReservedWord(Tokens[i], ReservedWords) do
  begin
    Inc(i);
  end;

  // Reconstruct ColumnsStr without leading reserved words
  if i >= Length(Tokens) then
    ColumnsStr := ''
  else
    ColumnsStr := String.Join(' ', Copy(Tokens, i, Length(Tokens) - i));

  if ColumnsStr.IsEmpty then Exit;

  // Use the new SplitSelectColumns function to split columns
  ColumnList := SplitSelectColumns(ColumnsStr);

  for i := 0 to Length(ColumnList) - 1 do
  begin
    ColumnStr := Trim(ColumnList[i]);

    // Regular expression to extract column expressions and aliases
    // Handles cases like "expression AS alias", "expression alias", or just "expression"
    Regex := TRegEx.Create('^(.*?)(?:\s+(?:AS\s+)?(\w+))?$', [roIgnoreCase]);
    Match := Regex.Match(ColumnStr);

    ColumnInfo := TColumnInfo.Create; // Create the ColumnInfo object

    if Match.Success then
    begin
      ColumnInfo.FullName := Match.Groups[1].Value.Trim;
      if Match.Groups.Count > 2 then
        ColumnInfo.QueryColumnAlias := Match.Groups[2].Value.Trim
      else
        ColumnInfo.QueryColumnAlias := '';
    end
    else
    begin
      ColumnInfo.FullName := ColumnStr;
      ColumnInfo.QueryColumnAlias := '';
    end;

    // Determine if the column is an expression
    if IsExpression(ColumnInfo.FullName) then
    begin
      // It's an expression
      ColumnInfo.RealSchemaName := '[none]';
      ColumnInfo.RealTableName := '[none]';
      ColumnInfo.ReferencedTableColumn := '[none]';
    end
    else
    begin
      // It's a simple column reference
      if ColumnInfo.FullName.Contains('.') then
      begin
        // Parse table alias/name and column name
        var DotPos := LastDelimiter('.', ColumnInfo.FullName);
        TableAliasOrName := Copy(ColumnInfo.FullName, 1, DotPos - 1).Trim(['"', '`']);
        ColumnName := Copy(ColumnInfo.FullName, DotPos + 1, Length(ColumnInfo.FullName)).Trim(['"', '`']);

        // Get the table info for this alias or name
        TableInfo := GetTableInfoByAliasOrName(TableAliasOrName);

        if Assigned(TableInfo) then
        begin
          ColumnInfo.RealSchemaName := TableInfo.SchemaName;
          ColumnInfo.RealTableName := TableInfo.TableName;
        end
        else
        begin
          // Table alias/name not found; mark as unknown
          ColumnInfo.RealSchemaName := '[unknown schema]';
          ColumnInfo.RealTableName := '[unknown table]';
        end;
        ColumnInfo.ReferencedTableColumn := ColumnName;
      end
      else
      begin
        // Column without table alias/name prefix
        ColumnInfo.ReferencedTableColumn := ColumnInfo.FullName.Trim(['"', '`']);
        ColumnInfo.RealTableName := '';
        ColumnInfo.RealSchemaName := '';

        if FTables.Count = 1 then
        begin
          // Assign the only table's name
          ColumnInfo.RealTableName := FTables[0].TableName;
          ColumnInfo.RealSchemaName := FTables[0].SchemaName;
        end
        else if FTables.Count > 1 then
        begin
          // More than one table: try to find the table(s) that contain this column
          var PossibleTables := TList<TTableInfo>.Create;
          try
            for var TInfo in FTables do
            begin
              var ColumnsList := GetTableColumnNames(TInfo.SchemaName, TInfo.TableName);
              if ColumnsList.Contains(LowerCase(ColumnInfo.ReferencedTableColumn)) then
                PossibleTables.Add(TInfo);
            end;

            if PossibleTables.Count = 1 then
            begin
              // Only one table contains the column, assign it
              ColumnInfo.RealTableName := PossibleTables[0].TableName;
              ColumnInfo.RealSchemaName := PossibleTables[0].SchemaName;
            end
            else if PossibleTables.Count > 1 then
            begin
              // Column is ambiguous - exists in multiple tables
              ColumnInfo.RealTableName := '[ambiguous]';
              ColumnInfo.RealSchemaName := '[ambiguous schema]';
            end
            else
            begin
              // Column doesn't exist in any known table
              ColumnInfo.RealTableName := '[unknown]';
              ColumnInfo.RealSchemaName := '[unknown schema]';
            end;
          finally
            PossibleTables.Free;
          end;
        end
        else
        begin
          // No table information available
          ColumnInfo.RealTableName := '[no tables parsed]';
          ColumnInfo.RealSchemaName := '[no tables parsed]';
        end;
      end;
    end;

    FColumns.Add(ColumnInfo);
  end;
end;

function TSQLParser.IsReservedWord(const Token: string; const ReservedWords: array of string): Boolean;
var
  Word: string;
begin
  for Word in ReservedWords do
  begin
    if SameText(Token, Word) then
      Exit(True);
  end;
  Result := False;
end;

function TSQLParser.IsExpression(const S: string): Boolean;
var
  Value: string;
  ReservedFunctions: array of string;
begin
  Value := Trim(S);

  // Check for string literal (enclosed in single quotes)
  if (Value.StartsWith('''') and Value.EndsWith('''')) then
    Exit(True);

  // Check for string literal (enclosed in double quotes)
  if (Value.StartsWith('"') and Value.EndsWith('"')) then
    Exit(True);

  // Check for numeric literal
  if TRegEx.IsMatch(Value, '^-?\d+(\.\d+)?$') then
    Exit(True);

  // Check for reserved SQL functions
  ReservedFunctions := ['CURRENT_TIMESTAMP', 'NOW', 'SYSDATE', 'GETDATE', 'CURDATE', 'CURRENT_DATE', 'CURRENT_TIME'];

  if IsReservedWord(Value, ReservedFunctions) then
    Exit(True);

  // Existing heuristic for expressions involving operators or parentheses
  Result := Value.Contains('(') or
            Value.Contains('+') or
            Value.Contains('-') or
            Value.Contains('*') or
            Value.Contains('/') or
            (Value.Contains(' ') and not Value.Contains('.'));
end;

function TSQLParser.GetTableInfoByAliasOrName(const AliasOrName: string): TTableInfo;
var
  TableInfo: TTableInfo;
begin
  Result := nil;
  for TableInfo in FTables do
  begin
    if SameText(TableInfo.Alias, AliasOrName) then
      Exit(TableInfo)
    else if (TableInfo.Alias.IsEmpty) and SameText(TableInfo.TableName, AliasOrName) then
      Exit(TableInfo);
  end;
end;

function TSQLParser.GetTableColumnNames(const SchemaName, TableName: string): TList<string>;
var
  ColumnsList: TList<string>;
  Query: TUniQuery;
  ColumnName: string;
  Key: string;
begin
  Key := LowerCase(SchemaName + '.' + TableName);
  if FTableColumns.TryGetValue(Key, ColumnsList) then
  begin
    Result := ColumnsList;
    Exit;
  end;

  // Load column names from the database schema
  ColumnsList := TList<string>.Create;
  try
    Query := TUniQuery.Create(nil);
    try
      Query.Connection := FConnection;
      Query.SQL.Text := 'SELECT COLUMN_NAME FROM information_schema.COLUMNS ' +
                        'WHERE TABLE_SCHEMA = :SchemaName AND TABLE_NAME = :TableName';
      Query.ParamByName('SchemaName').AsString := SchemaName;
      Query.ParamByName('TableName').AsString := TableName;
      Query.Open;

      while not Query.Eof do
      begin
        ColumnName := LowerCase(Query.FieldByName('COLUMN_NAME').AsString);
        ColumnsList.Add(ColumnName);
        Query.Next;
      end;
      Query.Close;
    finally
      Query.Free;
    end;
    FTableColumns.Add(Key, ColumnsList);
    Result := ColumnsList;
  except
    ColumnsList.Free;
    raise;
  end;
end;

function TSQLParser.IsJoinType(const Token: string): Boolean;
const
  JoinTypes: array[0..7] of string = ('JOIN', 'INNER', 'LEFT', 'RIGHT', 'FULL', 'CROSS', 'NATURAL', 'OUTER');
var
  JoinType: string;
begin
  Result := False;
  if Token.IsEmpty then Exit;
  for JoinType in JoinTypes do
  begin
    if SameText(Token, JoinType) then
      Exit(True);
  end;
end;

procedure TSQLParser.FillPrimaryKeyDictionary;
var
  Query: TUniQuery;
  TableName, ColumnName, SchemaName: string;
  ColumnsList: TList<string>;
begin
  if not Assigned(FConnection) then
    Exit; // Cannot fill without a database connection

  Query := TUniQuery.Create(nil);
  try
    Query.Connection := FConnection;
    // Use the schema name from the connection if not specified
    SchemaName := FConnection.Database;

    Query.SQL.Text :=
      'SELECT TABLE_NAME, COLUMN_NAME FROM information_schema.KEY_COLUMN_USAGE ' +
      'WHERE TABLE_SCHEMA = :SchemaName AND CONSTRAINT_NAME = ''PRIMARY'' ' +
      'ORDER BY TABLE_NAME, ORDINAL_POSITION';

    Query.ParamByName('SchemaName').AsString := SchemaName;
    Query.Open;

    while not Query.Eof do
    begin
      TableName := LowerCase(Query.FieldByName('TABLE_NAME').AsString);
      ColumnName := LowerCase(Query.FieldByName('COLUMN_NAME').AsString);

      if not FPrimaryKeys.TryGetValue(TableName, ColumnsList) then
      begin
        ColumnsList := TList<string>.Create;
        FPrimaryKeys.Add(TableName, ColumnsList);
      end;

      ColumnsList.Add(ColumnName);

      Query.Next;
    end;

    Query.Close;
  finally
    Query.Free;
  end;
end;

procedure TSQLParser.CheckPrimaryKeys;
var
  ColumnInfo: TColumnInfo;
  TableName: string;
  ColumnName: string;
  ColumnsList: TList<string>;
begin
  for ColumnInfo in FColumns do
  begin
    if (ColumnInfo.RealTableName <> '') and
       not (ColumnInfo.RealTableName.StartsWith('[') and ColumnInfo.RealTableName.EndsWith(']')) and
       (ColumnInfo.ReferencedTableColumn <> '') and
       not (ColumnInfo.ReferencedTableColumn.StartsWith('[') and ColumnInfo.ReferencedTableColumn.EndsWith(']')) then
    begin
      TableName := LowerCase(ColumnInfo.RealTableName);
      ColumnName := LowerCase(ColumnInfo.ReferencedTableColumn);

      if FPrimaryKeys.TryGetValue(TableName, ColumnsList) then
      begin
        ColumnInfo.IsPKColumn := ColumnsList.Contains(ColumnName);
      end
      else
      begin
        // Table not found in primary keys, so column is not a primary key
        ColumnInfo.IsPKColumn := False;
      end;
    end
    else
    begin
      // For expressions or columns without table reference
      ColumnInfo.IsPKColumn := False;
    end;
  end;
end;

end.

--------------------------------

unit ORM_GenerateDelphiClassFromQuery;

interface

uses Uni, DB, System.Generics.Collections, SysUtils, System.Character, System.Classes, SQLParserEnhanced;

function GenerateDelphiClassFromQuery(const SQLText: string; const ClassName: string; AConnection: TUniConnection): string;

implementation

function GenerateDelphiClassFromQuery(const SQLText: string; const ClassName: string; AConnection: TUniConnection): string;
var
  Parser: TSQLParser;
  ColumnInfo: TColumnInfo;
  i, PropIndex: Integer;
  FieldsList: TObjectList<TColumnInfo>;
  AttrsLine: string;
  FieldName, PropertyName: string;
  NullableDelphiType, WriteMethod: string;
  ResultList: TStringList;
  AttributesList: TList<string>;

  function CreateValidIdentifier(const Name: string): string;
  var
    i: Integer;
    c: Char;
  begin
    Result := '';
    for i := 1 to Length(Name) do
    begin
      c := Name[i];
      if c.IsLetterOrDigit or (c = '_') then
        Result := Result + c
      else
        Result := Result + '_'; // Replace invalid chars with '_'
    end;
    // Ensure the identifier does not start with a digit or invalid character
    if (Result = '') or not (Result[1].IsLetter or (Result[1] = '_')) then
      Result := '_' + Result;
  end;

  function GetDelphiTypeMapping(FieldType: TFieldType; out NullableDelphiType, WriteMethod: string): Boolean;
  begin
    Result := True;
    case FieldType of
      TFieldType.ftString, TFieldType.ftWideString, TFieldType.ftMemo, TFieldType.ftWideMemo:
      begin
        NullableDelphiType := 'TNullable<String>';
        WriteMethod := 'Set_Info_NullableString';
      end;
      TFieldType.ftInteger, TFieldType.ftByte, TFieldType.ftSmallint, TFieldType.ftWord, TFieldType.ftLongWord, TFieldType.ftShortint:
      begin
        NullableDelphiType := 'TNullable<Integer>';
        WriteMethod := 'Set_Info_NullableInteger';
      end;
      TFieldType.ftLargeint:
      begin
        NullableDelphiType := 'TNullable<Int64>';
        WriteMethod := 'Set_Info_NullableInt64';
      end;
      TFieldType.ftSingle, TFieldType.ftFloat, TFieldType.ftExtended:
      begin
        NullableDelphiType := 'TNullable<Extended>';
        WriteMethod := 'Set_Info_NullableExtended';
      end;
      TFieldType.ftDate, TFieldType.ftTime, TFieldType.ftDateTime, TFieldType.ftTimeStamp:
      begin
        NullableDelphiType := 'TNullable<TDateTime>';
        WriteMethod := 'Set_Info_NullableDateTime';
      end;
      TFieldType.ftCurrency:
      begin
        NullableDelphiType := 'TNullable<Currency>';
        WriteMethod := 'Set_Info_NullableCurrency';
      end;
      TFieldType.ftFMTBcd, TFieldType.ftBCD:
      begin
        NullableDelphiType := 'TNullable<Currency>';
        WriteMethod := 'Set_Info_NullableCurrency';
      end;
      TFieldType.ftBoolean:
      begin
        NullableDelphiType := 'TNullable<Boolean>';
        WriteMethod := 'Set_Info_NullableBoolean';
      end;
      else
      begin
        NullableDelphiType := 'TNullable<Variant>';
        WriteMethod := 'Set_Info_NullableVariant';
        Result := False;
      end;
    end;
  end;

begin
  ResultList := TStringList.Create;
  try
    ResultList.Add('type');
    ResultList.Add(Format('  T%s = class(TQryRecInfo)', [ClassName]));
    ResultList.Add('  private');

    Parser := TSQLParser.Create(SQLText, AConnection);
    try
      FieldsList := Parser.Columns;  // Get the columns info

      // Iterate over the columns to generate field declarations
      for i := 0 to FieldsList.Count - 1 do
      begin
        ColumnInfo := FieldsList[i];

        if not GetDelphiTypeMapping(ColumnInfo.DataType, NullableDelphiType, WriteMethod) then
        begin
          // Handle unsupported type if necessary
        end;

        // Use QueryColumnAlias as the field name or the column name
        if ColumnInfo.QueryColumnAlias <> '' then
          FieldName := ColumnInfo.QueryColumnAlias
        else
          FieldName := ColumnInfo.ReferencedTableColumn;

        // Sanitize the FieldName (remove special characters, etc.)
        FieldName := CreateValidIdentifier(FieldName);
        FieldName := '_' + FieldName; // Prefix with '_'

        // Initialize the list of attributes
        AttributesList := TList<string>.Create;
        try
          // Build custom attributes
          if not ColumnInfo.RealTableName.IsEmpty and
             not ((ColumnInfo.RealTableName = '[none]') or (ColumnInfo.RealTableName = '[ambiguous]') or (ColumnInfo.RealTableName = '[unknown]')) then
          begin
            // Insert Table attribute
            AttributesList.Add(Format('Table(''%s'')', [ColumnInfo.RealTableName]));
          end;

          if ColumnInfo.IsPKColumn then
          begin
            AttributesList.Add('PrimaryKey');
          end;

          if not ColumnInfo.ReferencedTableColumn.IsEmpty and (ColumnInfo.ReferencedTableColumn <> '[none]') then
          begin
            AttributesList.Add(Format('RefColumn(''%s'')', [ColumnInfo.ReferencedTableColumn]));
          end;

          // Combine attributes
          if AttributesList.Count > 0 then
            AttrsLine := Format('    [%s]', [String.Join(', ', AttributesList.ToArray)])
          else
            AttrsLine := '';

          // Add field declaration
          if AttrsLine <> '' then
            ResultList.Add(Format('%s %s: %s;', [AttrsLine, FieldName, NullableDelphiType]))
          else
            ResultList.Add(Format('    %s: %s;', [FieldName, NullableDelphiType]));
        finally
          AttributesList.Free;
        end;
      end;

      // Generate published property declarations
      ResultList.Add('  published');
      PropIndex := 0;
      for i := 0 to FieldsList.Count - 1 do
      begin
        ColumnInfo := FieldsList[i];

        if not GetDelphiTypeMapping(ColumnInfo.DataType, NullableDelphiType, WriteMethod) then
        begin
          // Handle unsupported type if necessary
        end;

        // Use the sanitized FieldName (without '_')
        if ColumnInfo.QueryColumnAlias <> '' then
          FieldName := ColumnInfo.QueryColumnAlias
        else
          FieldName := ColumnInfo.ReferencedTableColumn;
        FieldName := CreateValidIdentifier(FieldName);

        // PropertyName is same as FieldName
        PropertyName := FieldName;

        // FieldName with '_'
        FieldName := '_' + FieldName;

        // Add property declaration
        ResultList.Add(Format('    property %s: %s index %d read %s write %s;', [PropertyName, NullableDelphiType, PropIndex, FieldName, WriteMethod]));

        Inc(PropIndex);
      end;

      ResultList.Add('  end;');
      ResultList.Add('');
    finally
      Parser.Free;
    end;

    Result := ResultList.Text;

  finally
    ResultList.Free;
  end;
end;

end.

------------------------

unit ORM_CustomAttributes;

{$TYPEINFO ON}

interface

uses
  System.SysUtils, System.Classes, System.Rtti;

type
 TFormatType = (tiString, tiInteger, tiDate, tiDateTime, tiMoney, tiFloat, tiBoolean, tiByteArray, tiNone);  

type
  /// <summary>
  /// Attribute to specify the database table associated with a class or field.
  /// </summary>
  TableAttribute = class(TCustomAttribute)
  private
    FTableName: string;
  public
    constructor Create(const ATableName: string);
    property TableName: string read FTableName;
  end;

  /// <summary>
  /// Attribute to mark a field as a primary key.
  /// </summary>
  PrimaryKeyAttribute = class(TCustomAttribute)
  public
    constructor Create;
  end;

  /// <summary>
  /// Attribute to specify the database column associated with a field.
  /// </summary>
  RefColumnAttribute = class(TCustomAttribute)
  private
    FColumnName: string;
  public
    constructor Create(const AColumnName: string);
    property ColumnName: string read FColumnName;
  end;

implementation

{ TableAttribute }

constructor TableAttribute.Create(const ATableName: string);
begin
  inherited Create;
  FTableName := ATableName;
end;

{ RefColumnAttribute }

constructor RefColumnAttribute.Create(const AColumnName: string);
begin
  inherited Create;
  FColumnName := AColumnName;
end;

{ PrimaryKeyAttribute }
constructor PrimaryKeyAttribute.Create;
begin
  inherited Create;
end;

end.

--------------------