如何调用保存在 TMemoryStream 中的DLL?

如何调用保存在 TMemoryStream 中的DLL? Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiAPI/html/delphi_20061116221822215.html
不要保存到磁盘上。  
   
  解决送   300分。

没有必要自己写,直接写好程序后用pebundle加壳成一个应用程序即可,比你自己写的安全多了,网上的一个p2p流媒体软件就是这样做的(tvkoo),用它加壳出来的东西,绝对是你想要的!呵呵,不知道是否可以得到你那300分啊,呵呵是的话我就可以多一只猩猩了,挖卡卡!

我早知道   PEBundle,   因为我一直在使用   PECompact,可是那东西是收费的。  
  我希望有自己的实现方式。已经从网上找到从内存运行EXE程序的代码,却没有内存调用DLL的代码。  
 

http://www.delphibbs.com/delphibbs/dispq.asp?lid=2612942  
   
  来自:WindDriver,   时间:2004-6-22   9:08:45,   ID:2675646  
  在国外站点找到答案了   ;)  
   
  {  
      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:   ^Pointer;  
      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

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_EXECUTE)   <>   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_EXECUTE_READWRITE  
                  end  
                  else  
                  begin  
                      Result   :=   Result   or   PAGE_EXECUTE_READ  
                  end;  
              end  
              else   if   (ImageScn   and   IMAGE_SCN_MEM_WRITE)   <>   0   then  
              begin  
                  Result   :=   Result   or   PAGE_EXECUTE_WRITECOPY  
              end  
              else  
              begin  
                  Result   :=   Result   or   PAGE_EXECUTE  
              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;  
   
  end.  
   
  ==========================================================  
   
   
  program   test;  
   
  {$R   'RSRC.res'   'RSRC.RC'}  
   
  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.

不错,记录一下。

收藏...

//我是这样测试的  
   
  function   SysPath:   string;   //   返回系统所在的路径  
  var  
      vBuffer:   array[0..MAX_PATH]   of   Char;  
  begin  
      GetSystemDirectory(vBuffer,   MAX_PATH);  
      Result   :=   IncludeTrailingPathDelimiter(vBuffer);  
  end;   {   SysPath   }  
   
  var  
      vAnsiUpper:   function   (lpsz:   LPSTR):   LPSTR;   stdcall;  
      vImports:   array   [0..0]   of   TImportItem   =(  
        (Name:   'CharUpperA';   PProcVar:   @@vAnsiUpper)  
      );  
   
  procedure   TForm1.Button1Click(Sender:   TObject);  
  var  
      vBuffer:   PChar;  
      vMemoryStream:   TMemoryStream;  
      vLibInfo:   TLibInfo;  
  begin  
      vMemoryStream   :=   TMemoryStream.Create;  
      vMemoryStream.LoadFromFile(SysPath   +   'user32.dll');  
      vLibInfo   :=   xLoadLibrary(vMemoryStream.Memory,   vImports);  
      GetMem(vBuffer,   2);  
      vBuffer[0]   :=   'a';  
      vBuffer[1]   :=   #0;  
      vAnsiUpper(vBuffer);  
      Caption   :=   vBuffer;  
      //xFreeLibrary(vLibInfo);   //就是释放dll有问题//需要再分析  
      vMemoryStream.Free;  
  end;

收藏~~~

谢谢,收到。待我测试后开贴送分。

收藏~~

收藏~~  
 

测试通过。

zswang(伴水清清)请接分  
  http://community.csdn.net/Expert/TopicView3.asp?id=5206299  
  http://community.csdn.net/Expert/TopicView3.asp?id=5206298

jf

怪不得Delphi顽强存在呢,原来有如此之强人强贴。

这个小小帖子的有着极其巨大的价值。

还是有一些局限性,比如注入Explorer.exe,如果使用xLoadLibaray会导致Explorer异常结束。

VirtualAlloc   ->   VirtualAllocEx  
  你需要申请的是IE的内存空间而不是自己进程的内存空间

嘿嘿,悄悄收藏之

posted on 2009-02-03 09:44  delphi2007  阅读(221)  评论(0编辑  收藏  举报