mahdisafsafi / ddetours Goto Github PK

Hello!

Can you do a demo how to hook this function? I would like to hook thread 
creation/termination in only my app. Is good idea for your demo. :)

Hello!

Maybe you can make a demo how to do this? To intercept requests, headers :)

http://web.archive.org/web/20130313164317/http://www.blackfishsoftware.com/blog/
don/passthroughapp_bho_toolbar_intercepting_requests_responses

MY CODE:
------
uses DDetours;

var
  TrampolineGetTickCount: function: DWORD; stdcall = nil;
  IsHooked: Boolean = False;

function InterceptGetTickCount: DWORD; stdcall;
begin
  Result := TrampolineGetTickCount;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if not IsHooked then
  begin
    @TrampolineGetTickCount := InterceptCreate(GetProcAddress(LoadLibrary('kernel32.dll'), 'GetTickCount'), @InterceptGetTickCount);
    IsHooked := True;
    Button1.Enabled := False;
    Button2.Enabled := True;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if (@TrampolineGetTickCount <> nil) and IsHooked then
  begin
    IsHooked := False;
    InterceptRemove(@TrampolineGetTickCount);
    TrampolineGetTickCount := nil;
    Button1.Enabled := True;
    Button2.Enabled := False;
  end;
end;

------


I get Access violation error when i click Button1

Please provide any additional information below.

DDL v2 is not compatible with DXE. The issues are:

* It has a namespaced unit : "WinApi.Windows"

* It has an incorrect compiler define that wraps the unit "WinApi.TLHelp32". 
Only DXE2 or better has this unit, the rest only has "TLHelp32"

* SIZE_T is not declared (DE7 has it defined as ULONG_PTR)

Fails on 32 & 64..

program Project3;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  Winapi.Windows,
  Winapi.Wininet,
  DDetours;

var
  FHttpAddRequestHeadersW: function(hRequest: HINTERNET; lpszHeaders: LPWSTR; dwHeadersLength: DWORD; dwModifiers: DWORD): BOOL; stdcall;

function HttpAddRequestHeadersW(hRequest: HINTERNET; lpszHeaders: LPWSTR; 
dwHeadersLength: DWORD; dwModifiers: DWORD): BOOL; stdcall;
begin
  Result := FHttpAddRequestHeadersW(hRequest, lpszHeaders, dwHeadersLength, dwModifiers);
end;

begin
   @FHttpAddRequestHeadersW := InterceptCreate('wininet.dll', 'HttpAddRequestHeadersW', @FHttpAddRequestHeadersW, tRUE); // ERROR!!
end.

{
  First chance exception at $75514598. Exception class Exception with message 'Invalid InterceptProc Pointer.'. Process Project3.exe (4296)
}

unit memprofile;

interface

implementation
uses
  Generics.Defaults,
  Generics.Collections,
  DDetours;

type
  TSimpleProc = procedure(Self: TObject);
var
  SaveAfterConstruction: TSimpleProc = nil;
  SaveBeforeDestruction: TSimpleProc = nil;
  mDict: TDictionary<string, Integer>;



procedure AfterConstruction(Self: TObject);
var
  cnt: Integer;
  s: String;
begin
  s := Self.ClassName;
  if not mDict.TryGetValue(s, cnt) then
  begin
    cnt := 0;
  end;
  inc(cnt);
  mDict.AddOrSetValue(s, cnt);
  SaveAfterConstruction(Self);
end;

procedure BeforeDestruction(Self: TObject);
var
  cnt: Integer;
  s: String;
begin
  s := Self.ClassName;
  if not mDict.TryGetValue(s, cnt) then
  begin
    cnt := 0;
  end;
  dec(cnt);
  mDict.AddOrSetValue(s, cnt);
  SaveBeforeDestruction(Self);
end;


initialization
   mDict := TDictionary<string, Integer>.Create;
   SaveAfterConstruction := InterceptCreate(@TObject.AfterConstruction, @AfterConstruction);
   SaveBeforeDestruction := InterceptCreate(@TObject.BeforeDestruction, @BeforeDestruction);

end.

Crashes with 
"First chance exception at $00007FFA621914B0. Exception class $C0000005 with 
message 'c0000005 ACCESS_VIOLATION'. Process Project3.exe (9752)" 

At 2# hook.

program HookThread;

{$APPTYPE CONSOLE}

{.$DEFINE WINDOWS_XP}

uses
  System.SysUtils,
  WinApi.Windows,
  System.Classes,
  CPUID,
  DDetours,
  InstDecode;

type
  LPTHREAD_START_ROUTINE = function(lpThreadParameter: LPVOID): DWORD; stdcall;
  TLdrShutdownThread = procedure; stdcall;
  TCreateThread = function(lpThreadAttributes: Pointer; dwStackSize: SIZE_T; lpStartAddress: TFNThreadStartRoutine; lpParameter: Pointer; dwCreationFlags: DWORD; var lpThreadId: DWORD): THandle; stdcall;

var
  LdrShutdownThread: TLdrShutdownThread;
  CreateThreadHook: TCreateThread;

procedure LdrShutdownThreadCallback;
begin
  Writeln('Shutdown Thread !');
  LdrShutdownThread;
end;

function CreateThreadCallback(lpThreadAttributes: Pointer; dwStackSize: SIZE_T; 
lpStartAddress: TFNThreadStartRoutine; lpParameter: Pointer; dwCreationFlags: 
DWORD; var lpThreadId: DWORD): THandle; stdcall;
begin
  Writeln('Thread Started !');
  Result := CreateThreadHook(lpThreadAttributes, dwStackSize, lpStartAddress, lpParameter, dwCreationFlags, lpThreadId);
end;

begin
  @LdrShutdownThread := InterceptCreate('ntdll.dll', 'LdrShutdownThread', @LdrShutdownThreadCallback);
  @CreateThreadHook := InterceptCreate('kernel32.dll', 'CreateThread', @CreateThreadCallback);  // CRASH

  TThread.CreateAnonymousThread(
  procedure
  begin
    Sleep(1000);
  end).Start;

  ReadLn;
end.

What is the function that you are trying to hook ?
- FInternetSetCookieExW := InterceptCreate('wininet.dll', 
'InternetSetCookieExW', @InternetSetCookieExW, True);
- FInternetGetCookieExW := InterceptCreate('wininet.dll', 
'InternetGetCookieExW', @InternetGetCookieExW, True);
- FInternetSetCookie := InterceptCreate('wininet.dll', 'InternetSetCookieW', 
@InternetSetCookie, True);
- FInternetGetCookie := InterceptCreate('wininet.dll', 'InternetSetCookieW', 
@InternetSetCookie, True);


What is the expected output? What do you see instead?
- Function is not fired

What version of the product are you using? On what operating system? Which
architecture x86 or x64 ?

- x64

If the function hooked is not an windows API function , please include this
function .


Please provide any additional information below.
- Nothing happens on WebBrowser1.Navigate('http://www.google.com');

What is the function that you are trying to hook ?

Using Vcl.Styles.Hooks: user32.dll > GetSysColor

What is the expected output? What do you see instead?

When hook is being created: EIntOverflow.


What version of the product are you using? On what operating system? Which
architecture x86 or x64 ?

Delphi XE3, Win8, x86.

Please provide any additional information below.

The version of DDetours included in VCL Style Utils was used.

What is the function that you are trying to hook ?

Interface IInternetProtocol

What is the expected output? What do you see instead?

First chance exception at $006C0063. Exception class $C0000005 with message 
'access violation at 0x006c0063: write of address 0x009f2948'. Process 
Project3.exe (6552)

What version of the product are you using? On what operating system? Which
architecture x86 or x64 ?
Both

If the function hooked is not an windows API function , please include this
function .



Please provide any additional information below.

unit ComHook;

interface

uses
    Winapi.Windows,
    Winapi.WinInet,
    ComObj,
    ComServ,
    ActiveX,
    UrlMon,
    MSHTML,
    SHDocVw,
    DDetours;

const
    CLSID_HttpProtocol: TGUID = '{79EAC9E2-BAF9-11CE-8C82-00AA004BA90B}';

type
  TInternetProtocol = record
    class function Read(Self: Pointer; pv: Pointer; cb: ULONG; out cbRead: ULONG): HResult; stdcall; static;
    class function Seek(Self: Pointer; dlibMove: LARGE_INTEGER; dwOrigin: DWORD; out libNewPosition: ULARGE_INTEGER): HResult; stdcall; static;
    class function LockRequest(Self: Pointer; dwOptions: DWORD): HResult; stdcall; static;
    class function UnlockRequest(Self: Pointer): HResult; stdcall; static;
  end;

  procedure Hook;
  procedure UnHook;

var
    FInternetProtocol: IInternetProtocol;
    FRead: function(Self: Pointer; pv: Pointer; cb: ULONG; out cbRead: ULONG): HResult; stdcall;
    FSeek: function(Self: Pointer; dlibMove: LARGE_INTEGER; dwOrigin: DWORD; out libNewPosition: ULARGE_INTEGER): HResult; stdcall;
    FLockRequest: function(Self: Pointer; dwOptions: DWORD): HResult; stdcall;
    FUnlockRequest: function(Self: Pointer): HResult; stdcall;

implementation

{ TInternetProtocol }

class function TInternetProtocol.Read(Self: Pointer; pv: Pointer; cb: ULONG; 
out cbRead: ULONG): HResult; stdcall;
begin
  Result := FRead(Self, pv, cb, cbRead);
end;

class function TInternetProtocol.Seek(Self: Pointer; dlibMove: LARGE_INTEGER; 
dwOrigin: DWORD; out libNewPosition: ULARGE_INTEGER): HResult; stdcall;
begin
  Result := FSeek(Self, dlibMove, dwOrigin, libNewPosition);
end;

class function TInternetProtocol.LockRequest(Self: Pointer; dwOptions: DWORD): 
HResult; stdcall;
begin
  Result := FLockRequest(Self, dwOptions);
end;

class function TInternetProtocol.UnlockRequest(Self: Pointer): HResult; stdcall;
begin
  Result := FUnlockRequest(Self);
end;

procedure Hook;
begin
  { IInternetProtocol } { starts with 7 }
  @FRead := InterceptCreate(FInternetProtocol, 'Read', @TInternetProtocol.Read);
  @FSeek := InterceptCreate(FInternetProtocol, 'Seek', @TInternetProtocol.Seek);
  @FLockRequest := InterceptCreate(FInternetProtocol, 'LockRequest', @TInternetProtocol.LockRequest);
  @FUnlockRequest := InterceptCreate(FInternetProtocol, 'UnlockRequest', @TInternetProtocol.UnlockRequest);
end;

procedure UnHook;
begin
//
end;

initialization
  CoCreateInstance(CLSID_HttpProtocol, nil, CLSCTX_INPROC_SERVER, IID_IInternetProtocol, FInternetProtocol);
  Hook;

end.

I look through the wiki and couldn't find a way to update hook in fast way. Can 
you make such a method?

This is a possibly-quite-complex feature request, but would be very useful.

The problem is this: multiple bits of code, written by several unrelated 
people, want to hook the same method.  (For example, CnPack hooks a method in 
the IDE, and other IDE plugins also want to hook the same method in the IDE.)

Uninstalling a hook overwrites the other hooks, so this relies on everyone very 
carefully installing a hook once, and uninstalling once only when the program 
exits (eg their DLL is unloaded) and hoping that other affected hooks aren't 
needed after that point. If anyone uninstalls (removes) a hook during normal 
program execution, it removes all hooks installed by other people too.

So - is it possible to create a list of hooks, and have DDetour's create and 
remove methods add to a list, each one of which is called by DDetours?  That 
way many hooks can co-exist.

I would suggest:
 - for each item (hook) in the list, being able to add a "before calling the trampoline" event, which can cancel calling the original
 - then call the original if it was not canceled
 - then for each item (hook) in the list, add a "after calling the trampoline" event, which is given the trampoline's result if it was a function

I know this would be complicated to implement, and not used very often.  But it 
is a cool idea, and in the cases where it is used, it would be very useful.

Hello!

Can you make a simple demo how to patch RTL functions? Such as Move or 
functions related to string operations etc.

This code assumes which the PShort type is defined in versions greater than 
Delphi 2009.

{{{

{$IF CompilerVersion <20}

type
  PUInt64 = ^UInt64;
  PShort = ^SHORT;
{$IFEND}

}}}


but is not, as workaround the type must be defined always, or just use the 
PSmallInt , because the SHORT type is an alias for  SmallInt.

Something like this:

var
  TrampolineSetTextBuf: procedure(const Self; Buffer: PChar) = nil;

TMyClass = class
  mprocedure SetTextBufHooked(const Self; Buffer: PChar);
end;

procedure TMyClass.SetTextBufHooked(const Self; Buffer: PChar);
var
  S: String;
begin
  S := 'Hooked _' + String(Buffer);
  TrampolineSetTextBuf(Self, PChar(S)); // Call the original function .
end;


@TrampolineSetTextBuf := InterceptCreate(@TControl.SetTextBuf, @TMyClass.SetTextBufHooked);

Hello!

Can you show how to hook WinINet in Delphi? I would like to monitor TWebbrowser 
control requests. 

What is the function that you are trying to use?
 - InterceptRemove, to remove a hook

What is the expected output? What do you see instead?
 - Expected: InterceptRemove returns True
 - Observed: InterceptRemove returns False

Please provide any additional information below.
The bug is in the call to VirtualFree.  It is called passing the size of the 
trampoline (eg, 42 bytes.)  However, according to MSDN's VirtualFree 
documentation:

"dwSize ... If the dwFreeType parameter is MEM_RELEASE, this parameter must be 
0 (zero)."

I can verify that if I change the DDetours code to pass a size of 0, instead of 
the TrampolineSize variable, VirtualFree succeeds.

Please note this issue was found by vitalyg2 of CnPack, not by me - see 
https://github.com/cnpack/cnwizards/pull/3 (a pull request from me to integrate 
DDetours into CnPack - halfway down you can see discussion about this method 
failing.)  However I have tested and can verify the problem and found the 
solution.

library Hook64;

uses
  System.SysUtils,
  System.Classes,
  Winapi.Windows,
  DDetours;

type
  HINST = NativeUInt;
  HMENU = type UINT_PTR;

var
_CreateWindowExW: function(
  dwExStyle: DWORD;
  lpClassName: LPCWSTR;
  lpWindowName: LPCWSTR;
  dwStyle: DWORD;
  x: Integer;
  y: Integer;
  nWidth: Integer;
  nHeight: Integer;
  hWndParent: HWND;
  hMenu: HMENU;
  hInstance: HINST;
  lpParam: LPVOID
): HWND; WINAPI = nil;


function __CreateWindowExW(
  dwExStyle: DWORD;
  lpClassName: LPCWSTR;
  lpWindowName: LPCWSTR;
  dwStyle: DWORD;
  x: Integer;
  y: Integer;
  nWidth: Integer;
  nHeight: Integer;
  hWndParent: HWND;
  hMenu: HMENU;
  hInstance: HINST;
  lpParam: LPVOID
): HWND; WINAPI;

begin
  if (lpClassName = 'Worker Window') then
  WriteLn('Intercepted!');

  Result := _CreateWindowExW(dwExStyle, lpClassName, lpWindowName, dwStyle, x, y, nWidth, nHeight, hWndParent, hMenu, hInstance, lpParam);
end;

begin
  AllocConsole;
  @_CreateWindowExW := InterceptCreate(@CreateWindowExW, @__CreateWindowExW);
end.

Hello!

I see this example in the demo..

procedure TMain.BtnEnableHookClick(Sender: TObject);
begin
  if not Assigned(Trampoline_FileOpenDialog_Show) then
    @Trampoline_FileOpenDialog_Show := InterceptCreate(FileOpenDialog, 3, @FileOpenDialog_Show_Hook); // Index???
  Trampoline_FileOpenDialog_SetTitle := InterceptCreate(FileOpenDialog, 17, @FileOpenDialog_SetTitle_Hook); // Index???
end;

But how do you get an index of the procedure/function of interface? Is there a 
way to calculate this? 

Thanks.

var
  TrampolineSetTextBuf: procedure(const Self) = nil;

procedure ClickWithOverride(const Self);
var
  Control: TControl;
begin
  Control := TControl(Self);
  X.Add('The name of the button is: ' + Control.Name);
  TrampolineSetTextBuf(Self);
end;

What is the function that you are trying to hook ?

type
  TUnhookSynchronizeWakeupProc = procedure;

var
 TrampoUnhookSynchronizeWakeup : TUnhookSynchronizeWakeupProc = nil;

procedure MyUnhookSynchronizeWakeup;
begin
 TrampoUnhookSynchronizeWakeup; <--- this line raise AV
end;

initialization

@TrampoUnhookSynchronizeWakeup := 
InterceptCreate(@Forms.TApplication.UnhookSynchronizeWakeup, 
@MyUnhookSynchronizeWakeup);


What is the expected output? What do you see instead?

I get AV.


What version of the product are you using? On what operating system? Which
architecture x86 or x64 ?

Delphi XE7, Windows 7 x64

What is the function that you are trying to hook ?
CloseHandle

What is the expected output? What do you see instead?
At function ResumeSuspendedThreads CloseHandle trumpoline function is not yet 
returned, so exception is caused


What version of the product are you using? On what operating system? Which
architecture x86 or x64 ?
Both

If the function hooked is not an windows API function , please include this
function .

Here is the fix by adding the following overloaded function:
procedure InterceptCreate(const TargetProc, InterceptProc: Pointer; var 
MyPointer : Pointer; Options: Byte = v1compatibility);
var
  Intercept: TIntercept;
begin
  Intercept := TIntercept.Create(Options);
  try
    MyPointer := Intercept.InstallHook(TargetProc, InterceptProc, Options);
  finally
    Intercept.Free;
  end;
end;




Please provide any additional information below.

Will it work on Linux?

Can you make an example how to hook local DirectX or OpenGL to get a screenshot 
of control hosted in VCL application that is hidden or rendered offscreen. 

Thanks!

Usings VCL.Styles.Hooks in a delphi application uses delphi-detours-library. 
The application fails then basic MS application verifier tests.
Problematic seems to be the uninstall of hooks. This is the error:

=======================================
VERIFIER STOP 0000060C: pid 0x1550: Incorrect Size parameter for VirtualFree 
(MEM_RELEASE) operation. 

    0000002A : Incorrect size used by the application.
    00000000 : Expected correct size (0).
    00000000 : Not used.
    00000000 : Not used.


=======================================

Debugger stops in DDetours in InterceptRemove:

    OrgProcAccess := SetMemPermission(P, Sb, PAGE_EXECUTE_READWRITE);
    CopyInstruction(Q^, P^, Sb);
    SetMemPermission(P, Sb, OrgProcAccess);
    Result := VirtualFree(PSave, TrampolineSize, MEM_RELEASE); // +++ problematic call here +++


Steps to reproduce:

Create empty Win32 Delphi application. Add VCL.Styles.Hooks tio uses clause, 
this integrates DDetours.
Add program in Application verifier and choose basic tests. start application 
in Delphi debugger and watch debug breakpoint while closing the application 
(break in InterceptRemove)

Best regards
Dirk

Library Hook;

{$IMAGEBASE $13140000}

{$ifdef win64}
  {$LIBSUFFIX '64'}
{$else}
  {$LIBSUFFIX '32'}
{$endif}

uses
  SysUtils,Vcl.Dialogs,
  Windows, Winapi.Messages,
  DDetours; //Using MahdiSafsafi Delphi Detours Library version 2 - https://github.com/MahdiSafsafi/delphi-detours-library

const
   HOOK_MEM_FILENAME = 'Hook.mem';
   MAPFILESIZE = 1000;

{$R *.res}

type
  old_TerminateProcess = function (hProcess: THandle;uExitCode: UINT): BOOL; Stdcall;
  old_OpenProcess = function (dwDesiredAccess: DWORD; bInheritHandle: BOOL; dwProcessId: DWORD): THandle; stdcall;

var
 MemFile  :  THandle;
 Haken    :  HHOOK = 0;
 THooking :  Boolean = False;
 SetPriv  :  Boolean = False;
 StartPid :  PDWORD;
 fhProcess:  THandle;
 NextHook1:  old_TerminateProcess = nil;
 NextHook2:  old_OpenProcess = nil;

function NewOpenProcess(dwDesiredAccess: DWORD; bInheritHandle: BOOL; dwProcessId: DWORD): THandle; stdcall;
begin
 if startPid^ = dwProcessId then
  begin
   Result := NextHook2 (dwDesiredAccess, bInheritHandle, dwProcessId);
   fhProcess:=Result;
   exit;
  end;
   Result := NextHook2(dwDesiredAccess, bInheritHandle, dwProcessId);
end;

 function NewTerminateProcess(hProcess: THandle;uExitCode: UINT): BOOL; Stdcall;
 begin
  if fhProcess = hProcess then
   begin
    ShowMessage('I am not allowed to close!');
    Result:=True;
    exit;
   end;
   Result:=NextHook1(hProcess,uExitCode);
 end;

procedure MemShared();
begin
   MemFile:=OpenFileMapping(FILE_MAP_ALL_ACCESS,False, HOOK_MEM_FILENAME);
   if (MemFile = 0) then begin
     MemFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, MAPFILESIZE, HOOK_MEM_FILENAME);
   end;
   if (MemFile <> 0) then
    begin
      StartPid := MapViewOfFile(MemFile,FILE_MAP_ALL_ACCESS,0,0,0);
      Fillchar(StartPid, 0, MAPFILESIZE);
    end;
end;

procedure UnMemShared();
begin
 if (StartPid <> NIL) then
  begin
   UnMapViewOfFile(StartPid);
   StartPid := NIL;
  end;
 if (MemFile > 0) then
  begin
   CloseHandle(MemFile);
   MemFile := 0;
  end;
end;

Function EnableDebugPriv(szPrivilege: LPCTSTR): BOOL;
Var
hToken          : THANDLE;
sedebugnameValue: Int64;
tkp             : TOKEN_PRIVILEGES;
ReturnLength    : LongWord;
begin
  Result:=SetPriv;
  If not OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) Then
     exit;
  If not LookupPrivilegeValue(nil,szPrivilege,sedebugnameValue) Then
    begin
      CloseHandle(hToken);
      exit;
    end;
  tkp.PrivilegeCount := 1;
  tkp.Privileges[0].Luid := sedebugnameValue;
  tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
  If not AdjustTokenPrivileges(hToken,False,tkp,Sizeof(tkp),nil,ReturnLength) Then
    begin
      Closehandle(hToken);
      exit;
    end
  else SetPriv:=True;
  Result := SetPriv;
end;

procedure InitHook;
begin
 if not Assigned(NextHook1) then
  begin
   BeginHooks();
   @NextHook2 := InterceptCreate('kernel32.dll','OpenProcess',@NewOpenProcess);
   @NextHook1 := InterceptCreate('kernel32.dll','TerminateProcess',@NewTerminateProcess);
   EndHooks();
  end;

 if (Assigned(NextHook1) and Assigned(NextHook2)) then
  begin
    THooking:=True;
  end;
end;

procedure UninitHook;
begin
 if THooking then
  begin
   BeginHooks();
   InterceptRemove(@NextHook1);
   InterceptRemove(@NextHook2);
   EndHooks();
   FreeAndNil(NextHook1);
   FreeAndNil(NextHook2);
   THooking:=False;
  end;
 UnMemShared;
end;

function HookProc(nCode: Integer; wParam: Cardinal; lParam: Integer):Integer; Stdcall;
begin
   Result := CallNextHookEx(Haken, nCode, wParam, lParam);
end;

procedure StartHook(pid: DWORD); Stdcall;
begin
   StartPid^ := pid;
  // Haken     := SetWindowsHookEx(WH_CALLWNDPROC, @HookProc, hInstance, 0);
end;

procedure EndHook; Stdcall;
begin
 if Haken <> 0 then
  begin
   UnhookWindowsHookEx(Haken);
  end;
end;

procedure DllEntry(dwResaon: DWORD);
begin
   case dwResaon of
     DLL_PROCESS_ATTACH: InitHook;
     DLL_PROCESS_DETACH: UninitHook;
     DLL_THREAD_ATTACH:;
     DLL_THREAD_DETACH:;
   end;
end;

exports
   StartHook, EndHook;

begin
 MemShared;
 EnableDebugPriv('SeDebugPrivilege');
 DllProc:= @DllEntry;
 DllEntry(DLL_PROCESS_ATTACH);
end.

> App to test DLL Hook

DelphiDetours is a great library!  I've been using it very happily.

One thing I thought of is that you could use it in an object-oriented way: to 
install a hook/detour object, and remove the hook by freeing the object.  
(Currently it's used only procedurally.)  So, for example:

TMyProc = function(A : Integer): Boolean; // Use this to type-safely declare 
the prototype of the method you're detouring
...
FDetour : TDetour<TMyProc>; // Using generics, now it's a detour only for this 
type of method
...
FDetour := TDetour<TMyProc>.Create(@Original, @Replacement); // Installs the 
detour
FDetour.Free; // Uninstalls the detour

Meanwhile, while it's installed, you can call the trampolined function like so:
FDetour.Trampoline(5); // Calls the trampoline / original

It's just a neat OO style of using the detour, and I think suits Delphi quite 
well.

In fact I wrote a small wrapper unit that does exactly the above, and so if you 
like it you are very welcome to add it to DDetours! I've attached it here.