How to Hack into Delphi class

The techniques introduce here against the design of Object Oriented Programming. As the title implied, OOP rules are not enforce here. I am hacking into the object and class to access the private or protected fields and methods. There is only one reason to do so: To patch a buggy class without changing the original source.

Access a protected field

TMyClass = class
protected
FValue: integer;
end;

The most easy way to access FValue is write a helper class:

TMyClassHelper = class helper for TMyClass
public
procedure SetValue(const aValue: integer);
end;

procedure TMyClassHelper.SetValue(const aValue: integer);
begin
FValue := aValue;
end;

Example:

var o: TMyClass;
begin
o := TMyClass.Create;
o.SetValue(100);
end;

Access a private field

type
TMyClass = class
strict private
FValue: integer;
end;

TMyClassAccessor = class
public
FValue: integer;
end;

Example:

var o: TMyClass;
begin
o := TMyClass.Create;
TMyClassAccessor(o).FValue := 100;
o.Free;
end;

Access a private class var field

This is particularly hard. My solution only work if the class is compiled into package.

type
TMyClass = class
strict private
class var FValue: integer;
end;

I found no way to access the static class var. If you are lucky that the class is compiled into a Delphi package (.bpl), then you are lucky.

1. Google for any PE Viewer that can view the information of Windows executables files (EXE/DLL/BPL).
2. Use the PE Viewer to open the Delphi package
3. Locate the Exports section and search for the exported name for the static class var. For example: @MyUnit@TMyClass@FValue
4. Delphi package mangle the name as something like @<unit-name>@<class-name>@<method-name>

Next, you may use GetProcAddress to get the field:

var H: THandle;
P: PInteger;
begin
H := LoadPackage('MyPackage.bpl');
P := GetProcAddress(H, '@MyUnit@TMyClass@FValue');
P^ := 1234;
UnloadPackage(P);
end;

Patching a method in class

Use the following to patch any methods that you able to retrieve the method address:

{$WEAKPACKAGEUNIT ON}
unit CodeRedirect;

interface

type
TCodeRedirect = class(TObject)
private
type
TInjectRec = packed record
Jump: Byte;
Offset: Integer;
end;

PWin9xDebugThunk = ^TWin9xDebugThunk;
TWin9xDebugThunk = packed record
PUSH: Byte;
Addr: Pointer;
JMP: Byte;
Offset: Integer;
end;

PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
TAbsoluteIndirectJmp = packed record
OpCode: Word; //$FF25(Jmp, FF /4)
Addr: ^Pointer;
end;
private
FSourceProc: Pointer;
FInjectRec: TInjectRec;
function GetActualAddr(Proc: Pointer): Pointer;
public
constructor Create(const aProc, aNewProc: Pointer);
procedure BeforeDestruction; override;
end;

implementation

uses SysUtils, Windows;

function TCodeRedirect.GetActualAddr(Proc: Pointer): Pointer;

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

begin
if Proc <> nil then begin
if (Win32Platform <> VER_PLATFORM_WIN32_NT) and IsWin9xDebugThunk(Proc) then
Proc := PWin9xDebugThunk(Proc).Addr;
if (PAbsoluteIndirectJmp(Proc).OpCode = $25FF) then
Result := PAbsoluteIndirectJmp(Proc).Addr^
else
Result := Proc;
end else
Result := nil;
end;

procedure TCodeRedirect.BeforeDestruction;
var n: DWORD;
begin
inherited;
if FInjectRec.Jump <> 0 then
WriteProcessMemory(GetCurrentProcess, GetActualAddr(FSourceProc), @FInjectRec, SizeOf(FInjectRec), n);
end;

constructor TCodeRedirect.Create(const aProc, aNewProc: Pointer);
var OldProtect: Cardinal;
P: pointer;
begin
inherited Create;
if Assigned(aProc)then begin
FSourceProc := aProc;
P := GetActualAddr(aProc);
if VirtualProtect(P, SizeOf(TInjectRec), PAGE_EXECUTE_READWRITE, OldProtect) then begin
FInjectRec := TInjectRec(P^);
TInjectRec(P^).Jump := $E9;
TInjectRec(P^).Offset := Integer(aNewProc) - (Integer(P) + SizeOf(TInjectRec));
VirtualProtect(P, SizeOf(TInjectRec), OldProtect, @OldProtect);
FlushInstructionCache(GetCurrentProcess, P, SizeOf(TInjectRec));
end;
end;
end;

end.