使用RTTI递归迭代delphi中的内部记录

时间:2018-08-29 23:48:11

标签: delphi rtti

我在Delphi(柏林)有许多记录结构,我试图通过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的返回值是垃圾。

1 个答案:

答案 0 :(得分: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
-------