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;
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.
typeTMyClass = 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.
- Google for any PE Viewer that can view the information of Windows executables files (EXE/DLL/BPL).
- Use the PE Viewer to open the Delphi package
- Locate the Exports section and search for the exported name for the static class var. For example: @MyUnit@TMyClass@FValue
- 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:
2 comments:
This is excellent! Thanks a lot for your work.
Do you know how i can redirect a normal global procedure without parameters?
Thanks,
Christian
Try this: TCodeRedirect.Create(@Global_Proc, @New_Global_Proc);
Post a Comment