xtool/contrib/Delphi_MemoryModule/MemoryModuleHook.pas

// Unit that hooks LoadLibrary, GetProcAddress, FreeLibrary for MemoryModule
// to allow transparent DLL loading.

unit MemoryModuleHook;

interface

uses
  Windows,
  MemoryModule, FuncHook;

type
  // 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;

implementation

var
  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;
begin
  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;

// Try to get library address and load it, run WinAPI routine otherwise.
function LoadLibraryHook(lpLibFileName: PWideChar): HMODULE; stdcall;
var
  LibPtr: Pointer;
begin
  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;

// If hModule was loaded via MM, run MM's routine. Otherwise, run WinAPI one.
function GetProcAddressHook(hModule: HMODULE; lpProcName: LPCSTR): FARPROC; stdcall;
begin
  if IndexOfLoadedModule(hModule) <> -1 then
    Result := FARPROC(MemoryGetProcAddress(TMemoryModule(hModule), lpProcName))
  else
    Result := GetProcAddress_Old(hModule, lpProcName);
end;

// If hLibModule was loaded via MM, run MM's routine. Otherwise, run WinAPI one.
function FreeLibraryHook(hLibModule: HMODULE): BOOL; stdcall;
var idx: Integer;
begin
  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;
begin
  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;
begin
  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;

initialization
  InitializeCriticalSection(CS);
  HI_LL.Init(@LoadLibrary, @LoadLibraryHook);
  HI_GPA.Init(@GetProcAddress, @GetProcAddressHook);
  HI_FL.Init(@FreeLibrary, @FreeLibraryHook);

finalization
  UninstallHook;
  DeleteCriticalSection(CS);

end.