Delphi XE2 RTTI坏了？

Question

我最近从 D2010 迁移到 DXE2，并在 XE2 和 XE3(在我的 friend XE3 中测试)中发现了一个与类内 TBytes 字段的 RTTI 生成相关的严重错误(或功能？)。

我发现类中 TBytes 变量的 RTTI 信息永远不会生成。

下面的代码在D2010中运行良好，但在XE2/XE3中显示“错误”消息

有人知道吗？这将彻底破坏我们所有的软件数据序列化实现

要测试代码，请将 Rtti 单位添加到使用声明中

type

  TMyClass = class
  public
    Field1: Integer;
    Field2: TBytes;
  end;


procedure TForm2.Button1Click(Sender: TObject);
var
  i: Integer;
  Data: TMyClass;
  Rtti: TRttiContext;
  RttiClassType: TRttiInstanceType;
begin

  Data := TMyClass.Create;
  try

    // Get the context
    Rtti := TRttiContext.Create;
    try

      // Get the type for the class
      RttiClassType := TRttiInstanceType(Rtti.GetType(Data.ClassInfo));

      // Check the fields
      for i := 0 to High(RttiClassType.GetFields) do
      begin

        // Check the field type
        if not Assigned(RttiClassType.GetFields[i].FieldType) then
          ShowMessage('Error');

      end;

    finally
      Rtti.Free;
    end;

  finally
    Data.Free;
  end;

end;

检查 Field2 是否为 TBytes 时，将显示错误消息，因为 FieldType 始终为 nil!!!

有谁知道 XE2 与 D2010 相比 RTTI 发生了什么变化？也许是因为 TBytes 类型从 Byte 数组更改为通用数组？

Answer 1

您可以修复此错误(它实际上与 Mason 提到的错误不同)。

type
  FixTypeInfoAttribute = class(TCustomAttribute)
  public
    FTypeInfo: PPTypeInfo;
    constructor Create(TypeInfo: PTypeInfo);
  end;

procedure FixFieldType(TypeInfo: PTypeInfo);
var
  ctx: TRttiContext;
  t: TRttiType;
  f: TRttiField;
  a: TCustomAttribute;
  n: Cardinal;
begin
  t := ctx.GetType(TypeInfo);
  for f in t.GetFields do
  begin
    for a in f.GetAttributes do
    begin
      if (a is FixTypeInfoAttribute) and f.ClassNameIs('TRttiInstanceFieldEx') then
      begin
        WriteProcessMemory(GetCurrentProcess, @PFieldExEntry(f.Handle).TypeRef,
          @FixTypeInfoAttribute(a).FTypeInfo, SizeOf(Pointer), n);
      end;
    end;
  end;
end;

constructor FixTypeInfoAttribute.Create(TypeInfo: PTypeInfo);
begin
  FTypeInfo := PPTypeInfo(PByte(TypeInfo) - SizeOf(Pointer));
end;

然后将属性添加到类定义中:

type
  TMyClass = class
  private
    Field1: Integer;
    [FixTypeInfo(TypeInfo(TBytes))]
    Field2: TBytes;
  end;

并确保调用 FixFieldType 例程:

initialization
  FixFieldType(TypeInfo(TMyClass));

在 XE 上测试