unit MemoryModuleHook;

Windows,

MemoryModule, FuncHook;

// Callback function that is called from LoadLibraryHook to determine

// an address of library data.

// lpLibFileName: name of library to load

// Returns:

// Pointer to library data; nil to bypass MemoryModule and use WinAPI

TGetLibPtrProc = function (lpLibFileName: PWideChar): Pointer;

function InstallHook(AGetLibPtrCallback: TGetLibPtrProc): Boolean;

function UninstallHook: Boolean;

HookInstalled: Boolean = False;

GetLibPtrCallback: TGetLibPtrProc;

LoadedModules: array of HMODULE;

CS: RTL_CRITICAL_SECTION;

LoadLibrary_Old: function (lpLibFileName: PWideChar): HMODULE; stdcall;

GetProcAddress_Old: function (hModule: HMODULE; lpProcName: LPCSTR): FARPROC; stdcall;

FreeLibrary_Old: function (hLibModule: HMODULE): BOOL; stdcall;

HI_LL, HI_GPA, HI_FL: THookInfo;

function IndexOfLoadedModule(hModule: HMODULE): Integer;

var i: Integer;

EnterCriticalSection(CS);

try

for i := Low(LoadedModules) to High(LoadedModules) do

if LoadedModules[i] = hModule then

Exit(i);

Result := -1;

finally

LeaveCriticalSection(CS);

end;

end;

function LoadLibraryHook(lpLibFileName: PWideChar): HMODULE; stdcall;

LibPtr: Pointer;

Result := 0;

LibPtr := GetLibPtrCallback(lpLibFileName);

if LibPtr = nil then

begin

LoadLibrary_Old(lpLibFileName);

Exit;

end;

Result := HMODULE(MemoryLoadLibary(LibPtr));

if Result <> 0 then

try

EnterCriticalSection(CS);

SetLength(LoadedModules, Length(LoadedModules) + 1);

LoadedModules[Length(LoadedModules) - 1] := Result;

finally

LeaveCriticalSection(CS);

end;

end;

function GetProcAddressHook(hModule: HMODULE; lpProcName: LPCSTR): FARPROC; stdcall;

if IndexOfLoadedModule(hModule) <> -1 then

Result := FARPROC(MemoryGetProcAddress(TMemoryModule(hModule), lpProcName))

else

Result := GetProcAddress_Old(hModule, lpProcName);

end;

function FreeLibraryHook(hLibModule: HMODULE): BOOL; stdcall;

var idx: Integer;

idx := IndexOfLoadedModule(hLibModule);

if idx <> -1 then

begin

MemoryFreeLibrary(TMemoryModule(hLibModule));

Result := BOOL(True);

// Remove from the list

try

EnterCriticalSection(CS);

LoadedModules[idx] := 0;

if idx < Length(LoadedModules) - 1 then

Move(LoadedModules[idx + 1], LoadedModules[idx], (Length(LoadedModules) - idx + 1)*SizeOf(HMODULE));

SetLength(LoadedModules, Length(LoadedModules) - 1);

finally

LeaveCriticalSection(CS);

end;

end

else

Result := FreeLibrary_Old(hLibModule);

end;

function InstallHook(AGetLibPtrCallback: TGetLibPtrProc): Boolean;

Result := False;

if not Assigned(AGetLibPtrCallback) then Exit;

EnterCriticalSection(CS);

try

if HookInstalled then Exit;

if not HookProcedure(False, HI_LL) or

not HookProcedure(False, HI_GPA) or

not HookProcedure(False, HI_FL) then Exit;

LoadLibrary_Old := HI_LL.OrigProc;

GetProcAddress_Old := HI_GPA.OrigProc;

FreeLibrary_Old := HI_FL.OrigProc;

HookInstalled := True;

GetLibPtrCallback := AGetLibPtrCallback;

Result := True;

finally

if not Result then

UninstallHook;

LeaveCriticalSection(CS);

end;

end;

function UninstallHook: Boolean;

Result := False;

EnterCriticalSection(CS);

try

if not HookInstalled then Exit;

while Length(LoadedModules) > 0 do

FreeLibrary(LoadedModules[0]);

Result :=

UnhookProcedure(HI_LL) and

UnhookProcedure(HI_GPA) and

UnhookProcedure(HI_FL);

GetLibPtrCallback := nil;

HookInstalled := False;

finally

LeaveCriticalSection(CS);

end;

end;

InitializeCriticalSection(CS);

HI_LL.Init(@LoadLibrary, @LoadLibraryHook);

HI_GPA.Init(@GetProcAddress, @GetProcAddressHook);

HI_FL.Init(@FreeLibrary, @FreeLibraryHook);

UninstallHook;

DeleteCriticalSection(CS);

end.