RTTI Attribute verändern

[himitsu]

Jede RTTI-Instanz besitzt ihre eigenen Listen.

Sobald das erste Mal in einem Context das Attribut ausgelesen wird, wird im jeweiligem GetAttributes eine eigene Instanz des Attributes erstellt.
Ja, man kann der einen Instanz einen neuen Wert zuweisen, aber Dieser gilt dann auch nur dort und andere/fremde Instanzen haben dennoch den Urspungswert.
Also eigentlich sind die Setter sinnlos. (entweder direkt die RTTI umschreiben, aber bestehende Instanzen bleiben unberührt, oder den Wert dynamisch holen)

Nach dem "nochmal" sieht man das Erzeugen der zweiten TTest1Attribute-Instanz.

Delphi-Quellcode:

type
  TTest1Attribute = class(TCustomAttribute)
  private
    FValue: Boolean;
    function  GetValue:        Boolean;
    procedure SetValue(AValue: Boolean);
  public
    constructor Create(AValue: Boolean);
    destructor  Destroy; override;
    property Value: Boolean read GetValue write SetValue;
  end;

  TTest2Attribute = class(TCustomAttribute)
  private
    FName: string;
    function GetValue: Boolean;
  public
    constructor Create(AName: string; AValue: Boolean=False);
    property Value: Boolean read GetValue;
  private
    class var FValues: array[0..10] of Boolean; //TDictionary<string,Boolean>;
  public
    class procedure SetValue(AName: string; AValue: Boolean);  // der Name wird erstmal nur einfach auf den Index umgecastet (Tipp: das TDictionary und ein Class-Constructor)
  end;

  TTest = class
  private
    FString: string;
  public
    [TTest1(False)] property Test1: string read FString write FString;
    [TTest2('2')]   property Test2: string read FString write FString;
  end;

constructor TTest1Attribute.Create(AValue: Boolean);
begin
  inherited Create;
  FValue := AValue;
  ShowMessage(ClassName + ': Create');
end;

destructor TTest1Attribute.Destroy;
begin
  ShowMessage(ClassName + ': Destroy');
  inherited;
end;

function TTest1Attribute.GetValue: Boolean;
begin
  ShowMessage(ClassName + ': GetValue');
  Result := FValue;
end;

procedure TTest1Attribute.SetValue(AValue: Boolean);
begin
  ShowMessage(ClassName + ': SetValue');
  FValue := AValue;
end;

constructor TTest2Attribute.Create(AName: string; AValue: Boolean);
begin
  inherited Create;
  FName := AName;
  SetValue(AName, AValue);
end;

function TTest2Attribute.GetValue: Boolean;
begin
  Result := FValues[StrToInt(FName)];
end;

class procedure TTest2Attribute.SetValue(AName: string; AValue: Boolean);
begin
  FValues[StrToInt(AName)] := AValue;
end;

Delphi-Quellcode:

var
  rtti:    TRttiContext;
  typ:     TRttiType;
  prop1:   TRttiInstanceProperty;
  prop2:   TRttiInstanceProperty;
  attr:    ^TAttrData;
  protOld: Cardinal;
  attrObj: TCustomAttribute;
begin
  ShowMessage(ClassName + ': Begin');
  rtti  := TRttiContext.Create;
  typ   := rtti.GetType({ClassType}TTest);
  prop1 := typ.GetProperty({APropName}'Test1') as TRttiInstanceProperty;
  prop2 := typ.GetProperty({APropName}'Test2') as TRttiInstanceProperty;

  //for attrObj in prop1.GetAttributes do
  //  if attrObj is TTest1Attribute then
  //    ShowMessage(attrObj.ClassName + ': ' + BoolToStr(TTest1Attribute(attrObj).Value, True))  // billig gecastet ... den Value-Property hätte man ja auch via RTTI suchen und auslesen können
  //  else if attrObj is TTest2Attribute then
  //    ShowMessage(attrObj.ClassName + ': ' + BoolToStr(TTest2Attribute(attrObj).Value, True))
  //  else
  //    ShowMessage(attrObj.ClassName);
  attrObj := prop1.GetAttributes[0];  ShowMessage(attrObj.ClassName + ': ' + BoolToStr((attrObj as TTest1Attribute).Value, True));
  attrObj := prop2.GetAttributes[0];  ShowMessage(attrObj.ClassName + ': ' + BoolToStr((attrObj as TTest2Attribute).Value, True));

  attr := @GetTypeData(prop1.Handle).AttrData;  // @prop.TypeData^.AttrData; // TypeData ist Privat
  VirtualProtect(attr, 4096, PAGE_READWRITE, protOld);
  Inc(attr, SizeOf(Word)); // TAttrData.Len überspringen
  if PAttrEntry(attr).AttrCtor = nil then ;  // k.A.
  VirtualProtect(attr, 4096, protOld, protOld);

  (prop1.GetAttributes[0] as TTest1Attribute).Value := True;

  TTest2Attribute.SetValue('2', True);

  attrObj := prop1.GetAttributes[0];  ShowMessage(attrObj.ClassName + ': ' + BoolToStr((attrObj as TTest1Attribute).Value, True));
  attrObj := prop2.GetAttributes[0];  ShowMessage(attrObj.ClassName + ': ' + BoolToStr((attrObj as TTest2Attribute).Value, True));

  // nochmal
  rtti  := TRttiContext.Create;
  typ   := rtti.GetType({ClassType}TTest);
  prop1 := typ.GetProperty({APropName}'Test1') as TRttiInstanceProperty;
  prop2 := typ.GetProperty({APropName}'Test2') as TRttiInstanceProperty;

  attrObj := prop1.GetAttributes[0];  ShowMessage(attrObj.ClassName + ': ' + BoolToStr((attrObj as TTest1Attribute).Value, True));
  attrObj := prop2.GetAttributes[0];  ShowMessage(attrObj.ClassName + ': ' + BoolToStr((attrObj as TTest2Attribute).Value, True));

  ShowMessage(ClassName + ': End');