Rtti访问复杂数据结构中的字段和属性

Question

正如Rtti data manipulation and consistency in Delphi 2010中所述，原始数据和rtti值之间的一致性可以通过使用一对TRttiField和一个实例指针访问成员来达到。如果只有基本成员类型的简单类（如整数或字符串），这将非常容易。 但是如果我们有结构化的字段类型呢？

下面是一个例子：

TIntArray = array [0..1] of Integer; 

TPointArray = array [0..1] of Point; 

TExampleClass = class 
    private 
    FPoint : TPoint; 
    FAnotherClass : TAnotherClass; 
    FIntArray : TIntArray; 
    FPointArray : TPointArray; 
    public 
    property Point : TPoint read FPoint write FPoint; 
    //.... and so on 
end; 

会员的一个容易获得欲BUIL构件-节点的树，其提供了用于获取和设置值，得到的属性，序列化/反序列化值的接口等等。

TMemberNode = class 
    private 
    FMember : TRttiMember; 
    FParent : TMemberNode; 
    FInstance : Pointer; 
    public 
    property Value : TValue read GetValue write SetValue; //uses FInstance 
end; 

因此，最重要的是获取/设置值，这是做了 - 使用的GetValue和TRttiField的功能的SetValue - 如前所述。

那么FPoint会员的实例是什么？比方说，家长是TExample类，其中的实例是已知的，该成员是一个字段的节点，然后实例是：

FInstance := Pointer (Integer (Parent.Instance) + TRttiField (FMember).Offset); 

但是如果我想知道创纪录的属性实例？在这种情况下没有抵消。那么是否有更好的解决方案来获取指向数据的指针？

对于FAnotherClass成员，实例是：

FInstance := Parent.Value.AsObject; 

到目前为止解决方案的工作，和数据操作可以通过使用RTTI还是原来的类型来进行，而不会丢失信息。

但在使用数组时，事情变得更加困难。特别是第二个点的数组。在这种情况下，我如何获得点的成员的实例？

Answer 1

TRttiField.GetValue其中该字段的类型是一个值类型会得到一个副本。这是设计。 TValue.MakeWithoutCopy用于管理接口和字符串等事物的引用计数;它不是为了避免这种复制行为。 TValue故意没有被设计为模仿Variant的ByRef行为，最终可能引用（例如）TValue中的堆栈对象，从而增加了陈旧指针的风险。这也会违反直觉;当你说GetValue，你应该期望一个值，而不是一个参考。

当存储在其他结构中时，处理值类型值的最有效方法是退后一步并添加另一个间接级别：通过计算偏移量而不是直接与TValue一起处理所有中间值类型的步骤该项目的路径。

这可以封装得相当平凡。我花了一小时左右写了一个小TLocation记录它使用RTTI做到这一点：

type 
    TLocation = record 
    Addr: Pointer; 
    Typ: TRttiType; 
    class function FromValue(C: TRttiContext; const AValue: TValue): TLocation; static; 
    function GetValue: TValue; 
    procedure SetValue(const AValue: TValue); 
    function Follow(const APath: string): TLocation; 
    procedure Dereference; 
    procedure Index(n: Integer); 
    procedure FieldRef(const name: string); 
    end; 

function GetPathLocation(const APath: string; ARoot: TLocation): TLocation; forward; 

{ TLocation } 

type 
    PPByte = ^PByte; 

procedure TLocation.Dereference; 
begin 
    if not (Typ is TRttiPointerType) then 
    raise Exception.CreateFmt('^ applied to non-pointer type %s', [Typ.Name]); 
    Addr := PPointer(Addr)^; 
    Typ := TRttiPointerType(Typ).ReferredType; 
end; 

procedure TLocation.FieldRef(const name: string); 
var 
    f: TRttiField; 
begin 
    if Typ is TRttiRecordType then 
    begin 
    f := Typ.GetField(name); 
    Addr := PByte(Addr) + f.Offset; 
    Typ := f.FieldType; 
    end 
    else if Typ is TRttiInstanceType then 
    begin 
    f := Typ.GetField(name); 
    Addr := PPByte(Addr)^ + f.Offset; 
    Typ := f.FieldType; 
    end 
    else 
    raise Exception.CreateFmt('. applied to type %s, which is not a record or class', 
     [Typ.Name]); 
end; 

function TLocation.Follow(const APath: string): TLocation; 
begin 
    Result := GetPathLocation(APath, Self); 
end; 

class function TLocation.FromValue(C: TRttiContext; const AValue: TValue): TLocation; 
begin 
    Result.Typ := C.GetType(AValue.TypeInfo); 
    Result.Addr := AValue.GetReferenceToRawData; 
end; 

function TLocation.GetValue: TValue; 
begin 
    TValue.Make(Addr, Typ.Handle, Result); 
end; 

procedure TLocation.Index(n: Integer); 
var 
    sa: TRttiArrayType; 
    da: TRttiDynamicArrayType; 
begin 
    if Typ is TRttiArrayType then 
    begin 
    // extending this to work with multi-dimensional arrays and non-zero 
    // based arrays is left as an exercise for the reader ... :) 
    sa := TRttiArrayType(Typ); 
    Addr := PByte(Addr) + sa.ElementType.TypeSize * n; 
    Typ := sa.ElementType; 
    end 
    else if Typ is TRttiDynamicArrayType then 
    begin 
    da := TRttiDynamicArrayType(Typ); 
    Addr := PPByte(Addr)^ + da.ElementType.TypeSize * n; 
    Typ := da.ElementType; 
    end 
    else 
    raise Exception.CreateFmt('[] applied to non-array type %s', [Typ.Name]); 
end; 

procedure TLocation.SetValue(const AValue: TValue); 
begin 
    AValue.Cast(Typ.Handle).ExtractRawData(Addr); 
end; 

本型可用于导航使用RTTI值中的位置。为了使它稍微容易使用，并稍微更有趣，我写的，我也写了一个解析器 - 的Follow方法：

function GetPathLocation(const APath: string; ARoot: TLocation): TLocation; 

    { Lexer } 

    function SkipWhite(p: PChar): PChar; 
    begin 
    while IsWhiteSpace(p^) do 
     Inc(p); 
    Result := p; 
    end; 

    function ScanName(p: PChar; out s: string): PChar; 
    begin 
    Result := p; 
    while IsLetterOrDigit(Result^) do 
     Inc(Result); 
    SetString(s, p, Result - p); 
    end; 

    function ScanNumber(p: PChar; out n: Integer): PChar; 
    var 
    v: Integer; 
    begin 
    v := 0; 
    while (p >= '0') and (p <= '9') do 
    begin 
     v := v * 10 + Ord(p^) - Ord('0'); 
     Inc(p); 
    end; 
    n := v; 
    Result := p; 
    end; 

const 
    tkEof = #0; 
    tkNumber = #1; 
    tkName = #2; 
    tkDot = '.'; 
    tkLBracket = '['; 
    tkRBracket = ']'; 

var 
    cp: PChar; 
    currToken: Char; 
    nameToken: string; 
    numToken: Integer; 

    function NextToken: Char; 
    function SetToken(p: PChar): PChar; 
    begin 
     currToken := p^; 
     Result := p + 1; 
    end; 
    var 
    p: PChar; 
    begin 
    p := cp; 
    p := SkipWhite(p); 
    if p^ = #0 then 
    begin 
     cp := p; 
     currToken := tkEof; 
     Exit(currToken); 
    end; 

    case p^ of 
     '0'..'9': 
     begin 
     cp := ScanNumber(p, numToken); 
     currToken := tkNumber; 
     end; 

     '^', '[', ']', '.': cp := SetToken(p); 

    else 
     cp := ScanName(p, nameToken); 
     if nameToken = '' then 
     raise Exception.Create('Invalid path - expected a name'); 
     currToken := tkName; 
    end; 

    Result := currToken; 
    end; 

    function Describe(tok: Char): string; 
    begin 
    case tok of 
     tkEof: Result := 'end of string'; 
     tkNumber: Result := 'number'; 
     tkName: Result := 'name'; 
    else 
     Result := '''' + tok + ''''; 
    end; 
    end; 

    procedure Expect(tok: Char); 
    begin 
    if tok <> currToken then 
     raise Exception.CreateFmt('Expected %s but got %s', 
     [Describe(tok), Describe(currToken)]); 
    end; 

    { Semantic actions are methods on TLocation } 
var 
    loc: TLocation; 

    { Driver and parser } 

begin 
    cp := PChar(APath); 
    NextToken; 

    loc := ARoot; 

    // Syntax: 
    // path ::= ('.' <name> | '[' <num> ']' | '^')+ ;; 

    // Semantics: 

    // '<name>' are field names, '[]' is array indexing, '^' is pointer 
    // indirection. 

    // Parser continuously calculates the address of the value in question, 
    // starting from the root. 

    // When we see a name, we look that up as a field on the current type, 
    // then add its offset to our current location if the current location is 
    // a value type, or indirect (PPointer(x)^) the current location before 
    // adding the offset if the current location is a reference type. If not 
    // a record or class type, then it's an error. 

    // When we see an indexing, we expect the current location to be an array 
    // and we update the location to the address of the element inside the array. 
    // All dimensions are flattened (multiplied out) and zero-based. 

    // When we see indirection, we expect the current location to be a pointer, 
    // and dereference it. 

    while True do 
    begin 
    case currToken of 
     tkEof: Break; 

     '.': 
     begin 
     NextToken; 
     Expect(tkName); 
     loc.FieldRef(nameToken); 
     NextToken; 
     end; 

     '[': 
     begin 
     NextToken; 
     Expect(tkNumber); 
     loc.Index(numToken); 
     NextToken; 
     Expect(']'); 
     NextToken; 
     end; 

     '^': 
     begin 
     loc.Dereference; 
     NextToken; 
     end; 

    else 
     raise Exception.Create('Invalid path syntax: expected ".", "[" or "^"'); 
    end; 
    end; 

    Result := loc; 
end; 

下面是一个例子类型，并操纵其常规（P）：

type 
    TPoint = record 
    X, Y: Integer; 
    end; 
    TArr = array[0..9] of TPoint; 

    TFoo = class 
    private 
    FArr: TArr; 
    constructor Create; 
    function ToString: string; override; 
    end; 

{ TFoo } 

constructor TFoo.Create; 
var 
    i: Integer; 
begin 
    for i := Low(FArr) to High(FArr) do 
    begin 
    FArr[i].X := i; 
    FArr[i].Y := -i; 
    end; 
end; 

function TFoo.ToString: string; 
var 
    i: Integer; 
begin 
    Result := ''; 
    for i := Low(FArr) to High(FArr) do 
    Result := Result + Format('(%d, %d) ', [FArr[i].X, FArr[i].Y]); 
end; 

procedure P; 
var 
    obj: TFoo; 
    loc: TLocation; 
    ctx: TRttiContext; 
begin 
    obj := TFoo.Create; 
    Writeln(obj.ToString); 

    ctx := TRttiContext.Create; 

    loc := TLocation.FromValue(ctx, obj); 
    Writeln(loc.Follow('.FArr[2].X').GetValue.ToString); 
    Writeln(obj.FArr[2].X); 

    loc.Follow('.FArr[2].X').SetValue(42); 
    Writeln(obj.FArr[2].X); // observe value changed 

    // alternate syntax, not using path parser, but location destructive updates 
    loc.FieldRef('FArr'); 
    loc.Index(2); 
    loc.FieldRef('X'); 
    loc.SetValue(24); 
    Writeln(obj.FArr[2].X); // observe value changed again 

    Writeln(obj.ToString); 
end; 

原理可以扩展到其他类型和Delphi表达式语法，或TLocation可以被改变以返回新TLocation实例而非破坏性自更新，或不平坦的数组索引可被支撑，等等

Answer 2

您似乎误解了实例指针的工作方式。您不存储指向该字段的指针，而是存储指向该类的指针或其所在字段的记录。对象引用已经是指针，所以不需要在那里进行投射。对于记录，您需要使用@符号获取指向它们的指针。

一旦你有了指针和一个引用该字段的TRttiField对象，你就可以在TRttiField上调用SetValue或GetValue，并传递实例指针，并为你处理所有的偏移量计算。

在数组的特定情况下，GetValue会给你一个表示数组的TValue。如果需要，您可以致电TValue.IsArray进行测试。当你有一个表示数组的TValue时，你可以得到TValue.GetArrayLength的数组长度，并用TValue.GetArrayElement检索单个元素。

编辑：以下是如何处理班级中的记录成员。

记录也是类型，他们有自己的RTTI。您可以修改他们没有做“的GetValue，修改的SetValue”像这样：

procedure ModifyPoint(example: TExampleClass; newXValue, newYValue: integer); 
var 
    context: TRttiContext; 
    value: TValue; 
    field: TRttiField; 
    instance: pointer; 
    recordType: TRttiRecordType; 
begin 
    field := context.GetType(TExampleClass).GetField('FPoint'); 
    //TValue that references the TPoint 
    value := field.GetValue(example); 
    //Extract the instance pointer to the TPoint within your object 
    instance := value.GetReferenceToRawData; 
    //RTTI for the TPoint type 
    recordType := context.GetType(value.TypeInfo) as TRttiRecordType; 
    //Access the individual members of the TPoint 
    recordType.GetField('X').SetValue(instance, newXValue); 
    recordType.GetField('Y').SetValue(instance, newYValue); 
end; 

它看起来就像你不知道的部分是TValue.GetReferenceToRawData。这会给你一个指向该字段的指针，而不需要担心计算偏移量并将指针转换为整数。

Answer 3

您正在触及这个问题的一些概念和问题。首先你已经混合了一些记录类型和一些属性，我想先处理它。然后，我会告诉你一些关于如何阅读记录的“左”和“顶”字段的简短信息，当该记录是班级中某个字段的一部分时......那么我会给你提供关于如何制作这项工作一般。我可能会稍微解释一下，但这是午夜，我无法入睡！

例子：

TPoint = record 
    Top: Integer; 
    Left: Integer; 
end; 

TMyClass = class 
protected 
    function GetMyPoint: TPoint; 
    procedure SetMyPoint(Value:TPoint); 
public 
    AnPoint: TPoint;   
    property MyPoint: TPoint read GetMyPoint write SetMyPoint; 
end; 

function TMyClass.GetMyPoint:Tpoint; 
begin 
    Result := AnPoint; 
end; 

procedure TMyClass.SetMyPoint(Value:TPoint); 
begin 
    AnPoint := Value; 
end; 

这里的交易。如果你写的代码，在运行时会做什么，似乎在做：

var X:TMyClass; 
x.AnPoint.Left := 7; 

但是这个代码将无法正常工作一样：由于代码相当于

var X:TMyClass; 
x.MyPoint.Left := 7; 

：

var X:TMyClass; 
var tmp:TPoint; 

tmp := X.GetMyPoint; 
tmp.Left := 7; 

解决这个问题的办法是做这样的事情：

var X:TMyClass; 
var P:TPoint; 

P := X.MyPoint; 
P.Left := 7; 
X.MyPoint := P; 

继续前进，您想要对RTTI做同样的事情。您可能会为“AnPoint：TPoint”字段和“MyPoint：TPoint”字段获取RTTI。由于使用RTTI本质上是使用函数来获取值，因此您需要使用两种方法（与X.MyPoint示例相同的代码）使用“进行本地复制，更改，回写”技术。

当我们使用RTTI进行操作时，我们总是从“root”（一个TExampleClass实例或一个TMyClass实例）开始，除了一系列Rtti GetValue和SetValue方法外，我们还会使用深层字段的值或设置相同深度字段的值。

我们假定我们有以下几点：

AnPointFieldRtti: TRttiField; // This is RTTI for the AnPoint field in the TMyClass class 
LeftFieldRtti: TRttiField; // This is RTTI for the Left field of the TPoint record 

我们想模仿这样的：

var X:TMyClass; 
begin 
    X.AnPoint.Left := 7; 
end; 

我们将制动到这步，我们的目标本：

var X:TMyClass; 
    V:TPoint; 
begin 
    V := X.AnPoint; 
    V.Left := 7; 
    X.AnPoint := V; 
end; 

因为我们想用RTTI来做，而且我们希望它能与任何东西一起工作，所以我们不会使用“TPoint”类型。因此，如预期，我们首先做到这一点：

var X:TMyClass; 
    V:TValue; // This will hide a TPoint value, but we'll pretend we don't know 
begin 
    V := AnPointFieldRtti.GetValue(X); 
end; 

对于下一步，我们将使用GetReferenceToRawData获得一个指向TPoint记录隐藏在V：TValue（要知道，一个我们可以假装什么都不知道关于 - 除了它是一个RECORD的事实）。一旦我们获得了一条指向该记录的指针，我们可以调用SetValue方法在记录内移动“7”。

LeftFieldRtti.SetValue(V.GetReferenceToRawData, 7); 

这是最重要的。现在我们只需要移动TValue返回到X：TMyClass：

AnPointFieldRtti.SetValue(X, V) 

从头部到尾部它应该是这样的：

var X:TMyClass; 
    V:TPoint; 
begin 
    V := AnPointFieldRtti.GetValue(X); 
    LeftFieldRtti.SetValue(V.GetReferenceToRawData, 7); 
    AnPointFieldRtti.SetValue(X, V); 
end; 

这显然可以扩展到处理的任何结构深度。请记住，您需要一步一步完成：第一个GetValue使用“root”实例，然后下一个GetValue使用从前一个GetValue结果中提取的实例。对于记录，我们可以使用TValue.GetReferenceToRawData，对于我们可以使用TValue.AsObject的对象！

下一个棘手的问题是以通用的方式做到这一点，所以你可以实现你的双向树状结构。为此，我建议以TRttiMember数组的形式存储从“root”到您的字段的路径（然后将使用铸造来查找实际的runtype类型，因此我们可以调用GetValue和SetValue）。一个节点将是这个样子：

TMemberNode = class 
    private 
    FMember : array of TRttiMember; // path from root 
    RootInstance:Pointer; 
    public 
    function GetValue:TValue; 
    procedure SetValue(Value:TValue); 
end; 

的GetValue的实现很简单：

function TMemberNode.GetValue:TValue; 
var i:Integer;  
begin 
    Result := FMember[0].GetValue(RootInstance); 
    for i:=1 to High(FMember) do 
    if FMember[i-1].FieldType.IsRecord then 
     Result := FMember[i].GetValue(Result.GetReferenceToRawData) 
    else 
     Result := FMember[i].GetValue(Result.AsObject); 
end; 

的SetValue的实现将是一个很小的一点更多地参与。由于那些（讨厌？）记录，我们需要做的一切所有 GetValue例程（因为我们需要实例指针为最后一个FMember元素），那么我们将能够调用SetValue，但我们可能需要调用SetValue作为它的父对象，然后调用它的父对象的父对象，等等......这显然意味着我们需要保持所有中间TValue的完整，以防万一需要它们。所以在这里我们去：

procedure TMemberNode.SetValue(Value:TValue); 
var Values:array of TValue; 
    i:Integer; 
begin 
    if Length(FMember) = 1 then 
    FMember[0].SetValue(RootInstance, Value) // this is the trivial case 
    else 
    begin 
     // We've got an strucutred case! Let the fun begin. 
     SetLength(Values, Length(FMember)-1); // We don't need space for the last FMember 

     // Initialization. The first is being read from the RootInstance 
     Values[0] := FMember[0].GetValue(RootInstance); 

     // Starting from the second path element, but stoping short of the last 
     // path element, we read the next value 
     for i:=1 to Length(FMember)-2 do // we'll stop before the last FMember element 
     if FMember[i-1].FieldType.IsRecord then 
      Values[i] := FMember[i].GetValue(Values[i-1].GetReferenceToRawData) 
     else 
      Values[i] := FMember[i].GetValue(Values[i-1].AsObject); 

     // We now know the instance to use for the last element in the path 
     // so we can start calling SetValue. 
     if FMember[High(FMember)-1].FieldType.IsRecord then 
     FMember[High(FMember)].SetValue(Values[High(FMember)-1].GetReferenceToRawData, Value) 
     else 
     FMember[High(FMember)].SetValue(Values[High(FMember)-1].AsObject, Value); 

     // Any records along the way? Since we're dealing with classes or records, if 
     // something is not a record then it's a instance. If we reach a "instance" then 
     // we can stop processing. 
     i := High(FMember)-1; 
     while (i >= 0) and FMember[i].FieldType.IsRecord do 
     begin 
     if i = 0 then 
      FMember[0].SetValue(RootInstance, Values[0]) 
     else 
      if FMember[i-1].FieldType.IsRecord then 
      FMember[i].SetValue(FMember[i-1].GetReferenceToRawData, Values[i]) 
      else 
      FMember[i].SetValue(FMember[i-1].AsObject, Values[i]); 
     // Up one level (closer to the root): 
     Dec(i) 
     end; 
    end; 
end; 

......这应该是它。现在一些警告：

• 不要期望这个编译！我实际上在Web浏览器中编写了这篇文章中的每一段代码。由于技术原因，我有权访问Rtti.pas源文件来查找方法和字段名称，但我无法访问编译器。
• 我会非常小心这个代码，特别是如果涉及到属性。一个属性可以在没有后台字段的情况下实现，setter过程可能不会达到你期望的。你可能会遇到循环引用！