<< Speciální jarní slevová akce | DeHL Library >>

Háček: nahrazení funkce nebo metody

vložil Radek Červinka 27. dubna 2010 00:51

Ve třetím a asi i posledním díle mini seriálu ukáži nahrazení cizí funkce, procedury nebo metody (nevirtuální). Tímto způsobem se dá opravovat cizí kód v koupených komponentách nebo třeba v samotné RTL.

Opět jsem vykradl VCLFixPack, ale ostatní to mohou dělat trochu odlišně. Příkladem odlišného řešení (a možného použití) je vyřešení problému s Data Execution Prevention (DEP) v Delphi RTL ve starších verzích Delphi (do verze D2005).

V podstatě napíšete stínovou implementaci nahrazované funkce se stejným rozhraním a provede nahrazení původního kódu většinou přes nějaký skok na svoji implementaci.

Pro demonstraci jsem nahradil SysUtils.DateToStr. Vlastní kód je až kolem 100 řádku.

    1unit uHack;
    2{**************************************************************************************************}
    3{                                                                                                  }
    4{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
    5{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
    6{ License at http://www.mozilla.org/MPL/                                                           }
    7{                                                                                                  }
    8{ The Original Code is VCLFixPack.pas.                                                             }
    9{                                                                                                  }
   10{ The Initial Developer of the Original Code is Andreas Hausladen (Andreas.Hausladen@gmx.de).      }
   11{ Portions created by Andreas Hausladen are Copyright © 2008 Andreas Hausladen.                  }
   12{ All Rights Reserved.                                                                             }
   13{                                                                                                  }
   14{**************************************************************************************************}
   15
   16{$R-} // range check off
   17interface
   18implementation
   19uses
   20  SysUtils,
   21  Windows,
   22  Classes;
   23
   24type
   25  TJumpOfs = Integer;
   26  PPointer = ^Pointer;
   27
   28  PXRedirCode = ^TXRedirCode;
   29  TXRedirCode = packed record
   30    Jump: Byte;
   31    Offset: TJumpOfs;
   32  end;
   33
   34  PWin9xDebugThunk = ^TWin9xDebugThunk;
   35  TWin9xDebugThunk = packed record
   36    PUSH: Byte;
   37    Addr: Pointer;
   38    JMP: TXRedirCode;
   39  end;
   40
   41  PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
   42  TAbsoluteIndirectJmp = packed record
   43    OpCode: Word;   //$FF25(Jmp, FF /4)
   44    Addr: PPointer;
   45  end;
   46
   47function GetActualAddr(Proc: Pointer): Pointer;
   48
   49  function IsWin9xDebugThunk(AAddr: Pointer): Boolean;
   50  begin
   51    Result := (AAddr <> nil) and
   52              (PWin9xDebugThunk(AAddr).PUSH = $68) and
   53              (PWin9xDebugThunk(AAddr).JMP.Jump = $E9);
   54  end;
   55
   56begin
   57  if Proc <> nil then
   58  begin
   59    if (Win32Platform <> VER_PLATFORM_WIN32_NT) and IsWin9xDebugThunk(Proc) then
   60      Proc := PWin9xDebugThunk(Proc).Addr;
   61    if (PAbsoluteIndirectJmp(Proc).OpCode = $25FF) then
   62      Result := PAbsoluteIndirectJmp(Proc).Addr^
   63    else
   64      Result := Proc;
   65  end
   66  else
   67    Result := nil;
   68end;
   69
   70procedure HookProc(Proc, Dest: Pointer; var BackupCode: TXRedirCode);
   71var
   72  n: DWORD;
   73  Code: TXRedirCode;
   74begin
   75  Proc := GetActualAddr(Proc);
   76  Assert(Proc <> nil);
   77  if ReadProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n) then
   78  begin
   79    Code.Jump := $E9;
   80    Code.Offset := PAnsiChar(Dest) - PAnsiChar(Proc) - SizeOf(Code);
   81    WriteProcessMemory(GetCurrentProcess, Proc, @Code, SizeOf(Code), n);
   82  end;
   83end;
   84
   85procedure UnhookProc(Proc: Pointer; var BackupCode: TXRedirCode);
   86var
   87  n: Cardinal;
   88begin
   89  if (BackupCode.Jump <> 0) and (Proc <> nil) then
   90  begin
   91    Proc := GetActualAddr(Proc);
   92    Assert(Proc <> nil);
   93    WriteProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n);
   94    BackupCode.Jump := 0;
   95  end;
   96end;
   97
   98var
   99  DateToStrJmp: TXRedirCode;
  100
  101// moje implementace
  102function OwnDateToStr(Date: TDateTime):string;
  103begin
  104
  105  DateTimeToString(Result, ShortDateFormat, Date);
  106  Result := 'DateToStr:'+Result;
  107end;
  108
  109// vlastni hack
  110
  111initialization
  112  // instalace
  113  HookProc(@SysUtils.DateToStr, @OwnDateToStr, DateToStrJmp);
  114finalization
  115  // a zpet
  116  UnhookProc(@SysUtils.DateToStr, DateToStrJmp);
  117end.

Pokud použijeme unit uHack dříve než SysUtils (tj. nejlépe pokud je náš unit co nejdříve v projektu) dojde k nahrazení DateToStr za naši pochybnou implementaci. Pozor: vyšší verze Delphi používají optimalizaci pomoc inline, tj. kompilátor (nebo spíše linker) odstraní (resp. může odstranit) přebytečné volání funkcí nebo metod a obsah volané např. funkce včlení do volajícího kódu, čímž ušetří x instrukcí, ale v tom případě tento hack nemůžeme použít.

Ale zpět:

    1program Project2;
    2{$APPTYPE CONSOLE}
    3uses
    4  uHack in 'uHack.pas',
    5  SysUtils;
    6
    7begin
    8  writeln(DateToStr(Now));
    9end.