更新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用于私有记录方法. – 虫子?所遇到的程序开发问题。
如果觉得内存溢出网站内容还不错,欢迎将内存溢出网站推荐给程序员好友。
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)