unit HookUnit;

{$MODE Delphi}

interface

uses
  PEStuff, Classes,tlhelp32,sysutils,windows;
type
  THookedFunction=record //_variablen sind redunant vorhanden
    OldFunc: string;
    _finalOldFunc:pointer;
    modul: string;
    NewFunc:pointer;
    Flags: cardinal;
    _ordinalName:dword;
    _modulHandle:dword;
  end;
  PPointer =  ^Pointer;

  TImportCode = packed record
    JumpInstruction: word; // should be $25FF
    AddressOfPointerToFunction: PPointer;
  end;
  PImportCode = ^TImportCode;

  TGetProcAddress =  function( hmod:HMODULE ; lpProcName :pchar):Pointer; stdcall;


function Int2Str(Number: Int64): string;
procedure HookGetProcAddressFunction;
function HookFunction(newfunc:pointer;oldfuncStr,modul:string):pointer;overload;
function HookFunction(oldfunc,newfunc:pointer;oldfuncStr,modul:string):pointer;overload;
procedure UnHookFunctions;

function NewGetProcAddress( hmod:HMODULE ; lpProcName :pchar):Pointer; stdcall;
implementation

var
  hookedFuncs:array of THookedFunction;
  OldProcAddress: TGetProcAddress=nil;
function Int2Str(Number: Int64): string;
var
  Minus: Boolean;
begin
  Result := '';
  if Number = 0 then
    Result := '0';
  Minus := Number < 0;
  if Minus then
    Number := -Number;
  while Number > 0 do
  begin
    Result := Char((Number mod 10) + Integer('0')) + Result;
    Number := Number div 10;
  end;
  if Minus then
    Result := '-' + Result;
end;

function WideStringToString(const ws: WideString; codePage: Word): AnsiString;
var
  l: integer;
begin
if ws = '' then
    Result := ''
  else
  begin
    l := WideCharToMultiByte(codePage, 
      WC_COMPOSITECHECK or WC_DISCARDNS or WC_SEPCHARS or WC_DEFAULTCHAR, 
      @ws[1], - 1, nil, 0, nil, nil);
    SetLength(Result, l - 1);
    if l > 1 then
      WideCharToMultiByte(codePage, 
        WC_COMPOSITECHECK or WC_DISCARDNS or WC_SEPCHARS or WC_DEFAULTCHAR, 
        @ws[1], - 1, @Result[1], l - 1, nil, nil); 
  end; 
end; { WideStringToString }


function UnicodeToAnsi(S: PWideChar): string;
var
  S1: PChar;
  i: Integer;
begin
  i := lstrlenw(S) + 1;
  GetMem(S1, 500);
  WideCharToMultiByte(CP_ACP, 0, S, i, S1, i * 2, nil, nil);
  Result := S1;
  FreeMem(S1, 500);
end;

function AnsiToUnicode(S: string; var NewSize: Integer): PWideChar;
var
  Size: Integer;
  P: PWideChar;
begin
 Size := Length(S);
 NewSize := Size * 2;
 P := VirtualAlloc(nil, Size, Mem_Commit, Page_ReadWrite);
 MultiByteToWideChar(CP_ACP, 0, PChar(S), Size, P, NewSize);
 Result := P;
end;

{function AreEquals(const s1,s2:string;len:integer):boolean;
var i:integer;
begin
  result:=false;
  if len>Length(s1) then len:=Length(s1);
  if len>Length(s2) then len:=Length(s2);
  for i:= 1 to len do
    if s1[i]<>s2[i] then exit;
  result:=true;
end;       }
function AreEquals(p:pchar;const s:string):boolean;
var i,len:integer;
    p2:pchar;
begin
  result:=false;
  len:=length(s);
  p2:=@s[1];
  for i:= 1 to len do begin
    if p^<>p2^ then exit;
    inc(p);inc(p2);
  end;
  result:=true;
end;
function PointerToFunctionAddress(Code: Pointer): PPointer;
var
  func: PImportCode;
begin
  Result := nil;
  if Code = nil then Exit;
  try
    func := code;
    if (func.JumpInstruction = $25FF) then
    begin
      Result := func.AddressOfPointerToFunction;
    end;
  except
    Result := nil;
  end;
end;

function FinalFunctionAddress(Code: Pointer): Pointer;
var
  func: PImportCode;
begin
  Result := Code;
  if Code = nil then Exit;
  try
    func := code;
    if (func.JumpInstruction = $25FF) then
    begin
      Result := func.AddressOfPointerToFunction^;
    end;
  except
    Result := nil;
  end;
end;



{(*}function PatchAddress(OldFunc, NewFunc: Pointer{;process:dword}): boolean;
var
  BeenDone: TList;

  function PatchAddressInModule(hModule: THandle; OldFunc, NewFunc: Pointer): boolean;
  var
    Dos: PImageDosHeader;
    NT: PImageNTHeaders;
    ImportDesc: PImage_Import_Entry;
    rva: DWORD;
    Func: PPointer;
    f: Pointer;
    temp: DWORD;
  begin
    Result := false;
    Dos := Pointer(hModule);
    if BeenDone.IndexOf(Dos) >= 0 then Exit;
    BeenDone.Add(Dos);

    nt:=getNTHeaders(hModule);
    if nt=nil then exit;

    RVA := NT^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress;

    if RVA = 0 then Exit;
    ImportDesc := Pointer(dword(Dos) + RVA);
    while (ImportDesc^.Name <> 0) do
    begin
   //   DLL := PChar(integer(Dos) + ImportDesc^.Name);
   //   PatchAddressInModule(GetModuleHandle(PChar(DLL)), OldFunc, NewFunc);
      Func := Pointer(dword(DOS) + ImportDesc.LookupTable);
      while Func^ <> nil do
      begin
        f := FinalFunctionAddress(Func^);
        if f = OldFunc then
        begin
          VirtualProtect(func,4,PAGE_READWRITE,@temp);
          WriteProcessMemory(GetCurrentProcess, Func, @NewFunc, 4, temp);
//          if Written > 0 then result++;
        end;
        Inc(Func);
      end;
      Inc(ImportDesc);
    end;
    result:=true;
  end;
var t32:Thandle;
    modul:TMODULEENTRY32;
begin
  BeenDone := TList.Create;
  try
    Result := PatchAddressInModule(cardinal(GetModuleHandle(nil)), OldFunc, NewFunc);
    t32:=CreateToolhelp32Snapshot(TH32CS_SNAPMODULE,0);
    Module32First(t32,modul);
    repeat
      result:=result and PatchAddressInModule(GetModuleHandle(modul.szModule),OldFunc,NewFunc);
    until (result and Module32Next(t32,modul))=false;
    CloseHandle(t32);
  finally
    BeenDone.Free;
  end;
end;

function getExportDirectory(hModule: THANDLE): PImageExportDirectory;
var dos : PIMAGEDOSHEADER;
    nt: PImageNtHeaders;
    rva: dword;
begin
  dos:=pointer(hModule);
  nt:=getNTHeaders(hModule);
  if nt = nil then exit(nil);

  RVA := NT^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT].VirtualAddress;
  if RVA = 0 then Exit(nil);
  result := Pointer(dword(Dos) + RVA);
end;


function HookFunction(newfunc: pointer; oldfuncStr, modul: string): pointer;
var lib:THANDLE;
begin
  lib:=LoadLibrary(pchar(modul));
  if lib=0 then exit(nil);
  result:=GetProcAddress(lib,pchar(oldfuncStr));
  if Result=nil then begin
    FreeLibrary(lib);
    exit(nil);
  end;
  result:=HookFunction(Result,newfunc,oldfuncStr,modul);
  FreeLibrary(lib);
end;

function HookFunction(oldfunc,newfunc:pointer;oldfuncStr,modul:string):pointer;
var hf:THookedFunction;
begin
  result:=oldFunc;
  if LowerCase(ExtractFileName(ParamStr(0)))='explorer.exe' then exit; //Don't hook explorer, it don't like it
  hf.OldFunc:=oldfuncStr;
  hf._finalOldFunc:=FinalFunctionAddress(oldfunc);
  hf.modul:=modul;
  hf.NewFunc:=newfunc;
  hf.Flags:=0;
  hf._modulHandle:=GetModuleHandle(pchar(modul));


  PatchAddress(hf._finalOldFunc, hf.NewFunc);
  {result:=FinalFunctionAddress(@MessageBoxA);
  PatchAddress(FinalFunctionAddress(@MessageBoxA),hf.NewFunc);}
  result:=hf._finalOldFunc;

  SetLength(hookedFuncs,length(hookedFuncs)+1);
  hookedFuncs[high(hookedFuncs)]:=hf;
end;
procedure HookGetProcAddressFunction;
begin
  if @OldProcAddress=nil then
    @OldProcAddress:=HookFunction(@GetProcAddress,@NewGetProcAddress,'GetProcAddress','kernel32.dll');
end;
procedure UnhookFunctions;
var i:integer;
begin
  for i:=0 to high(hookedfuncs) do
    PatchAddress(hookedfuncs[i].NewFunc,hookedfuncs[i]._finalOldFunc);

end;



function NewGetProcAddress( hmod:HMODULE ; lpProcName :pchar):Pointer; stdcall;
var i:integer;
    libName: array[1..MaxPathLen] of char;
begin
  if @OldProcAddress = nil then exit(nil);
  result:=OldProcAddress(hmod,lpProcName);
  if result=nil then exit;
  result:=FinalFunctionAddress(result);
  for i:=0 to high(hookedFuncs) do
    if hookedFuncs[i]._finalOldFunc=result then
      exit(hookedFuncs[i].NewFunc);
end;

initialization
  setlength(hookedfuncs,0);
finalization
  UnhookFunctions;
end.

