使用RTTI在Delphi中递归迭代内部记录

3

我在Delphi(Berlin)中有许多记录结构,我试图使用RTTI递归迭代这些结构。但是代码对内部记录无法正常工作。我在这里做错了什么?

 Procedure WriteFields(Const RType  : TRttiType;
                       Const Test   : TTestRecord;
                       Var   Offset : integer);
 var
   RFields : TArray<TRTTIField>;
   i : integer;
   Val : TValue;
 begin
   RFields := GetFields(Rtype);
   try
     for i := Low(RFields) to High(RFields) do
     begin
       if RFields[i].FieldType.TypeKind <> tkRecord then
       begin
         Val := rfields[i].GetValue(@Test);
         writeln(Format('Field Name: %s, Type: %s, Value: %s, Offset: %d',[
                RFields[i].Name,
                RFields[i].FieldType.ToString,
                Val.ToString,
                RFields[i].Offset]));
       end
       else
       begin
         WriteLn(Format('------- Inner record : %s',[RFields[i].name]));
         //recursively call this routine for the other records, and fields
         Writefields(RFields[i].FieldType,Test,Offset);
       end;
       Offset := OffSet +  RFields[i].Offset;
     end;
  finally
    SetLength(RFIelds,0);
  end;
end;

这里是我的测试记录结构。
TInfo = packed record
  Age : integer;
end;

TTestRecord = packed record
  Name : String;
  Text : String;
  Info : TInfo;   //inner record structure
end;

这是我的测试记录数据。
  //set a few values on it
  Test.Name := 'Fred';
  Test.text := 'Some random text';
  Test.Info.Age := 50;

这里是运行在控制台应用程序中的代码输出。
Size of 12

Field Name: Name, Type: string, Value: Fred, Offset: 0
Field Name: Text, Type: string, Value: Some text, Offset: 4
     ------- Inner record : Info
     Field Name: Age, Type: Integer, Value: 38642604, Offset: 0

Total offset of bytes read 12

正如您所见,内部记录 Age 返回的值是垃圾值。


2
在这个调用 rfields[i].GetValue(@Test) 中,你总是传递 Test。它应该是内部记录字段的地址。 - Victoria
完全同意您删除的问题。 - Magoo
1个回答

9
递归调用时,你没有将内部记录实例传递给WriteFields()。你再次传递了外层记录实例。因此,调用TRttiField.GetValue()会导致未定义的行为,因为你提供了错误的指针。

如果你将第二个输入参数更改为 Pointer(这正是TRttiField.GetValue()所期望的),或者更改为无类型的const,然后在进行递归调用时应用RFields[i].Offset到该值,那么你的代码将按预期工作。

例如:

Procedure WriteFields(const RType : TRttiType;
                      const Instance : Pointer);
var
  RField : TRTTIField;
  Val : TValue;
begin
  for RField in RType.GetFields do
  begin
    if RField.FieldType.TypeKind <> tkRecord then
    begin
      Val := RField.GetValue(Instance);
      WriteLn(Format('Field Name: %s, Type: %s, Value: %s, Offset: %d',[
              RField.Name,
              RField.FieldType.ToString,
              Val.ToString,
              RField.Offset]));
    end
    else
    begin
      WriteLn(Format('------- Inner record : %s, Offset: %d',[RField.Name, RField.Offset]));
      //recursively call this routine for the other records, and fields
      WriteFields(RField.FieldType, PByte(Instance)+RField.Offset);
      WriteLn('-------'); 
    end;
  end;
end;

...

var
  Test: TTestRecord;
...
WriteFields(..., @Test);

或者:

Procedure WriteFields(const RType : TRttiType;
                      const Instance);
var
  RField : TRTTIField;
  Val : TValue;
begin
  for RField in RType.GetFields do
  begin
    if RField.FieldType.TypeKind <> tkRecord then
    begin
      Val := RField.GetValue(@Instance);
      WriteLn(Format('Field Name: %s, Type: %s, Value: %s, Offset: %d',[
              RField.Name,
              RField.FieldType.ToString,
              Val.ToString,
              RField.Offset]));
    end
    else
    begin
      WriteLn(Format('------- Inner record : %s, Offset: %d',[RField.Name, RField.Offset]));
      //recursively call this routine for the other records, and fields
      WriteFields(RField.FieldType, (PByte(@Instance)+RField.Offset)^);
      WriteLn('-------');
    end;
  end;
end;

...

var
  Test: TTestRecord;
  ...
WriteFields(..., Test);

在这两种情况下,输出结果都是您所期望的:
Field Name: Name, Type: string, Value: Fred, Offset: 0
Field Name: Text, Type: string, Value: Some random text, Offset: 4
------- Inner record : Info, Offset: 8
Field Name: Age, Type: Integer, Value: 50, Offset: 0
-------

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接