unit MW_MemoryDll;

interface

{$REGION 'Documentation'}
// =================================================================================================
// Memory DLL 32 Bit functions
//
// Loads and calls DLL functions and methods from memory from a resource within the EXE.
// Replaces typical use whereby the DLL is compiled as a resource and at runtime is saved
// to a file, then loaded and executed.
// Works in a similar fashion to Delphi LoadLibrary(),GetProcAddress() and FreeLibrary()
// functions except the DLL is loaded from resource to memory.
// It is best to call the functions in a try..except structure
//
// Mike Heydon 2010
//
// =================================================================================================

// The original unit sample is taken from
//  http://delphi.cjcsoft.net//viewthread.php?tid=48024
// This instance of helper unit contains minor corrections, auto formatted.
{$ENDREGION}

uses Windows, SysUtils, Classes;

// Prototype Definitions
function MemoryLoadLibrary(const ADllResName: string): Pointer;

function MemoryGetProcAddress(AModule: Pointer; const AName: string;
  ACaseSensitive: boolean = false): Pointer; stdcall;

procedure MemoryFreeLibrary(AModule: Pointer); stdcall;

// ------------------------------------------------------------------------------------------------
implementation

{$REGION 'Types and Constants'}
// -------------------------------------------------------------------------------------------------

type
  TDllEntryProc = function(hinstdll: THandle; fdwReason: DWORD;
    lpReserved: Pointer): BOOL; stdcall;
  PBTMemoryModule = ^TBTMemoryModule;

  _BT_MEMORY_MODULE = packed record
    Headers: PImageNtHeaders;
    CodeBase: Pointer;
    Modules: Pointer;
    NumModules: integer;
    Initialized: boolean;
  end;

{$EXTERNALSYM _BT_MEMORY_MODULE}

  TBTMemoryModule = _BT_MEMORY_MODULE;
  BT_MEMORY_MODULE = _BT_MEMORY_MODULE;
{$EXTERNALSYM BT_MEMORY_MODULE}

  // Missing Windows API Definitions

  PImageBaseRelocation = ^TImageBaseRelocation;

  _IMAGE_BASE_RELOCATION = packed record
    VirtualAddress: DWORD;
    SizeOfBlock: DWORD;
  end;

{$EXTERNALSYM _IMAGE_BASE_RELOCATION}

  TImageBaseRelocation = _IMAGE_BASE_RELOCATION;
  IMAGE_BASE_RELOCATION = _IMAGE_BASE_RELOCATION;
{$EXTERNALSYM IMAGE_BASE_RELOCATION}
  PImageImportDescriptor = ^TImageImportDescriptor;

  _IMAGE_IMPORT_DESCRIPTOR = packed record
    OriginalFirstThunk: DWORD;
    TimeDateStamp: DWORD;
    ForwarderChain: DWORD;
    Name: DWORD;
    FirstThunk: DWORD;
  end;

{$EXTERNALSYM _IMAGE_IMPORT_DESCRIPTOR}

  TImageImportDescriptor = _IMAGE_IMPORT_DESCRIPTOR;
  IMAGE_IMPORT_DESCRIPTOR = _IMAGE_IMPORT_DESCRIPTOR;
{$EXTERNALSYM IMAGE_IMPORT_DESCRIPTOR}
  PImageImportByName = ^TImageImportByName;

  _IMAGE_IMPORT_BY_NAME = packed record
    Hint: Word;
    Name: array [0 .. 255] of byte;
  end;

{$EXTERNALSYM _IMAGE_IMPORT_BY_NAME}

  TImageImportByName = _IMAGE_IMPORT_BY_NAME;
  IMAGE_IMPORT_BY_NAME = _IMAGE_IMPORT_BY_NAME;
{$EXTERNALSYM IMAGE_IMPORT_BY_NAME}

const
  IMAGE_SIZEOF_BASE_RELOCATION = 8;
{$EXTERNALSYM IMAGE_SIZEOF_BASE_RELOCATION}
  IMAGE_REL_BASED_HIGHLOW = 3;
{$EXTERNALSYM IMAGE_REL_BASED_HIGHLOW}
  IMAGE_ORDINAL_FLAG32 = DWORD($80000000);
{$EXTERNALSYM IMAGE_ORDINAL_FLAG32}
{$ENDREGION}
{$REGION 'Internal Calls'}
  // -------------------------------------------------------------------------------------------------

function _GetFieldOffset(const AStruc; const AField): NativeUInt; stdcall; inline;
begin
  Result := NativeUInt(@AField) - NativeUInt(@AStruc);
end;

function _GetImageFirstSection(ANtHeader: PImageNtHeaders): PImageSectionHeader;
  stdcall; inline;
begin
  Result := PImageSectionHeader(NativeUInt(ANtHeader) +
    _GetFieldOffset(ANtHeader^, ANtHeader^.OptionalHeader) +
    ANtHeader^.FileHeader.SizeOfOptionalHeader);
end;

function _GetHeaderDictionary(AModule: PBTMemoryModule; AIdx: integer)
  : PImageDataDirectory; stdcall; inline;
begin
  Result := PImageDataDirectory
    (@(AModule.Headers.OptionalHeader.DataDirectory[AIdx]));
end;

function _GetImageOrdinal(AOrdinal: DWORD): Word; stdcall; inline;
begin
  Result := AOrdinal and $FFFF;
end;

function _GetImageSnapByOrdinal(AOrdinal: DWORD): boolean; stdcall; inline;
begin
  Result := (AOrdinal and IMAGE_ORDINAL_FLAG32) <> 0
end;

procedure _CopySections(const AData: Pointer;
  const AOldHeaders: TImageNtHeaders; AModule: PBTMemoryModule); stdcall;
var
  iSize, i: integer;
  pCodebase, pDest: Pointer;
  pSection: PImageSectionHeader;
begin
  pCodebase := AModule.CodeBase;
  pSection := _GetImageFirstSection(AModule.Headers);

  for i := 0 to AModule.Headers.FileHeader.NumberOfSections - 1 do
  begin
    // Section doesn't contain data in the dll itself, but may define uninitialized data
    if (pSection.SizeOfRawData = 0) then
    begin
      iSize := AOldHeaders.OptionalHeader.SectionAlignment;

      if iSize > 0 then
      begin
        pDest := VirtualAlloc
          (Pointer(NativeUInt(pCodebase) + pSection.VirtualAddress), iSize,
          MEM_COMMIT, PAGE_READWRITE);
        pSection.Misc.PhysicalAddress := NativeUInt(pDest);
        ZeroMemory(pDest, iSize);
      end;

      Inc(NativeUInt(pSection), sizeof(TImageSectionHeader));
      Continue;
    end;

    // Commit memory block and copy data from DLL
    pDest := VirtualAlloc(Pointer(NativeUInt(pCodebase) +
      pSection.VirtualAddress), pSection.SizeOfRawData, MEM_COMMIT,
      PAGE_READWRITE);
    CopyMemory(pDest, Pointer(NativeUInt(AData) + pSection.pointerToRawData),
      pSection.SizeOfRawData);
    pSection.Misc.PhysicalAddress := NativeUInt(pDest);
    // IMAGE_SIZEOF_SECTION_HEADER
    Inc(NativeUInt(pSection), sizeof(TImageSectionHeader));
  end;
end;

procedure _PerformBaseRelocation(AModule: PBTMemoryModule;
  ADelta: NativeUInt); stdcall;
var
  i: cardinal;
  pCodebase, pDest: Pointer;
  pDirectory: PImageDataDirectory;
  pRelocation: PImageBaseRelocation;
  pRelInfo: ^Word;
  pPatchAddrHL: ^DWORD;
  iType, iOffset: NativeInt;
begin
  pCodebase := AModule.CodeBase;
  pDirectory := _GetHeaderDictionary(AModule, IMAGE_DIRECTORY_ENTRY_BASERELOC);

  if pDirectory.Size > 0 then
  begin
    pRelocation := PImageBaseRelocation(NativeUInt(pCodebase) +
      pDirectory.VirtualAddress);

    while pRelocation.VirtualAddress > 0 do
    begin
      pDest := Pointer((NativeUInt(pCodebase) + pRelocation.VirtualAddress));
      pRelInfo := Pointer(NativeUInt(pRelocation) + IMAGE_SIZEOF_BASE_RELOCATION);

      for i := 0 to
        (trunc(((pRelocation.SizeOfBlock - IMAGE_SIZEOF_BASE_RELOCATION) /
        2)) - 1) do
      begin
        // Upper 4 bits define the type of relocation
        iType := (pRelInfo^ shr 12);
        // Lower 12 bits define the offset
        iOffset := pRelInfo^ and $FFF;

        if iType = IMAGE_REL_BASED_HIGHLOW then
        begin
          // Change complete 32 bit address
          pPatchAddrHL := Pointer(NativeUInt(pDest) + NativeUInt(iOffset));
          pPatchAddrHL^ := pPatchAddrHL^ + ADelta;
        end;

        Inc(pRelInfo);
      end;

      pRelocation := Pointer(NativeUInt(pRelocation) + pRelocation.SizeOfBlock);
    end;
  end;
end;

function _BuildImportTable(AModule: PBTMemoryModule; out AErrStr: string)
  : boolean; stdcall;
var
  pCodebase: Pointer;
  pDirectory: PImageDataDirectory;
  pImportDesc: PImageImportDescriptor;
  pThunkRef, pFuncRef: ^NativeUInt;
  iHandle: HMODULE;
  iTemp: integer;
  rThunkData: TImageImportByName;
begin
  Result := true;
  pCodebase := AModule.CodeBase;
  pDirectory := _GetHeaderDictionary(AModule, IMAGE_DIRECTORY_ENTRY_IMPORT);

  if (pDirectory.Size > 0) then
  begin
    pImportDesc := PImageImportDescriptor(NativeUInt(pCodebase) +
      pDirectory.VirtualAddress);

    while (not IsBadReadPtr(pImportDesc, sizeof(TImageImportDescriptor))) and
      (pImportDesc.Name > 0) do
    begin
      iHandle := LoadLibraryA
        (PAnsiChar(NativeUInt(pCodebase) + pImportDesc.Name));

      if (iHandle = INVALID_HANDLE_VALUE) or (iHandle = 0) then
      begin
        AErrStr := 'BuildImportTable: can''t load library: ' +
          PAnsiChar(NativeUInt(pCodebase) + pImportDesc.Name);
        Result := false;
        exit;
      end;

      // ReallocMemory crashes if "AModule.Modules = nil"
      if AModule.Modules = nil then
        AModule.Modules := AllocMem(1);
      AModule.Modules := ReallocMemory(AModule.Modules,
        ((AModule.NumModules + 1) * (sizeof(HMODULE))));

      if AModule.Modules = nil then
      begin
        AErrStr := 'BuildImportTable: ReallocMemory failed';
        Result := false;
        exit;
      end;

      iTemp := (sizeof(NativeUInt) * (AModule.NumModules));
      Inc(NativeUInt(AModule.Modules), iTemp);
      NativeUInt(AModule.Modules^) := iHandle;
      Dec(NativeUInt(AModule.Modules), iTemp);
      AModule.NumModules := AModule.NumModules + 1;

      if pImportDesc.OriginalFirstThunk > 0 then
      begin
        pThunkRef := Pointer(NativeUInt(pCodebase) +
          pImportDesc.OriginalFirstThunk);
        pFuncRef := Pointer(NativeUInt(pCodebase) + pImportDesc.FirstThunk);
      end
      else
      begin
        // No hint table
        pThunkRef := Pointer(NativeUInt(pCodebase) + pImportDesc.FirstThunk);
        pFuncRef := Pointer(NativeUInt(pCodebase) + pImportDesc.FirstThunk);
      end;

      while pThunkRef^ <> 0 do
      begin
        if _GetImageSnapByOrdinal(pThunkRef^) then
          pFuncRef^ := NativeUInt(GetProcAddress(iHandle,
            PAnsiChar(_GetImageOrdinal(pThunkRef^))))
        else
        begin
          CopyMemory(@rThunkData, Pointer(NativeUInt(pCodebase) + pThunkRef^),
            sizeof(TImageImportByName));
          pFuncRef^ := NativeUInt(GetProcAddress(iHandle,
            PAnsiChar(@(rThunkData.Name))));
        end;

        if pFuncRef^ = 0 then
        begin
          AErrStr := 'BuildImportTable: GetProcAddress failed';
          Result := false;
          break;
        end;

        Inc(pFuncRef);
        Inc(pThunkRef);
      end;

      Inc(NativeUInt(pImportDesc), sizeof(TImageImportDescriptor));
    end;
  end;
end;

function _GetSectionProtection(ASectionHeader: cardinal): cardinal; stdcall;
var
  iResult: cardinal;
begin
  iResult := 0;
  if (ASectionHeader and IMAGE_SCN_MEM_NOT_CACHED) > 0 then
    iResult := iResult or PAGE_NOCACHE;

  // E - Execute, R - Read , W - Write
  if (ASectionHeader and IMAGE_SCN_MEM_EXECUTE) > 0 // E ?
  then
    if (ASectionHeader and IMAGE_SCN_MEM_READ) > 0 // ER ?
    then
      if (ASectionHeader and IMAGE_SCN_MEM_WRITE) > 0 // ERW ?
      then
        iResult := iResult or PAGE_EXECUTE_READWRITE
      else
        iResult := iResult or PAGE_EXECUTE_READ
    else if (ASectionHeader and IMAGE_SCN_MEM_WRITE) > 0 // EW?
    then
      iResult := iResult or PAGE_EXECUTE_WRITECOPY
    else
      iResult := iResult or PAGE_EXECUTE
  else if (ASectionHeader and IMAGE_SCN_MEM_READ) > 0 // R?
  then
    if (ASectionHeader and IMAGE_SCN_MEM_WRITE) > 0 // RW?
    then
      iResult := iResult or PAGE_READWRITE
    else
      iResult := iResult or PAGE_READONLY
  else if (ASectionHeader and IMAGE_SCN_MEM_WRITE) > 0 // W?
  then
    iResult := iResult or PAGE_WRITECOPY
  else
    iResult := iResult or PAGE_NOACCESS;

  Result := iResult;
end;

procedure _FinalizeSections(AModule: PBTMemoryModule); stdcall;
var
  i: integer;
  pSection: PImageSectionHeader;
  iProtect, iOldProtect, iSize: cardinal;
begin
  pSection := _GetImageFirstSection(AModule.Headers);

  for i := 0 to AModule.Headers.FileHeader.NumberOfSections - 1 do
  begin

    if (pSection.Characteristics and IMAGE_SCN_MEM_DISCARDABLE) > 0 then
    begin
      // Section is not needed any more and can safely be freed
      VirtualFree(Pointer(pSection.Misc.PhysicalAddress),
        pSection.SizeOfRawData, MEM_DECOMMIT);
      Inc(NativeUInt(pSection), sizeof(TImageSectionHeader));
      Continue;
    end;

    iProtect := _GetSectionProtection(pSection.Characteristics);
    if (pSection.Characteristics and IMAGE_SCN_MEM_NOT_CACHED) > 0 then
      iProtect := (iProtect or PAGE_NOCACHE);

    // Determine size of region
    iSize := pSection.SizeOfRawData;

    if iSize = 0 then
    begin
      if (pSection.Characteristics and IMAGE_SCN_CNT_INITIALIZED_DATA) > 0 then
        iSize := AModule.Headers.OptionalHeader.SizeOfInitializedData
      else
      begin
        if (pSection.Characteristics and IMAGE_SCN_CNT_UNINITIALIZED_DATA) > 0 then
          iSize := AModule.Headers.OptionalHeader.SizeOfUninitializedData;
      end;
      if iSize > 0 then
      begin
        if not VirtualProtect(Pointer(pSection.Misc.PhysicalAddress),
          pSection.SizeOfRawData, iProtect, @iOldProtect) then
          raise Exception.Create('FinalizeSections: VirtualProtect failed');
      end;
    end;

    Inc(NativeUInt(pSection), sizeof(TImageSectionHeader));
  end;
end;

// ========================================
// Load Library into memory structure
// ========================================

function _MemoryLoadLibary(AData: Pointer): PBTMemoryModule; stdcall;
var
  sErrStr: string;
  pResult: PBTMemoryModule;
  rDosHeader: TImageDosHeader;
  rOldHeader: TImageNtHeaders;
  pCode, pHeaders: Pointer;
  iLocationDelta: NativeUInt;
  rDllEntry: TDllEntryProc;
  bSuccessfull: boolean;
begin
  sErrStr := '';
  pResult := nil;

  try
    CopyMemory(@rDosHeader, AData, sizeof(_IMAGE_DOS_HEADER));

    if (rDosHeader.e_magic > IMAGE_DOS_SIGNATURE) then
      raise Exception.Create('MemoryLoadLibary: DLL DOS header is not valid');

    CopyMemory(@rOldHeader, Pointer(NativeUInt(AData) + rDosHeader._lfanew),
      sizeof(_IMAGE_NT_HEADERS));

    if rOldHeader.Signature > IMAGE_NT_SIGNATURE then
      raise Exception.Create
        ('MemoryLoadLibary: IMAGE_NT_SIGNATURE is not valid');

    // Reserve memory for image of library
    pCode := VirtualAlloc(Pointer(rOldHeader.OptionalHeader.ImageBase),
      rOldHeader.OptionalHeader.SizeOfImage, MEM_RESERVE, PAGE_READWRITE);

    // Try to allocate memory at arbitrary position
    if pCode = nil then
      pCode := VirtualAlloc(nil, rOldHeader.OptionalHeader.SizeOfImage,
        MEM_RESERVE, PAGE_READWRITE);

    if pCode = nil then
      raise Exception.Create('MemoryLoadLibary: VirtualAlloc failed');

    // Alloc space for the result record
    pResult := PBTMemoryModule(HeapAlloc(GetProcessHeap(), 0,
      sizeof(TBTMemoryModule)));
    pResult.CodeBase := pCode;
    pResult.NumModules := 0;
    pResult.Modules := nil;
    pResult.Initialized := false;
    // xy: is it correct to commit the complete memory region at once?
    // Calling DllEntry raises an exception if we don't...
    VirtualAlloc(pCode, rOldHeader.OptionalHeader.SizeOfImage, MEM_COMMIT,
      PAGE_READWRITE);
    // Commit memory for headers
    pHeaders := VirtualAlloc(pCode, rOldHeader.OptionalHeader.SizeOfHeaders,
      MEM_COMMIT, PAGE_READWRITE);
    // Copy PE header to code
    CopyMemory(pHeaders, AData,
      (cardinal(rDosHeader._lfanew) + rOldHeader.OptionalHeader.SizeOfHeaders));
    pResult.Headers := PImageNtHeaders(NativeUInt(pHeaders) + rDosHeader._lfanew);
    // Update position
    pResult.Headers.OptionalHeader.ImageBase := NativeUInt(pCode);
    // Copy sections from DLL file block to new memory location
    _CopySections(AData, rOldHeader, pResult);
    // Adjust base address of imported data
    iLocationDelta := NativeUInt(NativeUInt(pCode) -
      rOldHeader.OptionalHeader.ImageBase);
    if iLocationDelta > 0 then
      _PerformBaseRelocation(pResult, iLocationDelta);

    // Load required dlls and adjust function table of imports
    if not _BuildImportTable(pResult, sErrStr) then
      raise Exception.Create
        (sErrStr + ' MemoryLoadLibary: BuildImportTable failed');

    // Mark memory pages depending on section headers and release
    // sections that are marked as "discardable"
    _FinalizeSections(pResult);

    // Get entry point of loaded library
    if (pResult.Headers.OptionalHeader.AddressOfEntryPoint) > 0 then
    begin
      @rDllEntry := Pointer(NativeUInt(pCode) +
        pResult.Headers.OptionalHeader.AddressOfEntryPoint);

      if @rDllEntry = nil then
        raise Exception.Create('MemoryLoadLibary: Get DLLEntyPoint failed');

      bSuccessfull := rDllEntry(NativeUInt(pCode), DLL_PROCESS_ATTACH, nil); // <---  Не может присоединиться для x64

      if not bSuccessfull then
        raise Exception.Create('MemoryLoadLibary: Can''t attach library');

      pResult.Initialized := true;
    end;
  except
    MemoryFreeLibrary(pResult);
    raise;
  end;

  Result := pResult;
end;

{$ENDREGION}
{$REGION 'User Calls'}
// -------------------------------------------------------------------------------------------------

// ========================================================
// Load the library from RESOURCE NAME in EXE into memory
// ========================================================

function MemoryLoadLibrary(const ADllResName: string): Pointer;
var
  oMs: TMemoryStream;
  oRs: TResourceStream;
  iDllDataSize: int64;
  pDllData: Pointer;
  pResult: PBTMemoryModule;
begin
  pResult := nil;

  if FindResource(hInstance, PWideChar(ADllResName), RT_RCDATA) > 0 then
  begin
    oRs := TResourceStream.Create(hInstance, ADllResName, RT_RCDATA);
    oMs := TMemoryStream.Create;
    try
      oMs.LoadFromStream(oRs);
      oMs.Position := 0;
      iDllDataSize := oMs.Size;
      pDllData := GetMemory(iDllDataSize);
      oMs.Read(pDllData^, iDllDataSize);
      pResult := Pointer(_MemoryLoadLibary(pDllData));
    finally
      oMs.Free;
      oRs.Free;
    end;
  end;

  Result := pResult;
end;


// ===============================================
// Find the Funcion/Procedure Entry point
// ===============================================

function MemoryGetProcAddress(AModule: Pointer; const AName: string;
  ACaseSensitive: boolean = false): Pointer; stdcall;
var
  sName: AnsiString;
  pFoundName, pName: PAnsiChar;
  sFoundName: string;
  pCodebase: Pointer;
  iIdx: integer;
  i: DWORD;
  pNameRef, pTemp: ^DWORD;
  pOrdinal: ^Word;
  pExports: PImageExportDirectory;
  pDirectory: PImageDataDirectory;
  pModule: PBTMemoryModule;
begin
  pModule := PBTMemoryModule(AModule);
  pCodebase := pModule.CodeBase;
  iIdx := -1;
  pDirectory := _GetHeaderDictionary(pModule, IMAGE_DIRECTORY_ENTRY_EXPORT);

  if pDirectory.Size = 0 then
    raise Exception.Create('MemoryGetProcAddress: no export table found');

  pExports := PImageExportDirectory(NativeUInt(pCodebase) +
    pDirectory.VirtualAddress);

  if ((pExports.NumberOfNames = 0) or (pExports.NumberOfFunctions = 0)) then
    raise Exception.Create
      ('MemoryGetProcAddress: DLL doesn''t export anything');

  // Search function name in list of exported names
  pNameRef := Pointer(NativeUInt(pCodebase) + NativeUInt(pExports.AddressOfNames));
  pOrdinal := Pointer(NativeUInt(pCodebase) +
    NativeUInt(pExports.AddressOfNameOrdinals));

  for i := 0 to pExports.NumberOfNames - 1 do
  begin
    if not ACaseSensitive then
    begin
      // Ignore Case
      pFoundName := PAnsiChar(NativeUInt(pCodebase) + pNameRef^);
      sFoundName := string(pFoundName);

      if SameText(AName, sFoundName) then
      begin
        iIdx := pOrdinal^;
        break;
      end;
    end
    else
    begin
      // Match Case
      sName := AnsiString(AName);
      pName := @sName[1];

      if StrComp(pName, PAnsiChar(NativeUInt(pCodebase) + pNameRef^)) = 0 then
      begin
        iIdx := pOrdinal^;
        break;
      end;
    end;

    Inc(pNameRef);
    Inc(pOrdinal);
  end;

  if (iIdx = -1) then
    raise Exception.Create('MemoryGetProcAddress: exported symbol not found');

  if (cardinal(iIdx) > pExports.NumberOfFunctions - 1) then
    raise Exception.Create
      ('MemoryGetProcAddress: name - ordinal number don''t match');

  // AddressOfFunctions contains the RVAs to the "real" functions
  pTemp := Pointer(NativeUInt(pCodebase) + NativeUInt(pExports.AddressOfFunctions) +
    NativeUInt((iIdx * 4)));
  Result := Pointer(NativeUInt(pCodebase) + pTemp^);
end;


// ======================================
// Free the Library if allocated
// ======================================

procedure MemoryFreeLibrary(AModule: Pointer); stdcall;
var
  pModule1, pModule2: PBTMemoryModule;
  i: integer;
  iTemp: integer;
  rDllEntry: TDllEntryProc;
begin
  pModule1 := PBTMemoryModule(AModule);
  pModule2 := PBTMemoryModule(AModule);

  if pModule1 <> nil then
  begin
    if pModule1.Initialized then
    begin
      @rDllEntry := Pointer(NativeUInt(pModule1.CodeBase) +
        pModule1.Headers.OptionalHeader.AddressOfEntryPoint);
      rDllEntry(NativeUInt(pModule1.CodeBase), DLL_PROCESS_DETACH, nil);
      pModule1.Initialized := false;

      // Free previously opened libraries
      for i := 0 to pModule1.NumModules - 1 do
      begin
        iTemp := (sizeof(NativeUInt) * (i));
        Inc(NativeUInt(pModule1.Modules), iTemp);
        if NativeUInt(pModule2.Modules^) <> INVALID_HANDLE_VALUE then
          FreeLibrary(NativeUInt(pModule2.Modules^));
        Dec(NativeUInt(pModule1.Modules), iTemp);
      end;

      FreeMemory(pModule1.Modules);
      if pModule1.CodeBase <> nil then
        VirtualFree(pModule1.CodeBase, 0, MEM_RELEASE);
      HeapFree(GetProcessHeap(), 0, pModule2);
      Pointer(pModule2) := nil;
    end;
  end;
end;
{$ENDREGION}
end.