Delphi 我得到一个私有记录方法的RTTIMethod.Visibility=mvPublic。--缺陷_Delphi_Rtti

Delphi 我得到一个私有记录方法的RTTIMethod.Visibility=mvPublic。--缺陷

delphi

Delphi 我得到一个私有记录方法的RTTIMethod.Visibility=mvPublic。--缺陷,delphi,rtti,Delphi,Rtti,我使用Delphi10.2获得（严格的）私有记录方法的RTTIMethod.Visibility=mvPublic。这是虫子吗更新2017-07-12：已创建问题：显示记录和类的所有实例成员类型和可见性的程序输出；从RTTI返回的可见性；在TSomeRec中查找PrivateProcedure： Types: Unit1.TSomeRec Fields: PrivateField Visibility: mvPrivate Public

我使用Delphi10.2获得（严格的）私有记录方法的

RTTIMethod.Visibility=mvPublic

。这是虫子吗

更新2017-07-12：已创建问题：

显示记录和类的所有实例成员类型和可见性的程序输出；从RTTI返回的可见性；在

TSomeRec

中查找

PrivateProcedure

：

Types:
  Unit1.TSomeRec
    Fields:
      PrivateField
        Visibility: mvPrivate
      PublicField
        Visibility: mvPublic
    Properties:
    Methods:
      PrivateProcedure
        Visibility: mvPublic
      PrivateFunction
        Visibility: mvPublic
      PublicProcedure
        Visibility: mvPublic
      PublicFunction
        Visibility: mvPublic
  Unit1.TSomeClass
    Fields:
      PrivateField
        Visibility: mvPrivate
      ProtectedField
        Visibility: mvProtected
      PublicField
        Visibility: mvPublic
    Properties:
      PrivateProperty
        Visibility: mvPrivate
      ProtectedProperty
        Visibility: mvProtected
      PublicProperty
        Visibility: mvPublic
      PublishedProperty
        Visibility: mvPublished
    Methods:
      PrivateProcedure
        Visibility: mvPrivate
      PrivateFunction
        Visibility: mvPrivate
      ProtectedProcedure
        Visibility: mvProtected
      ProtectedFunction
        Visibility: mvProtected
      PublicProcedure
        Visibility: mvPublic
      PublicFunction
        Visibility: mvPublic
      PublishedProcedure
        Visibility: mvPublished
      PublishedFunction
        Visibility: mvPublished

单元1.pas：

unit Unit1;

interface

{$RTTI explicit
  Methods ([vcPrivate, vcProtected, vcPublic, vcPublished])
  Properties ([vcPrivate, vcProtected, vcPublic, vcPublished])
  Fields ([vcPrivate, vcProtected, vcPublic, vcPublished])
}

{$Region 'TSomeRec'}

type
  TSomeRec = record
  strict private
    PrivateField: Boolean;
    property PrivateProperty: Boolean read PrivateField;
    procedure PrivateProcedure;
    function PrivateFunction: Boolean;

  public
    PublicField: Boolean;
    property PublicProperty: Boolean read PublicField;
    procedure PublicProcedure;
    function PublicFunction: Boolean;
  end;

{$EndRegion}
{$Region 'TSomeClass'}

type
  TSomeClass = class
  strict private
    PrivateField: Boolean;
    property PrivateProperty: Boolean read PrivateField;
    procedure PrivateProcedure;
    function PrivateFunction: Boolean;

  strict protected
    ProtectedField: Boolean;
    property ProtectedProperty: Boolean read ProtectedField;
    procedure ProtectedProcedure;
    function ProtectedFunction: Boolean;

  public
    PublicField: Boolean;
    property PublicProperty: Boolean read PublicField;
    procedure PublicProcedure;
    function PublicFunction: Boolean;

  published
    property PublishedProperty: Boolean read PublicField;
    procedure PublishedProcedure;
    function PublishedFunction: Boolean;
  end;

{$EndRegion}

implementation

{$Region 'TSomeRec'}

{ TSomeRec }

function TSomeRec.PrivateFunction: Boolean;
begin
  Result := False;
end;

procedure TSomeRec.PrivateProcedure;
begin
end;

function TSomeRec.PublicFunction: Boolean;
begin
  Result := False;
end;

procedure TSomeRec.PublicProcedure;
begin
end;

{$EndRegion}
{$Region 'TSomeClass'}

{ TSomeClass }

function TSomeClass.PrivateFunction: Boolean;
begin
  Result := False;
end;

procedure TSomeClass.PrivateProcedure;
begin
end;

function TSomeClass.ProtectedFunction: Boolean;
begin
  Result := False;
end;

procedure TSomeClass.ProtectedProcedure;
begin
end;

function TSomeClass.PublicFunction: Boolean;
begin
  Result := False;
end;

procedure TSomeClass.PublicProcedure;
begin
end;

function TSomeClass.PublishedFunction: Boolean;
begin
  Result := False;
end;

procedure TSomeClass.PublishedProcedure;
begin
end;

{$EndRegion}

end.

program Project1;

{$AppType Console}

{$R *.res}

uses
  System.RTTI,
  System.StrUtils,
  System.SysUtils,
  System.TypInfo,
  Unit1 in 'Unit1.pas';

{$Region 'IWriter, TWriter'}

type
  IWriter = interface
    procedure BeginSection(const Value: String = '');
    procedure EndSection;
    procedure WriteMemberSection(const Value: TRTTIMember);
  end;

  TWriter = class (TInterfacedObject, IWriter)
  strict private
    FIndentCount: NativeInt;

  strict protected
    procedure BeginSection(const Value: String);
    procedure EndSection;
    procedure WriteLn(const Value: String);
    procedure WriteMemberSection(const Value: TRTTIMember);

  public
  const
    IndentStr = '  ';
  end;

{ TWriter }

procedure TWriter.BeginSection(const Value: String);
begin
  WriteLn(Value);
  Inc(FIndentCount);
end;

procedure TWriter.EndSection;
begin
  Dec(FIndentCount);
end;

procedure TWriter.WriteLn(const Value: String);
begin
  System.WriteLn(DupeString(IndentStr, FIndentCount) + Value);
end;

procedure TWriter.WriteMemberSection(const Value: TRTTIMember);
begin
  BeginSection(Value.Name);
  try
    WriteLn('Visibility: ' + TValue.From<TMemberVisibility>(Value.Visibility).ToString);
  finally
    EndSection;
  end;
end;

{$EndRegion}

{$Region '...'}

procedure Run;
var
  Writer: IWriter;
  RTTIContext: TRTTIContext;
  RTTIType: TRTTIType;
  RTTIField: TRTTIField;
  RTTIProp: TRTTIProperty;
  RTTIMethod: TRTTIMethod;
begin
  Writer := TWriter.Create;
  RTTIContext := TRTTIContext.Create;
  try
    RTTIContext.GetType(TypeInfo(TSomeRec));
    RTTIContext.GetType(TypeInfo(TSomeClass));
    Writer.BeginSection('Types:');
    for RTTIType in RTTIContext.GetTypes do
    begin
      if not RTTIType.Name.Contains('ISome')
        and not RTTIType.Name.Contains('TSome') then
        Continue;
      Writer.BeginSection(RTTIType.QualifiedName);
      Writer.BeginSection('Fields:');
      for RTTIField in RTTIType.GetFields do
      begin
        if not RTTIField.Name.EndsWith('Field') then
          Continue;
        Writer.WriteMemberSection(RTTIField);
      end;
      Writer.EndSection;
      Writer.BeginSection('Properties:');
      for RTTIProp in RTTIType.GetProperties do
      begin
        if not RTTIProp.Name.EndsWith('Property') then
          Continue;
        Writer.WriteMemberSection(RTTIProp);
      end;
      Writer.EndSection;
      Writer.BeginSection('Methods:');
      for RTTIMethod in RTTIType.GetMethods do
      begin
        if not RTTIMethod.Name.Contains('Procedure')
          and not RTTIMethod.Name.Contains('Function') then
          Continue;
        Writer.WriteMemberSection(RTTIMethod);
      end;
      Writer.EndSection;
      Writer.EndSection;
    end;
    Writer.EndSection;
  finally
    RTTIContext.Free;
  end;
end;

{$EndRegion}

begin
  {$Region '...'}
  try
    Run;
  except
    on E: Exception do
      WriteLn(E.ClassName, ': ', E.Message);
  end;
  ReadLn;
  {$EndRegion}
end.

项目1.dpr：

unit Unit1;

interface

{$RTTI explicit
  Methods ([vcPrivate, vcProtected, vcPublic, vcPublished])
  Properties ([vcPrivate, vcProtected, vcPublic, vcPublished])
  Fields ([vcPrivate, vcProtected, vcPublic, vcPublished])
}

{$Region 'TSomeRec'}

type
  TSomeRec = record
  strict private
    PrivateField: Boolean;
    property PrivateProperty: Boolean read PrivateField;
    procedure PrivateProcedure;
    function PrivateFunction: Boolean;

  public
    PublicField: Boolean;
    property PublicProperty: Boolean read PublicField;
    procedure PublicProcedure;
    function PublicFunction: Boolean;
  end;

{$EndRegion}
{$Region 'TSomeClass'}

type
  TSomeClass = class
  strict private
    PrivateField: Boolean;
    property PrivateProperty: Boolean read PrivateField;
    procedure PrivateProcedure;
    function PrivateFunction: Boolean;

  strict protected
    ProtectedField: Boolean;
    property ProtectedProperty: Boolean read ProtectedField;
    procedure ProtectedProcedure;
    function ProtectedFunction: Boolean;

  public
    PublicField: Boolean;
    property PublicProperty: Boolean read PublicField;
    procedure PublicProcedure;
    function PublicFunction: Boolean;

  published
    property PublishedProperty: Boolean read PublicField;
    procedure PublishedProcedure;
    function PublishedFunction: Boolean;
  end;

{$EndRegion}

implementation

{$Region 'TSomeRec'}

{ TSomeRec }

function TSomeRec.PrivateFunction: Boolean;
begin
  Result := False;
end;

procedure TSomeRec.PrivateProcedure;
begin
end;

function TSomeRec.PublicFunction: Boolean;
begin
  Result := False;
end;

procedure TSomeRec.PublicProcedure;
begin
end;

{$EndRegion}
{$Region 'TSomeClass'}

{ TSomeClass }

function TSomeClass.PrivateFunction: Boolean;
begin
  Result := False;
end;

procedure TSomeClass.PrivateProcedure;
begin
end;

function TSomeClass.ProtectedFunction: Boolean;
begin
  Result := False;
end;

procedure TSomeClass.ProtectedProcedure;
begin
end;

function TSomeClass.PublicFunction: Boolean;
begin
  Result := False;
end;

procedure TSomeClass.PublicProcedure;
begin
end;

function TSomeClass.PublishedFunction: Boolean;
begin
  Result := False;
end;

procedure TSomeClass.PublishedProcedure;
begin
end;

{$EndRegion}

end.

program Project1;

{$AppType Console}

{$R *.res}

uses
  System.RTTI,
  System.StrUtils,
  System.SysUtils,
  System.TypInfo,
  Unit1 in 'Unit1.pas';

{$Region 'IWriter, TWriter'}

type
  IWriter = interface
    procedure BeginSection(const Value: String = '');
    procedure EndSection;
    procedure WriteMemberSection(const Value: TRTTIMember);
  end;

  TWriter = class (TInterfacedObject, IWriter)
  strict private
    FIndentCount: NativeInt;

  strict protected
    procedure BeginSection(const Value: String);
    procedure EndSection;
    procedure WriteLn(const Value: String);
    procedure WriteMemberSection(const Value: TRTTIMember);

  public
  const
    IndentStr = '  ';
  end;

{ TWriter }

procedure TWriter.BeginSection(const Value: String);
begin
  WriteLn(Value);
  Inc(FIndentCount);
end;

procedure TWriter.EndSection;
begin
  Dec(FIndentCount);
end;

procedure TWriter.WriteLn(const Value: String);
begin
  System.WriteLn(DupeString(IndentStr, FIndentCount) + Value);
end;

procedure TWriter.WriteMemberSection(const Value: TRTTIMember);
begin
  BeginSection(Value.Name);
  try
    WriteLn('Visibility: ' + TValue.From<TMemberVisibility>(Value.Visibility).ToString);
  finally
    EndSection;
  end;
end;

{$EndRegion}

{$Region '...'}

procedure Run;
var
  Writer: IWriter;
  RTTIContext: TRTTIContext;
  RTTIType: TRTTIType;
  RTTIField: TRTTIField;
  RTTIProp: TRTTIProperty;
  RTTIMethod: TRTTIMethod;
begin
  Writer := TWriter.Create;
  RTTIContext := TRTTIContext.Create;
  try
    RTTIContext.GetType(TypeInfo(TSomeRec));
    RTTIContext.GetType(TypeInfo(TSomeClass));
    Writer.BeginSection('Types:');
    for RTTIType in RTTIContext.GetTypes do
    begin
      if not RTTIType.Name.Contains('ISome')
        and not RTTIType.Name.Contains('TSome') then
        Continue;
      Writer.BeginSection(RTTIType.QualifiedName);
      Writer.BeginSection('Fields:');
      for RTTIField in RTTIType.GetFields do
      begin
        if not RTTIField.Name.EndsWith('Field') then
          Continue;
        Writer.WriteMemberSection(RTTIField);
      end;
      Writer.EndSection;
      Writer.BeginSection('Properties:');
      for RTTIProp in RTTIType.GetProperties do
      begin
        if not RTTIProp.Name.EndsWith('Property') then
          Continue;
        Writer.WriteMemberSection(RTTIProp);
      end;
      Writer.EndSection;
      Writer.BeginSection('Methods:');
      for RTTIMethod in RTTIType.GetMethods do
      begin
        if not RTTIMethod.Name.Contains('Procedure')
          and not RTTIMethod.Name.Contains('Function') then
          Continue;
        Writer.WriteMemberSection(RTTIMethod);
      end;
      Writer.EndSection;
      Writer.EndSection;
    end;
    Writer.EndSection;
  finally
    RTTIContext.Free;
  end;
end;

{$EndRegion}

begin
  {$Region '...'}
  try
    Run;
  except
    on E: Exception do
      WriteLn(E.ClassName, ': ', E.Message);
  end;
  ReadLn;
  {$EndRegion}
end.

程序项目1；
{$AppType控制台}
{$R*.res}
使用
System.RTTI，
系统结构，
System.SysUtils，
System.TypInfo，
“Unit1.pas”中的Unit1；
{$Region'IWriter，TWriter'}
类型
IWriter=接口
过程开始（常量值：字符串=“”）；
程序结束部分；
过程WriteMemberSection（常量值：TRTTIMember）；
结束；
TWriter=类（TInterfacedObject，IWriter）
严格保密
FIndentCount:NativeInt；
严格保护
过程开始（常量值：字符串）；
程序结束部分；
过程WriteLn（常量值：字符串）；
过程WriteMemberSection（常量值：TRTTIMember）；
公众的
常数
IndentStr=''；
结束；
{TWriter}
过程TWriter.beginstation（常量值：字符串）；
开始
WriteLn（值）；
公司（FIndentCount）；
结束；
程序TWriter.EndSection；
开始
12月（芬登计数）；
结束；
过程TWriter.WriteLn（常量值：字符串）；
开始
System.WriteLn（DupeString（IndentStr，FIndentCount）+值）；
结束；
过程TWriter.WriteMemberSection（常量值：TRTTIMember）；
开始
beginstation（Value.Name）；
尝试
WriteLn（'Visibility:'+TValue.From（Value.Visibility.ToString））；
最后
端部；
结束；
结束；
{$EndRegion}
{$Region'.''}
程序运行；
变量
作者：IWriter；
RTTIContext:TRTTIContext；
rttType:trtType；
RTTIField:TRTTIField；
RTTIProp:trtti属性；
RTTIMethod:trtti方法；
开始
Writer:=TWriter.Create；
RTTIContext:=TRTTIContext.Create；
尝试
GetType（TypeInfo（tsomeec））；
GetType（TypeInfo（TSomeClass））；
Writer.beginstation（'Types:'）；
对于RTTIContext.GetTypes中的RTTIType
开始
如果不是RTTIType.Name.Contains（'ISOM'）
而不是RTTIType.Name.Contains（'TSome'），然后
继续；
Writer.beginstation（RTTIType.QualifiedName）；
Writer.beginstation（'Fields:'）；
对于RTTIType.GetFields中的RTTIField
开始
如果不是RTTIField.Name.EndsWith（'Field'），则
继续；
Writer.WriteMemberSection（RTTIField）；
结束；
Writer.EndSection；
Writer.beginstation（'Properties:'）；
对于RTTIType.GetProperties中的RTTIProp
开始
如果不是RTTIProp.Name.EndsWith（“属性”），则
继续；
Writer.WriteMemberSection（RTTIProp）；
结束；
Writer.EndSection；
Writer.beginestation（'Methods:'）；
对于RTTIType.GetMethods中的RTTIMethod
开始
如果不是RTTIMethod.Name.Contains（'过程'）
而不是RTTIMethod.Name.Contains（'Function'），然后
继续；
writermembersection（RTTIMethod）；
结束；
Writer.EndSection；
Writer.EndSection；
结束；
Writer.EndSection；
最后
RTTIContext.Free；
结束；
结束；
{$EndRegion}
开始
{$Region'.''}
尝试
跑
除了
关于E:Exception-do
WriteLn（E.ClassName，“：”，E.Message）；
结束；
ReadLn；
{$EndRegion}
结束。

错误在于在TrtiRecordMethod中GetVisibility没有被覆盖。我仔细研究了一下代码，关于可见性的信息实际上在Flag字段中

因此，与其他GetVisibility覆盖（如在TrtiRecordField中）类似，它需要实现。我将此报告为

我写了一个小补丁，如果你真的需要修复它（仅限windows）

是的，这看起来像个bug。我在Delphi 10.2和Delphi XE3中重复了你的结果。@DaveOlson:我只尝试了XE6和Tokyo，也得到了同样的结果。这似乎是一个相对较老的bug。虽然代码尚未投入生产，但该修补程序能够在正确的行为基础上构建，并在Windows下继续开发和测试。一旦一个非Windows版本被构建，我将再次讨论这个问题，我希望到那时能找到一个固定的RTL。非常感谢你，Stefan Glienke，@RudyVelthuis和@DaveOlson！