Ann: Мониторинг создания объектов

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;