捐赠 | 广告 | 注册 | 发布 | 上传 | 关于我们    
  沪ICP备05001939号 DELPHI盒子 | 盒子论坛 | 盒子文章 | 盒子问答悬赏 | 最新更新 | 论坛检索 | 下载中心 | 高级搜索    
  精品专区 | 繁體中文 | 奖励公告栏 | 直通车账号登陆 | 关闭GOOGLE广告 | 临时留言    
 
广告
评论:7z压缩接口封装成控件(内存加载7Z.DLL 无需安装7Z和 7Z.DLL)
mytion 77624 2014/1/2 23:04:22
为什么没有源码?
lobtao 42806 2012/10/1 23:44:00
只解压其中的某个文件或某个文件夹,好像没有涉及到这一块
laohe 41690 2011/7/12 9:41:37
一份支持 D2010的MemLibrary.pas或(和)MemLibrary.dcu到我的邮箱可以吗?
heyongping@gmail.com

谢谢
wind7809 41354 2011/2/28 22:46:46
安装dpk时候提示找不到“MemLibLoader.pas”,还请高手指点一下
xiaoqionghui 40313 2010/6/25 9:38:51
求一份MemLibLoader.pas,麻烦发我一份 chyie@21cn.com  谢谢!!
gaoyong_gy 40309 2010/6/25 8:16:39
1、怎样实现进度条。
2、怎样实现加密,文件名也得加密。
希望作者改进,谢谢。
yhhe 40302 2010/6/24 17:53:32
把文件直接用7z压缩后保存流到数据库搞定了,但是把流从数据库中读取出来后直接解压到文件始终搞不定,必须把流读取出来后保存到文件然后读取该文件再解决。

不知是否有高手能搞定读取流直接解决到文件的问题?
james_ 40298 2010/6/24 11:55:20
dorry,干脆发布个dll版本吧:)
plantsoot 40297 2010/6/23 23:22:39
发一份支持 D2010的MemLibLoader.pas或(和)MemLibLoader.dcu到我的邮箱可以吗?

plantsoot@gmail.com

谢谢
plantsoot 40296 2010/6/23 23:21:19
发一份支持 D2010的MemLibrary.pas或(和)MemLibrary.dcu到我的邮箱可以吗?

plantsoot@gmail.com

谢谢
dorry 40285 2010/6/23 9:48:38
请到如下网址下载
http://cid-6e4d4d5bbb17a750.office.live.com/self.aspx/.Public/%e5%86%85%e5%ad%98%e8%a3%85%e8%bd%bdDLL.7z

http://cid-6e4d4d5bbb17a750.office.live.com/self.aspx/.Public/MemLibrary.pas
sail2000 40284 2010/6/23 4:42:07
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: PChar): Pointer; stdcall;
// free module
procedure BTMemoryFreeLibrary(var f_module: PBTMemoryModule); stdcall;
// returns last error
function BTMemoryGetLastError: string; 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: string;


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

function BTMemoryGetLastError: string; 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 := LoadLibrary(PChar(Cardinal(l_codeBase) + l_importDesc.Name));
      if (l_handle = INVALID_HANDLE_VALUE) then begin
        lastErrStr := 'BuildImportTable: can''t load library: ' + PChar(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, PChar(GetImageOrdinal(l_thunkRef^))))
        else begin
          CopyMemory(@l_thunkData, Pointer(Cardinal(l_codeBase) + l_thunkRef^), sizeof(TImageImportByName));
          l_funcRef^ := Cardinal(GetProcAddress(l_handle, PChar(@(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: PChar): 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, PChar(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.
aket 40282 2010/6/22 22:01:56
发到盒子上吧
ychsquid 40281 2010/6/22 18:07:56
同求MemLibLoader.pas
sx-squid@163.com
zwscool 40280 2010/6/22 17:00:25
想要一份MemLibLoader.pas,麻烦也发我一份 jonsankings@163.com
tjcfeng 40279 2010/6/22 15:28:17
想要一份MemLibLoader.pas,麻烦您给我发一份,谢谢。
tjCFeng@126.com
dorry 40276 2010/6/22 13:05:50
DELPHI 2010 中报错:
[DCC Fatal Error] sevenzip.pas(612): F2063 Could not compile used unit 'MemLibLoader.pas'

to plantsoot
你可以下载风铃夜思雨的 'MemLibLoader.pas'的D2010 支持版。
如果需要我可以发给你!
james_ 40274 2010/6/22 12:49:03
格式化部分缩进不太理想,如:
          if NodeChar = StringChar then
          begin
          LastNode := Node;
          Node := Node^.Next;
          end
是D2010格式化的?
yayongm 40273 2010/6/22 10:42:36
//格式化一下:
{ **********
  *          *
  * DLL linking is provided by Benjamin Rosseaux, www.0ok.de,          *
  * mailto:benjamin@0ok.de          *
  *          *
  * This DLL Loader code is coyyrighted: (C) 2004, Benjamin Rosseaux      *
  *          *
  ********** }

unit DLLLoader;

interface

uses
  Windows, Classes;

const
  IMPORTED_NAME_OFFSET = $00000002;
  IMAGE_ORDINAL_FLAG32 = $80000000;
  IMAGE_ORDINAL_MASK32 = $0000FFFF;

  RTL_CRITSECT_TYPE = 0;
  RTL_RESOURCE_TYPE = 1;

  DLL_PROCESS_ATTACH = 1;
  DLL_THREAD_ATTACH = 2;
  DLL_THREAD_DETACH = 3;
  DLL_PROCESS_DETACH = 0;

  IMAGE_SizeHeader = 20;

  IMAGE_FILE_RELOCS_STRIPPED = $0001;
  IMAGE_FILE_EXECUTABLE_IMAGE = $0002;
  IMAGE_FILE_LINE_NUMS_STRIPPED = $0004;
  IMAGE_FILE_LOCAL_SYMS_STRIPPED = $0008;
  IMAGE_FILE_AGGRESIVE_WS_TRIM = $0010;
  IMAGE_FILE_BYTES_REVERSED_LO = $0080;
  IMAGE_FILE_32BIT_MACHINE = $0100;
  IMAGE_FILE_DEBUG_STRIPPED = $0200;
  IMAGE_FILE_REMOVABLE_RUN_FROM_SWAP = $0400;
  IMAGE_FILE_NET_RUN_FROM_SWAP = $0800;
  IMAGE_FILE_SYSTEM = $1000;
  IMAGE_FILE_DLL = $2000;
  IMAGE_FILE_UP_SYSTEM_ONLY = $4000;
  IMAGE_FILE_BYTES_REVERSED_HI = $8000;

  IMAGE_FILE_MACHINE_UNKNOWN = 0;
  IMAGE_FILE_MACHINE_I386 = $14C;
  IMAGE_FILE_MACHINE_R3000 = $162;
  IMAGE_FILE_MACHINE_R4000 = $166;
  IMAGE_FILE_MACHINE_R10000 = $168;
  IMAGE_FILE_MACHINE_ALPHA = $184;
  IMAGE_FILE_MACHINE_POWERPC = $1F0;

  IMAGE_NUMBEROF_DIRECTORY_ENTRIES = 16;

  IMAGE_SUBSYSTEM_UNKNOWN = 0;
  IMAGE_SUBSYSTEM_NATIVE = 1;
  IMAGE_SUBSYSTEM_WINdoWS_GUI = 2;
  IMAGE_SUBSYSTEM_WINdoWS_CUI = 3;
  IMAGE_SUBSYSTEM_OS2_CUI = 5;
  IMAGE_SUBSYSTEM_POSIX_CUI = 7;
  IMAGE_SUBSYSTEM_RESERVED = 8;

  IMAGE_DIRECTORY_ENTRY_EXPORT = 0;
  IMAGE_DIRECTORY_ENTRY_IMPORT = 1;
  IMAGE_DIRECTORY_ENTRY_RESOURCE = 2;
  IMAGE_DIRECTORY_ENTRY_EXCEPTION = 3;
  IMAGE_DIRECTORY_ENTRY_SECURITY = 4;
  IMAGE_DIRECTORY_ENTRY_BASERELOC = 5;
  IMAGE_DIRECTORY_ENTRY_DEBUG = 6;
  IMAGE_DIRECTORY_ENTRY_COPYRIGHT = 7;
  IMAGE_DIRECTORY_ENTRY_GLOBALPTR = 8;
  IMAGE_DIRECTORY_ENTRY_TLS = 9;
  IMAGE_DIRECTORY_ENTRY_LOAD_CONFIG = 10;
  IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT = 11;
  IMAGE_DIRECTORY_ENTRY_IAT = 12;

  IMAGE_SIZEOF_SHORT_NAME = 8;

  IMAGE_SCN_TYIMAGE_REG = $00000000;
  IMAGE_SCN_TYIMAGE_DSECT = $00000001;
  IMAGE_SCN_TYIMAGE_NOLOAD = $00000002;
  IMAGE_SCN_TYIMAGE_GROUP = $00000004;
  IMAGE_SCN_TYIMAGE_NO_PAD = $00000008;
  IMAGE_SCN_TYIMAGE_COPY = $00000010;
  IMAGE_SCN_CNT_CODE = $00000020;
  IMAGE_SCN_CNT_INITIALIZED_DATA = $00000040;
  IMAGE_SCN_CNT_UNINITIALIZED_DATA = $00000080;
  IMAGE_SCN_LNK_OTHER = $00000100;
  IMAGE_SCN_LNK_INFO = $00000200;
  IMAGE_SCN_TYIMAGE_OVER = $0000400;
  IMAGE_SCN_LNK_REMOVE = $00000800;
  IMAGE_SCN_LNK_COMDAT = $00001000;
  IMAGE_SCN_MEM_PROTECTED = $00004000;
  IMAGE_SCN_MEM_FARDATA = $00008000;
  IMAGE_SCN_MEM_SYSHEAP = $00010000;
  IMAGE_SCN_MEM_PURGEABLE = $00020000;
  IMAGE_SCN_MEM_16BIT = $00020000;
  IMAGE_SCN_MEM_LOCKED = $00040000;
  IMAGE_SCN_MEM_PRELOAD = $00080000;
  IMAGE_SCN_ALIGN_1ByteS = $00100000;
  IMAGE_SCN_ALIGN_2ByteS = $00200000;
  IMAGE_SCN_ALIGN_4ByteS = $00300000;
  IMAGE_SCN_ALIGN_8ByteS = $00400000;
  IMAGE_SCN_ALIGN_16ByteS = $00500000;
  IMAGE_SCN_ALIGN_32ByteS = $00600000;
  IMAGE_SCN_ALIGN_64ByteS = $00700000;
  IMAGE_SCN_LNK_NRELOC_OVFL = $01000000;
  IMAGE_SCN_MEM_DISCARDABLE = $02000000;
  IMAGE_SCN_MEM_NOT_CACHED = $04000000;
  IMAGE_SCN_MEM_NOT_PAGED = $08000000;
  IMAGE_SCN_MEM_SHARED = $10000000;
  IMAGE_SCN_MEM_EXECUTE = $20000000;
  IMAGE_SCN_MEM_READ = $40000000;
  IMAGE_SCN_MEM_WRITE = LongWord($80000000);

  IMAGE_REL_BASED_ABSOLUTE = 0;
  IMAGE_REL_BASED_HIGH = 1;
  IMAGE_REL_BASED_LOW = 2;
  IMAGE_REL_BASED_HIGHLOW = 3;
  IMAGE_REL_BASED_HIGHADJ = 4;
  IMAGE_REL_BASED_MIPS_JMPADDR = 5;
  IMAGE_REL_BASED_SECTION = 6;
  IMAGE_REL_BASED_REL32 = 7;

  IMAGE_REL_BASED_MIPS_JMPADDR16 = 9;
  IMAGE_REL_BASED_IA64_IMM64 = 9;
  IMAGE_REL_BASED_DIR64 = 10;
  IMAGE_REL_BASED_HIGH3ADJ = 11;

  PAGE_NOACCESS = 1;
  PAGE_REAdoNLY = 2;
  PAGE_READWRITE = 4;
  PAGE_WRITECOPY = 8;
  PAGE_EXECUTE = $10;
  PAGE_EXECUTE_READ = $20;
  PAGE_EXECUTE_READWRITE = $40;
  PAGE_EXECUTE_WRITECOPY = $80;
  PAGE_GUARD = $100;
  PAGE_NOCACHE = $200;
  MEM_COMMIT = $1000;
  MEM_RESERVE = $2000;
  MEM_DECOMMIT = $4000;
  MEM_RELEASE = $8000;
  MEM_FREE = $10000;
  MEM_PRIVATE = $20000;
  MEM_MAPPED = $40000;
  MEM_RESET = $80000;
  MEM_TOP_doWN = $100000;
  SEC_FILE = $800000;
  SEC_IMAGE = $1000000;
  SEC_RESERVE = $4000000;
  SEC_COMMIT = $8000000;
  SEC_NOCACHE = $10000000;
  MEM_IMAGE = SEC_IMAGE;

type
  PPointer = ^Pointer;

  PLongWord = ^LongWord;
  PPLongWord = ^PLongWord;

  PWORD = ^WORD;
  PPWORD = ^PWord;

  HInst = LongWord;
  HMODULE = HInst;

  PWordArray = ^TWordArray;
  TWordArray = array [0..(2147483647 div SizeOf(WORD)) - 1] of WORD;

  PLongWordArray = ^TLongWordArray;
  TLongWordArray = array [0..(2147483647 div SizeOf(LongWord)) - 1] of LongWord;

  PImagedoSHeader = ^TImagedoSHeader;

  TImagedoSHeader = packed record
    Signature: Word;
    PartPag: Word;
    PageCnt: Word;
    ReloCnt: Word;
    HdrSize: Word;
    MinMem: Word;
    MaxMem: Word;
    ReloSS: Word;
    ExeSP: Word;
    ChkSum: Word;
    ExeIP: Word;
    ReloCS: Word;
    TablOff: Word;
    Overlay: Word;
    Reserved: packed array [0 .. 3] of WORD;
    OEMID: Word;
    OEMInfo: Word;
    Reserved2: packed array [0 .. 9] of WORD;
    LFAOffset: LongWord;
  end;

  TISHMisc = packed record
    case Integer of
      0:
        (PhysicalAddress: LongWord);
      1:
        (VirtualSize: LongWord);
  end;

  PImageExportDirectory = ^TImageExportDirectory;

  TImageExportDirectory = packed record
    Characteristics: LongWord;
    TimeDateStamp: LongWord;
    MajorVersion: Word;
    MinorVersion: Word;
    Name: LongWord;
    Base: LongWord;
    NumberOffunctions: LongWord;
    NumberOfNames: LongWord;
    AddressOffunctions: PPLongWord;
    AddressOfNames: PPLongWord;
    AddressOfNameOrdinals: PPWORD;
  end;

  PImageSectionHeader = ^TImageSectionHeader;

  TImageSectionHeader = packed record
    Name: packed array [0 .. IMAGE_SizeOf_SHORT_NAME - 1] of Byte;
    Misc: TISHMisc;
    VirtualAddress: LongWord;
    SizeOfRawData: LongWord;
    PointerToRawData: LongWord;
    PointerToRelocations: LongWord;
    PointerToLinenumbers: LongWord;
    NumberOfRelocations: Word;
    NumberOfLinenumbers: Word;
    Characteristics: LongWord;
  end;

  PImageSectionHeaders = ^TImageSectionHeaders;
  TImageSectionHeaders = array [0..(2147483647 div SizeOf(TImageSectionHeader)) - 1] of TImageSectionHeader;

  PImageDataDirectory = ^TImageDataDirectory;

  TImageDataDirectory = packed record
    VirtualAddress: LongWord;
    Size: LongWord;
  end;

  PImageFileHeader = ^TImageFileHeader;

  TImageFileHeader = packed record
    Machine: Word;
    NumberOfSections: Word;
    TimeDateStamp: LongWord;
    PointerToSymbolTable: LongWord;
    NumberOfSymbols: LongWord;
    SizeOfOptionalHeader: Word;
    Characteristics: Word;
  end;

  PImageOptionalHeader = ^TImageOptionalHeader;

  TImageOptionalHeader = packed record
    Magic: Word;
    MajorLinkerVersion: Byte;
    MinorLinkerVersion: Byte;
    SizeOfCode: LongWord;
    SizeOfInitializedData: LongWord;
    SizeOfUninitializedData: LongWord;
    AddressOfEntryPoint: LongWord;
    BaseOfCode: LongWord;
    BaseOfData: LongWord;
    ImageBase: LongWord;
    SectionAlignment: LongWord;
    FileAlignment: LongWord;
    MajorOperatingSystemVersion: Word;
    MinorOperatingSystemVersion: Word;
    MajorImageVersion: Word;
    MinorImageVersion: Word;
    MajorSubsystemVersion: Word;
    MinorSubsystemVersion: Word;
    Win32VersionValue: LongWord;
    SizeOfImage: LongWord;
    SizeOfHeaders: LongWord;
    CheckSum: LongWord;
    Subsystem: Word;
    DllCharacteristics: Word;
    SizeOfStackReserve: LongWord;
    SizeOfStackCommit: LongWord;
    SizeOfHeapReserve: LongWord;
    SizeOfHeapCommit: LongWord;
    LoaderFlags: LongWord;
    NumberOfRvaAndSizes: LongWord;
    DataDirectory: packed array [0..IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1] of TImageDataDirectory;
  end;

  PImageNTHeaders = ^TImageNTHeaders;

  TImageNTHeaders = packed record
    Signature: LongWord;
    FileHeader: TImageFileHeader;
    OptionalHeader: TImageOptionalHeader;
  end;

  PImageImportDescriptor = ^TImageImportDescriptor;

  TImageImportDescriptor = packed record
    OriginalFirstThunk: LongWord;
    TimeDateStamp: LongWord;
    ForwarderChain: LongWord;
    Name: LongWord;
    FirstThunk: LongWord;
  end;

  PImageBaseRelocation = ^TImageBaseRelocation;

  TImageBaseRelocation = packed record
    VirtualAddress: LongWord;
    SizeOfBlock: LongWord;
  end;

  PImageThunkData = ^TImageThunkData;

  TImageThunkData = packed record
    ForwarderString: LongWord;
    Funktion: LongWord;
    Ordinal: LongWord;
    AddressOfData: LongWord;
  end;

  PSection = ^TSection;

  TSection = packed record
    Base: Pointer;
    RVA: LongWord;
    Size: LongWord;
    Characteristics: LongWord;
  end;

  TSections = array of TSection;

  TDLLEntryProc = function(HInstDLL: HMODULE; dwReason: LongWord;
    lpvReserved: Pointer): Boolean; stdcall;

  TNameOrID = (niName, niID);

  TExternalLibrary = record
    LibraryName: string;
    LibraryHandle: HInst;
  end;

  TExternalLibrarys = array of TExternalLibrary;

  PDLLfunctionImport = ^TDLLfunctionImport;

  TDLLfunctionImport = record
    NameOrID: TNameOrID;
    Name: string;
    ID: Integer;
  end;

  PDLLImport = ^TDLLImport;

  TDLLImport = record
    LibraryName: string;
    LibraryHandle: HInst;
    Entries: array of TDLLfunctionImport;
  end;

  TImports = array of TDLLImport;

  PDLLfunctionExport = ^TDLLfunctionExport;

  TDLLfunctionExport = record
    Name: string;
    Index: Integer;
    functionPointer: Pointer;
  end;

  TExports = array of TDLLfunctionExport;

  TExportTreeLink = Pointer;

  PExportTreeNode = ^TExportTreeNode;

  TExportTreeNode = record
    TheChar: Char;
    Link: TExportTreeLink;
    LinkExist: Boolean;
    Prevoius, Next, Up, Down: PExportTreeNode;
  end;

  TExportTree = class
  private
    Root: PExportTreeNode;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Dump;
    function Add(functionName: string; Link: TExportTreeLink): Boolean;
    function Delete(functionName: string): Boolean;
    function Find(functionName: string; var Link: TExportTreeLink): Boolean;
  end;

  TDLLLoader = class
  private
    ImageBase: Pointer;
    ImageBaseDelta: Integer;
    DLLProc: TDLLEntryProc;
    ExternalLibraryArray: TExternalLibrarys;
    ImportArray: TImports;
    ExportArray: TExports;
    Sections: TSections;
    ExportTree: TExportTree;
    function FindExternalLibrary(LibraryName: string): Integer;
    function LoadExternalLibrary(LibraryName: string): Integer;
    function GetExternalLibraryHandle(LibraryName: string): HInst;
  public
    constructor Create;
    destructor Destroy; override;
    function Load(Stream: TStream): Boolean;
    function Unload: Boolean;
    function FindExport(functionName: string): Pointer;
    function FindExportPerIndex(functionIndex: Integer): Pointer;
    function GetExportList: TStringList;
  end;

implementation

function StrToInt(S: string): Integer;
var
  C: Integer;
begin
  Val(S, Result, C);
end;

function CreateExportTreeNode(AChar: Char): PExportTreeNode;
begin
  GetMem(RESULT, SizeOf(TExportTreeNode));
  Result^.TheChar := AChar;
  Result^.Link := nil;
  Result^.LinkExist := False;
  Result^.Prevoius := nil;
  Result^.Next := nil;
  Result^.Up := nil;
  Result^.Down := nil;
end;

procedure DestroyExportTreeNode(Node: PExportTreeNode);
begin
  if Assigned(Node) then
  begin
    DestroyExportTreeNode(Node^.Next);
    DestroyExportTreeNode(Node^.Down);
    FreeMem(Node);
  end;
end;

constructor TExportTree.Create;
begin
  inherited Create;
  Root := nil;
end;

destructor TExportTree.Destroy;
begin
  DestroyExportTreeNode(Root);
  inherited Destroy;
end;

procedure TExportTree.Dump;
var
  Ident: Integer;

  procedure DumpNode(Node: PExportTreeNode);
  var
    SubNode: PExportTreeNode;
    IdentCounter, IdentOld: Integer;
  begin
    for IdentCounter := 1 to Ident do
      Write(' ');
    Write(Node^.TheChar);
    IdentOld := Ident;
    SubNode := Node^.Next;
    while Assigned(SubNode) do
    begin
      Write(SubNode.TheChar);
      if not Assigned(SubNode^.Next) then
        break;
      Inc(Ident);
      SubNode := SubNode^.Next;
    end;
    Writeln;
    Inc(Ident);
    while Assigned(SubNode) and (SubNode <> Node) do
    begin
      if Assigned(SubNode^.Down) then
        DumpNode(SubNode^.Down);
      SubNode := SubNode^.Prevoius;
      Dec(Ident);
    end;
    Ident := IdentOld;
    if Assigned(Node^.Down) then
      DumpNode(Node^.Down);
  end;

begin
  Ident := 0;
  DumpNode(Root);
end;

function TExportTree.Add(FunctionName: string; Link: TExportTreeLink): Boolean;
var
  StringLength, Position, PositionCounter: Integer;
  NewNode, LastNode, Node: PExportTreeNode;
  StringChar, NodeChar: Char;
begin
  Result := False;
  StringLength := Length(FunctionName);
  if StringLength > 0 then
  begin
    LastNode := nil;
    Node := Root;
    for Position := 1 to StringLength do
    begin
      StringChar := FunctionName[Position];
      if Assigned(Node) then
      begin
        NodeChar := Node^.TheChar;
        if NodeChar = StringChar then
        begin
          LastNode := Node;
          Node := Node^.Next;
        end
        else
        begin
          while (NodeChar < StringChar) and Assigned(Node^.Down) do
          begin
          Node := Node^.Down;
          NodeChar := Node^.TheChar;
          end;

          if NodeChar = StringChar then
          begin
          LastNode := Node;
          Node := Node^.Next;
          end
          else
          begin
          NewNode := CreateExportTreeNode(StringChar);
          if NodeChar < StringChar then
          begin
          NewNode^.Down := Node^.Down;
          NewNode^.Up := Node;
          if Assigned(NewNode^.Down) then
          begin
          NewNode^.Down^.Up := NewNode;
          end;
          NewNode^.Prevoius := Node^.Prevoius;
          Node^.Down := NewNode;
          end
          else if NodeChar > StringChar then
          begin
          NewNode^.Down := Node;
          NewNode^.Up := Node^.Up;
          if Assigned(NewNode^.Up) then
          begin
          NewNode^.Up^.Down := NewNode;
          end;
          NewNode^.Prevoius := Node^.Prevoius;
          if not Assigned(NewNode^.Up) then
          begin
          if Assigned(NewNode^.Prevoius) then
          begin
          NewNode^.Prevoius^.Next := NewNode;
          end
          else
          begin
          Root := NewNode;
          end;
          end;
          Node^.Up := NewNode;
          end;
          LastNode := NewNode;
          Node := LastNode^.Next;
          end;
        end;
      end
      else
      begin
        for PositionCounter := Position to StringLength do
        begin
          NewNode := CreateExportTreeNode(functionName[PositionCounter]);
          if Assigned(LastNode) then
          begin
          NewNode^.Prevoius := LastNode;
          LastNode^.Next := NewNode;
          LastNode := LastNode^.Next;
          end
          else
          begin
          if not Assigned(Root) then
          begin
          Root := NewNode;
          LastNode := Root;
          end;
          end;
        end;
        break;
      end;
    end;

    if Assigned(LastNode) then
    begin
      if not LastNode^.LinkExist then
      begin
        LastNode^.Link := Link;
        LastNode^.LinkExist := True;
        Result := True;
      end;
    end;
  end;
end;

function TExportTree.Delete(FunctionName: string): Boolean;
var
  StringLength, Position: Integer;
  Node: PExportTreeNode;
  StringChar, NodeChar: Char;
begin
  Result := False;
  StringLength := Length(FunctionName);
  if StringLength > 0 then
  begin
    Node := Root;
    for Position := 1 to StringLength do
    begin
      StringChar := FunctionName[Position];
      if Assigned(Node) then
      begin
        NodeChar := Node^.TheChar;
        while (NodeChar <> StringChar) and Assigned(Node^.Down) do
        begin
          Node := Node^.Down;
          NodeChar := Node^.TheChar;
        end;
        if NodeChar = StringChar then
        begin
          if (Position = StringLength) and Node^.LinkExist then
          begin
          Node^.LinkExist := False;
          Result := True;
          break;
          end;
          Node := Node^.Next;
        end;
      end
      else
      begin
        break;
      end;
    end;
  end;
end;

function TExportTree.Find(FunctionName: string; var Link: TExportTreeLink): Boolean;
var
  StringLength, Position: Integer;
  Node: PExportTreeNode;
  StringChar, NodeChar: Char;
begin
  Result := False;
  StringLength := Length(FunctionName);
  if StringLength > 0 then
  begin
    Node := Root;
    for Position := 1 to StringLength do
    begin
      StringChar := FunctionName[Position];
      if Assigned(Node) then
      begin
        NodeChar := Node^.TheChar;
        while (NodeChar <> StringChar) and Assigned(Node^.Down) do
        begin
          Node := Node^.Down;
          NodeChar := Node^.TheChar;
        end;
        if NodeChar = StringChar then
        begin
          if (Position = StringLength) and Node^.LinkExist then
          begin
          Link := Node^.Link;
          Result := True;
          break;
          end;
          Node := Node^.Next;
        end;
      end
      else
      begin
        break;
      end;
    end;
  end;
end;

constructor TDLLLoader.Create;
begin
  inherited Create;

  ImageBase := nil;
  DLLProc := nil;
  ExternalLibraryArray := nil;
  ImportArray := nil;
  ExportArray := nil;
  Sections := nil;
  ExportTree := nil;
end;

destructor TDLLLoader.Destroy;
begin
  if @DLLProc <> nil then
    Unload;
  if Assigned(ExportTree) then
    ExportTree.Destroy;

  inherited Destroy;
end;

function TDLLLoader.FindExternalLibrary(LibraryName: string): Integer;
var
  I: Integer;
begin
  Result := -1;

  for I := 0 to Length(ExternalLibraryArray) - 1 do
  begin
    if ExternalLibraryArray[I].LibraryName = LibraryName then
    begin
      Result := I;
      exit;
    end;
  end;
end;

function TDLLLoader.LoadExternalLibrary(LibraryName: string): Integer;
begin
  Result := FindExternalLibrary(LibraryName);

  if Result < 0 then
  begin
    Result := Length(ExternalLibraryArray);
    SetLength(ExternalLibraryArray, Length(ExternalLibraryArray) + 1);
    ExternalLibraryArray[RESULT].LibraryName := LibraryName;
    ExternalLibraryArray[RESULT].LibraryHandle := LoadLibrary(PChar(LibraryName));
  end;
end;

function TDLLLoader.GetExternalLibraryHandle(LibraryName: string): LongWord;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to Length(ExternalLibraryArray) - 1 do
  begin
    if ExternalLibraryArray[I].LibraryName = LibraryName then
    begin
      Result := ExternalLibraryArray[I].LibraryHandle;
      exit;
    end;
  end;
end;

function TDLLLoader.Load(Stream: TStream): Boolean;
var
  ImagedoSHeader: TImagedoSHeader;
  ImageNTHeaders: TImageNTHeaders;
  OldProtect: LongWord;

  function ConvertPointer(RVA: LongWord): Pointer;
  var
    I: Integer;
  begin
    Result := nil;
    for I := 0 to Length(Sections) - 1 do
    begin
      if (RVA < (Sections[I].RVA + Sections[I].Size)) and
        (RVA >= Sections[I].RVA) then
      begin
        Result := Pointer(LongWord((RVA - LongWord(Sections[I].RVA)) +
          LongWord(Sections[I].Base)));
        exit;
      end;
    end;
  end;

  function ReadImageHeaders: Boolean;
  begin
    Result := False;
    if Stream.Size > 0 then
    begin
      FillChar(ImageNTHeaders, SizeOf(TImageNTHeaders), #0);
      if Stream.Read(ImagedoSHeader, SizeOf(TImagedoSHeader)) <>
        SizeOf(TImagedoSHeader) then
        exit;
      if ImagedoSHeader.Signature <> $5A4D then
        exit;
      if Stream.Seek(ImagedoSHeader.LFAOffset, soFromBeginning) <>
        LongInt(ImagedoSHeader.LFAOffset) then
        exit;
      if Stream.Read(ImageNTHeaders.Signature, SizeOf(LongWord)) <>
        SizeOf(LongWord) then
        exit;
      if ImageNTHeaders.Signature <> $00004550 then
        exit;
      if Stream.Read(ImageNTHeaders.FileHeader, SizeOf(TImageFileHeader)) <>
        SizeOf(TImageFileHeader) then
        exit;
      if ImageNTHeaders.FileHeader.Machine <> $14C then
        exit;
      if Stream.Read(ImageNTHeaders.OptionalHeader,
        ImageNTHeaders.FileHeader.SizeOfOptionalHeader)
        <> ImageNTHeaders.FileHeader.SizeOfOptionalHeader then
        exit;

      Result := True;
    end;
  end;

  function InitializeImage: Boolean;
  var
    SectionBase: Pointer;
    OldPosition: Integer;
  begin
    Result := False;
    if ImageNTHeaders.FileHeader.NumberOfSections > 0 then
    begin
      ImageBase := VirtualAlloc(nil, ImageNTHeaders.OptionalHeader.SizeOfImage,
        MEM_RESERVE, PAGE_NOACCESS);
      ImageBaseDelta := LongWord(ImageBase) -
        ImageNTHeaders.OptionalHeader.ImageBase;
      SectionBase := VirtualAlloc(ImageBase,
        ImageNTHeaders.OptionalHeader.SizeOfHeaders, MEM_COMMIT,
        PAGE_READWRITE);
      OldPosition := Stream.Position;
      Stream.Seek(0, soFromBeginning);
      Stream.Read(SectionBase^, ImageNTHeaders.OptionalHeader.SizeOfHeaders);
      VirtualProtect(SectionBase, ImageNTHeaders.OptionalHeader.SizeOfHeaders,
        PAGE_REAdoNLY, OldProtect);
      Stream.Seek(OldPosition, soFromBeginning);

      Result := True;
    end;
  end;

  function ReadSections: Boolean;
  var
    I: Integer;
    Section: TImageSectionHeader;
    SectionHeaders: PImageSectionHeaders;
  begin
    Result := False;

    if ImageNTHeaders.FileHeader.NumberOfSections > 0 then
    begin
      GetMem(SectionHeaders,
        ImageNTHeaders.FileHeader.NumberOfSections * SizeOf
          (TImageSectionHeader));
      if Stream.Read(SectionHeaders^,
        (ImageNTHeaders.FileHeader.NumberOfSections * SizeOf
          (TImageSectionHeader))) <>
        (ImageNTHeaders.FileHeader.NumberOfSections * SizeOf
          (TImageSectionHeader)) then
        exit;
      SetLength(Sections, ImageNTHeaders.FileHeader.NumberOfSections);
      for I := 0 to ImageNTHeaders.FileHeader.NumberOfSections - 1 do
      begin
        Section := SectionHeaders^[I];
        Sections[I].RVA := Section.VirtualAddress;
        Sections[I].Size := Section.SizeOfRawData;
        if Sections[I].Size < Section.Misc.VirtualSize then
        begin
          Sections[I].Size := Section.Misc.VirtualSize;
        end;
        Sections[I].Characteristics := Section.Characteristics;
        Sections[I].Base := VirtualAlloc
          (Pointer(LongWord(Sections[I].RVA + LongWord(ImageBase))),
          Sections[I].Size, MEM_COMMIT, PAGE_READWRITE);
        FillChar(Sections[I].Base^, Sections[I].Size, #0);
        if Section.PointerToRawData <> 0 then
        begin
          Stream.Seek(Section.PointerToRawData, soFromBeginning);
          if Stream.Read(Sections[I].Base^, Section.SizeOfRawData) <> LongInt
          (Section.SizeOfRawData) then
          exit;
        end;
      end;
      FreeMem(SectionHeaders);

      Result := True;
    end;
  end;

  function ProcessRelocations: Boolean;
  var
    Relocations: PChar;
    Position: LongWord;
    BaseRelocation: PImageBaseRelocation;
    Base: Pointer;
    NumberOfRelocations: LongWord;
    Relocation: PWordArray;
    RelocationCounter: LongInt;
    RelocationPointer: Pointer;
    RelocationType: LongWord;
  begin
    if ImageNTHeaders.OptionalHeader.DataDirectory
      [IMAGE_DIRECTORY_ENTRY_BASERELOC].VirtualAddress <> 0 then
    begin
      Result := False;
      Relocations := ConvertPointer(ImageNTHeaders.OptionalHeader.DataDirectory
          [IMAGE_DIRECTORY_ENTRY_BASERELOC].VirtualAddress);
      Position := 0;
      while Assigned(Relocations) and
        (Position < ImageNTHeaders.OptionalHeader.DataDirectory
          [IMAGE_DIRECTORY_ENTRY_BASERELOC].Size) do
      begin
        BaseRelocation := PImageBaseRelocation(Relocations);
        Base := ConvertPointer(BaseRelocation^.VirtualAddress);
        if not Assigned(Base) then
          exit;
        NumberOfRelocations := (BaseRelocation^.SizeOfBlock - SizeOf
          (TImageBaseRelocation)) div SizeOf(WORD);
        Relocation := Pointer(LongWord(LongWord(BaseRelocation) + SizeOf
          (TImageBaseRelocation)));
        for RelocationCounter := 0 to NumberOfRelocations - 1 do
        begin
          RelocationPointer := Pointer
          (LongWord(LongWord(Base) + (Relocation^[RelocationCounter]
          and $FFF)));
          RelocationType := Relocation^[RelocationCounter] shr 12;
          case RelocationType of
          IMAGE_REL_BASED_ABSOLUTE:
          begin
          end;
          IMAGE_REL_BASED_HIGH:
          begin
          PWORD(RelocationPointer)^ :=
          (LongWord(((LongWord(PWORD(RelocationPointer)^ + LongWord
          (ImageBase)
          - ImageNTHeaders.OptionalHeader.ImageBase))))
          shr 16) and $FFFF;
          end;
          IMAGE_REL_BASED_LOW:
          begin
          PWORD(RelocationPointer)^ := LongWord
          (((LongWord(PWORD(RelocationPointer)^ + LongWord(ImageBase)
          - ImageNTHeaders.OptionalHeader.ImageBase))))
          and $FFFF;
          end;
          IMAGE_REL_BASED_HIGHLOW:
          begin
          PPointer(RelocationPointer)^ := Pointer
          ((LongWord(LongWord(PPointer(RelocationPointer)^) + LongWord
          (ImageBase) - ImageNTHeaders.OptionalHeader.ImageBase))
          );
          end;
          IMAGE_REL_BASED_HIGHADJ:
          begin
          // ???
          end;
          IMAGE_REL_BASED_MIPS_JMPADDR:
          begin
          // Only for MIPS CPUs ;)
          end;
          end;
        end;
        Relocations := Pointer
          (LongWord(LongWord(Relocations) + BaseRelocation^.SizeOfBlock));
        Inc(Position, BaseRelocation^.SizeOfBlock);
      end;
    end;

    Result := True;
  end;

  function ProcessImports: Boolean;
  var
    ImportDescriptor: PImageImportDescriptor;
    ThunkData: PLongWord;
    Name: PChar;
    DLLImport: PDLLImport;
    DLLfunctionImport: PDLLfunctionImport;
    functionPointer: Pointer;
  begin
    if ImageNTHeaders.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT]
      .VirtualAddress <> 0 then
    begin
      ImportDescriptor := ConvertPointer
        (ImageNTHeaders.OptionalHeader.DataDirectory
          [IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress);
      if Assigned(ImportDescriptor) then
      begin
        SetLength(ImportArray, 0);
        while ImportDescriptor^.Name <> 0 do
        begin
          Name := ConvertPointer(ImportDescriptor^.Name);
          SetLength(ImportArray, Length(ImportArray) + 1);
          LoadExternalLibrary(Name);
          DLLImport := @ImportArray[Length(ImportArray) - 1];
          DLLImport^.LibraryName := Name;
          DLLImport^.LibraryHandle := GetExternalLibraryHandle(Name);
          DLLImport^.Entries := nil;
          if ImportDescriptor^.TimeDateStamp = 0 then
          begin
          ThunkData := ConvertPointer(ImportDescriptor^.FirstThunk);
          end
          else
          begin
          ThunkData := ConvertPointer(ImportDescriptor^.OriginalFirstThunk);
          end;
          while ThunkData^ <> 0 do
          begin
          SetLength(DLLImport^.Entries, Length(DLLImport^.Entries) + 1);
          DLLfunctionImport := @DLLImport^.Entries[Length(DLLImport^.Entries) - 1];
          if (ThunkData^ and IMAGE_ORDINAL_FLAG32) <> 0 then
          begin
          DLLfunctionImport^.NameOrID := niID;
          DLLfunctionImport^.ID := ThunkData^ and IMAGE_ORDINAL_MASK32;
          DLLfunctionImport^.Name := '';
          functionPointer := GetProcAddress(DLLImport^.LibraryHandle,
          PChar(ThunkData^ and IMAGE_ORDINAL_MASK32));
          end
          else
          begin
          Name := ConvertPointer(LongWord(ThunkData^) + IMPORTED_NAME_OFFSET);
          DLLfunctionImport^.NameOrID := niName;
          DLLfunctionImport^.ID := 0;
          DLLfunctionImport^.Name := Name;
          functionPointer := GetProcAddress(DLLImport^.LibraryHandle, Name);
          end;
          PPointer(ThunkData)^ := functionPointer;
          Inc(ThunkData);
          end;
          Inc(ImportDescriptor);
        end;
      end;
    end;

    Result := True;
  end;

  function ProtectSections: Boolean;
  var
    I: Integer;
    Characteristics: LongWord;
    Flags: LongWord;
  begin
    Result := False;
    if ImageNTHeaders.FileHeader.NumberOfSections > 0 then
    begin
      for I := 0 to ImageNTHeaders.FileHeader.NumberOfSections - 1 do
      begin
        Characteristics := Sections[I].Characteristics;
        Flags := 0;
        if (Characteristics and IMAGE_SCN_MEM_EXECUTE) <> 0 then
        begin
          if (Characteristics and IMAGE_SCN_MEM_READ) <> 0 then
          begin
          if (Characteristics and IMAGE_SCN_MEM_WRITE) <> 0 then
          begin
          Flags := Flags or PAGE_EXECUTE_READWRITE;
          end
          else
          begin
          Flags := Flags or PAGE_EXECUTE_READ;
          end;
          end
          else if (Characteristics and IMAGE_SCN_MEM_WRITE) <> 0 then
          begin
          Flags := Flags or PAGE_EXECUTE_WRITECOPY;
          end
          else
          begin
          Flags := Flags or PAGE_EXECUTE;
          end;
        end
        else if (Characteristics and IMAGE_SCN_MEM_READ) <> 0 then
        begin
          if (Characteristics and IMAGE_SCN_MEM_WRITE) <> 0 then
          begin
          Flags := Flags or PAGE_READWRITE;
          end
          else
          begin
          Flags := Flags or PAGE_REAdoNLY;
          end;
        end
        else if (Characteristics and IMAGE_SCN_MEM_WRITE) <> 0 then
        begin
          Flags := Flags or PAGE_WRITECOPY;
        end
        else
        begin
          Flags := Flags or PAGE_NOACCESS;
        end;
        if (Characteristics and IMAGE_SCN_MEM_NOT_CACHED) <> 0 then
        begin
          Flags := Flags or PAGE_NOCACHE;
        end;
        VirtualProtect(Sections[I].Base, Sections[I].Size, Flags, OldProtect);
      end;

      Result := True;
    end;
  end;

  function InitializeLibrary: Boolean;
  begin
    Result := False;
    @DLLProc := ConvertPointer
      (ImageNTHeaders.OptionalHeader.AddressOfEntryPoint);
    if DLLProc(Cardinal(ImageBase), DLL_PROCESS_ATTACH, nil) then
    begin
      Result := True;
    end;
  end;

  function ProcessExports: Boolean;
  var
    I: Integer;
    ExportDirectory: PImageExportDirectory;
    ExportDirectorySize: LongWord;
    functionNamePointer: Pointer;
    functionName: PChar;
    functionIndexPointer: Pointer;
    functionIndex: LongWord;
    functionPointer: Pointer;
    ForwarderCharPointer: PChar;
    ForwarderString: string;
    ForwarderLibrary: string;
    ForwarderLibraryHandle: HInst;

    function ParseStringToNumber(AString: string): LongWord;
    var
      CharCounter: Integer;
    begin
      Result := 0;
      for CharCounter := 0 to Length(AString) - 1 do
      begin
        if AString[CharCounter] IN ['0' .. '9'] then
        begin
          Result := (RESULT * 10) + Byte
          (Byte(AString[CharCounter]) - Byte('0'));
        end
        else
        begin
          exit;
        end;
      end;
    end;

  begin
    if ImageNTHeaders.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT]
      .VirtualAddress <> 0 then
    begin
      ExportTree := TExportTree.Create;
      ExportDirectory := ConvertPointer
        (ImageNTHeaders.OptionalHeader.DataDirectory
          [IMAGE_DIRECTORY_ENTRY_EXPORT].VirtualAddress);
      if Assigned(ExportDirectory) then
      begin
        ExportDirectorySize := ImageNTHeaders.OptionalHeader.DataDirectory
          [IMAGE_DIRECTORY_ENTRY_EXPORT].Size;
        SetLength(ExportArray, ExportDirectory^.NumberOfNames);
        for I := 0 to ExportDirectory^.NumberOfNames - 1 do
        begin
          functionNamePointer := ConvertPointer
          (LongWord(ExportDirectory^.AddressOfNames));
          functionNamePointer := ConvertPointer
          (PLongWordArray(functionNamePointer)^[I]);
          functionName := functionNamePointer;
          functionIndexPointer := ConvertPointer
          (LongWord(ExportDirectory^.AddressOfNameOrdinals));
          functionIndex := PWordArray(functionIndexPointer)^[I];
          functionPointer := ConvertPointer
          (LongWord(ExportDirectory^.AddressOffunctions));
          functionPointer := ConvertPointer(PLongWordArray(functionPointer)
          ^[functionIndex]);
          ExportArray[I].Name := functionName;
          ExportArray[I].Index := functionIndex;
          if (LongWord(ExportDirectory) < LongWord(functionPointer)) AND
          (LongWord(functionPointer) < (LongWord(ExportDirectory)
          + ExportDirectorySize)) then
          begin
          ForwarderCharPointer := functionPointer;
          ForwarderString := ForwarderCharPointer;
          while ForwarderCharPointer^ <> '.' do
          Inc(ForwarderCharPointer);
          ForwarderLibrary := COPY(ForwarderString, 1,
          POS('.', ForwarderString) - 1);
          LoadExternalLibrary(ForwarderLibrary);
          ForwarderLibraryHandle := GetExternalLibraryHandle
          (ForwarderLibrary);
          if ForwarderCharPointer^ = '#' then
          begin
          Inc(ForwarderCharPointer);
          ForwarderString := ForwarderCharPointer;
          ForwarderCharPointer := ConvertPointer
          (ParseStringToNumber(ForwarderString));
          ForwarderString := ForwarderCharPointer;
          end
          else
          begin
          ForwarderString := ForwarderCharPointer;
          ExportArray[I].functionPointer := GetProcAddress
          (ForwarderLibraryHandle, PChar(ForwarderString));
          end;
          end
          else
          begin
          ExportArray[I].functionPointer := functionPointer;
          end;
          ExportTree.Add(ExportArray[I].Name, ExportArray[I].functionPointer);
        end
      end;
    end;
    Result := True;
  end;

begin
  Result := False;
  if Assigned(Stream) then
  begin
    Stream.Seek(0, soFromBeginning);
    if Stream.Size > 0 then
    begin
      if ReadImageHeaders then
      begin
        if InitializeImage then
        begin
          if ReadSections then
          begin
          if ProcessRelocations then
          begin
          if ProcessImports then
          begin
          if ProtectSections then
          begin
          if InitializeLibrary then
          begin
          if ProcessExports then
          begin
          Result := True;
          end;
          end;
          end;
          end;
          end;
          end;
        end;
      end;
    end;
  end;
end;

function TDLLLoader.Unload: Boolean;
var
  I, J: Integer;
begin
  Result := False;
  if @DLLProc <> nil then
  begin
    DLLProc(LongWord(ImageBase), DLL_PROCESS_DETACH, nil);
  end;
  for I := 0 to Length(Sections) - 1 do
  begin
    if Assigned(Sections[I].Base) then
    begin
      VirtualFree(Sections[I].Base, 0, MEM_RELEASE);
    end;
  end;
  SetLength(Sections, 0);
  for I := 0 to Length(ExternalLibraryArray) - 1 do
  begin
    ExternalLibraryArray[I].LibraryName := '';
    FreeLibrary(ExternalLibraryArray[I].LibraryHandle);
  end;
  SetLength(ExternalLibraryArray, 0);
  for I := 0 to Length(ImportArray) - 1 do
  begin
    for J := 0 to Length(ImportArray[I].Entries) - 1 do
    begin
      ImportArray[I].Entries[J].Name := '';
    end;
    SetLength(ImportArray[I].Entries, 0);
  end;
  SetLength(ImportArray, 0);
  for I := 0 to Length(ExportArray) - 1 do
    ExportArray[I].Name := '';
  SetLength(ExportArray, 0);
  VirtualFree(ImageBase, 0, MEM_RELEASE);
  if Assigned(ExportTree) then
  begin
    ExportTree.Destroy;
    ExportTree := nil;
  end;
end;

function TDLLLoader.FindExport(FunctionName: string): Pointer;
var
  I: Integer;
begin
  Result := nil;
  if Assigned(ExportTree) then
  begin
    ExportTree.Find(FunctionName, Result);
  end
  else
  begin
    for I := 0 to Length(ExportArray) - 1 do
    begin
      if ExportArray[I].Name = FunctionName then
      begin
        Result := ExportArray[I].functionPointer;
        exit;
      end;
    end;
  end;
end;

function TDLLLoader.FindExportPerIndex(FunctionIndex: Integer): Pointer;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Length(ExportArray) - 1 do
  begin
    if ExportArray[I].Index = FunctionIndex then
    begin
      Result := ExportArray[I].FunctionPointer;
      exit;
    end;
  end;
end;

function TDLLLoader.GetExportList: TStringList;
var
  I: Integer;
begin
  Result := TStringList.Create;
  for I := 0 to Length(ExportArray) - 1 do
    Result.Add(ExportArray[I].Name);
  Result.Sort;
end;

end.
plantsoot 40272 2010/6/22 9:32:09
DELPHI 2010 中报错:
[DCC Fatal Error] sevenzip.pas(612): F2063 Could not compile used unit 'MemLibLoader.pas'
第一页 上一页 下一页 最后页 有 25 条纪录 共2页 1 - 20
 用户名:
 密 码:
自动登陆(30天有效)
 
  DELPHI盒子版权所有 1999-2023 V4.01 粤ICP备10103342号-1 更新RSS列表