{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 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) }
// 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;
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;
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;
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 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;