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
|
program DumpMethods;
{$mode objfpc}{$H+}
uses
Classes, SysUtils;
const
VMT_COUNT = 100;
ITEM_COUNT = 1000;
type
TMethodNameTableEntry = packed record
Name: PShortstring;
Addr: Pointer;
end;
TMethodNameTable = packed record
Count: DWord;
Entries: packed array[0..ITEM_COUNT-1] of TMethodNameTableEntry;
end;
PMethodNameTable = ^TMethodNameTable;
TPointerArray = packed array[0..ITEM_COUNT-1] of Pointer;
PPointerArray = ^TPointerArray;
{$M+}
TMyTest = class(TObject)
// published
procedure P1; virtual;
procedure P2; virtual;
end;
{$M-}
TMyTest2 = class(TMyTest)
// published
procedure P2; override;
procedure P3; virtual;
end;
TMyPersistent = class(TPersistent)
// published
procedure P1; virtual;
procedure P2; virtual;
end;
procedure TMyTest.P1;
begin
end;
procedure TMyTest.P2;
begin
end;
procedure TMyTest2.P2;
begin
end;
procedure TMyTest2.P3;
begin
end;
procedure TMyPersistent.P1;
begin
end;
procedure TMyPersistent.P2;
begin
end;
procedure DumpClass(AClass: TClass);
var
Cvmt: PPointerArray;
Cmnt: PMethodNameTable;
Indent: String;
n, idx: Integer;
SearchAddr: Pointer;
begin
WriteLn('---------------------------------------------');
WriteLn('Dump of ', AClass.ClassName);
WriteLn('---------------------------------------------');
Indent := '';
while AClass <> nil do
begin
WriteLn(Indent, 'Processing ', AClass.Classname);
Indent := Indent + ' ';
Cmnt := PPointer(Pointer(AClass) + vmtMethodTable)^;
if Cmnt <> nil
then begin
WriteLn(Indent, 'Method count: ', IntToStr(Cmnt^.Count));
Cvmt := Pointer(AClass) + vmtMethodStart;
for n := 0 to Cmnt^.Count - 1 do
begin
WriteLn(Indent, 'Search: ', Cmnt^.Entries[n].Name^);
SearchAddr := Cmnt^.Entries[n].Addr;
for idx := 0 to VMT_COUNT - 1 do
begin
if Cvmt^[idx] = SearchAddr
then begin
WriteLn(Indent, 'Found at index: ', IntToStr(idx));
Break;
end;
if idx = VMT_COUNT - 1
then begin
WriteLn('[WARNING] VMT entry "', Cmnt^.Entries[n].Name^, '" not found in "', AClass.ClassName, '"');
Break;
end;
end;
end;
end;
AClass := AClass.ClassParent;
end;
end;
begin
DumpClass(TMyTest);
DumpClass(TMyTest2);
DumpClass(TPersistent);
DumpClass(TMyPersistent);
end.
|
