├── Demo
    ├── Project2.dpr
    └── Project2.dproj
├── FuncHook.pas
├── MemoryModule.pas
├── MemoryModuleHook.pas
└── README.md


/Demo/Project2.dpr:
--------------------------------------------------------------------------------
  1 | program Project2;
  2 | 
  3 | {$APPTYPE CONSOLE}
  4 | 
  5 | uses
  6 |   SysUtils, Classes, Windows,
  7 |   MemoryModule in '..\MemoryModule.pas',
  8 |   FuncHook in '..\FuncHook.pas',
  9 |   MemoryModuleHook in '..\MemoryModuleHook.pas';
 10 | 
 11 | const
 12 |   SUsage =
 13 |     'Test project for loading DLL from memory'+sLineBreak+
 14 |     'Params:'+sLineBreak+
 15 |     '  [DLL name] (required) - full path to DLL to load'+sLineBreak+
 16 |     '  [Function name] (optional) - function to execute (no parameters, result is DWORD/Handle/Pointer)'+sLineBreak+
 17 |     'Good testing sample is <%WinDir%\System32\KernelBase.dll> and <GetCurrentThread>';
 18 | type
 19 |   TNativeUIntFunc = function: NativeUInt;
 20 | var
 21 |   ms: TMemoryStream;
 22 |   lib : TMemoryModule;
 23 |   func: TNativeUIntFunc;
 24 |   res: array[0..2] of NativeUInt;
 25 |   i: Integer;
 26 | 
 27 | function GetLibPtrProc(lpLibFileName: PWideChar): Pointer;
 28 | begin
 29 |   // Catch only those paths that start with *, let others go
 30 |   if lpLibFileName^ = '*' then
 31 |     Result := ms.Memory;
 32 | end;
 33 | 
 34 | function CheckLoadLib(lib: Pointer): Boolean;
 35 | begin
 36 |   if lib = nil then
 37 |   begin
 38 |     Writeln('Error loading lib '+ParamStr(1)+': '+SysErrorMessage(GetLastError));
 39 |     Exit(False);
 40 |   end;
 41 |   Writeln(ParamStr(1)+' loaded');
 42 |   Exit(True);
 43 | end;
 44 | 
 45 | function CheckLoadAndExecFunc(func: TNativeUIntFunc; out res: NativeUInt): Boolean;
 46 | begin
 47 |   if @func = nil then
 48 |   begin
 49 |     Writeln('Error loading func '+ParamStr(2)+': '+SysErrorMessage(GetLastError));
 50 |     Exit(False);
 51 |   end;
 52 |   res := func;
 53 |   Writeln(Format('Function call result: %u (%x)', [res, res]));
 54 |   Exit(True);
 55 | end;
 56 | 
 57 | begin
 58 |   try
 59 |     if ParamCount = 0 then
 60 |     begin
 61 |       Writeln(SUsage);
 62 |       Exit;
 63 |     end;
 64 | 
 65 |     Writeln('===== Test #0, usual load =====');
 66 | 
 67 |     try
 68 |       lib := Pointer(LoadLibrary(PChar(ParamStr(1))));
 69 |       if not CheckLoadLib(lib) then Exit;
 70 | 
 71 |       if ParamStr(2) <> '' then
 72 |       begin
 73 |         func := TNativeUIntFunc(GetProcAddress(HMODULE(lib), PAnsiChar(AnsiString(ParamStr(2)))));
 74 |         if not CheckLoadAndExecFunc(func, res[0]) then Exit;
 75 |       end;
 76 |     finally
 77 |       FreeLibrary(HMODULE(lib));
 78 |     end;
 79 | 
 80 |     Writeln('===== Test #1, load from memory =====');
 81 | 
 82 |     try
 83 |       ms := TMemoryStream.Create;
 84 |       ms.LoadFromFile(ParamStr(1));
 85 |       ms.Position := 0;
 86 |       lib := MemoryLoadLibary(ms.Memory);
 87 |       ms.Free;
 88 |       if not CheckLoadLib(lib) then Exit;
 89 | 
 90 |       if ParamStr(2) <> '' then
 91 |       begin
 92 |         func := TNativeUIntFunc(MemoryGetProcAddress(lib, PAnsiChar(AnsiString(ParamStr(2)))));
 93 |         if not CheckLoadAndExecFunc(func, res[1]) then Exit;
 94 |       end;
 95 |     finally
 96 |       MemoryFreeLibrary(lib);
 97 |     end;
 98 | 
 99 |     Writeln('===== Test #2, load with hooking =====');
100 | 
101 |     if not InstallHook(@GetLibPtrProc) then
102 |     begin
103 |       Writeln('Error installing hook');
104 |       Exit;
105 |     end;
106 | 
107 |     try
108 |       ms := TMemoryStream.Create;
109 |       ms.LoadFromFile(ParamStr(1));
110 |       ms.Position := 0;
111 |       // Custom lib names example:
112 |       // Adding * char to the lib path for callback to distinguish whether it should act
113 |       lib := Pointer(LoadLibrary(PChar('*'+ParamStr(1))));
114 |       ms.Free;
115 |       if not CheckLoadLib(lib) then Exit;
116 | 
117 |       if ParamStr(2) <> '' then
118 |       begin
119 |         func := TNativeUIntFunc(GetProcAddress(HMODULE(lib), PAnsiChar(AnsiString(ParamStr(2)))));
120 |         if not CheckLoadAndExecFunc(func, res[2]) then Exit;
121 |       end;
122 |     finally
123 |       FreeLibrary(HMODULE(lib));
124 |       UninstallHook;
125 |     end;
126 | 
127 |     if ParamStr(2) <> '' then
128 |     begin
129 |       Writeln('===== Test #3, comparing results =====');
130 |       for i := Low(res) to High(res) do
131 |         if res[i] <> res[0] then
132 |         begin
133 |           Writeln('Failure! Results vary');
134 |           Exit;
135 |         end;
136 |       Writeln('Success! Results identical')
137 |     end;
138 | 
139 |   except on E: Exception do
140 |     Writeln('Error: '+E.Message);
141 |   end;
142 |   Readln;
143 | end.
144 | 


--------------------------------------------------------------------------------
/Demo/Project2.dproj:
--------------------------------------------------------------------------------
  1 | 	<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  2 | 		<PropertyGroup>
  3 | 			<ProjectGuid>{6C9E4C93-535D-4563-AD0C-384ED9405089}</ProjectGuid>
  4 | 			<ProjectVersion>13.4</ProjectVersion>
  5 | 			<FrameworkType>None</FrameworkType>
  6 | 			<MainSource>Project2.dpr</MainSource>
  7 | 			<Base>True</Base>
  8 | 			<Config Condition="'$(Config)'==''">Debug</Config>
  9 | 			<Platform Condition="'$(Platform)'==''">Win64</Platform>
 10 | 			<TargetedPlatforms>3</TargetedPlatforms>
 11 | 			<AppType>Console</AppType>
 12 | 		</PropertyGroup>
 13 | 		<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
 14 | 			<Base>true</Base>
 15 | 		</PropertyGroup>
 16 | 		<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
 17 | 			<Base_Win64>true</Base_Win64>
 18 | 			<CfgParent>Base</CfgParent>
 19 | 			<Base>true</Base>
 20 | 		</PropertyGroup>
 21 | 		<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
 22 | 			<Base_Win32>true</Base_Win32>
 23 | 			<CfgParent>Base</CfgParent>
 24 | 			<Base>true</Base>
 25 | 		</PropertyGroup>
 26 | 		<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
 27 | 			<Cfg_1>true</Cfg_1>
 28 | 			<CfgParent>Base</CfgParent>
 29 | 			<Base>true</Base>
 30 | 		</PropertyGroup>
 31 | 		<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
 32 | 			<Cfg_1_Win32>true</Cfg_1_Win32>
 33 | 			<CfgParent>Cfg_1</CfgParent>
 34 | 			<Cfg_1>true</Cfg_1>
 35 | 			<Base>true</Base>
 36 | 		</PropertyGroup>
 37 | 		<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
 38 | 			<Cfg_2>true</Cfg_2>
 39 | 			<CfgParent>Base</CfgParent>
 40 | 			<Base>true</Base>
 41 | 		</PropertyGroup>
 42 | 		<PropertyGroup Condition="'$(Base)'!=''">
 43 | 			<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
 44 | 			<DCC_CodePage>65001</DCC_CodePage>
 45 | 			<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
 46 | 			<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
 47 | 			<BRCC_CompilerToUse>rc</BRCC_CompilerToUse>
 48 | 			<DCC_DebugInformation>false</DCC_DebugInformation>
 49 | 			<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
 50 | 			<BRCC_EnableMultiByte>true</BRCC_EnableMultiByte>
 51 | 			<VerInfo_Locale>1049</VerInfo_Locale>
 52 | 			<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
 53 | 			<DCC_UsePackage>soaprtl;bindcompfmx;fmx;dsnap;rtl;dbrtl;fmxase;bindcomp;fmxobj;xmlrtl;ibxpress;DbxCommonDriver;fmxdae;dbxcds;bindengine;dbexpress;$(DCC_UsePackage)</DCC_UsePackage>
 54 | 			<Manifest_File>None</Manifest_File>
 55 | 		</PropertyGroup>
 56 | 		<PropertyGroup Condition="'$(Base_Win64)'!=''">
 57 | 			<VerInfo_Locale>1033</VerInfo_Locale>
 58 | 			<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)</DCC_Namespace>
 59 | 			<DCC_UsePackage>ZCore;vcltouch;ZComponent;vclribbon;VclSmp;vcl;OverbyteIcsDXe2Run;TeeDB;vclib;ZDbc;Tee;ZPlain;ZParseSql;vclx;vclimg;VirtualTreesR;vclactnband;TeeUI;adortl;vcldb;$(DCC_UsePackage)</DCC_UsePackage>
 60 | 		</PropertyGroup>
 61 | 		<PropertyGroup Condition="'$(Base_Win32)'!=''">
 62 | 			<Debugger_RunParams>&quot;E:\tmp\New Folder2\Targets\TLS_Example_1.exe&quot;</Debugger_RunParams>
 63 | 			<VerInfo_Locale>1033</VerInfo_Locale>
 64 | 			<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
 65 | 			<DCC_UsePackage>sdlbasepack_rt_101X2;ZCore;vcltouch;ZComponent;vclribbon;VclSmp;vcl;frx16;OverbyteIcsDXe2Run;TeeDB;CodeSiteExpressPkg;WizFavoritesP;vclib;ZDbc;Tee;ZPlain;sdlgeopack_101X2;ZParseSql;vclx;sdlmathpack_rt_101X2;WizMenuActionsP;vclimg;fmi;sdlgeopack_rt_101X2;bdertl;VirtualTreesR;vclactnband;TeeUI;adortl;vcldb;WizTabToolsP;$(DCC_UsePackage)</DCC_UsePackage>
 66 | 			<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
 67 | 		</PropertyGroup>
 68 | 		<PropertyGroup Condition="'$(Cfg_1)'!=''">
 69 | 			<DCC_CodePage>65001</DCC_CodePage>
 70 | 			<DCC_IntegerOverflowCheck>true</DCC_IntegerOverflowCheck>
 71 | 			<DCC_LocalDebugSymbols>true</DCC_LocalDebugSymbols>
 72 | 			<DCC_MapFile>0</DCC_MapFile>
 73 | 			<DCC_SymbolReferenceInfo>2</DCC_SymbolReferenceInfo>
 74 | 			<DCC_DebugInformation>true</DCC_DebugInformation>
 75 | 			<DCC_RangeChecking>true</DCC_RangeChecking>
 76 | 			<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
 77 | 			<DCC_Optimize>false</DCC_Optimize>
 78 | 			<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
 79 | 			<DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
 80 | 		</PropertyGroup>
 81 | 		<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
 82 | 			<DCC_DebugDCUs>true</DCC_DebugDCUs>
 83 | 			<Debugger_RunParams>C:\Windows\SysWOW64\KernelBase.dll GetCurrentThread</Debugger_RunParams>
 84 | 			<VerInfo_Locale>1033</VerInfo_Locale>
 85 | 			<DCC_RemoteDebug>false</DCC_RemoteDebug>
 86 | 		</PropertyGroup>
 87 | 		<PropertyGroup Condition="'$(Cfg_2)'!=''">
 88 | 			<DCC_CodePage>65001</DCC_CodePage>
 89 | 			<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
 90 | 			<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
 91 | 			<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
 92 | 			<DCC_DebugInformation>false</DCC_DebugInformation>
 93 | 		</PropertyGroup>
 94 | 		<ItemGroup>
 95 | 			<DelphiCompile Include="$(MainSource)">
 96 | 				<MainSource>MainSource</MainSource>
 97 | 			</DelphiCompile>
 98 | 			<DCCReference Include="..\MemoryModule.pas"/>
 99 | 			<DCCReference Include="..\FuncHook.pas"/>
100 | 			<DCCReference Include="..\MemoryModuleHook.pas"/>
101 | 			<BuildConfiguration Include="Release">
102 | 				<Key>Cfg_2</Key>
103 | 				<CfgParent>Base</CfgParent>
104 | 			</BuildConfiguration>
105 | 			<BuildConfiguration Include="Base">
106 | 				<Key>Base</Key>
107 | 			</BuildConfiguration>
108 | 			<BuildConfiguration Include="Debug">
109 | 				<Key>Cfg_1</Key>
110 | 				<CfgParent>Base</CfgParent>
111 | 			</BuildConfiguration>
112 | 		</ItemGroup>
113 | 		<ProjectExtensions>
114 | 			<Borland.Personality>Delphi.Personality.12</Borland.Personality>
115 | 			<Borland.ProjectType/>
116 | 			<BorlandProject>
117 | 				<Delphi.Personality>
118 | 					<VersionInfo>
119 | 						<VersionInfo Name="IncludeVerInfo">False</VersionInfo>
120 | 						<VersionInfo Name="AutoIncBuild">False</VersionInfo>
121 | 						<VersionInfo Name="MajorVer">1</VersionInfo>
122 | 						<VersionInfo Name="MinorVer">0</VersionInfo>
123 | 						<VersionInfo Name="Release">0</VersionInfo>
124 | 						<VersionInfo Name="Build">0</VersionInfo>
125 | 						<VersionInfo Name="Debug">False</VersionInfo>
126 | 						<VersionInfo Name="PreRelease">False</VersionInfo>
127 | 						<VersionInfo Name="Special">False</VersionInfo>
128 | 						<VersionInfo Name="Private">False</VersionInfo>
129 | 						<VersionInfo Name="DLL">False</VersionInfo>
130 | 						<VersionInfo Name="Locale">1049</VersionInfo>
131 | 						<VersionInfo Name="CodePage">1251</VersionInfo>
132 | 					</VersionInfo>
133 | 					<VersionInfoKeys>
134 | 						<VersionInfoKeys Name="CompanyName"/>
135 | 						<VersionInfoKeys Name="FileDescription"/>
136 | 						<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
137 | 						<VersionInfoKeys Name="InternalName"/>
138 | 						<VersionInfoKeys Name="LegalCopyright"/>
139 | 						<VersionInfoKeys Name="LegalTrademarks"/>
140 | 						<VersionInfoKeys Name="OriginalFilename"/>
141 | 						<VersionInfoKeys Name="ProductName"/>
142 | 						<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
143 | 						<VersionInfoKeys Name="Comments"/>
144 | 					</VersionInfoKeys>
145 | 					<Excluded_Packages>
146 | 						<Excluded_Packages Name="$(BDSBIN)\dclmid160.bpl">Embarcadero MyBase DataAccess Components</Excluded_Packages>
147 | 						<Excluded_Packages Name="$(BDS)\UserDir\Bpl\test.bpl">(untitled)</Excluded_Packages>
148 | 					</Excluded_Packages>
149 | 					<Source>
150 | 						<Source Name="MainSource">Project2.dpr</Source>
151 | 					</Source>
152 | 				</Delphi.Personality>
153 | 				<Platforms>
154 | 					<Platform value="Win64">True</Platform>
155 | 					<Platform value="Win32">True</Platform>
156 | 				</Platforms>
157 | 			</BorlandProject>
158 | 			<ProjectFileVersion>12</ProjectFileVersion>
159 | 		</ProjectExtensions>
160 | 		<Import Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')" Project="$(BDS)\Bin\CodeGear.Delphi.Targets"/>
161 | 		<Import Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')" Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj"/>
162 | 	</Project>
163 | 


--------------------------------------------------------------------------------
/FuncHook.pas:
--------------------------------------------------------------------------------
  1 | (*==============================================================================
  2 |                       ====== Function hooking ======
  3 |  Functions exported from DLL contain single instruction "JMP [fn_addr]" that
  4 |  points to actual code. So there could be 2 ways of hooking:
  5 |    1) Patch the JMP not touching the code
  6 |     + Original proc could be called via HookInfo.OrigProc
  7 |     - (or feature) Only the one imported function is hooked. If there's another
  8 |       export definition or dynamic load, the hook won't change them.
  9 |    2) Patch the very code as usual
 10 |     + All function imports are impacted
 11 |     - No way to use original proc
 12 |  2nd way is called "strict address mode" here and is controlled by HookProcedure()'s
 13 |  StrictMode parameter.
 14 | 
 15 |  Compatibility: RAD Studio 2009+ (uses advanced records and Exit(param)), x32/x64.
 16 | ==============================================================================*)
 17 | 
 18 | unit FuncHook;
 19 | 
 20 | interface
 21 | 
 22 | uses
 23 |   Windows;
 24 | 
 25 | type
 26 |   TInjectInstr = packed record
 27 |     Opcode: UInt8;
 28 |     Offset: Int32;
 29 |   end;
 30 |   PInjectInstr = ^TInjectInstr;
 31 | 
 32 |   THookInfo = record
 33 |   private
 34 |     OrigCode: TInjectInstr;   // Original instruction
 35 |     HookCode: TInjectInstr;   // Hook instruction (saved only for check on uninstall)
 36 |     ProcAddr: Pointer;        // Address of a routine to hook
 37 |     TrampAddr: Pointer;       // Address of a trampoline (original routine; DLL exports only)
 38 |     HookAddr: Pointer;        // Address of a hook routine
 39 |     StrictMode: Boolean;      // Hook was installed in strict address mode
 40 |   public
 41 |     procedure Init(ProcAddr, HookAddr: Pointer);
 42 |     property OrigProc: Pointer read TrampAddr;
 43 |   end;
 44 | 
 45 | function HookProcedure(StrictMode: Boolean; var HookInfo: THookInfo): Boolean;
 46 | function UnhookProcedure(var HookInfo: THookInfo): Boolean;
 47 | 
 48 | implementation
 49 | 
 50 | const
 51 |   INDIRECT_JMP = $25FF;
 52 |   RELATIVE_JMP = $E9;
 53 |   EmptyInstr: TInjectInstr = (Opcode: 0; Offset: Int32($DEADBEEF));
 54 | 
 55 | function IsEqual(const Instr1, Instr2: TInjectInstr): Boolean;
 56 | begin
 57 |   Result := (Instr1.Opcode = Instr2.Opcode) and (Instr1.Offset = Instr2.Offset);
 58 | end;
 59 | 
 60 | { THookInfo }
 61 | 
 62 | procedure THookInfo.Init(ProcAddr, HookAddr: Pointer);
 63 | begin
 64 |   ZeroMemory(@Self, SizeOf(Self));
 65 |   OrigCode := EmptyInstr;
 66 |   Self.ProcAddr := ProcAddr;
 67 |   Self.HookAddr := HookAddr;
 68 | end;
 69 | 
 70 | // Utility function to (un)install hook by patching function code.
 71 | //   Install: (un)install the hook
 72 | //   HookInfo: all required data
 73 | // Returns: True = success, False = fail
 74 | function PatchCode(Install: Boolean; var HookInfo: THookInfo): Boolean;
 75 | 
 76 | // Get the real address of a function (for functions exported from DLL)
 77 | function GetStrictAddr: Pointer;
 78 | type
 79 |   TAbsIndirectJmp = packed record
 80 |     OpCode: UInt16;   // $FF25 (x32: Jmp, FF /4; x64: Jmp, Rel /4)
 81 |     Addr  : Int32;
 82 |   end;
 83 |   PAbsIndirectJmp = ^TAbsIndirectJmp;
 84 | var
 85 |   jmp: PAbsIndirectJmp;
 86 | begin
 87 |   Result := nil;
 88 |   jmp := PAbsIndirectJmp(HookInfo.ProcAddr);
 89 |   if jmp.OpCode = INDIRECT_JMP then
 90 |   {$IFDEF CPUX86}
 91 |     Result := PPointer(jmp.Addr)^;
 92 |   {$ENDIF}
 93 |   {$IFDEF CPUX64}
 94 |     Result := PPointer(PByte(HookInfo.ProcAddr) + jmp.Addr + SizeOf(TAbsIndirectJmp))^;
 95 |   {$ENDIF}
 96 | end;
 97 | 
 98 | var
 99 |   OldProtect: DWORD;
100 |   DestAddr: PInjectInstr;
101 | begin
102 |   // Check strict address mode
103 |   if HookInfo.StrictMode
104 |     then DestAddr := GetStrictAddr
105 |     else DestAddr := HookInfo.ProcAddr;
106 | 
107 |   Result := VirtualProtect(DestAddr, SizeOf(TInjectInstr), PAGE_EXECUTE_READWRITE, OldProtect);
108 |   if not Result then Exit;
109 | 
110 |   if Install then
111 |   begin
112 |     // For functions exported from DLL, the only instruction they contain is
113 |     // "JMP [fn_addr]" so we can save the address as a trampoline
114 |     if not HookInfo.StrictMode
115 |       then HookInfo.TrampAddr := GetStrictAddr
116 |       else HookInfo.TrampAddr := nil;
117 |     HookInfo.OrigCode := DestAddr^;
118 |     DestAddr^ := HookInfo.HookCode;
119 |   end
120 |   else
121 |   begin
122 |     // Check that patch wasn't overwritten
123 |     if IsEqual(HookInfo.HookCode, DestAddr^) then
124 |     begin
125 |       DestAddr^ := HookInfo.OrigCode;
126 |       // Clear OrigCode field thus indicating that hook is not installed
127 |       HookInfo.OrigCode := EmptyInstr;
128 |       HookInfo.StrictMode := False;
129 |     end
130 |     else
131 |       Result := False;
132 |   end;
133 | 
134 |   FlushInstructionCache(GetCurrentProcess, DestAddr, SizeOf(TInjectInstr));
135 |   VirtualProtect(DestAddr, SizeOf(TInjectInstr), OldProtect, OldProtect);
136 | end;
137 | 
138 | // Install the hook
139 | //   StrictMode: "strict address mode" flag
140 | //   HookInfo: all required data
141 | // Returns: True = success, False = fail
142 | function HookProcedure(StrictMode: Boolean; var HookInfo: THookInfo): Boolean;
143 | begin
144 |   // Required data is missing?
145 |   if (HookInfo.HookAddr = nil) or (HookInfo.ProcAddr = nil) or
146 |   // Hook is installed already?
147 |      not IsEqual(HookInfo.OrigCode, EmptyInstr) then
148 |     Exit(False);
149 |   HookInfo.HookCode.Opcode := RELATIVE_JMP;
150 |   HookInfo.HookCode.Offset := PByte(HookInfo.HookAddr) - PByte(HookInfo.ProcAddr) - SizeOf(TInjectInstr);
151 |   HookInfo.StrictMode := StrictMode;
152 |   Result := PatchCode(True, HookInfo);
153 | end;
154 | 
155 | // Uninstall the hook
156 | //   HookInfo: all required data
157 | // Returns: True = success, False = fail
158 | function UnhookProcedure(var HookInfo: THookInfo): Boolean;
159 | begin
160 |   // Required data is missing?
161 |   if (HookInfo.HookAddr = nil) or (HookInfo.ProcAddr = nil) or
162 |   // Hook is not installed yet?
163 |      IsEqual(HookInfo.OrigCode, EmptyInstr) then
164 |     Exit(False);
165 |   Result := PatchCode(False, HookInfo);
166 | end;
167 | 
168 | end.
169 | 


--------------------------------------------------------------------------------
/MemoryModule.pas:
--------------------------------------------------------------------------------
  1 | // To compile under FPC, Delphi mode must be used
  2 | // Also define CPUX64 for simplicity
  3 | {$IFDEF FPC}
  4 |   {$mode delphi}
  5 |   {$IFDEF CPU64}
  6 |     {$DEFINE CPUX64}
  7 |   {$ENDIF}
  8 | {$ENDIF}
  9 | 
 10 | unit MemoryModule;
 11 | 
 12 | { * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 13 |   * Memory DLL loading code
 14 |   * ------------------------
 15 |   *
 16 |   * Original C Code
 17 |   * Memory DLL loading code
 18 |   * Version 0.0.4
 19 |   *
 20 |   * Copyright (c) 2004-2015 by Joachim Bauch / mail@joachim-bauch.de
 21 |   * http://www.joachim-bauch.de
 22 |   *
 23 |   * The contents of this file are subject to the Mozilla Public License Version
 24 |   * 2.0 (the "License"); you may not use this file except in compliance with
 25 |   * the License. You may obtain a copy of the License at
 26 |   * http://www.mozilla.org/MPL/
 27 |   *
 28 |   * Software distributed under the License is distributed on an "AS IS" basis,
 29 |   * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 30 |   * for the specific language governing rights and limitations under the
 31 |   * License.
 32 |   *
 33 |   * The Original Code is MemoryModule.c
 34 |   *
 35 |   * The Initial Developer of the Original Code is Joachim Bauch.
 36 |   *
 37 |   * Portions created by Joachim Bauch are Copyright (C) 2004-2015
 38 |   * Joachim Bauch. All Rights Reserved.
 39 |   *
 40 |   * ================== MemoryModule "Conversion to Delphi" ==================
 41 |   *
 42 |   * Copyright (c) 2015 by Fr0sT / https://github.com/Fr0sT-Brutal
 43 |   *
 44 |   * Initially based on the code by:
 45 |   *   Copyright (c) 2005 - 2006 by Martin Offenwanger / coder@dsplayer.de / http://www.dsplayer.de
 46 |   *   Carlo Pasolini / cdpasop@hotmail.it / http://pasotech.altervista.org
 47 |   *
 48 |   * NOTE
 49 |   *   This code is Delphi translation of original C code taken from https://github.com/fancycode/MemoryModule
 50 |   *     (commit dc173ca from Mar 1, 2015).
 51 |   *   Resource loading and exe loading, custom functions, user data not implemented yet.
 52 |   *   Tested under RAD Studio XE2 and XE6 32/64-bit, Lazarus 32-bit
 53 |   * }
 54 | 
 55 | interface
 56 | 
 57 | uses
 58 |   Windows;
 59 | 
 60 | type
 61 |   TMemoryModule = Pointer;
 62 | 
 63 |   { ++++++++++++++++++++++++++++++++++++++++++++++++++
 64 |     ***  Memory DLL loading functions Declaration  ***
 65 |     -------------------------------------------------- }
 66 | 
 67 | // return value is nil if function fails
 68 | function MemoryLoadLibary(Data: Pointer): TMemoryModule; stdcall;
 69 | // return value is nil if function fails
 70 | function MemoryGetProcAddress(Module: TMemoryModule; const Name: PAnsiChar): Pointer; stdcall;
 71 | // free module
 72 | procedure MemoryFreeLibrary(Module: TMemoryModule); stdcall;
 73 | 
 74 | implementation
 75 | 
 76 |   { ++++++++++++++++++++++++++++++++++++++++
 77 |     ***  Missing Windows API Definitions ***
 78 |     ---------------------------------------- }
 79 |   {$IF NOT DECLARED(IMAGE_BASE_RELOCATION)}
 80 |   type
 81 |   {$ALIGN 4}
 82 |   IMAGE_BASE_RELOCATION = record
 83 |     VirtualAddress: DWORD;
 84 |     SizeOfBlock: DWORD;
 85 |   end;
 86 |   {$ALIGN ON}
 87 |   PIMAGE_BASE_RELOCATION = ^IMAGE_BASE_RELOCATION;
 88 |   {$IFEND}
 89 | 
 90 |   // Types that are declared in Pascal-style (ex.: PImageOptionalHeader); redeclaring them in C-style
 91 | 
 92 |   {$IF NOT DECLARED(PIMAGE_DATA_DIRECTORY)}
 93 |   type PIMAGE_DATA_DIRECTORY = ^IMAGE_DATA_DIRECTORY;
 94 |   {$IFEND}
 95 | 
 96 |   {$IF NOT DECLARED(PIMAGE_SECTION_HEADER)}
 97 |   type PIMAGE_SECTION_HEADER = ^IMAGE_SECTION_HEADER;
 98 |   {$IFEND}
 99 | 
100 |   {$IF NOT DECLARED(PIMAGE_EXPORT_DIRECTORY)}
101 |   type PIMAGE_EXPORT_DIRECTORY = ^IMAGE_EXPORT_DIRECTORY;
102 |   {$IFEND}
103 | 
104 |   {$IF NOT DECLARED(PIMAGE_DOS_HEADER)}
105 |   type PIMAGE_DOS_HEADER = ^IMAGE_DOS_HEADER;
106 |   {$IFEND}
107 | 
108 |   {$IF NOT DECLARED(PIMAGE_NT_HEADERS)}
109 |   type PIMAGE_NT_HEADERS = ^IMAGE_NT_HEADERS;
110 |   {$IFEND}
111 | 
112 |   {$IF NOT DECLARED(PUINT_PTR)}
113 |   type PUINT_PTR = ^UINT_PTR;
114 |   {$IFEND}
115 | 
116 | // Missing constants
117 | const
118 |   IMAGE_REL_BASED_ABSOLUTE = 0;
119 |   IMAGE_REL_BASED_HIGHLOW = 3;
120 |   IMAGE_REL_BASED_DIR64 = 10;
121 | 
122 | // Things that are incorrectly defined at least up to XE6 (miss x64 mapping)
123 | {$IFDEF CPUX64}
124 | type
125 |   PIMAGE_TLS_DIRECTORY = PIMAGE_TLS_DIRECTORY64;
126 | const
127 |   IMAGE_ORDINAL_FLAG = IMAGE_ORDINAL_FLAG64;
128 | {$ENDIF}
129 | 
130 | { +++++++++++++++++++++++++++++++++++++++++++++++
131 |   ***  Internal MemoryModule Const Definition  ***
132 |   ----------------------------------------------- }
133 | const
134 |   IMAGE_SIZEOF_BASE_RELOCATION = SizeOf(IMAGE_BASE_RELOCATION);
135 |   {$IFDEF CPUX64}
136 |   HOST_MACHINE = IMAGE_FILE_MACHINE_AMD64;
137 |   {$ELSE}
138 |   HOST_MACHINE = IMAGE_FILE_MACHINE_I386;
139 |   {$ENDIF}
140 | 
141 | type
142 | { +++++++++++++++++++++++++++++++++++++++++++++++
143 |   ***  Internal MemoryModule Type Definition  ***
144 |   ----------------------------------------------- }
145 |   TMemoryModuleRec = record
146 |     Headers: PIMAGE_NT_HEADERS;
147 |     CodeBase: Pointer;
148 |     Modules: array of HMODULE;
149 |     NumModules: Integer;
150 |     Initialized: Boolean;
151 |     IsRelocated: Boolean;
152 |     PageSize: DWORD;
153 |   end;
154 |   PMemoryModule = ^TMemoryModuleRec;
155 | 
156 |   TDllEntryProc = function(hinstDLL: HINST; fdwReason: DWORD; lpReserved: Pointer): BOOL; stdcall;
157 | 
158 |   TSectionFinalizeData = record
159 |     Address: Pointer;
160 |     AlignedAddress: Pointer;
161 |     Size: SIZE_T;
162 |     Characteristics: DWORD;
163 |     Last: Boolean;
164 |   end;
165 | 
166 | // Explicitly export these functions to allow hooking of their origins
167 | function GetProcAddress_Internal(hModule: HMODULE; lpProcName: LPCSTR): FARPROC; stdcall; external kernel32 name 'GetProcAddress';
168 | function LoadLibraryA_Internal(lpLibFileName: LPCSTR): HMODULE; stdcall; external kernel32 name 'LoadLibraryA';
169 | function FreeLibrary_Internal(hLibModule: HMODULE): BOOL; stdcall; external kernel32 name 'FreeLibrary';
170 | 
171 | // Just an imitation to allow using try-except block. DO NOT try to handle this
172 | // like "on E do ..." !
173 | procedure Abort;
174 | begin
175 |   raise TObject.Create;
176 | end;
177 | 
178 | // Copy from SysUtils to get rid of this unit
179 | function StrComp(const Str1, Str2: PAnsiChar): Integer;
180 | var
181 |   P1, P2: PAnsiChar;
182 | begin
183 |   P1 := Str1;
184 |   P2 := Str2;
185 |   while True do
186 |   begin
187 |     if (P1^ <> P2^) or (P1^ = #0) then
188 |       Exit(Ord(P1^) - Ord(P2^));
189 |     Inc(P1);
190 |     Inc(P2);
191 |   end;
192 | end;
193 | 
194 |   { +++++++++++++++++++++++++++++++++++++++++++++++++++++
195 |     ***                Missing WinAPI macros          ***
196 |     ----------------------------------------------------- }
197 | 
198 | {$IF NOT DECLARED(IMAGE_ORDINAL)}
199 | //  #define IMAGE_ORDINAL64(Ordinal) (Ordinal & 0xffff)
200 | //  #define IMAGE_ORDINAL32(Ordinal) (Ordinal & 0xffff)
201 | function IMAGE_ORDINAL(Ordinal: NativeUInt): Word; inline;
202 | begin
203 |   Result := Ordinal and $FFFF;
204 | end;
205 | {$IFEND}
206 | 
207 | {$IF NOT DECLARED(IMAGE_SNAP_BY_ORDINAL)}
208 | //  IMAGE_SNAP_BY_ORDINAL64(Ordinal) ((Ordinal & IMAGE_ORDINAL_FLAG64) != 0)
209 | //  IMAGE_SNAP_BY_ORDINAL32(Ordinal) ((Ordinal & IMAGE_ORDINAL_FLAG32) != 0)
210 | function IMAGE_SNAP_BY_ORDINAL(Ordinal: NativeUInt): Boolean; inline;
211 | begin
212 |   Result := ((Ordinal and IMAGE_ORDINAL_FLAG) <> 0);
213 | end;
214 | {$IFEND}
215 | 
216 |   { +++++++++++++++++++++++++++++++++++++++++++++++++++++
217 |     ***                 Helper functions              ***
218 |     ----------------------------------------------------- }
219 | 
220 | function GET_HEADER_DICTIONARY(Module: PMemoryModule; Idx: Integer): PIMAGE_DATA_DIRECTORY;
221 | begin
222 |   Result := PIMAGE_DATA_DIRECTORY(@(Module.Headers.OptionalHeader.DataDirectory[Idx]));
223 | end;
224 | 
225 | function ALIGN_DOWN(Address: Pointer; Alignment: DWORD): Pointer;
226 | begin
227 |   Result := Pointer(UIntPtr(Address) and not (Alignment - 1));
228 | end;
229 | 
230 | function CopySections(data: Pointer; old_headers: PIMAGE_NT_HEADERS; module: PMemoryModule): Boolean;
231 | var
232 |   i, Size: Integer;
233 |   CodeBase: Pointer;
234 |   dest: Pointer;
235 |   Section: PIMAGE_SECTION_HEADER;
236 | begin
237 |   CodeBase := Module.CodeBase;
238 |   Section := PIMAGE_SECTION_HEADER(IMAGE_FIRST_SECTION(Module.Headers{$IFNDEF FPC}^{$ENDIF}));
239 |   for i := 0 to Module.Headers.FileHeader.NumberOfSections - 1 do
240 |   begin
241 |     // Section doesn't contain data in the dll itself, but may define
242 |     // uninitialized Data
243 |     if Section.SizeOfRawData = 0 then
244 |     begin
245 |       Size := Old_headers.OptionalHeader.SectionAlignment;
246 |       if Size > 0 then
247 |       begin
248 |         dest := VirtualAlloc(PByte(CodeBase) + Section.VirtualAddress,
249 |                              Size,
250 |                              MEM_COMMIT,
251 |                              PAGE_READWRITE);
252 |         if dest = nil then
253 |           Exit(False);
254 |         // Always use position from file to support alignments smaller
255 |         // than page Size.
256 |         dest := PByte(CodeBase) + Section.VirtualAddress;
257 |         Section.Misc.PhysicalAddress := DWORD(dest);
258 |         ZeroMemory(dest, Size);
259 |       end;
260 |       // Section is empty
261 |       Inc(Section);
262 |       Continue;
263 |     end; // if
264 | 
265 |     // commit memory block and copy Data from dll
266 |     dest := VirtualAlloc(PByte(CodeBase) + Section.VirtualAddress,
267 |                          Section.SizeOfRawData,
268 |                          MEM_COMMIT,
269 |                          PAGE_READWRITE);
270 |     if dest = nil then
271 |       Exit(False);
272 | 
273 |     // Always use position from file to support alignments smaller
274 |     // than page Size.
275 |     dest := PByte(CodeBase) + Section.VirtualAddress;
276 |     CopyMemory(dest, PByte(Data) + Section.PointerToRawData, Section.SizeOfRawData);
277 |     Section.Misc.PhysicalAddress := DWORD(dest);
278 |     Inc(Section);
279 |   end; // for
280 | 
281 |   Result := True;
282 | end;
283 | 
284 | // Protection flags for memory pages (Executable, Readable, Writeable)
285 | const
286 |   ProtectionFlags: array[Boolean, Boolean, Boolean] of DWORD =
287 |   (
288 |     (
289 |         // not executable
290 |         (PAGE_NOACCESS, PAGE_WRITECOPY),
291 |         (PAGE_READONLY, PAGE_READWRITE)
292 |     ),
293 |     (
294 |         // executable
295 |         (PAGE_EXECUTE, PAGE_EXECUTE_WRITECOPY),
296 |         (PAGE_EXECUTE_READ, PAGE_EXECUTE_READWRITE)
297 |     )
298 | );
299 | 
300 | function GetRealSectionSize(Module: PMemoryModule; Section: PIMAGE_SECTION_HEADER): DWORD;
301 | begin
302 |   Result := Section.SizeOfRawData;
303 |   if Result = 0 then
304 |     if (Section.Characteristics and IMAGE_SCN_CNT_INITIALIZED_DATA) <> 0 then
305 |       Result := Module.Headers.OptionalHeader.SizeOfInitializedData
306 |     else if (Section.Characteristics and IMAGE_SCN_CNT_UNINITIALIZED_DATA) <> 0 then
307 |       Result := Module.Headers.OptionalHeader.SizeOfUninitializedData;
308 | end;
309 | 
310 | function FinalizeSection(Module: PMemoryModule; const SectionData: TSectionFinalizeData): Boolean;
311 | var
312 |   protect, oldProtect: DWORD;
313 |   executable, readable, writeable: Boolean;
314 | begin
315 |   if SectionData.Size = 0 then
316 |     Exit(True);
317 | 
318 |   if (SectionData.Characteristics and IMAGE_SCN_MEM_DISCARDABLE) <> 0 then
319 |   begin
320 |     // Section is not needed any more and can safely be freed
321 |     if (SectionData.Address = SectionData.AlignedAddress) and
322 |        ( SectionData.Last or
323 |          (Module.Headers.OptionalHeader.SectionAlignment = Module.PageSize) or
324 |          (SectionData.Size mod Module.PageSize = 0)
325 |        ) then
326 |          // Only allowed to decommit whole pages
327 |          VirtualFree(SectionData.Address, SectionData.Size, MEM_DECOMMIT);
328 |     Exit(True);
329 |   end;
330 | 
331 |   // determine protection flags based on Characteristics
332 |   executable := (SectionData.Characteristics and IMAGE_SCN_MEM_EXECUTE) <> 0;
333 |   readable   := (SectionData.Characteristics and IMAGE_SCN_MEM_READ) <> 0;
334 |   writeable  := (SectionData.Characteristics and IMAGE_SCN_MEM_WRITE) <> 0;
335 |   protect := ProtectionFlags[executable][readable][writeable];
336 |   if (SectionData.Characteristics and IMAGE_SCN_MEM_NOT_CACHED) <> 0 then
337 |     protect := protect or PAGE_NOCACHE;
338 | 
339 |   // change memory access flags
340 |   Result := VirtualProtect(SectionData.Address, SectionData.Size, protect, oldProtect);
341 | end;
342 | 
343 | function FinalizeSections(Module: PMemoryModule): Boolean;
344 | var
345 |   i: Integer;
346 |   Section: PIMAGE_SECTION_HEADER;
347 |   imageOffset: UIntPtr;
348 |   SectionData: TSectionFinalizeData;
349 |   sectionAddress, AlignedAddress: Pointer;
350 |   sectionSize: DWORD;
351 | begin
352 |   Section := PIMAGE_SECTION_HEADER(IMAGE_FIRST_SECTION(Module.Headers{$IFNDEF FPC}^{$ENDIF}));
353 |   {$IFDEF CPUX64}
354 |   imageOffset := (NativeUInt(Module.CodeBase) and $ffffffff00000000);
355 |   {$ELSE}
356 |   imageOffset := 0;
357 |   {$ENDIF}
358 | 
359 |   SectionData.Address := Pointer(UIntPtr(Section.Misc.PhysicalAddress) or imageOffset);
360 |   SectionData.AlignedAddress := ALIGN_DOWN(SectionData.Address, Module.PageSize);
361 |   SectionData.Size := GetRealSectionSize(Module, Section);
362 |   SectionData.Characteristics := Section.Characteristics;
363 |   SectionData.Last := False;
364 |   Inc(Section);
365 | 
366 |   // loop through all sections and change access flags
367 | 
368 |   for i := 1 to Module.Headers.FileHeader.NumberOfSections - 1 do
369 |   begin
370 |     sectionAddress := Pointer(UIntPtr(Section.Misc.PhysicalAddress) or imageOffset);
371 |     AlignedAddress := ALIGN_DOWN(SectionData.Address, Module.PageSize);
372 |     sectionSize := GetRealSectionSize(Module, Section);
373 |     // Combine access flags of all sections that share a page
374 |     // TODO(fancycode): We currently share flags of a trailing large Section
375 |     //   with the page of a first small Section. This should be optimized.
376 |     if (SectionData.AlignedAddress = AlignedAddress) or
377 |        (PByte(SectionData.Address) + SectionData.Size > PByte(AlignedAddress)) then
378 |     begin
379 |       // Section shares page with previous
380 |       if (Section.Characteristics and IMAGE_SCN_MEM_DISCARDABLE = 0) or
381 |          (SectionData.Characteristics and IMAGE_SCN_MEM_DISCARDABLE = 0) then
382 |         SectionData.Characteristics := (SectionData.Characteristics or Section.Characteristics) and not IMAGE_SCN_MEM_DISCARDABLE
383 |       else
384 |         SectionData.Characteristics := SectionData.Characteristics or Section.Characteristics;
385 |       SectionData.Size := PByte(sectionAddress) + sectionSize - PByte(SectionData.Address);
386 |       Inc(Section);
387 |       Continue;
388 |     end;
389 | 
390 |     if not FinalizeSection(Module, SectionData) then
391 |       Exit(False);
392 | 
393 |     SectionData.Address := sectionAddress;
394 |     SectionData.AlignedAddress := AlignedAddress;
395 |     SectionData.Size := sectionSize;
396 |     SectionData.Characteristics := Section.Characteristics;
397 | 
398 |     Inc(Section);
399 |   end; // for
400 | 
401 |   SectionData.Last := True;
402 |   if not FinalizeSection(Module, SectionData) then
403 |     Exit(False);
404 | 
405 |   Result := True;
406 | end;
407 | 
408 | function ExecuteTLS(Module: PMemoryModule): Boolean;
409 | var
410 |   CodeBase: Pointer;
411 |   directory: PIMAGE_DATA_DIRECTORY;
412 |   tls: PIMAGE_TLS_DIRECTORY;
413 |   callback: PPointer; // =^PIMAGE_TLS_CALLBACK;
414 | 
415 |   // TLS callback pointers are VA's (ImageBase included) so if the module resides at
416 |   // the other ImageBage they become invalid. This routine relocates them to the
417 |   // actual ImageBase.
418 |   // The case seem to happen with DLLs only and they rarely use TLS callbacks.
419 |   // Moreover, they probably don't work at all when using DLL dynamically which is
420 |   // the case in our code.
421 |   function FixPtr(OldPtr: Pointer): Pointer;
422 |   begin
423 |     Result := Pointer(NativeInt(OldPtr) - Module.Headers.OptionalHeader.ImageBase + NativeInt(CodeBase));
424 |   end;
425 | 
426 | begin
427 |   Result := True;
428 |   CodeBase := Module.CodeBase;
429 | 
430 |   directory := GET_HEADER_DICTIONARY(Module, IMAGE_DIRECTORY_ENTRY_TLS);
431 |   if directory.VirtualAddress = 0 then
432 |     Exit;
433 | 
434 |   tls := PIMAGE_TLS_DIRECTORY(PByte(CodeBase) + directory.VirtualAddress);
435 |   // Delphi syntax is quite awkward when dealing with proc pointers so we have to
436 |   // use casts to untyped pointers
437 |   callback := Pointer(tls.AddressOfCallBacks);
438 |   if callback <> nil then
439 |   begin
440 |     callback := FixPtr(callback);
441 |     while callback^ <> nil do
442 |     begin
443 |       PIMAGE_TLS_CALLBACK(FixPtr(callback^))(CodeBase, DLL_PROCESS_ATTACH, nil);
444 |       Inc(callback);
445 |     end;
446 |   end;
447 | end;
448 | 
449 | function PerformBaseRelocation(Module: PMemoryModule; Delta: NativeInt): Boolean;
450 | var
451 |   i: Cardinal;
452 |   CodeBase: Pointer;
453 |   directory: PIMAGE_DATA_DIRECTORY;
454 |   relocation: PIMAGE_BASE_RELOCATION;
455 |   dest: Pointer;
456 |   relInfo: ^UInt16;
457 |   patchAddrHL: PDWORD;
458 |   {$IFDEF CPUX64}
459 |   patchAddr64: PULONGLONG;
460 |   {$ENDIF}
461 |   relType, offset: Integer;
462 | begin
463 |   CodeBase := Module.CodeBase;
464 |   directory := GET_HEADER_DICTIONARY(Module, IMAGE_DIRECTORY_ENTRY_BASERELOC);
465 |   if directory.Size = 0 then
466 |     Exit(Delta = 0);
467 | 
468 |   relocation := PIMAGE_BASE_RELOCATION(PByte(CodeBase) + directory.VirtualAddress);
469 |   while relocation.VirtualAddress > 0 do
470 |   begin
471 |     dest := Pointer(PByte(CodeBase) + relocation.VirtualAddress);
472 |     relInfo := Pointer(PByte(relocation) + IMAGE_SIZEOF_BASE_RELOCATION);
473 |     for i := 0 to Trunc(((relocation.SizeOfBlock - IMAGE_SIZEOF_BASE_RELOCATION) / 2)) - 1 do
474 |     begin
475 |       // the upper 4 bits define the type of relocation
476 |       relType := relInfo^ shr 12;
477 |       // the lower 12 bits define the offset
478 |       offset := relInfo^ and $FFF;
479 | 
480 |       case relType of
481 |         IMAGE_REL_BASED_ABSOLUTE:
482 |           // skip relocation
483 |           ;
484 |         IMAGE_REL_BASED_HIGHLOW:
485 |           begin
486 |             // change complete 32 bit address
487 |             patchAddrHL := Pointer(PByte(dest) + offset);
488 |             Inc(patchAddrHL^, Delta);
489 |           end;
490 | 
491 |         {$IFDEF CPUX64}
492 |         IMAGE_REL_BASED_DIR64:
493 |           begin
494 |             patchAddr64 := Pointer(PByte(dest) + offset);
495 |             Inc(patchAddr64^, Delta);
496 |           end;
497 |         {$ENDIF}
498 |       end;
499 | 
500 |       Inc(relInfo);
501 |     end; // for
502 | 
503 |     // advance to next relocation block
504 |     relocation := PIMAGE_BASE_RELOCATION(PByte(relocation) + relocation.SizeOfBlock);
505 |   end; // while
506 | 
507 |   Result := True;
508 | end;
509 | 
510 | function BuildImportTable(Module: PMemoryModule): Boolean; stdcall;
511 | var
512 |   CodeBase: Pointer;
513 |   directory: PIMAGE_DATA_DIRECTORY;
514 |   importDesc: PIMAGE_IMPORT_DESCRIPTOR;
515 |   thunkRef: PUINT_PTR;
516 |   funcRef: ^FARPROC;
517 |   handle: HMODULE;
518 |   thunkData: PIMAGE_IMPORT_BY_NAME;
519 | begin
520 |   CodeBase := Module.CodeBase;
521 |   Result := True;
522 | 
523 |   directory := GET_HEADER_DICTIONARY(Module, IMAGE_DIRECTORY_ENTRY_IMPORT);
524 |   if directory.Size = 0 then
525 |     Exit(True);
526 | 
527 |   importDesc := PIMAGE_IMPORT_DESCRIPTOR(PByte(CodeBase) + directory.VirtualAddress);
528 |   while (not IsBadReadPtr(importDesc, SizeOf(IMAGE_IMPORT_DESCRIPTOR))) and (importDesc.Name <> 0) do
529 |   begin
530 |     handle := LoadLibraryA_Internal(PAnsiChar(PByte(CodeBase) + importDesc.Name));
531 |     if handle = 0 then
532 |     begin
533 |       SetLastError(ERROR_MOD_NOT_FOUND);
534 |       Result := False;
535 |       Break;
536 |     end;
537 | 
538 |     try
539 |       SetLength(Module.Modules, Module.NumModules + 1);
540 |     except
541 |       FreeLibrary_Internal(handle);
542 |       SetLastError(ERROR_OUTOFMEMORY);
543 |       Result := False;
544 |       Break;
545 |     end;
546 |     Module.Modules[Module.NumModules] := handle;
547 |     Inc(Module.NumModules);
548 | 
549 |     if importDesc.OriginalFirstThunk <> 0 then
550 |     begin
551 |       thunkRef := Pointer(PByte(CodeBase) + importDesc.OriginalFirstThunk);
552 |       funcRef := Pointer(PByte(CodeBase) + importDesc.FirstThunk);
553 |     end
554 |     else
555 |     begin
556 |       // no hint table
557 |       thunkRef := Pointer(PByte(CodeBase) + importDesc.FirstThunk);
558 |       funcRef := Pointer(PByte(CodeBase) + importDesc.FirstThunk);
559 |     end;
560 | 
561 |     while thunkRef^ <> 0 do
562 |     begin
563 |       if IMAGE_SNAP_BY_ORDINAL(thunkRef^) then
564 |         funcRef^ := GetProcAddress_Internal(handle, PAnsiChar(IMAGE_ORDINAL(thunkRef^)))
565 |       else
566 |       begin
567 |         thunkData := PIMAGE_IMPORT_BY_NAME(PByte(CodeBase) + thunkRef^);
568 |         funcRef^ := GetProcAddress_Internal(handle, PAnsiChar(@(thunkData.Name)));
569 |       end;
570 |       if funcRef^ = nil then
571 |       begin
572 |         Result := False;
573 |         Break;
574 |       end;
575 |       Inc(funcRef);
576 |       Inc(thunkRef);
577 |     end; // while
578 | 
579 |     if not Result then
580 |     begin
581 |       FreeLibrary_Internal(handle);
582 |       SetLastError(ERROR_PROC_NOT_FOUND);
583 |       Break;
584 |     end;
585 | 
586 |     Inc(importDesc);
587 |   end; // while
588 | end;
589 | 
590 |   { +++++++++++++++++++++++++++++++++++++++++++++++++++++
591 |     ***  Memory DLL loading functions Implementation  ***
592 |     ----------------------------------------------------- }
593 | 
594 | function MemoryLoadLibary(Data: Pointer): TMemoryModule; stdcall;
595 | var
596 |   dos_header: PIMAGE_DOS_HEADER;
597 |   old_header: PIMAGE_NT_HEADERS;
598 |   code, Headers: Pointer;
599 |   locationdelta: NativeInt;
600 |   sysInfo: SYSTEM_INFO;
601 |   DllEntry: TDllEntryProc;
602 |   successfull: Boolean;
603 |   Module: PMemoryModule;
604 | begin
605 |   Result := nil; Module := nil;
606 | 
607 |   try
608 |     dos_header := PIMAGE_DOS_HEADER(Data);
609 |     if (dos_header.e_magic <> IMAGE_DOS_SIGNATURE) then
610 |     begin
611 |       SetLastError(ERROR_BAD_EXE_FORMAT);
612 |       Exit;
613 |     end;
614 | 
615 |     // old_header = (PIMAGE_NT_HEADERS)&((const unsigned char * )(Data))[dos_header->e_lfanew];
616 |     old_header := PIMAGE_NT_HEADERS(PByte(Data) + dos_header._lfanew);
617 |     if old_header.Signature <> IMAGE_NT_SIGNATURE then
618 |     begin
619 |       SetLastError(ERROR_BAD_EXE_FORMAT);
620 |       Exit;
621 |     end;
622 | 
623 |     {$IFDEF CPUX64}
624 |     if old_header.FileHeader.Machine <> IMAGE_FILE_MACHINE_AMD64 then
625 |     {$ELSE}
626 |     if old_header.FileHeader.Machine <> IMAGE_FILE_MACHINE_I386 then
627 |     {$ENDIF}
628 |     begin
629 |       SetLastError(ERROR_BAD_EXE_FORMAT);
630 |       Exit;
631 |     end;
632 | 
633 |     if (old_header.OptionalHeader.SectionAlignment and 1) <> 0 then
634 |     begin
635 |       // Only support section alignments that are a multiple of 2
636 |       SetLastError(ERROR_BAD_EXE_FORMAT);
637 |       Exit;
638 |     end;
639 | 
640 |     // reserve memory for image of library
641 |     // XXX: is it correct to commit the complete memory region at once?
642 |     //      calling DllEntry raises an exception if we don't...
643 |     code := VirtualAlloc(Pointer(old_header.OptionalHeader.ImageBase),
644 |                          old_header.OptionalHeader.SizeOfImage,
645 |                          MEM_RESERVE or MEM_COMMIT,
646 |                          PAGE_READWRITE);
647 |     if code = nil then
648 |     begin
649 |       // try to allocate memory at arbitrary position
650 |       code := VirtualAlloc(nil,
651 |                            old_header.OptionalHeader.SizeOfImage,
652 |                            MEM_RESERVE or MEM_COMMIT,
653 |                            PAGE_READWRITE);
654 |       if code = nil then
655 |       begin
656 |         SetLastError(ERROR_OUTOFMEMORY);
657 |         Exit;
658 |       end;
659 |     end;
660 | 
661 |     Module := PMemoryModule(HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, SizeOf(TMemoryModuleRec)));
662 |     if Module = nil then
663 |     begin
664 |       VirtualFree(code, 0, MEM_RELEASE);
665 |       SetLastError(ERROR_OUTOFMEMORY);
666 |       Exit;
667 |     end;
668 | 
669 |     // memory is zeroed by HeapAlloc
670 |     Module.CodeBase := code;
671 |     GetNativeSystemInfo({$IFDEF FPC}@{$ENDIF}sysInfo);
672 |     Module.PageSize := sysInfo.dwPageSize;
673 | 
674 |     // commit memory for Headers
675 |     Headers := VirtualAlloc(code,
676 |                             old_header.OptionalHeader.SizeOfHeaders,
677 |                             MEM_COMMIT,
678 |                             PAGE_READWRITE);
679 | 
680 |     // copy PE header to code
681 |     CopyMemory(Headers, dos_header, old_header.OptionalHeader.SizeOfHeaders);
682 |     // result->Headers = (PIMAGE_NT_HEADERS)&((const unsigned char *)(Headers))[dos_header->e_lfanew];
683 |     Module.Headers := PIMAGE_NT_HEADERS(PByte(Headers) + dos_header._lfanew);
684 | 
685 |     // copy sections from DLL file block to new memory location
686 |     if not CopySections(Data, old_header, Module) then
687 |       Abort;
688 | 
689 |     // adjust base address of imported data
690 |     locationdelta := NativeInt(code) - old_header.OptionalHeader.ImageBase;
691 |     if locationdelta <> 0 then
692 |       Module.IsRelocated := PerformBaseRelocation(Module, locationdelta)
693 |     else
694 |       Module.IsRelocated := True;
695 | 
696 |     // load required dlls and adjust function table of imports
697 |     if not BuildImportTable(Module) then
698 |       Abort;
699 | 
700 |     // mark memory pages depending on Section Headers and release
701 |     // sections that are marked as "discardable"
702 |     if not FinalizeSections(Module) then
703 |       Abort;
704 | 
705 |     // TLS callbacks are executed BEFORE the main loading
706 |     if not ExecuteTLS(Module) then
707 |       Abort;
708 | 
709 |     // get entry point of loaded library
710 |     if Module.Headers.OptionalHeader.AddressOfEntryPoint <> 0 then
711 |     begin
712 |       @DllEntry := Pointer(PByte(code) + Module.Headers.OptionalHeader.AddressOfEntryPoint);
713 |       // notify library about attaching to process
714 |       successfull := DllEntry(HINST(code), DLL_PROCESS_ATTACH, nil);
715 |       if not successfull then
716 |       begin
717 |         SetLastError(ERROR_DLL_INIT_FAILED);
718 |         Abort;
719 |       end;
720 |       Module.Initialized := True;
721 |     end;
722 | 
723 |     Result := Module;
724 |   except
725 |     // cleanup
726 |     MemoryFreeLibrary(Module);
727 |     Exit;
728 |   end;
729 | end;
730 | 
731 | function MemoryGetProcAddress(Module: TMemoryModule; const Name: PAnsiChar): Pointer; stdcall;
732 | var
733 |   CodeBase: Pointer;
734 |   Idx: Integer;
735 |   i: DWORD;
736 |   nameRef: PDWORD;
737 |   ordinal: PWord;
738 |   exportDir: PIMAGE_EXPORT_DIRECTORY;
739 |   directory: PIMAGE_DATA_DIRECTORY;
740 |   temp: PDWORD;
741 |   mmodule: PMemoryModule;
742 | begin
743 |   Result := nil;
744 |   mmodule := PMemoryModule(Module);
745 | 
746 |   CodeBase := mmodule.CodeBase;
747 |   directory := GET_HEADER_DICTIONARY(mmodule, IMAGE_DIRECTORY_ENTRY_EXPORT);
748 |   // no export table found
749 |   if directory.Size = 0 then
750 |   begin
751 |     SetLastError(ERROR_PROC_NOT_FOUND);
752 |     Exit;
753 |   end;
754 | 
755 |   exportDir := PIMAGE_EXPORT_DIRECTORY(PByte(CodeBase) + directory.VirtualAddress);
756 |   // DLL doesn't export anything
757 |   if (exportDir.NumberOfNames = 0) or (exportDir.NumberOfFunctions = 0) then
758 |   begin
759 |     SetLastError(ERROR_PROC_NOT_FOUND);
760 |     Exit;
761 |   end;
762 | 
763 |   // search function name in list of exported names
764 |   nameRef := Pointer(PByte(CodeBase) + exportDir.AddressOfNames);
765 |   ordinal := Pointer(PByte(CodeBase) + exportDir.AddressOfNameOrdinals);
766 |   Idx := -1;
767 |   for i := 0 to exportDir.NumberOfNames - 1 do
768 |   begin
769 |     if StrComp(Name, PAnsiChar(PByte(CodeBase) + nameRef^)) = 0 then
770 |     begin
771 |       Idx := ordinal^;
772 |       Break;
773 |     end;
774 |     Inc(nameRef);
775 |     Inc(ordinal);
776 |   end;
777 | 
778 |   // exported symbol not found
779 |   if (Idx = -1) then
780 |   begin
781 |     SetLastError(ERROR_PROC_NOT_FOUND);
782 |     Exit;
783 |   end;
784 | 
785 |   // name <-> ordinal number don't match
786 |   if (DWORD(Idx) > exportDir.NumberOfFunctions) then
787 |   begin
788 |     SetLastError(ERROR_PROC_NOT_FOUND);
789 |     Exit;
790 |   end;
791 | 
792 |   // AddressOfFunctions contains the RVAs to the "real" functions     {}
793 |   temp := Pointer(PByte(CodeBase) + exportDir.AddressOfFunctions + Idx*4);
794 |   Result := Pointer(PByte(CodeBase) + temp^);
795 | end;
796 | 
797 | procedure MemoryFreeLibrary(Module: TMemoryModule); stdcall;
798 | var
799 |   i: Integer;
800 |   DllEntry: TDllEntryProc;
801 |   mmodule: PMemoryModule;
802 | begin
803 |   if Module = nil then Exit;
804 | 
805 |   mmodule := PMemoryModule(Module);
806 | 
807 |   if mmodule.Initialized then
808 |   begin
809 |     // notify library about detaching from process
810 |     @DllEntry := Pointer(PByte(mmodule.CodeBase) + mmodule.Headers.OptionalHeader.AddressOfEntryPoint);
811 |     DllEntry(HINST(mmodule.CodeBase), DLL_PROCESS_DETACH, nil);
812 |   end;
813 | 
814 |   if Length(mmodule.Modules) <> 0 then
815 |   begin
816 |     // free previously opened libraries
817 |     for i := 0 to mmodule.NumModules - 1 do
818 |       if mmodule.Modules[i] <> 0 then
819 |         FreeLibrary_Internal(mmodule.Modules[i]);
820 | 
821 |     SetLength(mmodule.Modules, 0);
822 |   end;
823 | 
824 |   if mmodule.CodeBase <> nil then
825 |     // release memory of library
826 |     VirtualFree(mmodule.CodeBase, 0, MEM_RELEASE);
827 | 
828 |   HeapFree(GetProcessHeap(), 0, mmodule);
829 | end;
830 | 
831 | end.
832 | 


--------------------------------------------------------------------------------
/MemoryModuleHook.pas:
--------------------------------------------------------------------------------
  1 | // Unit that hooks LoadLibrary, GetProcAddress, FreeLibrary for MemoryModule
  2 | // to allow transparent DLL loading.
  3 | 
  4 | unit MemoryModuleHook;
  5 | 
  6 | interface
  7 | 
  8 | uses
  9 |   Windows,
 10 |   MemoryModule, FuncHook;
 11 | 
 12 | type
 13 |   // Callback function that is called from LoadLibraryHook to determine
 14 |   // an address of library data.
 15 |   //   lpLibFileName: name of library to load
 16 |   // Returns:
 17 |   //   Pointer to library data; nil to bypass MemoryModule and use WinAPI
 18 |   TGetLibPtrProc = function (lpLibFileName: PWideChar): Pointer;
 19 | 
 20 | function InstallHook(AGetLibPtrCallback: TGetLibPtrProc): Boolean;
 21 | function UninstallHook: Boolean;
 22 | 
 23 | implementation
 24 | 
 25 | var
 26 |   HookInstalled: Boolean = False;
 27 |   GetLibPtrCallback: TGetLibPtrProc;
 28 | 
 29 |   LoadedModules: array of HMODULE;
 30 |   CS: RTL_CRITICAL_SECTION;
 31 | 
 32 |   LoadLibrary_Old: function (lpLibFileName: PWideChar): HMODULE; stdcall;
 33 |   GetProcAddress_Old: function (hModule: HMODULE; lpProcName: LPCSTR): FARPROC; stdcall;
 34 |   FreeLibrary_Old: function (hLibModule: HMODULE): BOOL; stdcall;
 35 | 
 36 |   HI_LL, HI_GPA, HI_FL: THookInfo;
 37 | 
 38 | function IndexOfLoadedModule(hModule: HMODULE): Integer;
 39 | var i: Integer;
 40 | begin
 41 |   EnterCriticalSection(CS);
 42 |   try
 43 |     for i := Low(LoadedModules) to High(LoadedModules) do
 44 |       if LoadedModules[i] = hModule then
 45 |         Exit(i);
 46 |     Result := -1;
 47 |   finally
 48 |     LeaveCriticalSection(CS);
 49 |   end;
 50 | end;
 51 | 
 52 | // Try to get library address and load it, run WinAPI routine otherwise.
 53 | function LoadLibraryHook(lpLibFileName: PWideChar): HMODULE; stdcall;
 54 | var
 55 |   LibPtr: Pointer;
 56 | begin
 57 |   Result := 0;
 58 | 
 59 |   LibPtr := GetLibPtrCallback(lpLibFileName);
 60 |   if LibPtr = nil then
 61 |   begin
 62 |     LoadLibrary_Old(lpLibFileName);
 63 |     Exit;
 64 |   end;
 65 | 
 66 |   Result := HMODULE(MemoryLoadLibary(LibPtr));
 67 |   if Result <> 0 then
 68 |   try
 69 |     EnterCriticalSection(CS);
 70 |     SetLength(LoadedModules, Length(LoadedModules) + 1);
 71 |     LoadedModules[Length(LoadedModules) - 1] := Result;
 72 |   finally
 73 |     LeaveCriticalSection(CS);
 74 |   end;
 75 | end;
 76 | 
 77 | // If hModule was loaded via MM, run MM's routine. Otherwise, run WinAPI one.
 78 | function GetProcAddressHook(hModule: HMODULE; lpProcName: LPCSTR): FARPROC; stdcall;
 79 | begin
 80 |   if IndexOfLoadedModule(hModule) <> -1 then
 81 |     Result := FARPROC(MemoryGetProcAddress(TMemoryModule(hModule), lpProcName))
 82 |   else
 83 |     Result := GetProcAddress_Old(hModule, lpProcName);
 84 | end;
 85 | 
 86 | // If hLibModule was loaded via MM, run MM's routine. Otherwise, run WinAPI one.
 87 | function FreeLibraryHook(hLibModule: HMODULE): BOOL; stdcall;
 88 | var idx: Integer;
 89 | begin
 90 |   idx := IndexOfLoadedModule(hLibModule);
 91 |   if idx <> -1 then
 92 |   begin
 93 |     MemoryFreeLibrary(TMemoryModule(hLibModule));
 94 |     Result := BOOL(True);
 95 |     // Remove from the list
 96 |     try
 97 |       EnterCriticalSection(CS);
 98 |       LoadedModules[idx] := 0;
 99 |       if idx < Length(LoadedModules) - 1 then
100 |         Move(LoadedModules[idx + 1], LoadedModules[idx], (Length(LoadedModules) - idx + 1)*SizeOf(HMODULE));
101 |       SetLength(LoadedModules, Length(LoadedModules) - 1);
102 |     finally
103 |       LeaveCriticalSection(CS);
104 |     end;
105 |   end
106 |   else
107 |     Result := FreeLibrary_Old(hLibModule);
108 | end;
109 | 
110 | function InstallHook(AGetLibPtrCallback: TGetLibPtrProc): Boolean;
111 | begin
112 |   Result := False;
113 |   if not Assigned(AGetLibPtrCallback) then Exit;
114 | 
115 |   EnterCriticalSection(CS);
116 |   try
117 |     if HookInstalled then Exit;
118 | 
119 |     if not HookProcedure(False, HI_LL) or
120 |        not HookProcedure(False, HI_GPA) or
121 |        not HookProcedure(False, HI_FL) then Exit;
122 | 
123 |     LoadLibrary_Old := HI_LL.OrigProc;
124 |     GetProcAddress_Old := HI_GPA.OrigProc;
125 |     FreeLibrary_Old := HI_FL.OrigProc;
126 | 
127 |     HookInstalled := True;
128 |     GetLibPtrCallback := AGetLibPtrCallback;
129 | 
130 |     Result := True;
131 |   finally
132 |     if not Result then
133 |       UninstallHook;
134 |     LeaveCriticalSection(CS);
135 |   end;
136 | end;
137 | 
138 | function UninstallHook: Boolean;
139 | begin
140 |   Result := False;
141 | 
142 |   EnterCriticalSection(CS);
143 |   try
144 |     if not HookInstalled then Exit;
145 | 
146 |     while Length(LoadedModules) > 0 do
147 |       FreeLibrary(LoadedModules[0]);
148 | 
149 |     Result :=
150 |       UnhookProcedure(HI_LL) and
151 |       UnhookProcedure(HI_GPA) and
152 |       UnhookProcedure(HI_FL);
153 | 
154 |     GetLibPtrCallback := nil;
155 |     HookInstalled := False;
156 |   finally
157 |     LeaveCriticalSection(CS);
158 |   end;
159 | end;
160 | 
161 | initialization
162 |   InitializeCriticalSection(CS);
163 |   HI_LL.Init(@LoadLibrary, @LoadLibraryHook);
164 |   HI_GPA.Init(@GetProcAddress, @GetProcAddressHook);
165 |   HI_FL.Init(@FreeLibrary, @FreeLibraryHook);
166 | 
167 | finalization
168 |   UninstallHook;
169 |   DeleteCriticalSection(CS);
170 | 
171 | end.
172 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/Fr0sT-Brutal/Delphi_MemoryModule/2347efa123c10f5232035fb364cd556a5dcfb778/README.md


--------------------------------------------------------------------------------