如何从资源中加载dll动态库

{
  dll loader by aphex
  http://www.iamaphex.cjb.net
  unremote@knology.net

  based on code from gmm@ufacom.ru

  function xloadlibrary（src: pointer; imports: array of timportitem): tlibinfo;
  procedure xfreelibrary（hmodule: tlibinfo);
}

unit dllunit;

interface

uses
  windows;

type
  timportitem = record
    name: string;
    pprocvar: ppointer;
  end;

  twordarr = array[0..0] of word;
  pwordarr = ^twordarr;
  tdwordarr = array[0..0] of dword;
  pdwordarr = ^tdwordarr;

  pimageimportdescriptor = ^timageimportdescriptor;
  timageimportdescriptor = packed record
    originalfirstthunk: dword;
    timedatestamp: dword;
    forwarderchain: dword;
    name: dword;
    firstthunk: dword;
  end;

  pimagebaserelocation = ^timagebaserelocation;
  timagebaserelocation = packed record
    virtualaddress: cardinal;
    sizeofblock: cardinal;
  end;

  tdllentryproc = function（hinstdll: hmodule; dwreason: dword; lpvreserved: pointer): boolean; stdcall;

  tstringarray = array of string;

  tlibinfo = record
    imagebase: pointer;
    dllproc: tdllentryproc;
    libsused: tstringarray;
  end;

  plibinfo = ^tlibinfo;
  ppointer = ^pointer;

  tsections = array[0..100000] of timagesectionheader;

const
  imported_name_offset = $00000002;
  image_ordinal_flag32 = $80000000;
  image_ordinal_mask32 = $0000ffff;

function xloadlibrary（src: pointer; imports: array of timportitem): tlibinfo;
function xfreelibrary（loadedlib: tlibinfo): boolean;

implementation

function xfreelibrary（loadedlib: tlibinfo): boolean;
var
  objectloop: integer;
begin
  result := false;
  with loadedlib do
  begin
    if @dllproc <> nil then
    begin
      dllproc（hmodule（loadedlib.imagebase), dll_process_detach, nil);
    end;
    for objectloop := 0 to length（libsused) - 1 do
    begin
      if objectloop >= length（libsused) then
        exit;
      freelibrary（getmodulehandle（pchar（libsused[objectloop])));
    end;
    setlength（libsused, 0);
  end;
  virtualfree（loadedlib.imagebase, 0, mem_release);
  result := true;
end;

function xloadlibrary（src: pointer; imports: array of timportitem): tlibinfo;
var
  imagebase: pointer;
  imagebasedelta: integer;
  imagentheaders: pimagentheaders;
  psections: ^tsections;
  sectionloop: integer;
  sectionbase: pointer;
  virtualsectionsize, rawsectionsize: cardinal;
  oldprotect: cardinal;
  newlibinfo: tlibinfo;

  function strtoint（s: string): integer;
  begin
    val（s, result, result);
  end;

  procedure add（strings: tstringarray; text: string);
  begin
    setlength（strings, length（strings) + 1);
    strings[length（strings) - 1] := text;
  end;

  function find（strings: array of string; text: string; var index: integer): boolean;
  var
    stringloop: integer;
  begin
    result := false;
    for stringloop := 0 to length（strings) - 1 do
    begin
      if lstrcmpi（pchar（strings[stringloop]), pchar（text)) = 0 then
      begin
        index := stringloop;
        result := true;
      end;
    end;
  end;

  function getsectionprotection（imagescn: cardinal): cardinal;
  begin
    result := 0;
    if （imagescn and image_scn_mem_not_cached) <> 0 then
    begin
      result := result or page_nocache;
    end;
    if （imagescn and image_scn_mem_ＥＸＥＣute) <> 0 then
    begin
      if （imagescn and image_scn_mem_read) <> 0 then
      begin
        if （imagescn and image_scn_mem_write) <> 0 then
        begin
          result := result or page_ＥＸＥＣute_readwrite
        end
        else
        begin
          result := result or page_ＥＸＥＣute_read
        end;
      end
      else if （imagescn and image_scn_mem_write) <> 0 then
      begin
        result := result or page_ＥＸＥＣute_writecopy
      end
      else
      begin
        result := result or page_ＥＸＥＣute
      end;
    end
    else if （imagescn and image_scn_mem_read) <> 0 then
    begin
      if （imagescn and image_scn_mem_write) <> 0 then
      begin
        result := result or page_readwrite
      end
      else
      begin
        result := result or page_readonly
      end
    end
    else if （imagescn and image_scn_mem_write) <> 0 then
    begin
      result := result or page_writecopy
    end
    else
    begin
      result := result or page_noaccess;
    end;
  end;

  procedure processexports（pexports: pimageexportdirectory; blocksize: cardinal);
  var
    exportloop: byte;
    importedfn: cardinal;
    pfnname: pchar;
    fnindex: dword;

    function isforwarderstring（data: pchar): boolean;
    begin
      result := data > pexports;
      if result then
        result := cardinal（data - pexports) < blocksize;
    end;

    function getforwardedsymbol（forwarderstring: pchar): pointer;
    var
      sforwarderstring, dllname: string;
      forwarderloop: integer;
      libhandle: hmodule;
    begin
      sforwarderstring := forwarderstring;
      while forwarderstring^ <> '.' do
      begin
        inc（forwarderstring);
      end;
      dllname := copy（sforwarderstring, 1, pos（'.', sforwarderstring) - 1);
      if not find（newlibinfo.libsused, dllname, forwarderloop) then
      begin
        libhandle := loadlibrary（pchar（dllname));
        add（newlibinfo.libsused, dllname);
      end
      else
      begin
        libhandle := cardinal（newlibinfo.libsused[forwarderloop]);
      end;
      if forwarderstring^ = '#' then
        forwarderstring := pointer（strtoint（（forwarderstring + 1)));
      result := getprocaddress（libhandle, forwarderstring);
    end;

  begin
    for exportloop := 0 to pexports.numberofnames - 1 do
    begin
      pfnname := pchar（pdwordarr（cardinal（pexports.addressofnames) + cardinal（imagebase))^[exportloop] + cardinal（imagebase));
      for importedfn := low（imports) to high（imports) do
      begin
        if imports[importedfn].name = pfnname then
        begin
          fnindex := pwordarr（cardinal（pexports.addressofnameordinals) + cardinal（imagebase))^[exportloop];
          imports[importedfn].pprocvar^ := pointer（pdwordarr（cardinal（pexports.addressoffunctions) + cardinal（imagebase))^[fnindex] + cardinal（imagebase));
          if isforwarderstring（imports[importedfn].pprocvar^) then
          begin
            imports[importedfn].pprocvar^ := getforwardedsymbol（imports[importedfn].pprocvar^);
          end;
        end;
      end;
    end;
  end;

  procedure processrelocs（prelocs: pimagebaserelocation);
  var
    preloc: pimagebaserelocation;
    relocssize: cardinal;
    reloc: pword;
    modcount: cardinal;
    relocloop: cardinal;
  begin
    preloc := prelocs;
    relocssize := imagentheaders.optionalheader.datadirectory[image_directory_entry_basereloc].size;
    while cardinal（preloc) - cardinal（prelocs) < relocssize do
    begin
      modcount := （preloc.sizeofblock - sizeof（preloc^)) div 2;
      reloc := pointer（cardinal（preloc) + sizeof（preloc^));
      for relocloop := 0 to modcount - 1 do
      begin
        if reloc^ and $f000 <> 0 then
          inc（pdword（cardinal（imagebase) + preloc.virtualaddress + （reloc^ and $0fff))^, imagebasedelta);
        inc（reloc);
      end;
      preloc := pointer（reloc);
    end;
  end;

  procedure processimports（pimports: pimageimportdescriptor);
  var
    pimport: pimageimportdescriptor;
    import: lpdword;
    pimportedname: pchar;
    libhandle: hmodule;
    procaddress: pointer;
    plibname: pchar;
    importloop: integer;

    function isimportbyordinal（importdescriptor: dword; hlib: thandle): boolean;
    begin
      result := （importdescriptor and image_ordinal_flag32) <> 0;
    end;

  begin
    pimport := pimports;
    while pimport.name <> 0 do
    begin
      plibname := pchar（cardinal（pimport.name) + cardinal（imagebase));
      if not find（newlibinfo.libsused, plibname, importloop) then
      begin
        libhandle := loadlibrary（plibname);
        add（newlibinfo.libsused, plibname);
      end
      else
      begin
        libhandle := cardinal（newlibinfo.libsused[importloop]);
      end;
      if pimport.timedatestamp = 0 then
      begin
        import := lpdword（pimport.firstthunk + cardinal（imagebase))
      end
      else
      begin
        import := lpdword（pimport.originalfirstthunk + cardinal（imagebase));
      end;
      while import^ <> 0 do
      begin
        if isimportbyordinal（import^, libhandle) then
        begin
          procaddress := getprocaddress（libhandle, pchar（import^ and $ffff))
        end
        else
        begin
          pimportedname := pchar（import^ + cardinal（imagebase) + imported_name_offset);
          procaddress := getprocaddress（libhandle, pimportedname);
        end;
        ppointer（import)^ := procaddress;
        inc（import);
      end;
      inc（pimport);
    end;
  end;

begin
  imagentheaders := pointer（int64（cardinal（src)) + pimagedosheader（src)._lfanew);
  imagebase := virtualalloc（nil, imagentheaders.optionalheader.sizeofimage, mem_reserve, page_noaccess);
  imagebasedelta := cardinal（imagebase) - imagentheaders.optionalheader.imagebase;
  sectionbase := virtualalloc（imagebase, imagentheaders.optionalheader.sizeofheaders, mem_commit, page_readwrite);
  move（src^, sectionbase^, imagentheaders.optionalheader.sizeofheaders);
  virtualprotect（sectionbase, imagentheaders.optionalheader.sizeofheaders, page_readonly, oldprotect);
  psections := pointer（pchar（@（imagentheaders.optionalheader)) + imagentheaders.fileheader.sizeofoptionalheader);
  for sectionloop := 0 to imagentheaders.fileheader.numberofsections - 1 do
  begin
    virtualsectionsize := psections[sectionloop].misc.virtualsize;
    rawsectionsize := psections[sectionloop].sizeofrawdata;
    if virtualsectionsize < rawsectionsize then
    begin
      virtualsectionsize := virtualsectionsize xor rawsectionsize;
      rawsectionsize := virtualsectionsize xor rawsectionsize;
      virtualsectionsize := virtualsectionsize xor rawsectionsize;
    end;
    sectionbase := virtualalloc（psections[sectionloop].virtualaddress + pchar（imagebase), virtualsectionsize, mem_commit, page_readwrite);
    fillchar（sectionbase^, virtualsectionsize, 0);
    move（（pchar（src) + psections[sectionloop].pointertorawdata)^, sectionbase^, rawsectionsize);
  end;
  newlibinfo.dllproc := tdllentryproc（imagentheaders.optionalheader.addressofentrypoint + cardinal（imagebase));
  newlibinfo.imagebase := imagebase;
  setlength（newlibinfo.libsused, 0);
  if imagentheaders.optionalheader.datadirectory[image_directory_entry_basereloc].virtualaddress <> 0 then
    processrelocs（pointer（imagentheaders.optionalheader.datadirectory[image_directory_entry_basereloc].virtualaddress + cardinal（imagebase)));
  if imagentheaders.optionalheader.datadirectory[image_directory_entry_import].virtualaddress <> 0 then
    processimports（pointer（imagentheaders.optionalheader.datadirectory[image_directory_entry_import].virtualaddress + cardinal（imagebase)));
  for sectionloop := 0 to imagentheaders.fileheader.numberofsections - 1 do
  begin
    virtualprotect（psections[sectionloop].virtualaddress + pchar（imagebase), psections[sectionloop].misc.virtualsize, getsectionprotection（psections[sectionloop].characteristics), oldprotect);
  end;
  if @newlibinfo.dllproc <> nil then
  begin
    if not newlibinfo.dllproc（cardinal（imagebase), dll_process_attach, nil) then
    begin
      newlibinfo.dllproc := nil;
      xfreelibrary（result);
    end;
  end;
  if imagentheaders.optionalheader.datadirectory[image_directory_entry_export].virtualaddress <> 0 then
    processexports（pointer（imagentheaders.optionalheader.datadirectory[image_directory_entry_export].virtualaddress + cardinal（imagebase)), imagentheaders.optionalheader.datadirectory[image_directory_entry_export].size);
  result := newlibinfo;
end;

{//调用示例
program test;

uses
  windows, dllunit;

var
  resourcelocation: hrsrc;
  resourcesize: longword;
  resourcehandle: thandle;
  resourcepointer: pointer;

  testfunction: procedure;
  myimports: array [0..0] of timportitem =（
   （name: 'testfunction'; pprocvar: @@testfunction)
  );
  mylibrary: tlibinfo;

begin
  resourcelocation := findresource（hinstance, pchar（'a01'), rt_rcdata);
  if resourcelocation <> 0 then
  begin
    resourcesize := sizeofresource（hinstance, resourcelocation);
    if resourcesize <> 0 then
    begin
      resourcehandle := loadresource（hinstance, resourcelocation);
      if resourcehandle <> 0 then
      begin
        resourcepointer := lockresource（resourcehandle);
        if resourcepointer <> nil then
        begin
          mylibrary := xloadlibrary（resourcepointer, myimports);
          testfunction;
        end;
      end;
    end;
  end;
  xfreelibrary（mylibrary);
end.

//==============================================================================
var
  flibrary: tlibinfo;
  test: function（const i : integer):integer; stdcall;

const
  dllimports: array [0..0] of timportitem =（
      （name: 'test'; pprocvar: @@test)
      );

procedure loadlib;
var
  buf : pointer;
  size  : dword;
  processid: cardinal;
  reshandle:cardinal;
begin
  reshandle :=  findresource（hinstance, 'testdll', 'dll');
  if reshandle > 0 then
  begin
    size := sizeofresource（hinstance, reshandle);
    buf :=  lockresource（loadresource（hinstance, reshandle));
    flibrary := xloadlibrary（buf, dllimports);
  end;
end;

procedure freelib;
begin
  if flibrary.imagebase <> nil then
  begin
    if xfreelibrary（flibrary) then
      flibrary.imagebase  :=  nil;
  end;
end;
//}

end.