Понадобилось мне узнать какие объекты созданы в данный момент в программе.
В итоге появился такой класс
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.
type
TPatchObject = class
strict private
type
TData = array[0..4] of Byte;
TSavedInfo = record
Start: Pointer;
Data: TData;
end;
strict private
class var
FAfterConstructionInfo: TSavedInfo;
FBeforeDestructionInfo: TSavedInfo;
strict private
class procedure NewAfterConstruction(ASender: TObject); static;
class procedure NewBeforeDestruction(ASender: TObject); static;
class procedure WriteAddr(var ASavedInfo: TSavedInfo; AData: Pointer; ASize: Cardinal); static;
class procedure PatchProc(out ASavedInfo: TSavedInfo; AReserved, ANewAddr: Pointer); static;
class procedure UnpatchProc(var ASavedInfo: TSavedInfo); static;
public
class procedure Init;
class procedure DeInit;
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
end;
{ TPatchObject }
class procedure TPatchObject.NewAfterConstruction(ASender: TObject);
begin
// Do notify construction
ASender.AfterConstruction;
end;
class procedure TPatchObject.NewBeforeDestruction(ASender: TObject);
begin
// Do notify destruction
ASender.BeforeDestruction;
end;
class procedure TPatchObject.WriteAddr(var ASavedInfo: TSavedInfo;
AData: Pointer; ASize: Cardinal);
var
LOldProtection: Cardinal;
begin
Win32Check(VirtualProtect(ASavedInfo.Start, ASize, PAGE_READWRITE, @LOldProtection));
try
Move(ASavedInfo.Start^, ASavedInfo.Data, ASize);
Move(AData^, ASavedInfo.Start^, ASize);
finally
Win32Check(VirtualProtect(ASavedInfo.Start, ASize, LOldProtection, @LOldProtection));
end;
Win32Check(FlushInstructionCache(GetCurrentProcess, ASavedInfo.Start, ASize));
end;
class procedure TPatchObject.PatchProc(out ASavedInfo: TSavedInfo; AReserved, ANewAddr: Pointer);
asm
mov edx, [esp] // Return point
sub ecx, edx // Offset from return point to new proc
sub edx, 5 // Start write address
mov [eax], edx
mov edx, esp
sub esp, 8 // Reserve 8 byte in stack
sub edx, 4
mov [edx], ecx
dec edx
mov [edx], byte ptr $E8 // call offset
mov ecx, 5
call WriteAddr
add esp, 8
end;
class procedure TPatchObject.UnpatchProc(var ASavedInfo: TSavedInfo);
var
LData: TData;
begin
LData := ASavedInfo.Data;
WriteAddr(ASavedInfo, @LData, SizeOf(LData));
FillChar(ASavedInfo, SizeOf(ASavedInfo), 0);
end;
class procedure TPatchObject.Init;
var
LObj: TObject;
begin
LObj := Create;
LObj.Free;
end;
class procedure TPatchObject.DeInit;
begin
UnpatchProc(FAfterConstructionInfo);
UnpatchProc(FBeforeDestructionInfo);
end;
procedure TPatchObject.AfterConstruction;
asm
lea eax, FAfterConstructionInfo
mov ecx, offset NewAfterConstruction
jmp PatchProc
end;
procedure TPatchObject.BeforeDestruction;
asm
lea eax, FBeforeDestructionInfo
mov ecx, offset NewBeforeDestruction
jmp PatchProc
end;
Схема использования:
Отредактировать методы NewAfterConstruction, NewBeforeDestruction для своей нотификации.
1.
2.
3.
TPatchObject.Init; // Включили мониторинг
......
TPatchObject.DeInit; // Выключили мониторинг
Идея: при создании объекта вызывается такая процедура
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
function _AfterConstruction(const Instance: TObject): TObject;
begin
try
Instance.AfterConstruction;
Result := Instance;
except
_BeforeDestruction(Instance, 1);
raise;
end;
end;
я поднимаюсь вверх по стеку и заменяю выделенную строку таким вызовом
1.
TPatchObject.NewAfterConstruction(Instance)
Аналогично для _BeforeDestruction
Разрабатывалось и тестировалось на Delphi XE3 при компиляции под x86. Под x64 в текущем виде работать гарантировано не будет. Под другие версии Delphi скорее всего заработает без вопросов.
С уважением, Vasilisk
