uian2000 / delphi-detours-library Goto Github PK

Will it work on Linux?

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.

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

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

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.

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.

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.

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.

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)

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.

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. :)

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!

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

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.

Hello!

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

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

Hello!

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

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 ?

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.

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.

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)
}