Access Violation in DLL Module when Hook.

[jreo]

Hello MahdiSafsafi,

I'm tried to use DDetours to creating DLL Hook, but I received a lot of access violation when stop the hook or when try to kill the process. In additional, causes craches in taskmanager and Windows Explorer as well. Could you please have any ideia about its happened? What's wrong?

My code builds without problems: Zero Hints, Zero Warnings and Zero Errors. I'm using Delphi 10.2 (Tokyo release).

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

unit HTeste;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
TForm2 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure Button3Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

procedure StartHook(pid: DWORD); stdcall; external 'Hook32.dll';
procedure EndHook; stdcall; external 'Hook32.dll';

var
Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
begin
StartHook(GetCurrentProcessId);
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
EndHook;
end;

procedure TForm2.Button3Click(Sender: TObject);
begin
close;
end;

end.