Rtti accessing fields and properties in complex data structures

前端 未结 3 1123
情书的邮戳
情书的邮戳 2020-12-28 11:34

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

相关标签:
3条回答
  • 2020-12-28 12:18

    You seem to be misunderstanding the way an instance pointer works. You don't store a pointer to the field, you store a pointer to the class or the record that it's a field of. Object references are pointers already, so no casting is needed there. For records, you need to obtain a pointer to them with the @ symbol.

    Once you have your pointer, and a TRttiField object that refers to that field, you can call SetValue or GetValue on the TRttiField, and pass in your instance pointer, and it takes care of all the offset calculations for you.

    In the specific case of arrays, GetValue it will give you a TValue that represents an array. You can test this by calling TValue.IsArray if you want. When you have a TValue that represents an array, you can get the length of the array with TValue.GetArrayLength and retrieve the individual elements with TValue.GetArrayElement.

    EDIT: Here's how to deal with record members in a class.

    Records are types too, and they have RTTI of their own. You can modify them without doing "GetValue, modify, SetValue" like this:

    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;
    

    It looks like the part you didn't know about is TValue.GetReferenceToRawData. That will give you a pointer to the field, without you needing to worry about calculating offsets and casting pointers to integers.

    0 讨论(0)
  • 2020-12-28 12:27

    You're touching a few concepts and problems with this question. First of all you've mixed in some record types and some properties, and I'd like to handle this first. Then I'll give you some short info on how to read the "Left" and "Top" fields of a record when that record is part of an field in a class... Then I'll give you suggestions on how to make this work generically. I'm probably going to explain a bit more then it's required, but it's midnight over here and I can't sleep!

    Example:

    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;
    

    Here's the deal. If you write this code, at runtime it will do what it seems to be doing:

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

    But this code will not work the same:

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

    Because that code is equivalent to:

    var X:TMyClass;
    var tmp:TPoint;
    
    tmp := X.GetMyPoint;
    tmp.Left := 7;
    

    The way to fix this is to do something like this:

    var X:TMyClass;
    var P:TPoint;
    
    P := X.MyPoint;
    P.Left := 7;
    X.MyPoint := P;
    

    Moving on, you want to do the same with RTTI. You may get RTTI for both the "AnPoint:TPoint" field and for the "MyPoint:TPoint" field. Because using RTTI you're essentially using a function to get the value, you'll need do use the "Make local copy, change, write back" technique with both (the same kind of code as for the X.MyPoint example).

    When doing it with RTTI we'll always start from the "root" (a TExampleClass instance, or a TMyClass instance) and use nothing but a series of Rtti GetValue and SetValue methods to get the value of the deep field or set the value of the same deep field.

    We'll assume we have the following:

    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
    

    We want to emulate this:

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

    We'll brake that into steps, we're aiming for this:

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

    Because we want to do it with RTTI, and we want it to work with anything, we will not use the "TPoint" type. So as expected we first do this:

    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;
    

    For the next step we'll use the GetReferenceToRawData to get a pointer to the TPoint record hidden in the V:TValue (you know, the one we pretend we know nothing about - except the fact it's a RECORD). Once we get a pointer to that record, we can call the SetValue method to move that "7" inside the record.

    LeftFieldRtti.SetValue(V.GetReferenceToRawData, 7);
    

    This is allmost it. Now we just need to move the TValue back into X:TMyClass:

    AnPointFieldRtti.SetValue(X, V)
    

    From head-to-tail it would look like this:

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

    This can obviously be expanded to handle structures of any depth. Just remember that you need to do it step-by-step: The first GetValue uses the "root" instance, then the next GetValue uses an Instance that's extracted from the previous GetValue result. For records we may use TValue.GetReferenceToRawData, for objects we can use TValue.AsObject!

    The next tricky bit is doing this in a generic way, so you can implement your bi-directional tree-like structure. For that, I'd recommend storing the path from "root" to your field in the form of an TRttiMember array (casting will then be used to find the actual runtype type, so we can call GetValue and SetValue). An node would look something like this:

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

    The implementation of GetValue is very simple:

    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;
    

    The implementation of SetValue would be a tiny little bit more involved. Because of those (pesky?) records we'll need to do everything the GetValue routine does (because we need the Instance pointer for the very last FMember element), then we'll be able to call SetValue, but we might need to call SetValue for it's parent, and then for it's parent's parent, and so on... This obviously means we need to KEEP all the intermediary TValue's intact, just in case we need them. So here we go:

    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;
    

    ... And this should be it. Now some warnings:

    • DON'T expect this to compile! I actually wrote every single bit of code in this post in the web browser. For technical reasons I had access to the Rtti.pas source file to look up method and field names, but I don't have access to an compiler.
    • I'd be VERY careful with this code, especially if PROPERTIES are involved. A property can be implemented without an backing field, the setter procedure might not do what you expect. You might run into circular references!
    0 讨论(0)
  • 2020-12-28 12:31

    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.

    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.

    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;
    

    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;
    

    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;
    

    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.

    0 讨论(0)
提交回复
热议问题