RTTI Attribute verändern

[Neutral General]

Hallo,

Ist es möglich zur Laufzeit die Werte von RTTI-Attributen einer Klasse/Property/Methode zu ändern?
Auslesen ist ja kein Problem. Aber kann man da auch zur Laufzeit was ändern?

[himitsu]

Eigentlich nein, denn die Typinfos sind ja fest einkompilert.

Aber man könnte den Schreibschutz von dem Speicherbreich entfernen und dann darin rumschreiben.
Windows verwaltet diesen Speicher ja als CopyOnWrite (standardmäßig aus der Datei gemappt, aber bei Veränderung wird im Hintergrund die Speicherverwaltung umgestellt)

Es ist aber nur möglich bestehende Attribute umzuschreiben, zu ersetzen oder zu entfernen.
Hinzufügen ist nicht so leicht, da es sich bei diesem AttrData um ein statisches Array handelt.

Delphi-Quellcode:

GetTypeData(TypeInfo(TDeinTyp)).AttrData  // alte RTTI
TRttiType(...).TypeData.AttrData  // Neue

Oder du baust dir eine Attribute-Klasse, welche sich die Daten nicht nur über die Parameter besorgt.
In den Parametern stehet dann z.B. nur die Position, wo das Attribut die Daten herholen soll und an der Stelle kannst du diese vermutlich veliebig verändern. (ich weiß jetzt allerdings nicht wann die Attribute-Instanzen genau erstellt werden und wie lange deren Lebensdauer ist)

[Neutral General]

Hallo,

Danke schon mal für die Antwort. Hinzufügen muss ich nicht, ich will nur ein vorhandenes Attribut ändern oder ersetzen (wenn Ändern nicht geht).

Ich will das Attribut einer Property ändern:

Delphi-Quellcode:

type
  TTestAttribut = class(TCustomAttribute)
  private
    FValue: Boolean;
  public
    constructor Create(AValue: Boolean);
    property Value: Boolean read FValue write FValue;
  end;

  TTest = class
    FString: String;
  public
    [TTestAttribut(false)] property Test: String read FString write FString;
  end;
 
// ....

var rtti: TRttiContext;
    typ: TRttiType;
    Prop: TRttiProperty;
    attrData: PAttrData;
    oldProt: Cardinal;
begin
  rtti := TRttiContext.Create;
  typ := rtti.GetType(ClassType);
  Prop := typ.GetProperty(APropName);

  attrData := @prop.PropertyType.Handle^.TypeData^.AttrData;
  VirtualProtect(attrData,4096,PAGE_READWRITE,oldProt);
  inc(attrData,SizeOf(Word)); // TAttrData.Len überspringen
  PAttrEntry(attrData)^...    // Dabei kommt nix sinnvolles raus.
end;

Das Problem ist dass in attrData, bzw. PAttrEntry(attrData)^ nichts sinnvolles drin steht.
Ich weiß aber auch nicht wo ich den Fehler mache :/

[Stevie]

Du kannst auch die Property beim Attribut schreibbar machen und es nach dem erstem Auslesen ändern.
Dazu musst du aber dafür sorgen, dass dein TRttiContext so lange lebt, wie du diesen geänderten Wert behalten willst. Somit bleiben auch die ganzen RTTI Objekte inkl der Attribut Instanzen am Leben.

[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');

[Stevie]

Zitat von himitsu:

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.

Und genau deshalb schrieb ich:

Zitat von Stevie:

Dazu musst du aber dafür sorgen, dass dein TRttiContext so lange lebt, wie du diesen geänderten Wert behalten willst. Somit bleiben auch die ganzen RTTI Objekte inkl der Attribut Instanzen am Leben.

[himitsu]

Zitat von Stevie:

Und genau deshalb schrieb ich:

Was nur geht, wenn die lesende Stelle den selben Context verwendet, wie die Schreibende.

[Stevie]

Zitat von himitsu:

Zitat von Stevie:

Und genau deshalb schrieb ich:

Was nur geht, wenn die lesende Stelle den selben Context verwendet, wie die Schreibende.

Falsch, es gibt intern nur eine Instanz der TRttiPool Klasse, welche durch den TRttiContext record gewrappt wird.

[himitsu]

Sicher?

Siehe mein TestCode. (getestet in XE)
Da wird zwei mal "gleichzeitig" eine Instanz des TTest1Attribute erzeugt, nach dem "nochmal", obwohl es davon nur ein Attribut.

Es ändert sich auch nichts, selbst wenn ich nach dem "nochmal" eigene Variablen verwende und die ersten Instanzen nicht überschreibe.
TTest1Attribute ist bei der letzen Abfrage auch wieder False.

[Stevie]

Zitat von himitsu:

Sicher?

Siehe mein TestCode. (getestet in XE)
Da wird zwei mal "gleichzeitig" eine Instanz des TTest1Attribute erzeugt, nach dem "nochmal", obwohl es davon nur ein Attribut.

Ja, 100% sicher, ich kenn nämlich den Rtti.pas Source inzwischen fast im Schlaf.

Garantiert wird bei dem Source, den du gepostet hast nicht mehrfach eine Attribut Instanz erzeugt. Außer du hast lokal bei dir noch vor dem "nochmal" einen rtti.Free Aufruf.
Wenn du mir nicht glaubst, dann debug doch durch das TRttiContext.Create .

Oder du liest den Artikel von Barry dazu.