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

时间：2010-05-10 13:18:24

标签： delphi delphi-2010 rtti

正如在Rtti data manipulation and consistency in Delphi 2010中已经讨论的那样，通过使用一对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类的Node，其中实例是已知的，成员是一个字段，然后Instance将是：

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

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

对于FAnotherClass成员，实例将是：

FInstance := Parent.Value.AsObject;

到目前为止，该解决方案仍然有效，并且可以使用rtti或原始类型完成数据操作，而不会丢失信息。

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

3 个答案:

答案 0 :(得分：13)

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

答案 1 :(得分：4)

您正在触及此问题的一些概念和问题。首先，你已经混合了一些记录类型和一些属性，我想先处理它。然后我会给你一些简短的信息，告诉你当一个记录是一个字段中的一个字段的一部分时如何读取记录的“左”和“顶部”字段...然后我会给你如何制作的建议这项工作一般来说。我可能会更多地解释一下这是必要的，但是在这里午夜，我无法入睡！

示例：

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获取指向隐藏在V：TValue中的TPoint记录的指针（你知道，我们假装我们一无所知的那个 - 除了它是一个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元素的Instance指针），那么我们就能调用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过程可能无法按预期执行。你可能会遇到循环引用！

答案 2 :(得分：0)

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

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

在数组的特定情况下，GetValue将为您提供代表数组的TValue。如果需要，您可以致电TValue.IsArray进行测试。如果您有一个代表数组的TValue，您可以使用TValue.GetArrayLength获取数组的长度，并使用TValue.GetArrayElement检索单个元素。

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

记录也是类型，并且它们具有自己的RTTI。您可以修改它们，而不必执行“GetValue，modify，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。这将为您提供指向该字段的指针，而无需担心计算偏移量并将指针转换为整数。

相关问题
最新问题