Rtti訪問複雜數據結構中的字段和屬性

Question

正如Rtti data manipulation and consistency in Delphi 2010中所述，原始數據和rtti值之間的一致性可以通過使用一對TRttiField和一個實例指針訪問成員來達到。如果只有基本成員類型的簡單類（如整數或字符串），這將非常容易。 但是如果我們有結構化的字段類型呢？

下面是一個例子：

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; 

會員的一個容易獲得欲BUIL構件-節點的樹，其提供了用於獲取和設置值，得到的屬性，序列化/反序列化值的接口等等。

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

因此，最重要的是獲取/設置值，這是做了 - 使用的GetValue和TRttiField的功能的SetValue - 如前所述。

那麼FPoint會員的實例是什麼？比方說，家長是TExample類，其中的實例是已知的，該成員是一個字段的節點，然後實例是：

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

您似乎誤解了實例指針的工作方式。您不存儲指向該字段的指針，而是存儲指向該類的指針或其所在字段的記錄。對象引用已經是指針，所以不需要在那裏進行投射。對於記錄，您需要使用@符號獲取指向它們的指針。

一旦你有了指針和一個引用該字段的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。這會給你一個指向該字段的指針，而不需要擔心計算偏移量並將指針轉換爲整數。

Answer 3

您正在觸及這個問題的一些概念和問題。首先你已經混合了一些記錄類型和一些屬性，我想先處理它。然後，我會告訴你一些關於如何閱讀記錄的「左」和「頂」字段的簡短信息，當該記錄是班級中某個字段的一部分時......那麼我會給你提供關於如何製作這項工作一般。我可能會稍微解釋一下，但這是午夜，我無法入睡！

例子：

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獲得一個指向TPoint記錄隱藏在V：TValue（要知道，一個我們可以假裝什麼都不知道關於 - 除了它是一個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元素），那麼我們將能夠調用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過程可能不會達到你期望的。你可能會遇到循環引用！