deks
Цитата:
создаются, как и рекорды, на стеке, это по-сути и есть рекорд с методами и наследованием ,но без полиморфизма. конструктор - это просто инициализатор, как и любой другой метод.
AlekXL
Цитата:
я бы тоже это не стал использовать ни в коем случае ) (хотя и паскаль-объекты тоже бы не стал, имхо уж лучше юзать обычные рекорды с агрегацией вместо наследования, если уж классы - никак)
код такой:
[more=RecordInterceptor.pas]
Код:
unit RecordInterceptor;
interface
uses System.TypInfo, System.SyncObjs, System.SysUtils, System.Classes;
type
TInitRecordCallBack = procedure(AStackPtr: Pointer; ATypeInfo: PTypeInfo; AIsInit: Boolean) of object;
TMemPatcher = record
type
PJump = ^TJump;
TJump = packed record
OpCode: Byte;
Distance: Cardinal;
procedure Init(ASource, ADest: Pointer); inline;
end;
const
JUMP_SIZE = SizeOf(TJump);
class procedure AddressPatch(ASource, ADestination: Pointer; var AOldCode: TJump); static; inline;
class procedure AddressUnPatch(ASource: Pointer; const AOldCode: TJump); static; inline;
end;
TInitRecordPatcher = record
strict private
type
TInitRecProc = procedure(p: Pointer; typeInfo: Pointer);
class var
CS: TCriticalSection;
OldInitCode, OldFInitCode: TMemPatcher.TJump;
OldInitRecordProc, OldFinitRecordProc: TInitRecProc;
CallBackList: TArray<TInitRecordCallBack>;
class procedure NewInitRecord(p: Pointer; typeInfo: Pointer); static;
class procedure NewFinitRecord(p: Pointer; typeInfo: Pointer); static;
class procedure PerformCall(AStackPtr, ATypeInfo: Pointer; AOldProc, ANewProc: TInitRecProc;
AIsInit: Boolean; AOldCode: TMemPatcher.TJump); static; inline;
class function InitRecordProcAddress: Pointer; static;
class function FinitRecordProcAddress: Pointer; static;
private
class procedure Init; static;
class procedure Finit; static;
public
class procedure RegisterInitRecordCallBack(ACallBack: TInitRecordCallBack); static;
// class procedure UnRegisterInitRecordCallBack(ACallBack: TInitRecordCallBack); static;
end;
implementation
uses Winapi.Windows;
{ TMemPatcher }
{ TMemPatcher.TJump }
procedure TMemPatcher.TJump.Init(ASource, ADest: Pointer);
begin
Distance := Cardinal(ADest) - Cardinal(ASource) - JUMP_SIZE;
OpCode := $E9; //jmp
end;
class procedure TMemPatcher.AddressPatch(ASource, ADestination: Pointer;
var AOldCode: TJump);
var
LJump: PJump absolute ASource;
LOldProtect: Cardinal;
begin
if VirtualProtect(ASource, JUMP_SIZE, PAGE_EXECUTE_READWRITE, LOldProtect) then
try
AOldCode := LJump^;
LJump.Init(ASource, ADestination);
FlushInstructionCache(GetCurrentProcess, ASource, JUMP_SIZE);
finally
VirtualProtect(ASource, JUMP_SIZE, LOldProtect, @LOldProtect);
end;
end;
class procedure TMemPatcher.AddressUnPatch(ASource: Pointer;
const AOldCode: TJump);
var
LOldProtect: Cardinal;
begin
if VirtualProtect(ASource, JUMP_SIZE, PAGE_EXECUTE_READWRITE, LOldProtect) then
try
PJump(ASource)^ := AOldCode;
FlushInstructionCache(GetCurrentProcess, ASource, JUMP_SIZE);
finally
VirtualProtect(ASource, JUMP_SIZE, LOldProtect, @LOldProtect);
end;
end;
{ TInitRecordPatcher }
class procedure TInitRecordPatcher.Finit;
begin
TMemPatcher.AddressUnPatch(@OldInitRecordProc, OldInitCode);
TMemPatcher.AddressUnPatch(@OldFinitRecordProc, OldFinitCode);
CS.Free;
end;
class procedure TInitRecordPatcher.Init;
begin
CS := TCriticalSection.Create;
@OldInitRecordProc := InitRecordProcAddress;
@OldFinitRecordProc := FinitRecordProcAddress;
TMemPatcher.AddressPatch(@OldInitRecordProc, @NewInitRecord, OldInitCode);
TMemPatcher.AddressPatch(@OldFinitRecordProc, @NewFinitRecord, OldFinitCode);
end;
class procedure TInitRecordPatcher.PerformCall(AStackPtr, ATypeInfo: Pointer;
AOldProc, ANewProc: TInitRecProc; AIsInit: Boolean; AOldCode: TMemPatcher.TJump);
var
i: integer;
begin
CS.Enter;
try
try
TMemPatcher.AddressUnPatch(@AOldProc, AOldCode);
AOldProc(AStackPtr, ATypeInfo);
for i := Low(CallBackList) to High(CallBackList) do
CallBackList[i](AStackPtr, ATypeInfo, AIsInit);
finally
TMemPatcher.AddressPatch(@AOldProc, @ANewProc, AOldCode);
end;
finally
CS.Leave;
end;
end;
class procedure TInitRecordPatcher.NewInitRecord(p: Pointer; typeInfo: Pointer);
begin
PerformCall(p, typeInfo, @OldInitRecordProc, @NewInitRecord, True, OldInitCode);
end;
class procedure TInitRecordPatcher.NewFinitRecord(p: Pointer; typeInfo: Pointer);
begin
PerformCall(p, typeInfo, @OldFinitRecordProc, @NewFinitRecord, False, OldFinitCode);
end;
class function TInitRecordPatcher.InitRecordProcAddress: Pointer;
asm
{$IFDEF CPUX86}
lea eax, System.@InitializeRecord
{$ELSE}
lea rax, System.@InitializeRecord
{$ENDIF}
end;
class function TInitRecordPatcher.FinitRecordProcAddress: Pointer;
asm
{$IFDEF CPUX86}
lea eax, System.@FinalizeRecord
{$ELSE}
lea rax, System.@FinalizeRecord
{$ENDIF}
end;
class procedure TInitRecordPatcher.RegisterInitRecordCallBack(ACallBack: TInitRecordCallBack);
begin
SetLength(CallBackList, Succ(Length(CallBackList)));
CallBackList[High(CallBackList)] := ACallBack;
end;
initialization
TInitRecordPatcher.Init;
finalization
TInitRecordPatcher.Finit;
end.
Цитата:
Скажите - а для этих "старых" объектов существует такое понятие, как конструктор? Как они создаются?
создаются, как и рекорды, на стеке, это по-сути и есть рекорд с методами и наследованием ,но без полиморфизма. конструктор - это просто инициализатор, как и любой другой метод.
AlekXL
Цитата:
вряд ли я стал бы это использовать, но в целях повышения квалификации, и ради академического интереса: выкладывай, конечно!
я бы тоже это не стал использовать ни в коем случае ) (хотя и паскаль-объекты тоже бы не стал, имхо уж лучше юзать обычные рекорды с агрегацией вместо наследования, если уж классы - никак)
код такой:
[more=RecordInterceptor.pas]
Код:
unit RecordInterceptor;
interface
uses System.TypInfo, System.SyncObjs, System.SysUtils, System.Classes;
type
TInitRecordCallBack = procedure(AStackPtr: Pointer; ATypeInfo: PTypeInfo; AIsInit: Boolean) of object;
TMemPatcher = record
type
PJump = ^TJump;
TJump = packed record
OpCode: Byte;
Distance: Cardinal;
procedure Init(ASource, ADest: Pointer); inline;
end;
const
JUMP_SIZE = SizeOf(TJump);
class procedure AddressPatch(ASource, ADestination: Pointer; var AOldCode: TJump); static; inline;
class procedure AddressUnPatch(ASource: Pointer; const AOldCode: TJump); static; inline;
end;
TInitRecordPatcher = record
strict private
type
TInitRecProc = procedure(p: Pointer; typeInfo: Pointer);
class var
CS: TCriticalSection;
OldInitCode, OldFInitCode: TMemPatcher.TJump;
OldInitRecordProc, OldFinitRecordProc: TInitRecProc;
CallBackList: TArray<TInitRecordCallBack>;
class procedure NewInitRecord(p: Pointer; typeInfo: Pointer); static;
class procedure NewFinitRecord(p: Pointer; typeInfo: Pointer); static;
class procedure PerformCall(AStackPtr, ATypeInfo: Pointer; AOldProc, ANewProc: TInitRecProc;
AIsInit: Boolean; AOldCode: TMemPatcher.TJump); static; inline;
class function InitRecordProcAddress: Pointer; static;
class function FinitRecordProcAddress: Pointer; static;
private
class procedure Init; static;
class procedure Finit; static;
public
class procedure RegisterInitRecordCallBack(ACallBack: TInitRecordCallBack); static;
// class procedure UnRegisterInitRecordCallBack(ACallBack: TInitRecordCallBack); static;
end;
implementation
uses Winapi.Windows;
{ TMemPatcher }
{ TMemPatcher.TJump }
procedure TMemPatcher.TJump.Init(ASource, ADest: Pointer);
begin
Distance := Cardinal(ADest) - Cardinal(ASource) - JUMP_SIZE;
OpCode := $E9; //jmp
end;
class procedure TMemPatcher.AddressPatch(ASource, ADestination: Pointer;
var AOldCode: TJump);
var
LJump: PJump absolute ASource;
LOldProtect: Cardinal;
begin
if VirtualProtect(ASource, JUMP_SIZE, PAGE_EXECUTE_READWRITE, LOldProtect) then
try
AOldCode := LJump^;
LJump.Init(ASource, ADestination);
FlushInstructionCache(GetCurrentProcess, ASource, JUMP_SIZE);
finally
VirtualProtect(ASource, JUMP_SIZE, LOldProtect, @LOldProtect);
end;
end;
class procedure TMemPatcher.AddressUnPatch(ASource: Pointer;
const AOldCode: TJump);
var
LOldProtect: Cardinal;
begin
if VirtualProtect(ASource, JUMP_SIZE, PAGE_EXECUTE_READWRITE, LOldProtect) then
try
PJump(ASource)^ := AOldCode;
FlushInstructionCache(GetCurrentProcess, ASource, JUMP_SIZE);
finally
VirtualProtect(ASource, JUMP_SIZE, LOldProtect, @LOldProtect);
end;
end;
{ TInitRecordPatcher }
class procedure TInitRecordPatcher.Finit;
begin
TMemPatcher.AddressUnPatch(@OldInitRecordProc, OldInitCode);
TMemPatcher.AddressUnPatch(@OldFinitRecordProc, OldFinitCode);
CS.Free;
end;
class procedure TInitRecordPatcher.Init;
begin
CS := TCriticalSection.Create;
@OldInitRecordProc := InitRecordProcAddress;
@OldFinitRecordProc := FinitRecordProcAddress;
TMemPatcher.AddressPatch(@OldInitRecordProc, @NewInitRecord, OldInitCode);
TMemPatcher.AddressPatch(@OldFinitRecordProc, @NewFinitRecord, OldFinitCode);
end;
class procedure TInitRecordPatcher.PerformCall(AStackPtr, ATypeInfo: Pointer;
AOldProc, ANewProc: TInitRecProc; AIsInit: Boolean; AOldCode: TMemPatcher.TJump);
var
i: integer;
begin
CS.Enter;
try
try
TMemPatcher.AddressUnPatch(@AOldProc, AOldCode);
AOldProc(AStackPtr, ATypeInfo);
for i := Low(CallBackList) to High(CallBackList) do
CallBackList[i](AStackPtr, ATypeInfo, AIsInit);
finally
TMemPatcher.AddressPatch(@AOldProc, @ANewProc, AOldCode);
end;
finally
CS.Leave;
end;
end;
class procedure TInitRecordPatcher.NewInitRecord(p: Pointer; typeInfo: Pointer);
begin
PerformCall(p, typeInfo, @OldInitRecordProc, @NewInitRecord, True, OldInitCode);
end;
class procedure TInitRecordPatcher.NewFinitRecord(p: Pointer; typeInfo: Pointer);
begin
PerformCall(p, typeInfo, @OldFinitRecordProc, @NewFinitRecord, False, OldFinitCode);
end;
class function TInitRecordPatcher.InitRecordProcAddress: Pointer;
asm
{$IFDEF CPUX86}
lea eax, System.@InitializeRecord
{$ELSE}
lea rax, System.@InitializeRecord
{$ENDIF}
end;
class function TInitRecordPatcher.FinitRecordProcAddress: Pointer;
asm
{$IFDEF CPUX86}
lea eax, System.@FinalizeRecord
{$ELSE}
lea rax, System.@FinalizeRecord
{$ENDIF}
end;
class procedure TInitRecordPatcher.RegisterInitRecordCallBack(ACallBack: TInitRecordCallBack);
begin
SetLength(CallBackList, Succ(Length(CallBackList)));
CallBackList[High(CallBackList)] := ACallBack;
end;
initialization
TInitRecordPatcher.Init;
finalization
TInitRecordPatcher.Finit;
end.
