Rtti访问复杂数据结构中的字段和属性 [英] Rtti accessing fields and properties in complex data structures

问题描述

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

As already discussed in Rtti data manipulation and consistency in Delphi 2010 a consistency between the original data and rtti values can be reached by accessing members by using a pair of TRttiField and an instance pointer. This would be very easy in case of a simple class with only basic member types (like e.g. integers or strings). But what if we have structured field types?

这是一个例子：

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;

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

For an easy access of Members I want to buil a tree of member-nodes, which provides an interface for getting and setting values, getting attributes, serializing/deserializing values and so on.

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

所以最重要的是获取/设置值，如前所述 - 使用TRttiField的GetValue和SetValue函数。

So the most important thing is getting/setting the values, which is done - as stated before - by using the GetValue and SetValue functions of TRttiField.

那么FPoint成员的实例是什么？假设Parent是TExample类的节点，实例已知，成员是一个字段，那么Instance将是：

So what is the Instance for FPoint members? Let's say Parent is the Node for TExample class, where the instance is known and the member is a field, then Instance would be:

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

但是，如果我想知道实例的记录属性怎么办？在这种情况下没有偏移。那么有更好的解决方案来获取数据的指针？

But what if I want to know the Instance for a record property? There is no offset in this case. So is there a better solution to get a pointer to the data?

对于FAnotherClass成员，实例将是：

For the FAnotherClass member, the Instance would be:

FInstance := Parent.Value.AsObject;  

解决方案到目前为止，数据操作可以通过使用rtti或原始类型完成，没有丢失信息。

So far the solution works, and data manipulation can be done by using rtti or the original types, without losing information.

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

But things get harder, when working with arrays. Especially the second array of Points. How can I get the instance for the members of points in this case?

推荐答案

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

TRttiField.GetValue where the field's type is a value type gets you a copy. This is by design. TValue.MakeWithoutCopy is for managing reference counts on things like interfaces and strings; it is not for avoiding this copy behaviour. TValue is intentionally not designed to mimic Variant's ByRef behaviour, where you can end up with references to (e.g.) stack objects inside a TValue, increasing the risk of stale pointers. It would also be counter-intuitive; when you say GetValue, you should expect a value, not a reference.

可能是最有效的操作方法价值类型的值存储在其他结构中时，是退出并添加另一个间接级别：通过计算偏移量而不是直接使用 TValue 直接为所有中间值输入步骤沿着该项目的路径。

Probably the most efficient way to manipulate values of value types when they are stored inside other structures is to step back and add another level of indirection: by calculating offsets rather than working with TValue directly for all the intermediary value typed steps along the path to the item.

这可以非常简单的封装。我花了几个小时左右写了一个使用RTTI的记录记录：

This can be encapsulated fairly trivially. I spent the past hour or so writing up a little TLocation record which uses RTTI to do this:

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在值内导航位置。为了使它稍微更容易使用，稍微更有趣的我写，我也写了一个解析器 - 跟随方法：

This type can be used to navigate locations within values using RTTI. To make it slightly easier to use, and slightly more fun for me to write, I also wrote a parser - the 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 ）操纵它：

Here's an example type, and a routine (P) that manipulates it:

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

The principle can be extended to other types and Delphi expression syntax, or TLocation may be changed to return new TLocation instances rather than destructive self-updates, or non-flat array indexing may be supported, etc.

这篇关于Rtti访问复杂数据结构中的字段和属性的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！