CodeRedirect.pas

{$WEAKPACKAGEUNIT ON}
unit CodeRedirect;

interface

uses
  System.SysUtils;

type
  TInstruction = class abstract
  const
    Default_OffSetLimit = 8192;
  public
    class function GetAddress(aIP: Pointer; aOffSet: NativeInt = 0): Pointer; overload;
    class function GetAddress(aIP: pointer; aSignature: array of byte; OffsetLimit:
        Integer = Default_OffSetLimit): Pointer; overload;
    class function GetAddressOfCall(aIP: pointer): Pointer; overload;
    class function GetAddressOfCall(aIP: pointer; aSignature: array of byte;
        OffsetLimit: Integer = Default_OffSetLimit): Pointer; overload;
    class procedure Patch(aAddr: Pointer; aPatchValues: array of Byte);
  end;

  TCodeRedirect = class(TObject)
  const
    Default_OffSetLimit = 8192;
  private
    FOriginalCode: TBytes;
    FSrcAddr: Pointer;
    FPatchCode: TBytes;
  public
    constructor CreateWithMethod(const aOldMethod, aNewMethod: Pointer); deprecated
        'Use https://github.com/MahdiSafsafi/DDetours';
    constructor Create(const aSrcAddr: Pointer; const aPatchCode: array of byte);
    procedure BeforeDestruction; override;
    procedure StopPatch;
    procedure StartPatch;
  end;

function IsRuntimePackaged: boolean;
function RuntimeArchitecture: TOSVersion.TArchitecture;

implementation

uses
  Winapi.Windows;

function IsRuntimePackaged: boolean;
begin
  Result := FindClassHInstance(TObject) <> MainInstance;
end;

function RuntimeArchitecture: TOSVersion.TArchitecture;
begin
  {$ifdef Win32}Exit(TOSVersion.TArchitecture.arIntelX86);{$endif}
  {$ifdef Win64}Exit(TOSVersion.TArchitecture.arIntelX64);{$endif}
  raise ENotSupportedException.Create('Platform not supported');
end;

class function TInstruction.GetAddress(aIP: Pointer; aOffSet: NativeInt = 0):
    Pointer;
type
  PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
  TAbsoluteIndirectJmp = packed record
    OpCode: Word;   //$FF25(Jmp, FF /4)
    Addr: Cardinal;
  end;

var J: PAbsoluteIndirectJmp;
{$ifdef Win32}
type
  PWin9xDebugThunk = ^TWin9xDebugThunk;
  TWin9xDebugThunk = packed record
    PUSH: Byte;
    Addr: Pointer;
    JMP: Byte;
    Offset: Integer;
  end;

  function IsWin9xDebugThunk(AAddr: Pointer): Boolean;
  begin
    Result := (AAddr <> nil) and
              (PWin9xDebugThunk(AAddr).PUSH = $68) and
              (PWin9xDebugThunk(AAddr).JMP = $E9);
  end;

begin
  if aIP = nil then Exit(aIP);

  if (Win32Platform <> VER_PLATFORM_WIN32_NT) and IsWin9xDebugThunk(aIP) then
    aIP := PWin9xDebugThunk(aIP).Addr;
  J := PAbsoluteIndirectJmp(aIP);
  if (J.OpCode = $25FF) then
    Result := PPointer(J.Addr)^
  else
    Result := aIP;
  Result := PByte(Result) + aOffset;
end;
{$endif}
{$ifdef Win64}
begin
  if aIP = nil then Exit(aIP);

  J := PAbsoluteIndirectJmp(aIP);
  if (J.OpCode = $25FF) then
    Result := PPointer(NativeUInt(aIP) + J.Addr + 6{Instruction Size})^
  else
    Result := aIP;

  Result := PByte(Result) + aOffset;
end;
{$endif}

class function TInstruction.GetAddress(aIP: pointer; aSignature: array of byte;
    OffsetLimit: Integer = Default_OffSetLimit): Pointer;
var P: ^NativeInt;
    i: integer;
    bFound: boolean;
begin
  i := 0;
  P := TInstruction.GetAddress(aIP);
  bFound := True;
  while not CompareMem(P, @aSignature, Length(aSignature)) do begin
    Inc(NativeUInt(P));
    Inc(i);
    if (i > OffsetLimit) then begin
      bFound := False;
      Break;
    end;
  end;
  if bFound then
    Result := P
  else
    Result := nil;
end;

class function TInstruction.GetAddressOfCall(aIP: pointer): Pointer;
var P: PByteArray;
begin
  P := aIP;
  if Assigned(P) then
    Result := Pointer(NativeInt(P) + 5{Instruction Size} + PInteger(@P[1])^)
  else
    Result := nil;
end;

class function TInstruction.GetAddressOfCall(aIP: pointer; aSignature: array of
    byte; OffsetLimit: Integer = Default_OffSetLimit): Pointer;
var P: PByteArray;
begin
  P := TInstruction.GetAddress(aIP, aSignature, OffsetLimit);
  if Assigned(P) then
    Result := Pointer(NativeInt(P) + 5{Instruction Size} + PInteger(@P[1])^)
  else
    Result := nil;
end;

class procedure TInstruction.Patch(aAddr: Pointer; aPatchValues: array of Byte);
var P: Cardinal;
    n: Integer;
begin
  n := Length(aPatchValues);
  if (n > 0) and VirtualProtect(aAddr, n, PAGE_EXECUTE_READWRITE, P) then begin
    Move(aPatchValues[0], aAddr^, n);
    VirtualProtect(aAddr, n, P, @P);
    FlushInstructionCache(GetCurrentProcess, aAddr, n);
  end;
end;

procedure TCodeRedirect.BeforeDestruction;
begin
  inherited;
  StopPatch;
end;

constructor TCodeRedirect.Create(const aSrcAddr: Pointer; const aPatchCode:
    array of byte);
begin
  inherited Create;
  FSrcAddr := aSrcAddr;

  SetLength(FPatchCode, Length(aPatchCode));
  Move(aPatchCode[0], FPatchCode[0], Length(aPatchCode));
  StartPatch;
end;

procedure TCodeRedirect.StopPatch;
var n: NativeUInt;
begin
  if not WriteProcessMemory(GetCurrentProcess, FSrcAddr, @FOriginalCode[0], Length(FOriginalCode), n) or (NativeInt(n) <> Length(FOriginalCode)) then
    RaiseLastOSError;
end;

constructor TCodeRedirect.CreateWithMethod(const aOldMethod, aNewMethod:
    Pointer);
var P: pointer;
    B: TBytes;
    O: PInteger;
begin
  if (aOldMethod = nil) or (aNewMethod = nil) then
    raise Exception.Create('Unknown method address');

  SetLength(B, 1{Jmp Instruction Size} + 4{Address size});
  P := TInstruction.GetAddress(aOldMethod);
  B[0] := $E9; // Jmp instruction
  O := @B[1];
  O^ := Integer(NativeInt(aNewMethod) - (NativeInt(P) + NativeInt(Length(B))));
  Create(P, B);
end;

procedure TCodeRedirect.StartPatch;
var OldProtect: Cardinal;
    n: Integer;
begin
  n := Length(FPatchCode);
  if VirtualProtect(FSrcAddr, n, PAGE_EXECUTE_READWRITE, OldProtect) then begin
    // Store original code
    SetLength(FOriginalCode, n);
    Move(FSrcAddr^, FOriginalCode[0], n);

    // Patch original code
    Move(FPatchCode[0], FSrcAddr^, n);

    VirtualProtect(FSrcAddr, n, OldProtect, @OldProtect);
    FlushInstructionCache(GetCurrentProcess, FSrcAddr, n);
  end;
end;

end.