Solved

Delphi PE Loader

Posted on 2004-05-01
10
7,069 Views
Last Modified: 2007-12-27
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

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.

//---- END DELPHI CODE ----


What I have here is a DLL Loader that can take a DLL from memory, initialize it and pass back the pointers to functions it exports. The DLL works just as perfectly as if it was called with LoadLibary(). I know that EXE files are different than DLLs, in that they don't have to be completely relocatable, but I know that PE loaders used by UPX and other EXE packers can do it just fine.

So, what I need is for this code to be modified so that it can take an EXE from memory, initialize it and call it's entrypoint just like what happens when you call CreateProcess().

0
Comment
Question by:OpenSourceDeveloper
  • 4
  • 3
  • 2
  • +1
10 Comments
 
LVL 20

Expert Comment

by:Madshi
ID: 10970712
The biggest problem is probably the  relocation. So how about setting the image base address of your own exe to something strange like $60000000. Then the image base address for the original exe should be available. After that I guess that you can use that function you posted above the load and prepare the exe. Finally search the entry point and call it. Shouldn't that work? I'm not sure...
0
 
LVL 2

Expert Comment

by:enkimute
ID: 10971837
Check www.wotsit.org for a complete PE description.

Appart from relocation, dll's don't do their own memory setup. So unless you are planning on running the exe in your own addressing space, you'll have to setup a new
process yourself. Exe loaders like upx can get away with simply loading the exe (much like in your code, without the relocs) and jumping to the entry point. They just
let the code run in the process that was created by the os for the loader. So, if you want to run several exe's, you'll have to setup several processes .. Also keep in mind
that this pe exe itself may load other dll files .. unless you force them to do so they will not use your routine to load librarys ..

Writing a debugger ?


0
 

Author Comment

by:OpenSourceDeveloper
ID: 10971903
@enkimute

>>So unless you are planning on running the exe in your own addressing space

yes I do

>>Also keep in mind that this pe exe itself may load other dll files

not a problem

>>Writing a debugger ?

no, I am writing an exe packer

I have tried to simply load it, fix the imports and jmp/ret/call (different variations, all fail) straight to the AddressOfEntryPoint but I get null access violations. something isn't getting setup right.
0
 
LVL 2

Expert Comment

by:enkimute
ID: 10972015
Ok, then your addressing space setup has to match that of the PE you are going to load .. code and data selector need to have the right size and base ..
a PE exe knows in advance at which address it wishes to be loaded. It will only work if loaded at that particular address .. Off course, this is a logical
address, so you can fix that by chaning the base address of the code and data selector .. And it might not be possible to do that for the current process.
0
 
LVL 20

Expert Comment

by:Madshi
ID: 10972042
Aren't the code and data selectors gone in 32bit programming?
0
Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
LVL 20

Expert Comment

by:Madshi
ID: 10972387
I've found a bunch of problems. I'm not sure whether fixing these will fix all problems, though. But here you go:

Instead of Notepad.exe compile this and try to make it work correctly:

program Project2;

uses Windows, SysUtils;

var arrCh : array [0..MAX_PATH] of char;
begin
  MessageBox(0, pchar(IntToHex(HInstance, 1)), 'info', 0);
  GetModuleFileName(HInstance, arrCh, MAX_PATH);
  MessageBox(0, arrCh, 'info', 0);
end.

This is the first step to make it work:

var GetModuleHandleNext : function (fileName: pchar) : dword; stdcall;
function GetModuleHandleCallback(fileName: pchar) : dword; stdcall;
begin
  if (fileName = nil) or IsDllNameEqual(fileName, CorrectFileNameOfLoadedExe) then
    result := CorrectImageBaseOfLoadedExe
  else
    result := GetModuleHandleNext(fileName);
end;

begin
  HookAPI('kernel32.dll', 'GetModuleHandleA', @GetModuleHandleCallback, @GetModuleHandleNext);

But it's only the first step. You need to correct other APIs, too. What about GetModuleHandleW, GetModuleFileNameA, GetModuleFileNameW? What about all the resource related functions? I'm not sure whether they work without being patched.

Sounds like an awful amount of work...   :-(
0
 

Author Comment

by:OpenSourceDeveloper
ID: 10972545
it won't even work if it just calls MessageBox(0, '', '', 0) I'd like to at least get that much working
0
 
LVL 20

Accepted Solution

by:
Madshi earned 500 total points
ID: 10972634
A simple MessageBox (without SysUtils) with only Windows.pas in the uses clause worked for me. But I had to set the image base address of your project to something high (I've chosen $60000000) and the image base address of the test exe to $10000000. It didn't work with $400000 because that address was already in use (didn't spend the time to find out why).
0
 
LVL 2

Expert Comment

by:enkimute
ID: 10973665
no, not gone in 32 bit mode .. there called selectors instead of segments (in real mode).
You can get memory description for the current process using a windows system call ..
let me get back to you on that tomorow, when I have the docs at my office ..
0
 

Expert Comment

by:jayc75
ID: 15090625
How can i use the PE DLL LOADER POSTED here can anyone please post a sample code..
Thank you.
0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

Suggested Solutions

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Illustrator's Shape Builder tool will let you combine shapes visually and interactively. This video shows the Mac version, but the tool works the same way in Windows. To follow along with this video, you can draw your own shapes or download the file…
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now