Change ImageBase of a PE File

unit uRebase;

interface

uses Windows;

function RebaseFile(szFilePath:string; szDestFile:string; dwNewImageBase:DWORD):Boolean;

type

  PImageBaseRelocation = ^TImageBaseRelocation;

  TImageBaseRelocation = packed record

     VirtualAddress: DWORD;

     SizeOfBlock: DWORD;

  end;

implementation

function FileToMem(szFilePath:string; var pFile:Pointer; var dwSize:DWORD):Boolean;

var

  hFile:  DWORD;

  dwNull: DWORD;

begin

  Result := FALSE;

  hFile := CreateFile(PChar(szFilePath), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);

  if hFile <> INVALID_HANDLE_VALUE then

  begin

    dwSize := GetFileSize(hFile, nil);

    if dwSize > 0 then

    begin

      GetMem(pFile, dwSize);

      SetFilePointer(hFile, 0, nil, FILE_BEGIN);

      ReadFile(hFile, pFile^, dwSize, dwNull, nil);

      CloseHandle(hFile);

      Result := TRUE;

    end;

  end;

end;

procedure MemToFile(pData:Pointer; sPath:string; dSize:DWORD);

var

hFile:    THandle;

dWritten: DWORD;

begin

  hFile := CreateFile(PChar(sPath), GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, 0, 0);

  if hFile <> 0 then

  begin

    SetFilePointer(hFile, 0, nil, FILE_BEGIN);

    WriteFile(hFile, pData^, dSize, dWritten, nil);

    FreeMem(pData, dSize);

    CloseHandle(hFile);

  end;

end;

procedure PerformBaseRelocation(f_module: Pointer; INH:PImageNtHeaders; f_delta: Cardinal); stdcall;

var

  l_i: Cardinal;

  l_codebase: Pointer;

  l_relocation: PImageBaseRelocation;

  l_dest: Pointer;

  l_relInfo: ^Word;

  l_patchAddrHL: ^DWord;

  l_type, l_offset: integer;

begin

  l_codebase := f_module;

  if INH^.OptionalHeader.DataDirectory[5].Size > 0 then

  begin

    l_relocation := PImageBaseRelocation(Cardinal(l_codebase) + INH^.OptionalHeader.DataDirectory[5].VirtualAddress);

    while l_relocation.VirtualAddress > 0 do

    begin

      l_dest := Pointer((Cardinal(l_codebase) + l_relocation.VirtualAddress));

      l_relInfo := Pointer(Cardinal(l_relocation) + 8);

      for l_i := 0 to (trunc(((l_relocation.SizeOfBlock - 8) / 2)) - 1) do

      begin

        l_type := (l_relInfo^ shr 12);

        l_offset := l_relInfo^ and $FFF;

        if l_type = 3 then

        begin

          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 AlignImage(pImage:Pointer):Pointer;

var

  IDH:  PImageDosHeader;

  INH:  PImageNtHeaders;

  ISH:  PImageSectionHeader;

  i:    WORD;

begin

  IDH := pImage;

  INH := Pointer(DWORD(pImage) + IDH^._lfanew);

  GetMem(Result, INH^.OptionalHeader.SizeOfImage);

  ZeroMemory(Result, INH^.OptionalHeader.SizeOfImage);

  CopyMemory(Result, pImage, INH^.OptionalHeader.SizeOfHeaders);

  for i := 0 to INH^.FileHeader.NumberOfSections - 1 do

  begin

    ISH := Pointer(DWORD(pImage) + IDH^._lfanew + 248 + i * 40);

    CopyMemory(Pointer(DWORD(Result) + ISH^.VirtualAddress), Pointer(DWORD(pImage) + ISH^.PointerToRawData), ISH^.SizeOfRawData);

  end;

end;

function RebuildImage(pImage:Pointer):Pointer;

var

  IDH:  PImageDosHeader;

  INH:  PImageNtHeaders;

  ISH:  PImageSectionHeader;

  i:    WORD;

begin

  IDH := pImage;

  INH := Pointer(DWORD(pImage) + IDH^._lfanew);

  ISH := Pointer(DWORD(pImage) + IDH^._lfanew + 248 + (INH.FileHeader.NumberOfSections - 1) * 40);

  GetMem(Result, (ISH.PointerToRawData + ISH.SizeOfRawData));

  ZeroMemory(Result, INH^.OptionalHeader.SizeOfHeaders);

  CopyMemory(Result, pImage, INH^.OptionalHeader.SizeOfHeaders);

  for i := 0 to INH^.FileHeader.NumberOfSections - 1 do

  begin

    ISH := Pointer(DWORD(pImage) + IDH^._lfanew + 248 + i * 40);

    CopyMemory(Pointer(DWORD(Result) + ISH^.PointerToRawData), Pointer(DWORD(pImage) + ISH^.VirtualAddress), ISH^.SizeOfRawData);

  end;

end;

function RebaseFile(szFilePath:string; szDestFile:string; dwNewImageBase:DWORD):Boolean;

var

  pFile:  Pointer;

  dwSize: DWORD;

  IDH:    PImageDosHeader;

  INH:    PImageNtHeaders;

begin

  Result := FALSE;

  if FileToMem(szFilePath, pFile, dwSize) then

  begin

    IDH := pFile;

    if IDH^.e_magic = IMAGE_DOS_SIGNATURE then

    begin

      INH := Pointer(DWORD(pFile) + IDH^._lfanew);

      if INH^.Signature = IMAGE_NT_SIGNATURE then

      begin

        pFile := AlignImage(pFile);

        if INH^.OptionalHeader.DataDirectory[5].Size > 0 then

        begin

          PerformBaseRelocation(pFile, INH, (dwNewImageBase - INH^.OptionalHeader.ImageBase));

          INH^.OptionalHeader.ImageBase := dwNewImageBase;

          CopyMemory(Pointer(DWORD(pFile) + IDH^._lfanew), INH, 248);

          pFile := RebuildImage(pFile);

          MemToFile(pFile, szDestFile, dwSize);

          Result := TRUE;

        end;

      end;

    end;

  end;

end;

end.