草庐IT

关于 delphi：我得到 RTTIMethod.Visibility = mvPublic 的私有记录方法。 – 漏洞？

codeneng 2023-03-28 原文

I get RTTIMethod.Visibility = mvPublic for a private record method. -- Bug?

我使用 Delphi 10.2 获得了一个(严格的)私有记录方法的 RTTIMethod.Visibility = mvPublic。这是一个错误吗？

2017 年 7 月 12 日更新：已创建问题：RSP-18587。

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
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:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
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.

Project1.dpr:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
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.

  • 是的，这看起来像一个错误。
  • 我在 Delphi 10.2 和 Delphi XE3 中重复了你的结果。
  • @DaveOlson：我只尝试过 XE6 和 Tokyo，也得到了相同的结果。这似乎是一个比较古老的错误。

错误是在 TRttiRecordMethod 中没有覆盖 GetVisibility。我看了一点代码，关于可见性的信息实际上在 Flag 字段中。

与其他 GetVisibility 覆盖(例如 TRttiRecordField)类似，它需要实现。我将此报告为 RSP-18588。

我写了一个小补丁，如果你真的需要修复这个问题(仅限 Windows)。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
unit PatchRecordMethodGetVisibility;

interface

implementation

uses
  Rtti, SysUtils, TypInfo, Windows;

type
  TRec = record
    procedure Method;
  end;

procedure TRec.Method;
begin
end;

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.

  • 虽然代码尚未投入生产，但该补丁可以构建正确的行为并继续在 Windows 下进行开发和测试。一旦要构建非 Windows 变体，我将重新审视这个问题，我希望到那时能找到一个固定的 RTL。非常感谢 Stefan Glienke、@RudyVelthuis 和 @DaveOlson！

私有RTTIMethodspanclassnbspdelphirtti

有关关于 delphi：我得到 RTTIMethod.Visibility = mvPublic 的私有记录方法。 – 漏洞？的更多相关文章

  1. ruby - 如何使用 Nokogiri 的 xpath 和 at_xpath 方法 - 2

    我正在学习如何使用Nokogiri，根据这段代码我遇到了一些问题:require'rubygems'require'mechanize'post_agent=WWW::Mechanize.newpost_page=post_agent.get('http://www.vbulletin.org/forum/showthread.php?t=230708')puts"\nabsolutepathwithtbodygivesnil"putspost_page.parser.xpath('/html/body/div/div/div/div/div/table/tbody/tr/td/div

  2. ruby - 如何从 ruby​​ 中的字符串运行任意对象方法？ - 2

    总的来说，我对ruby​​还比较陌生，我正在为我正在创建的对象编写一些rspec测试用例。许多测试用例都非常基础，我只是想确保正确填充和返回值。我想知道是否有办法使用循环结构来执行此操作。不必为我要测试的每个方法都设置一个assertEquals。例如:describeitem,"TestingtheItem"doit"willhaveanullvaluetostart"doitem=Item.new#HereIcoulddotheitem.name.shouldbe_nil#thenIcoulddoitem.category.shouldbe_nilendend但我想要一些方法来使用

  3. ruby - 为什么我可以在 Ruby 中使用 Object#send 访问私有(private)/ protected 方法？ - 2

    类classAprivatedeffooputs:fooendpublicdefbarputs:barendprivatedefzimputs:zimendprotecteddefdibputs:dibendendA的实例a=A.new测试a.foorescueputs:faila.barrescueputs:faila.zimrescueputs:faila.dibrescueputs:faila.gazrescueputs:fail测试输出failbarfailfailfail.发送测试[:foo,:bar,:zim,:dib,:gaz].each{|m|a.send(m)resc

  4. ruby - Facter::Util::Uptime:Module 的未定义方法 get_uptime (NoMethodError) - 2

    我正在尝试设置一个puppet节点，但ruby​​gems似乎不正常。如果我通过它自己的二进制文件(/usr/lib/ruby/gems/1.8/gems/facter-1.5.8/bin/facter)在cli上运行facter，它工作正常，但如果我通过由ruby​​gems(/usr/bin/facter)安装的二进制文件，它抛出:/usr/lib/ruby/1.8/facter/uptime.rb:11:undefinedmethod`get_uptime'forFacter::Util::Uptime:Module(NoMethodError)from/usr/lib/ruby

  5. ruby - 具有身份验证的私有(private) Ruby Gem 服务器 - 2

    我想安装一个带有一些身份验证的私有(private)Rubygem服务器。我希望能够使用公共(public)Ubuntu服务器托管内部gem。我读到了http://docs.rubygems.org/read/chapter/18.但是那个没有身份验证-如我所见。然后我读到了https://github.com/cwninja/geminabox.但是当我使用基本身份验证(他们在他们的Wiki中有)时，它会提示从我的服务器获取源。所以。如何制作带有身份验证的私有(private)Rubygem服务器？这是不可能的吗？谢谢。编辑:Geminabox问题。我尝试“捆绑”以安装新的gem..

  6. Ruby 方法() 方法 - 2

    我想了解Ruby方法methods()是如何工作的。我尝试使用“ruby方法”在Google上搜索，但这不是我需要的。我也看过ruby​​-doc.org，但我没有找到这种方法。你能详细解释一下它是如何工作的或者给我一个链接吗？更新我用methods()方法做了实验，得到了这样的结果:'labrat'代码classFirstdeffirst_instance_mymethodenddefself.first_class_mymethodendendclassSecond使用类#returnsavailablemethodslistforclassandancestorsputsSeco

  7. ruby-on-rails - Rails 3.2.1 中 ActionMailer 中的未定义方法 'default_content_type=' - 2

    我在我的项目中添加了一个系统来重置用户密码并通过电子邮件将密码发送给他，以防他忘记密码。昨天它运行良好(当我实现它时)。当我今天尝试启动服务器时，出现以下错误。=>BootingWEBrick=>Rails3.2.1applicationstartingindevelopmentonhttp://0.0.0.0:3000=>Callwith-dtodetach=>Ctrl-CtoshutdownserverExiting/Users/vinayshenoy/.rvm/gems/ruby-1.9.3-p0/gems/actionmailer-3.2.1/lib/action_mailer

  8. ruby - Highline 询问方法不会使用同一行 - 2

    设置:狂欢ruby1.9.2高线(1.6.13)描述:我已经相当习惯在其他一些项目中使用highline，但已经有几个月没有使用它了。现在，在Ruby1.9.2上全新安装时，它似乎不允许在同一行回答提示。所以以前我会看到类似的东西:require"highline/import"ask"Whatisyourfavoritecolor?"并得到:Whatisyourfavoritecolor?|现在我看到类似的东西:Whatisyourfavoritecolor?|竖线(|)符号是我的终端光标。知道为什么会发生这种变化吗？ 最佳答案

  9. ruby - 主要 :Object when running build from sublime 的未定义方法 `require_relative' - 2

    我已经从我的命令行中获得了一切，所以我可以运行rubymyfile并且它可以正常工作。但是当我尝试从sublime中运行它时，我得到了undefinedmethod`require_relative'formain:Object有人知道我的sublime设置中缺少什么吗？我正在使用OSX并安装了rvm。 最佳答案 或者，您可以只使用“require”，它应该可以正常工作。我认为“require_relative”仅适用于ruby​​1.9+ 关于ruby-主要:Objectwhenrun

  10. ruby - 多个属性的 update_column 方法 - 2

    我有一个具有一些属性的模型:attr1、attr2和attr3。我需要在不执行回调和验证的情况下更新此属性。我找到了update_column方法，但我想同时更新三个属性。我需要这样的东西:update_columns({attr1:val1,attr2:val2,attr3:val3})代替update_column(attr1,val1)update_column(attr2,val2)update_column(attr3,val3) 最佳答案 您可以使用update_columns(attr1:val1,attr2:val2

随机推荐