unit BTMemoryModule;

 {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  * Memory DLL loading code                                                 *
  * ------------------------                                                *
  *                                                                         *
  * MemoryModule "Conversion to Delphi"                                     *
  * Copyright (c) 2005 - 2006 by Martin Offenwanger / coder@dsplayer.de     *
  * http://www.dsplayer.de                                                  *
  *                                                                         *
  * Original C++ Code "MemoryModule Version 0.0.1"                          *
  * Copyright (c) 2004- 2006 by Joachim Bauch / mail@joachim-bauch.de       *
  * http://www.joachim-bauch.de                                             *
  *                                                                         *
  * This library is free software; you can redistribute it and/or           *
  * modify it under the terms of the GNU Lesser General Public              *
  * License as published by the Free Software Foundation; either            *
  * version 2.1 of the License, or (at your option) any later version.      *
  *                                                                         *
  * This library is distributed in the hope that it will be useful,         *
  * but WITHOUT ANY WARRANTY; without even the implied warranty of          *
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU       *
  * Lesser General Public License for more details.                         *
  *                                                                         *
  * You should have received a copy of the GNU Lesser General Public        *
  * License along with this library; if not, write to the Free Software     *
  * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *
  *                                                                         *
  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{
@author(Martin Offenwanger: coder@dsplayer.de)
@created(Mar 20, 2005)
@lastmod(Sep 27, 2005)
}

interface

uses
  // Borland Run-time Library
  Windows;

   {++++++++++++++++++++++++++++++++++++++
    ***  MemoryModule Type Definition  ***
    --------------------------------------}
type
  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}


   {++++++++++++++++++++++++++++++++++++++++++++++++++
    ***  Memory DLL loading functions Declaration  ***
    --------------------------------------------------}

// return value is nil if function fails
function BTMemoryLoadLibary(var f_data: Pointer; const f_size: int64): PBTMemoryModule; stdcall;
// return value is nil if function fails
function BTMemoryGetProcAddress(var f_module: PBTMemoryModule; const f_name: PAnsiChar): Pointer; stdcall;
// free module
procedure BTMemoryFreeLibrary(var f_module: PBTMemoryModule); stdcall;
// returns last error
function BTMemoryGetLastError: AnsiString; stdcall;


implementation

uses
  // Borland Run-time Library
  SysUtils;

   {+++++++++++++++++++++++++++++++++++
    ***  Dll EntryPoint Definition  ***
    -----------------------------------}
type
  TDllEntryProc = function(hinstdll: THandle; fdwReason: DWORD; lpReserved: Pointer): BOOL; stdcall;


   {++++++++++++++++++++++++++++++++++++++++
    ***  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; // original: "Name: array [0..0] 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}

var
  lastErrStr: AnsiString;


   {+++++++++++++++++++++++++++++++++++++++++++++++++++++
    ***  Memory DLL loading functions Implementation  ***
    -----------------------------------------------------}

function BTMemoryGetLastError: AnsiString; stdcall;
begin
  Result := lastErrStr;
end;

function GetFieldOffset(const Struc; const Field): Cardinal; stdcall;
begin
  Result := Cardinal(@Field) - Cardinal(@Struc);
end;

function GetImageFirstSection(NtHeader: PImageNtHeaders): PImageSectionHeader; stdcall;
begin
  Result := PImageSectionHeader(Cardinal(NtHeader) +
    GetFieldOffset(NtHeader^, NtHeader^.OptionalHeader) +
    NtHeader^.FileHeader.SizeOfOptionalHeader);
end;

function GetHeaderDictionary(f_module: PBTMemoryModule; f_idx: integer): PImageDataDirectory; stdcall;
begin
  Result := PImageDataDirectory(@(f_module.headers.OptionalHeader.DataDirectory[f_idx]));
end;

function GetImageOrdinal(Ordinal: DWORD): Word; stdcall;
begin
  Result := Ordinal and $FFFF;
end;

function GetImageSnapByOrdinal(Ordinal: DWORD): Boolean; stdcall;
begin
  Result := ((Ordinal and IMAGE_ORDINAL_FLAG32) <> 0);
end;

procedure CopySections(const f_data: Pointer; const f_old_headers: TImageNtHeaders; f_module: PBTMemoryModule); stdcall;
var
  l_size, i: integer;
  l_codebase: Pointer;
  l_dest: Pointer;
  l_section: PImageSectionHeader;
begin
  l_codebase := f_module.codeBase;
  l_section := GetImageFirstSection(f_module.headers);
  for i := 0 to f_module.headers.FileHeader.NumberOfSections - 1 do begin
    // section doesn't contain data in the dll itself, but may define
    // uninitialized data
    if (l_section.SizeOfRawData = 0) then begin
      l_size := f_old_headers.OptionalHeader.SectionAlignment;
      if l_size > 0 then begin
        l_dest := VirtualAlloc(Pointer(Cardinal(l_codebase) + l_section.VirtualAddress), l_size, MEM_COMMIT, PAGE_READWRITE);
        l_section.Misc.PhysicalAddress := cardinal(l_dest);
        ZeroMemory(l_dest, l_size);
      end;
      inc(longword(l_section), sizeof(TImageSectionHeader));
      // Continue with the nex loop
      Continue;
    end;
    // commit memory block and copy data from dll
    l_dest := VirtualAlloc(Pointer(Cardinal(l_codebase) + l_section.VirtualAddress), l_section.SizeOfRawData, MEM_COMMIT, PAGE_READWRITE);
    CopyMemory(l_dest, Pointer(longword(f_data) + l_section.PointerToRawData), l_section.SizeOfRawData);
    l_section.Misc.PhysicalAddress := cardinal(l_dest);
    // IMAGE_SIZEOF_SECTION_HEADER
    inc(longword(l_section), sizeof(TImageSectionHeader));
  end;
end;

procedure PerformBaseRelocation(f_module: PBTMemoryModule; f_delta: Cardinal); stdcall;
var
  l_i: Cardinal;
  l_codebase: Pointer;
  l_directory: PImageDataDirectory;
  l_relocation: PImageBaseRelocation;
  l_dest: Pointer;
  l_relInfo: ^Word;
  l_patchAddrHL: ^DWord;
  l_type, l_offset: integer;
begin
  l_codebase := f_module.codeBase;
  l_directory := GetHeaderDictionary(f_module, IMAGE_DIRECTORY_ENTRY_BASERELOC);
  if l_directory.Size > 0 then begin
    l_relocation := PImageBaseRelocation(Cardinal(l_codebase) + l_directory.VirtualAddress);
    while l_relocation.VirtualAddress > 0 do begin
      l_dest := Pointer((Cardinal(l_codebase) + l_relocation.VirtualAddress));
      l_relInfo := Pointer(Cardinal(l_relocation) + IMAGE_SIZEOF_BASE_RELOCATION);
      for l_i := 0 to (trunc(((l_relocation.SizeOfBlock - IMAGE_SIZEOF_BASE_RELOCATION) / 2)) - 1) do begin
        // the upper 4 bits define the type of relocation
        l_type := (l_relInfo^ shr 12);
        // the lower 12 bits define the offset
        l_offset := l_relInfo^ and $FFF;
        //showmessage(inttostr(l_relInfo^));
        if l_type = IMAGE_REL_BASED_HIGHLOW then begin
          // change complete 32 bit address
          l_patchAddrHL := Pointer(Cardinal(l_dest) + Cardinal(l_offset));
          l_patchAddrHL^ := l_patchAddrHL^ + f_delta;
        end;
        inc(l_relInfo);
      end;
      l_relocation := Pointer(cardinal(l_relocation) + l_relocation.SizeOfBlock);
    end;
  end;
end;

function BuildImportTable(f_module: PBTMemoryModule): boolean; stdcall;
var
  l_codeBase: Pointer;
  l_directory: PImageDataDirectory;
  l_importDesc: PImageImportDescriptor;
  l_thunkRef, l_funcRef: ^DWORD;
  l_handle: HMODULE;
  l_temp: integer;
  l_thunkData: TImageImportByName;
begin
  Result := true;
  l_codeBase := f_module.codeBase;
  l_directory := GetHeaderDictionary(f_module, IMAGE_DIRECTORY_ENTRY_IMPORT);
  if (l_directory.Size > 0) then begin
    l_importDesc := PImageImportDescriptor(Cardinal(l_codeBase) + l_directory.VirtualAddress);
    while (not IsBadReadPtr(l_importDesc, sizeof(TImageImportDescriptor))) and (l_importDesc.Name <> 0) do begin
      l_handle := LoadLibraryA(PAnsiChar(Cardinal(l_codeBase) + l_importDesc.Name));
      if (l_handle = INVALID_HANDLE_VALUE) then begin
        lastErrStr := AnsiString('BuildImportTable: can''t load library: ') + PAnsiChar(Cardinal(l_codeBase) + l_importDesc.Name);
        Result := false;
        exit;
      end;
      // ReallocMemory crashes if "f_module.modules = nil"
      if f_module.modules = nil then
        f_module.modules := AllocMem(1);
      f_module.modules := ReallocMemory(f_module.modules, ((f_module.numModules + 1) * (sizeof(HMODULE))));
      if f_module.modules = nil then begin
        lastErrStr := 'BuildImportTable: ReallocMemory failed';
        result := false;
        exit;
      end;
      // module->modules[module->numModules++] = handle;
      l_temp := (sizeof(cardinal) * (f_module.numModules));
      inc(Cardinal(f_module.modules), l_temp);
      cardinal(f_module.modules^) := l_handle;
      dec(Cardinal(f_module.modules), l_temp);
      f_module.numModules := f_module.numModules + 1;
      if l_importDesc.OriginalFirstThunk <> 0 then begin
        l_thunkRef := Pointer(Cardinal(l_codeBase) + l_importDesc.OriginalFirstThunk);
        l_funcRef := Pointer(Cardinal(l_codeBase) + l_importDesc.FirstThunk);
      end else begin
        // no hint table
        l_thunkRef := Pointer(Cardinal(l_codeBase) + l_importDesc.FirstThunk);
        l_funcRef := Pointer(Cardinal(l_codeBase) + l_importDesc.FirstThunk);
      end;
      while l_thunkRef^ <> 0 do begin
        if GetImageSnapByOrdinal(l_thunkRef^) then
          l_funcRef^ := Cardinal(GetProcAddress(l_handle, PAnsiChar(GetImageOrdinal(l_thunkRef^))))
        else begin
          CopyMemory(@l_thunkData, Pointer(Cardinal(l_codeBase) + l_thunkRef^), sizeof(TImageImportByName));
          l_funcRef^ := Cardinal(GetProcAddress(l_handle, PAnsiChar(@(l_thunkData.Name))));
        end;
        if l_funcRef^ = 0 then begin
          lastErrStr := 'BuildImportTable: GetProcAddress failed';
          result := false;
          break;
        end;
        inc(l_funcRef);
        inc(l_thunkRef);
      end;
      inc(longword(l_importDesc), sizeof(TImageImportDescriptor));
    end;
  end;
end;

function GetSectionProtection(SC: cardinal): cardinal; stdcall;
//SC – ImageSectionHeader.Characteristics
begin
  result := 0;
  if (SC and IMAGE_SCN_MEM_NOT_CACHED) <> 0 then
    result := result or PAGE_NOCACHE;
  // E - Execute, R – Read , W – Write
  if (SC and IMAGE_SCN_MEM_EXECUTE) <> 0 //E ?
    then if (SC and IMAGE_SCN_MEM_READ) <> 0 //ER ?
    then if (SC and IMAGE_SCN_MEM_WRITE) <> 0 //ERW ?
      then result := result or PAGE_EXECUTE_READWRITE
      else result := result or PAGE_EXECUTE_READ
    else if (SC and IMAGE_SCN_MEM_WRITE) <> 0 //EW?
      then result := result or PAGE_EXECUTE_WRITECOPY
    else result := result or PAGE_EXECUTE
  else if (SC and IMAGE_SCN_MEM_READ) <> 0 // R?
    then if (SC and IMAGE_SCN_MEM_WRITE) <> 0 //RW?
    then result := result or PAGE_READWRITE
    else result := result or PAGE_READONLY
  else if (SC and IMAGE_SCN_MEM_WRITE) <> 0 //W?
    then result := result or PAGE_WRITECOPY
  else result := result or PAGE_NOACCESS;
end;

procedure FinalizeSections(f_module: PBTMemoryModule); stdcall;
var
  l_i: integer;
  l_section: PImageSectionHeader;
  l_protect, l_oldProtect, l_size: Cardinal;
begin
  l_section := GetImageFirstSection(f_module.headers);
  for l_i := 0 to f_module.headers.FileHeader.NumberOfSections - 1 do begin

    if (l_section.Characteristics and IMAGE_SCN_MEM_DISCARDABLE) <> 0 then begin
      // section is not needed any more and can safely be freed
      VirtualFree(Pointer(l_section.Misc.PhysicalAddress), l_section.SizeOfRawData, MEM_DECOMMIT);
      inc(longword(l_section), sizeof(TImageSectionHeader));
      continue;
    end;

    l_protect := GetSectionProtection(l_section.Characteristics);
    if (l_section.Characteristics and IMAGE_SCN_MEM_NOT_CACHED) <> 0 then
      l_protect := (l_protect or PAGE_NOCACHE);

    // determine size of region
    l_size := l_section.SizeOfRawData;
    if l_size = 0 then begin
      if (l_section.Characteristics and IMAGE_SCN_CNT_INITIALIZED_DATA) <> 0 then begin
        l_size := f_module.headers.OptionalHeader.SizeOfInitializedData;
      end else begin
        if (l_section.Characteristics and IMAGE_SCN_CNT_UNINITIALIZED_DATA) <> 0 then
          l_size := f_module.headers.OptionalHeader.SizeOfUninitializedData;
      end;
      if l_size > 0 then begin
        if not VirtualProtect(Pointer(l_section.Misc.PhysicalAddress), l_section.SizeOfRawData, l_protect, @l_oldProtect) then begin
          lastErrStr := 'FinalizeSections: VirtualProtect failed';
          exit;
        end;
      end;
    end;
    inc(longword(l_section), sizeof(TImageSectionHeader));
  end;
end;

function BTMemoryLoadLibary(var f_data: Pointer; const f_size: int64): PBTMemoryModule; stdcall;
var
  l_result: PBTMemoryModule;
  l_dos_header: TImageDosHeader;
  l_old_header: TImageNtHeaders;
  l_code, l_headers: Pointer;
  l_locationdelta: Cardinal;
  l_DllEntry: TDllEntryProc;
  l_successfull: boolean;
begin
  l_result := nil;
  Result := nil;
  try
    CopyMemory(@l_dos_header, f_data, sizeof(_IMAGE_DOS_HEADER));
    if (l_dos_header.e_magic <> IMAGE_DOS_SIGNATURE) then begin
      lastErrStr := 'BTMemoryLoadLibary: dll dos header is not valid';
      exit;
    end;
    CopyMemory(@l_old_header, pointer(longint(f_data) + l_dos_header._lfanew), sizeof(_IMAGE_NT_HEADERS));
    if l_old_header.Signature <> IMAGE_NT_SIGNATURE then begin
      lastErrStr := 'BTMemoryLoadLibary: IMAGE_NT_SIGNATURE is not valid';
      exit;
    end;
    // reserve memory for image of library
    l_code := VirtualAlloc(Pointer(l_old_header.OptionalHeader.ImageBase), l_old_header.OptionalHeader.SizeOfImage, MEM_RESERVE, PAGE_READWRITE);
    if l_code = nil then
        // try to allocate memory at arbitrary position
      l_code := VirtualAlloc(nil, l_old_header.OptionalHeader.SizeOfImage, MEM_RESERVE, PAGE_READWRITE);
    if l_code = nil then begin
      lastErrStr := 'BTMemoryLoadLibary: VirtualAlloc failed';
      exit;
    end;
    // alloc space for the result record
    l_result := PBTMemoryModule(HeapAlloc(GetProcessHeap(), 0, sizeof(TBTMemoryModule)));
    l_result.codeBase := l_code;
    l_result.numModules := 0;
    l_result.modules := nil;
    l_result.initialized := false;
    // xy: is it correct to commit the complete memory region at once?
    //     calling DllEntry raises an exception if we don't...
    VirtualAlloc(l_code, l_old_header.OptionalHeader.SizeOfImage, MEM_COMMIT, PAGE_READWRITE);
    // commit memory for headers
    l_headers := VirtualAlloc(l_code, l_old_header.OptionalHeader.SizeOfHeaders, MEM_COMMIT, PAGE_READWRITE);
    // copy PE header to code
    CopyMemory(l_headers, f_data, (Cardinal(l_dos_header._lfanew) + l_old_header.OptionalHeader.SizeOfHeaders));
    l_result.headers := PImageNtHeaders(longint(l_headers) + l_dos_header._lfanew);
    // update position
    l_result.headers.OptionalHeader.ImageBase := cardinal(l_code);
    // copy sections from DLL file block to new memory location
    CopySections(f_data, l_old_header, l_result);
    // adjust base address of imported data
    l_locationdelta := Cardinal(Cardinal(l_code) - l_old_header.OptionalHeader.ImageBase);
    if l_locationdelta <> 0 then
      PerformBaseRelocation(l_result, l_locationdelta);
    // load required dlls and adjust function table of imports
    if not BuildImportTable(l_result) then begin
      lastErrStr := lastErrStr + ' BTMemoryLoadLibary: BuildImportTable failed';
      Abort;
    end;
    // mark memory pages depending on section headers and release
    // sections that are marked as "discardable"
    FinalizeSections(l_result);
    // get entry point of loaded library
    if (l_result.headers.OptionalHeader.AddressOfEntryPoint) <> 0 then begin
      @l_DllEntry := Pointer(Cardinal(l_code) + l_result.headers.OptionalHeader.AddressOfEntryPoint);
      if @l_DllEntry = nil then begin
        lastErrStr := 'BTMemoryLoadLibary: Get DLLEntyPoint failed';
        Abort;
      end;
      l_successfull := l_DllEntry(Cardinal(l_code), DLL_PROCESS_ATTACH, nil);
      if not l_successfull then begin
        lastErrStr := 'BTMemoryLoadLibary: Can''t attach library';
        Abort;
      end;
      l_result.initialized := true;
    end;
  except
    BTMemoryFreeLibrary(l_result);
    exit;
  end;
  Result := l_result;
end;

function BTMemoryGetProcAddress(var f_module: PBTMemoryModule; const f_name: PAnsiChar): Pointer; stdcall;
var
  l_codeBase: Pointer;
  l_idx: integer;
  l_i: DWORD;
  l_nameRef: ^DWORD;
  l_ordinal: ^WORD;
  l_exports: PImageExportDirectory;
  l_directory: PImageDataDirectory;
  l_temp: ^DWORD;
begin
  Result := nil;
  l_codeBase := f_module.codeBase;
  l_idx := -1;
  l_directory := GetHeaderDictionary(f_module, IMAGE_DIRECTORY_ENTRY_EXPORT);
  if l_directory.Size = 0 then begin
    lastErrStr := 'BTMemoryGetProcAddress: no export table found';
    exit;
  end;
  l_exports := PImageExportDirectory(Cardinal(l_codeBase) + l_directory.VirtualAddress);
  if ((l_exports.NumberOfNames = 0) or (l_exports.NumberOfFunctions = 0)) then begin
    lastErrStr := 'BTMemoryGetProcAddress: DLL doesn''t export anything';
    exit;
  end;
  // search function name in list of exported names
  l_nameRef := Pointer(Cardinal(l_codeBase) + Cardinal(l_exports.AddressOfNames));
  l_ordinal := Pointer(Cardinal(l_codeBase) + Cardinal(l_exports.AddressOfNameOrdinals));
  for l_i := 0 to l_exports.NumberOfNames - 1 do begin
    if StrComp(f_name, PAnsiChar(Cardinal(l_codeBase) + l_nameRef^)) = 0 then begin
      l_idx := l_ordinal^;
      break;
    end;
    inc(l_nameRef);
    inc(l_ordinal);
  end;
  if (l_idx = -1) then begin
    lastErrStr := 'BTMemoryGetProcAddress: exported symbol not found';
    exit;
  end;
  if (Cardinal(l_idx) > l_exports.NumberOfFunctions - 1) then begin
    lastErrStr := 'BTMemoryGetProcAddress: name <-> ordinal number don''t match';
    exit;
  end;
  // AddressOfFunctions contains the RVAs to the "real" functions
  l_temp := Pointer(Cardinal(l_codeBase) + Cardinal(l_exports.AddressOfFunctions) + Cardinal((l_idx * 4)));
  Result := Pointer(Cardinal(l_codeBase) + l_temp^);
end;

procedure BTMemoryFreeLibrary(var f_module: PBTMemoryModule); stdcall;
var
  l_module: PBTMemoryModule;
  l_i: integer;
  l_temp: integer;
  l_DllEntry: TDllEntryProc;
begin
  l_module := f_module;
  if l_module <> nil then begin
    if l_module.initialized then begin
      @l_DllEntry := Pointer(Cardinal(l_module.codeBase) + l_module.headers.OptionalHeader.AddressOfEntryPoint);
      l_DllEntry(Cardinal(l_module.codeBase), DLL_PROCESS_DETACH, nil);
      l_module.initialized := false;
      // free previously opened libraries
      for l_i := 0 to l_module.numModules - 1 do begin
        l_temp := (sizeof(cardinal) * (l_i));
        inc(Cardinal(l_module.modules), l_temp);
        if Cardinal(f_module.modules^) <> INVALID_HANDLE_VALUE then
          FreeLibrary(Cardinal(f_module.modules^));
        dec(Cardinal(l_module.modules), l_temp);
      end;
      FreeMemory(l_module.modules);
      if l_module.codeBase <> nil then
        // release memory of library
        VirtualFree(l_module.codeBase, 0, MEM_RELEASE);
      HeapFree(GetProcessHeap(), 0, f_module);
      Pointer(f_module) := nil;
    end;
  end;
end;

end.