时间戳

首页 > 解决方案 > 使用RTTI递归迭代delphi中的内部记录

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

问题描述

我在 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 返回的值是垃圾。

标签： delphirtti

解决方案

WriteFields()在递归调用期间，您没有将内部记录实例传递给。 您再次传递外部记录实例。因此，调用TRttiField.GetValue()失败并出现未定义的行为，因为您给了它错误的指针。

如果您将第二个输入参数更改为 a Pointer（TRttiField.GetValue()无论如何都是预期的）或 untyped 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
-------

推荐阅读