unit elCodeHook;

interface
uses
  Windows,
  PSAPI,
  SysUtils;

type
  PJump = ^TJump;
  TJump = packed record
    OpCode: Byte;
    Distance: Pointer;
  end;

  TCodeHook = class
  private
    FOldJump: TJump;
    FOldAddr: Pointer;
    FNewAddr: Pointer;
  public
    procedure Install;
    procedure UnInstall;
    constructor Create(OldAddr: Pointer; NewAddr: Pointer);
    destructor Destroy; override;
    property OldJump: TJump read FOldJump;
    property OldAddr: Pointer read FOldAddr;
    property NewAddr: Pointer read FNewAddr;
  end;

function CreateCodeHook(ModuleHandle: THandle; OldProcName: String; NewProcAddr: Pointer): TCodeHook;

implementation

procedure TCodeHook.Install;
var
  NewJump: PJump;
  OldProtect: DWORD;
begin
  if not VirtualProtect(OldAddr, SizeOf(TJump), PAGE_READWRITE, OldProtect) then
  begin
///    RaiseLastOSError;
  end;

  NewJump := PJump(OldAddr);
  FOldJump := NewJump^;

  NewJump.OpCode := $E9;
  NewJump.Distance := Pointer(Integer(NewAddr) - Integer(OldAddr) - 5);

  if not VirtualProtect(OldAddr, SizeOf(TJump), OldProtect, nil) then
  begin
///    RaiseLastOSError;
  end;
  if not FlushInstructionCache(GetCurrentProcess, OldAddr, SizeOf(TJump)) then
  begin
    RaiseLastOSError;
  end;
end;

constructor TCodeHook.Create(OldAddr: Pointer; NewAddr: Pointer);
begin
  inherited Create;
  FOldAddr := OldAddr;
  FNewAddr := NewAddr;
  Install;
end;

procedure TCodeHook.UnInstall;
var
  NewJump: PJump;
  OldProtect: DWORD;
begin
  if not VirtualProtect(OldAddr, SizeOf(TJump), PAGE_READWRITE, @OldProtect) then
  begin
///    RaiseLastOSError;
  end;
  NewJump := PJump(OldAddr);
  NewJump^ := OldJump;
  if not VirtualProtect(OldAddr, SizeOf(TJump), OldProtect, nil) then
  begin
///    RaiseLastOSError;
  end;
  if not FlushInstructionCache(GetCurrentProcess, OldAddr, SizeOf(TJump)) then
  begin
    RaiseLastOSError;
  end;
end;

destructor TCodeHook.Destroy;
begin
  UnInstall;
  inherited;
end;

function CreateCodeHook(ModuleHandle: THandle; OldProcName: String; NewProcAddr: Pointer): TCodeHook;
var
  OldProcAddr: Pointer;
begin
  OldProcAddr := GetProcAddress(ModuleHandle, PChar(OldProcName));
  Assert(Assigned(OldProcAddr), OldProcName);

  Result := TCodeHook.Create(OldProcAddr, NewProcAddr);
end;

end.