RTTI ve Custom Attribute

[3ddark]

Elimde şöyle bir attribute sınıfım var

type
 AttTableName = class(TCustomAttribute)
 private
   FName: string;
 public
   property Name: string read FName write FName;
   constructor Create(AValue: string);
 end;

 AttFieldName = class(TCustomAttribute)
 private
   FName: String;
  public
    property Name: String read FName write FName;
  end;

Birde aşağıdaki gibi bir table sınıfım var. Bu table sınıfına Table ve Field attribute tanımlamalarını yapıyorum.

type
  [AttTableName('country')]
  TCountry = class(TTable)
  private
    FCountryCode       : string;
    FCountryName       : string;
  public
    [AttFieldName('country_code')]
    Property CountryCode    : string    read FCountryCode        write FCountryCode;
    [AttFieldName('country_name')]
    Property CountryName    : string    read FCountryName        write FCountryName;
  end;

Bu fonksiyonla table attribute bilgilsine çalışma sırasında erişebiliyorum

function GetTableAttribute(pClass: TTable): string;
var
  vC: TRttiContext;
  vT: TRttiType;
  vA: TCustomAttribute;
begin
  Result := '';
  if pClass <> nil then
  begin
    vC := TRttiContext.Create;
    try
      vT := vC.GetType(pClass.ClassType);
      for vA in  vT.GetAttributes do
        if vA is AttTableName then
          Result := Result + (vA as AttTableName).Name;
    finally
      vC.Free
    end;
  end;
end;

Bu fonksiyonla field attribute bilgilerinin tümüne çalışma sırasında erişebiliyorum. Şu anda ikinci parametrenin hiç bir anlamı yok.

function TTable.GetFieldAttribute(pClass: TTable; pFieldName: string): string;
var
  vC: TRttiContext;
  vT: TRttiType;
  vA: TCustomAttribute;
  vP: TRttiProperty;
begin
  Result := '';
  if pClass <> nil then
  begin
    vC := TRttiContext.Create;
    try
      vT := vC.GetType(pClass.ClassType);
      for vP in  vT.GetProperties do
      begin
-        for vA in vP.GetAttributes do
        begin
          if vA is AttFieldName then
            Result := Result + AttFieldName(vA).Name + sLineBreak;
        end;
      end;
    finally
      vC.Free
    end;
  end;
end;

fonksiyonları şu şekilde çağırarak table ve field attribute bilgilerine erişiyorum

  vCountry := TCountry.Create(SingletonDB.DataBase);
  try
    ShowMessage(vCountry.GetFieldAttribute(vCountry, ''));
    ShowMessage(vCountry.GetTableAttribute(vCountry));
  finally
    vCountry.Free;
  end;

{ 
** Fakat benim istediğim sadece istediğim property için attribute bilgisine erişmek.
** Bu şekilde sadece istediğim property için attribute bilgisini alabilir miyim? Bunu nasıl yapabilirim?
** Property ler içinde yeni TFieldDB şeklinde yeni bir sınıf yapıp. Bu sınıf üzerinden mi attribute almalıyım.

   classType.PropertyName
}

vCountry.CountryCode

[Tuğrul HELVACI]

Önce GetProperty çağrımını yapan, TRttiProperty elde ettikten sonra, o property'nin attribute'leri üzerinde dönen bir metod yazabilirsiniz.

[3ddark]

(20-05-2018, Saat: 17:37)Tuğrul HELVACI Adlı Kullanıcıdan Alıntı: Önce GetProperty çağrımını yapan, TRttiProperty elde ettikten sonra, o property'nin attribute'leri üzerinde dönen bir metod yazabilirsiniz.

Cevap için teşekkürler.

Öncelikle özür dilerim biraz eksik bilgi yazdım. Evet dediğiniz şekilde zaten istediğim işlemi yapabilirim.
Fakat GetProperty(const AName: string) şeklinde Name parametresi istiyor.

Benim asıl sormak istediğim. Table sınıfında elde ettiğim gibi attribute bilgisini almak istiyorum. Bu mümkün mü?

Table sınıfında statik olarak bir string değer vermiyorum. Parametre olarak class gönderiyorum ve attribute bilgisini elde edebiliyorum.

Aynı işlemi property içinde yapmak mümkün mü? Sadece property yi ile attribute elde etme işlemi.

Çözüm sadece property elemanlarını da TXXXField gibi bir class olarak kullanmak mı?

[ismailkocacan]

TTable sınıfı tek, sınıf içerisinde birden fazla property var.Attribute bilgisine erişmek istenen property'nin isminden belirtilmesi gerekir.
Aynı şekilde method, field vs içinde bu durum geçerli.

function TTable.GetFieldAttribute(pClass: TTable; pFieldName: string): string;

Yukarıdaki method TTable sınıfına ait görünüyor. pFieldName parametresi olmalı ve GetProperty methoduna parametre olarak gönderebilirsiniz.
pClass parametresini kaldırıp, method içerisinde pClass.GetType yerine Self.ClassType ile değiştirebilirsiniz.

Böylelikle nesneyi tekrar method'a parametre olarak göndermeye gerek kalmaz.

vCountry.GetFieldAttribute('FieldName');

[3ddark]

Cevaplar için teşekkürler. Şu durumda benim işim çözülmüyor yapıyı tekrar gözden geçirmem gerekecek.

[3ddark]

Kodu bu şekilde değiştirmek zorunda kaldım.
TFieldDB sınıfı var. Bu sınıfın elemanlarına istediğim bilgilerin ekledim.

type
 TFieldDB = class
 private
   FFieldName: string;
   FFieldType: TFieldType;
   FValue: Variant;
   FMaxLength: Integer;
   FIsAutoInc: Boolean;
   FIsNullable: Boolean;
 public
   property FieldName: string read FFieldName write FFieldName;
   property FieldType: TFieldType read FFieldType write FFieldType;
   property Value: Variant read FValue write FValue;
   property MaxLength: Integer read FMaxLength write FMaxLength default 0;
   property IsAutoInc: Boolean read FIsAutoInc write FIsAutoInc default False;
   property IsNullable: Boolean read FIsNullable write FIsNullable default True;

   constructor Create(pFieldName: string; pFieldType: TFieldType;
     pValue: Variant; pMaxLength: Integer = 0; pIsAutoInc: Boolean=False;
     pIsNullable:Boolean=True);
 end;

implementation

{ TFieldDB }

constructor TFieldDB.Create(pFieldName: string; pFieldType: TFieldType;
 pValue: Variant; pMaxLength: Integer = 0; pIsAutoInc: Boolean=False;
 pIsNullable:Boolean=True);
begin
 FFieldName := pFieldName;
 FFieldType := pFieldType;
 FValue := pValue;
 FIsAutoInc := pIsAutoInc;
 FIsNullable := pIsNullable;
 FMaxLength := pMaxLength;
end;

Bu şekilde Table sınıfı create edilirken bir defa attribute gibi bilgiyi yazıyorum. Bundan sonra istediğim bilgiye direkt olarak erişebiliyorum.

  TCurrency = class(TTable)
 private
   FCode         : TFieldDB;
   FSymbol       : TFieldDB;
   FIsDefault    : TFieldDB;
   FCodeComment  : TFieldDB;
   ...
   ...
 public

   Property Code         : TFieldDB  read FCode        write FCode;
   Property Symbol       : TFieldDB  read FSymbol      write FSymbol;
   Property IsDefault    : TFieldDB  read FIsDefault   write FIsDefault;
   Property CodeComment  : TFieldDB  read FCodeComment write FCodeComment;
 end;

implementation

constructor TCurrency.Create(OwnerDatabase:TDatabase);
begin
 inherited Create(OwnerDatabase);
 TableName := 'currency';

 Self.FCode := TFieldDB.Create('code', ftString, '');
 Self.FSymbol := TFieldDB.Create('symbol', ftString, '');
 Self.FIsDefault := TFieldDB.Create('is_default', ftBoolean, False);
 Self.FCodeComment := TFieldDB.Create('code_comment', ftString, '');
end;

Asıl almak istediğim bilgi buydu. Bu şekilde de istediğim bilgiye ulaşıyorum. Malesef Rtti Attribute ile bu işlemi yapamadım.

Self.Code.FieldName

Aşağıda da otomatik olarak TFieldDB tipinden olan property öğeleri destroy ediliyor. Her biri için tek tek free etmek zorunda kalmıyoruz.

destructor TTable.Destroy;
var
 vCtx : TRttiContext;
 vRtm : TRttiMethod;
 vRtf : TRttiField;
 vRtt : TRttiType;
begin
 vCtx := TRttiContext.Create;
 vRtt := vCtx.GetType(Self.ClassType);
 for vRtf in vRtt.GetFields do
 begin
   if vRtf.FieldType.Name = 'TFieldDB' then
   begin
     for vRtm in vRtf.FieldType.GetMethods('Destroy') do
     begin
       if vRtm.IsDestructor then
       begin
         vRtm.Invoke(vRtf.GetValue(Self), []);
         vRtf.SetValue(Self, nil);
         break;
       end;
     end;
   end;
 end;
end;

[ismailkocacan]

if vRtf.FieldType.Name = 'TFieldDB' then

 yerine 

if vRtf.FieldType.Name = TFieldDB.ClassName then

yazabilirsiniz.
Başka bir zaman, TFieldDB sınıfının ismini değiştirirseniz, örneğin TDbField yapmak isterseniz, TTable.Destroy içerisindeki kod değişiklikten etkilenmez.