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

正如已经讨论过的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 或原始类型来完成数据操作，而不会丢失信息。

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

TRttiField.GetValue如果字段的类型是值类型，则会为您提供一个副本。这是设计使然。TValue.MakeWithoutCopy用于管理接口和字符串等内容的引用计数；这并不是为了避免这种复制行为。TValue故意不旨在模仿Variant的 ByRef 行为，您最终可以引用（例如）a 中的堆栈对象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 method:

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可以支持实例而不是破坏性的自我更新，或者非平面数组索引等。