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

Question

正如 Delphi 2010 中的 Rtti 数据操作和一致性中已经讨论的那样可以通过使用一对 TRttiField 和实例指针访问成员来达到原始数据和 rtti 值之间的一致性。如果是只有基本成员类型（例如整数或字符串）的简单类，这将非常容易。 但是如果我们有结构化字段类型怎么办？

这是一个例子：

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;

为了方便地访问成员，我想构建一个成员节点树，它提供了一个用于获取和设置值、获取属性、序列化/反序列化值等的接口。

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

因此，最重要的是获取/设置值，如前所述，这是通过使用 TRttiField 的 GetValue 和 SetValue 函数来完成的。

那么什么是FPoint会员实例呢？假设 Parent 是 TExample 类的节点，其中实例已知且成员是字段，则 Instance 将为：

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

您正在触及这个问题的一些概念和问题。首先，您混合了一些记录类型和一些属性，我想先处理这个问题。然后，我将向您提供一些简短信息，说明当该记录是类中字段的一部分时，如何读取记录的“左侧”和“顶部”字段...然后我将向您提供有关如何制作的建议这项工作一般。我可能会解释更多一点，但现在是午夜，我睡不着！

示例：

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 执行此操作时，我们始终从“根”（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 来获取指向隐藏在 V:TValue 中的 TPoint 记录的指针（您知道，我们假装对此一无所知 - 除了事实上它是一个记录）。一旦我们获得指向该记录的指针，我们就可以调用 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”到字段的路径（然后将使用转换来查找实际的运行类型类型，因此我们可以调用 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 元素的 Instance 指针），然后我们将能够调用 SetValue ，但我们可能需要为它的父级调用 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;

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

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

Answer 3

您似乎误解了实例指针的工作方式。您不存储指向该字段的指针，而是存储指向该字段所属的类或记录的指针。对象引用已经是指针，因此不需要进行强制转换。对于记录，您需要使用@符号获取指向它们的指针。

一旦有了指针和引用该字段的 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。这将为您提供指向该字段的指针，而无需担心计算偏移量并将指针转换为整数。