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
    {$Hint Off} 
    FValue: integer;

    {$Hint On}
  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

Delphi VCL source may have problems or bugs.  A famous solution is to fix the VCL source directly and include the source file into the project.  This is fine if you release your application in single .EXE without using runtime package.

Delphi doesn’t include the project file to build the VCL runtime packages.  We are not able to re-compile VCL runtime packages.

A better solution is using TCodeRedirect class to patch the methods or functions that has problem without changing the VCL source.  You may remove the patch from your project if the problem has fixed in later version of Delphi release.

{$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;
    FNewProc: Pointer;
    FInjectRec: TInjectRec;
  public
    constructor Create(const aProc, aNewProc: Pointer);
    procedure BeforeDestruction; override;
    procedure Disable;
    procedure Enable;
    class function GetActualAddr(Proc: Pointer): Pointer;
    class function GetAddressOf(aMethodAddr: pointer; aSignature: array of byte): Pointer;
  end;

implementation

uses SysUtils, Windows;

class 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;
begin
  inherited;
  Disable;
end;

constructor TCodeRedirect.Create(const aProc, aNewProc: Pointer);
begin
  inherited Create;
  FSourceProc := aProc;
  FNewProc := aNewProc;
  Enable;
end;

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

procedure TCodeRedirect.Enable;
var OldProtect: Cardinal;
    P: pointer;
begin
  if Assigned(FSourceProc)then begin
    P := GetActualAddr(FSourceProc);
    if VirtualProtect(P, SizeOf(TInjectRec), PAGE_EXECUTE_READWRITE, OldProtect) then begin
      FInjectRec := TInjectRec(P^);
      TInjectRec(P^).Jump := $E9;
      TInjectRec(P^).Offset := Integer(FNewProc) - (Integer(P) + SizeOf(TInjectRec));
      VirtualProtect(P, SizeOf(TInjectRec), OldProtect, @OldProtect);
      FlushInstructionCache(GetCurrentProcess, P, SizeOf(TInjectRec));
    end;
  end;
end;

class function TCodeRedirect.GetAddressOf(aMethodAddr: pointer;
  aSignature: array of byte): Pointer;
var P: PByteArray;
begin
  P := GetActualAddr(aMethodAddr);
  while not CompareMem(P, @aSignature, Length(aSignature)) do
    Inc(PByte(P));
  Result := Pointer(Integer(@P[5]) + PInteger(@P[1])^);
end;

end.

Example: Patching public method

This example shows how to patch a public method TForm.Close.  Assume that TForm.Close has an error and you want to patch it.  Here is a patch:

type
  TFormPatch = class helper for TForm
  public
    procedure ClosePatch;
  end;

procedure TFormPatch.ClosePatch;
var
  CloseAction: TCloseAction;
begin
  ShowMessage('TForm.Close has been patched');

  if fsModal in FFormState then
    ModalResult := mrCancel
  else
    if CloseQuery then
    begin
      if FormStyle = fsMDIChild then
        if biMinimize in BorderIcons then
          CloseAction := caMinimize else
          CloseAction := caNone
      else
        CloseAction := caHide;
      DoClose(CloseAction);
      if CloseAction <> caNone then
        if Application.MainForm = Self then Application.Terminate
        else if CloseAction = caHide then Hide
        else if CloseAction = caMinimize then WindowState := wsMinimized
        else Release;
    end;
end;

var P: TCodeRedirect;

initialization
  P := TCodeRedirect.Create(@TForm.Close, @TForm.ClosePatch);
finalization
  P.Free;
end.

ClosePatch method is a new method to replace Close method.  In this example, I copy from TCustomForm.Close method and add a new line ShowMessage at top.  You are freely to write any code in ClosePatch method.  The initialization and finalization part activate and deactivate the patch respectively.

Once this code has been injected into your project, all code that trigger TForm.Close method will show a message before closing the form.

Example: Patching protected method

Access to protected method is prohibit unless the code is in same unit as the class.  This example attempt to patch a protected method TStringList.GetCount.

TStringListAccess = class(TStringList)
protected
  function GetCountPatch: Integer;
end;

function TStringListAccess.GetCountPatch: Integer;
begin
  Result := 100;
end;

var P: TCodeRedirect;

initialization
  P := TCodeRedirect.Create(@TStringListAccess.GetCount, @TStringListAccess.GetCountPatch);
finalization
  P.Free;
end.

The above example using class inheritance to access protected method GetCount.

If we execute the following code with TStringList.GetCountPatch injected, invoke Count method will always return 100 regardless of how many string has been added into instance s:

var S: TStringList;
begin
  S := TStringList.Create;
  try
    ShowMessage(IntToStr(S.Count));
    S.Add('1');
    ShowMessage(IntToStr(S.Count));
    S.Add('2');
    ShowMessage(IntToStr(S.Count));
  finally
    S.Free;
  end;
end;

Example: Patching private method

Patching a private method requires more effort as private method is not visible by any means unless access it in same unit.  A clue is to find a way to obtain the address of the private method.

The following example shows how to patch a private method TWinControl.UpdateShowing. 

TWinControlPatch = class helper for TWinControl
public
  procedure UpdateShowingPatch;
end;

const
  Controls_6988 : array[boolean, 0..4] of byte = (
    ($E8, $61, $DE, $FF, $FF),
    ($E8, $31, $DD, $FF, $FF)
  );

var P: TCodeRedirect;

initialization
  P := TCodeRedirect.Create(
         TCodeRedirect.GetAddressOf(@TWinControl.SetDesignVisible, Controls_6988[False]),
         @TWinControl.UpdateShowingPatch
       );
finalization
  P.Free;
end.

Firstly, we need to search in source code of the class for code we can access that invoke TWinControl.UpdateShowing. TWinControl.SetDesignVisible is such method that we after:

procedure TWinControl.SetDesignVisible(Value: Boolean);
begin
  if (csDesigning in ComponentState) and (Value <> not (csDesignerHide in ControlState)) then
  begin
    if not Value then
      Include(FControlState, csDesignerHide)
    else
      Exclude(FControlState, csDesignerHide);
    UpdateShowing;
  end;
end;

We then run our application with debugger to track the address of TWinControl.UpdateShowing.  We may set a breakpoint in TWinControl.SetDesignVisible method and view the code in assembly language (Accessed via Delphi IDE: View | Debug Windows | CPU Windows | Entire CPU).

Assembly code of TWinControl.SetDesignVisible for applicationbuilt without runtime packages (Delphi 2007 11.0.2902.10471):

Controls.pas.8006: begin
00443900 53               push ebx
00443901 8BD8             mov ebx,eax
Controls.pas.8007: if (csDesigning in ComponentState) and (Value <> not (csDesignerHide in ControlState)) then
00443903 F6431C10         test byte ptr [ebx+$1c],$10
00443907 7426             jz $0044392f
00443909 F6435508         test byte ptr [ebx+$55],$08
0044390D 0F95C0           setnz al
00443910 3401             xor al,$01
00443912 3AD0             cmp dl,al
00443914 7419             jz $0044392f
Controls.pas.8009: if not Value then
00443916 84D2             test dl,dl
00443918 7508             jnz $00443922
Controls.pas.8010: Include(FControlState, csDesignerHide)
0044391A 66814B540008     or word ptr [ebx+$54],$0800
00443920 EB06             jmp $00443928
Controls.pas.8012: Exclude(FControlState, csDesignerHide);
00443922 66816354FFF7     and word ptr [ebx+$54],$f7ff
Controls.pas.8013: UpdateShowing;
00443928 8BC3             mov eax,ebx
0044392A E861DEFFFF       call TWinControl.UpdateShowing
Controls.pas.8015: end;
0044392F 5B               pop ebx
00443930 C3               ret

The instruction code E861DEFFFF is the machine code of invoke TWinControl.UpdateShowing.  We may then use

TCodeRedirect.GetAddressOf(@TWinControl.SetDesignVisible, Controls_6988[False])

to match the machine code and obtain the address of the method.

Once we got the address, we may use TCodeRedirect to patch UpdateShowing as usual.

Please note the address of a method may vary if application is built with runtime package.  Also, different version of Delphi VCL or any update in between will make the address vary too.

The following show assembly code of TWinControl.SetDesignVisible for application built with runtime packages (Delphi 2007 11.0.2902.10471):

TWinControl.SetDesignVisible:
005628CC 53               push ebx
005628CD 8BD8             mov ebx,eax
Controls.pas.8007:
005628CF F6431C10         test byte ptr [ebx+$1c],$10
005628D3 7426             jz $005628fb
005628D5 F6435508         test byte ptr [ebx+$55],$08
005628D9 0F95C0           setnz al
005628DC 3401             xor al,$01
005628DE 3AD0             cmp dl,al
005628E0 7419             jz $005628fb
Controls.pas.8009:
005628E2 84D2             test dl,dl
005628E4 7508             jnz $005628ee
Controls.pas.8010:
005628E6 66814B540008     or word ptr [ebx+$54],$0800
005628EC EB06             jmp $005628f4
Controls.pas.8012:
005628EE 66816354FFF7     and word ptr [ebx+$54],$f7ff
Controls.pas.8013:
005628F4 8BC3             mov eax,ebx
005628F6 E831DDFFFF       call $0056062c
Controls.pas.8015:
005628FB 5B               pop ebx
005628FC C3               ret

You may see the machine code for both application built with and without runtime package is different.

Reference:

1. Hack #5: Access to private fields
2. How to patch private function and private method
3. http://opensvn.csie.org/historypp/3rdparty/RtlVclOptimize.pas