delphi – 我得到RTTIMethod.Visibility = mvPublic用于私有记录方法. – 虫子?

delphi – 我得到RTTIMethod.Visibility = mvPublic用于私有记录方法. – 虫子?,第1张

概述我使用Delphi 10.2获得了RTTIMethod.Visibility = mvPublic(严格)私有记录方法.这是一个错误吗? 更新2017-07-12:已创建问题:RSP-18587. 程序输出显示记录和类的所有实例成员类型和可见性;从RTTI返回的可见性;在TSomeRec中查看PrivateProcedure: Types: Unit1.TSomeRec Fields: @H_419_4@ 我使用Delphi 10.2获得了RTTIMethod.Visibility = mvPublic(严格)私有记录方法.这是一个错误吗?

更新2017-07-12:已创建问题:RSP-18587.

程序输出显示记录和类的所有实例成员类型和可见性;从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

Unit1.pas:

unit Unit1;interface{$RTTI explicit  Methods ([vcPrivate,vcProtected,vcpublic,vcpublished])  PropertIEs ([vcPrivate,vcpublished])  FIElds ([vcPrivate,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;beginend;function TSomeRec.PublicFunction: Boolean;begin  Result := False;end;procedure TSomeRec.PublicProcedure;beginend;{$EndRegion}{$Region 'TSomeClass'}{ TSomeClass }function TSomeClass.PrivateFunction: Boolean;begin  Result := False;end;procedure TSomeClass.PrivateProcedure;beginend;function TSomeClass.ProtectedFunction: Boolean;begin  Result := False;end;procedure TSomeClass.ProtectedProcedure;beginend;function TSomeClass.PublicFunction: Boolean;begin  Result := False;end;procedure TSomeClass.PublicProcedure;beginend;function TSomeClass.PublishedFunction: Boolean;begin  Result := False;end;procedure TSomeClass.PublishedProcedure;beginend;{$EndRegion}end.

Project1.dpr:

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.
@H_419_4@解决方法 问题是在TRttiRecordMethod中没有覆盖GetVisibility.我看了一下代码,有关可见性的信息实际上在Flag字段内.

所以类似于其他GetVisibility覆盖,例如在TRttiRecordFIEld中,它需要实现.我把这报告为RSP-18588.

我写了一个小补丁,应该修复,如果你真的需要修复它(仅限windows).

unit PatchRecordMethodGetVisibility;interfaceimplementationuses  Rtti,SysUtils,TypInfo,windows;type  TRec = record    procedure Method;  end;procedure TRec.Method;beginend;function GetVirtualMethod(AClass: TClass; const Index: Integer): Pointer;begin  Result := PPointer(UINT_PTR(AClass) + UINT_PTR(Index * SizeOf(Pointer)))^;end;procedure RedirectFunction(OrgProc,NewProc: Pointer);type  TJmpBuffer = packed record    Jmp: Byte;    Offset: Integer;  end;var  n: UINT_PTR;  JmpBuffer: TJmpBuffer;begin  JmpBuffer.Jmp := $E9;  JmpBuffer.Offset := PByte(NewProc) - (PByte(OrgProc) + 5);  if not WriteProcessMemory(GetCurrentProcess,OrgProc,@JmpBuffer,SizeOf(JmpBuffer),n) then    RaiseLastOSError;end;type  TRttiRecordMethodFix = class(TRttiMethod)    function GetVisibility: TMemberVisibility;  end;procedure PatchIt;var  ctx: TRttiContext;  recmethodCls: TClass;begin  recmethodCls := ctx.GetType(TypeInfo(TRec)).getmethod('Method').Classtype;  RedirectFunction(GetVirtualMethod(recmethodCls,3),@TRttiRecordMethodFix.GetVisibility);end;{ TRttiRecordMethodFix }function TRttiRecordMethodFix.GetVisibility: TMemberVisibility;  function GetBitFIEld(Value,Shift,Bits: Integer): Integer;  begin    Result := (Value shr Shift) and ((1 shl Bits) - 1);  end;const  rmfVisibilityShift = 2;  rmfVisibilityBits = 2;begin  Result := TMemberVisibility(GetBitFIEld(PrecordtypeMethod(Handle)^.Flags,rmfVisibilityShift,rmfVisibilityBits))end;initialization  PatchIt;end.
@H_419_4@ @H_419_4@ @H_419_4@ @H_419_4@ 总结

以上是内存溢出为你收集整理的delphi – 我得到RTTIMethod.Visibility = mvPublic用于私有记录方法. – 虫子?全部内容,希望文章能够帮你解决delphi – 我得到RTTIMethod.Visibility = mvPublic用于私有记录方法. – 虫子?所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错,欢迎将内存溢出网站推荐给程序员好友。

欢迎分享,转载请注明来源:内存溢出

原文地址: https://outofmemory.cn/langs/1272478.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2022-06-08
下一篇 2022-06-08

发表评论

登录后才能评论

评论列表(0条)

保存