当前位置： 正文

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

01-05 技术文章 242

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！

来源：https://www.codenong.com/45040739/

微信公众号
手机浏览(小程序)

Warning: get_headers(): SSL operation failed with code 1. OpenSSL Error messages: error:14090086:SSL routines:ssl3_get_server_certificate:certificate verify failed in /mydata/web/wwwshanhubei/web/wp-content/themes/shanhuke/single.php on line 57

Warning: get_headers(): Failed to enable crypto in /mydata/web/wwwshanhubei/web/wp-content/themes/shanhuke/single.php on line 57

Warning: get_headers(https://static.shanhubei.com/qrcode/qrcode_viewid_9200.jpg): failed to open stream: operation failed in /mydata/web/wwwshanhubei/web/wp-content/themes/shanhuke/single.php on line 57
0
分享到：

猜你喜欢

关于拖放：在 jsPlumb jQuery 中以编程方式”拾取”元素之间的连接 | 珊瑚贝
技术文章

01-05 1746
运行时 Ruby/Rails rspec 下载错误 | 珊瑚贝
技术文章

01-05 775
关于shell：如果第 2 和第 3 字段相同，我如何使用排序或其他 bash 命令从所有行中获取 1 行 | 珊瑚贝
技术文章

01-05 1104
关于sql：根据另一个表中的列的值生成行 | 珊瑚贝
技术文章

01-05 1780
关于python：如何使用 to_html 将 CSS 类(我的风格)应用到 Pandas DataFrame | 珊瑚贝
技术文章

01-05 1060
WHERE 子句中可能不会出现聚合(SQL Server 错误) | 珊瑚贝
技术文章

01-05 2215
没有账号？ 忘记密码？