Dynamic Forking of the Win32 Executable

posted 7 Sep 2010, 16:22 by Delphi Basics
Complete Delphi port of the original memory execution: 

Unfortunately, this code only works perfectly on XP or Vista systems. For Windows 7 compatibility, use this memory execution unit: 

unit U_PEMemExec;
 interface  
 uses windows;  
 function MemExecute(const ABuffer; Len: Integer; CmdParam: string; var ProcessId: Cardinal): Cardinal;  
 implementation  
 //{$R ExeShell.res}   // ?????? (98???)  
type  
  TImageSectionHeaders = array [0..0] of TImageSectionHeader;
  PImageSectionHeaders = ^TImageSectionHeaders;  
 { ???????? }  
 function GetAlignedSize(Origin, Alignment: Cardinal): Cardinal;  
 begin  
   result := (Origin + Alignment - 1) div Alignment * Alignment;  
 end;  
 { ????pe???????????,????? OptionalHeader.SizeOfImage?????????????????exe?????0 }  
 function CalcTotalImageSize(MzH: PImageDosHeader; FileLen: Cardinal; peH: PImageNtHeaders;  
     peSecH: PImageSectionHeaders): Cardinal;  
 var  
   i: Integer;  
 begin  
   {??pe????}  
  result := GetAlignedSize(PeH.OptionalHeader.SizeOfHeaders, PeH.OptionalHeader.SectionAlignment);  
  {????????}  
   for i := 0 to peH.FileHeader.NumberOfSections - 1 do  
     if peSecH[i].PointerToRawData + peSecH[i].SizeOfRawData > FileLen then  // ??????  
    begin  
       result := 0;  
       exit;  
     end  
    else if peSecH[i].VirtualAddress <> 0 then  //??????????  
       if peSecH[i].Misc.VirtualSize <> 0 then  
         result := GetAlignedSize(peSecH[i].VirtualAddress + peSecH[i].Misc.VirtualSize, PeH.OptionalHeader.SectionAlignment)  
      else  
         result := GetAlignedSize(peSecH[i].VirtualAddress + peSecH[i].SizeOfRawData, PeH.OptionalHeader.SectionAlignment)  
     else if peSecH[i].Misc.VirtualSize < peSecH[i].SizeOfRawData then  
       result := result + GetAlignedSize(peSecH[i].SizeOfRawData, peH.OptionalHeader.SectionAlignment)  
    else  
       result := result + GetAlignedSize(peSecH[i].Misc.VirtualSize, PeH.OptionalHeader.SectionAlignment);  
 end;  
 { ??pe????????? }  
 function AlignPEToMem(const Buf; Len: Integer; var PeH: PImageNtHeaders;  
     var PeSecH: PImageSectionHeaders; var Mem: Pointer; var ImageSize: Cardinal): Boolean;  
var  
  SrcMz: PImageDosHeader;            // DOS?  
  SrcPeH: PImageNtHeaders;           // PE?  
  SrcPeSecH: PImageSectionHeaders;   // ??  
   i: Integer;  
   l: Cardinal;  
   Pt: Pointer;  
 begin  
   result := false;  
   SrcMz := @Buf;  
   if Len < sizeof(TImageDosHeader) then exit;  
   if SrcMz.e_magic <> IMAGE_DOS_SIGNATURE then exit;  
   if Len < SrcMz._lfanew+Sizeof(TImageNtHeaders) then exit;  
  SrcPeH := pointer(Integer(SrcMz)+SrcMz._lfanew);  
   if (SrcPeH.Signature <> IMAGE_NT_SIGNATURE) then exit;  
   if (SrcPeH.FileHeader.Characteristics and IMAGE_FILE_DLL <> 0) or  
       (SrcPeH.FileHeader.Characteristics and IMAGE_FILE_EXECUTABLE_IMAGE = 0)  
       or (SrcPeH.FileHeader.SizeOfOptionalHeader <> SizeOf(TImageOptionalHeader)) then exit;  
   SrcPeSecH := Pointer(Integer(SrcPeH)+SizeOf(TImageNtHeaders));  
  ImageSize := CalcTotalImageSize(SrcMz, Len, SrcPeH, SrcPeSecH);  
   if ImageSize = 0 then  
     exit;  
   Mem := VirtualAlloc(nil, ImageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE);  // ????  
   if Mem <> nil then  
   begin  
    // ???????PE????  
     l := SrcPeH.OptionalHeader.SizeOfHeaders;  
     for i := 0 to SrcPeH.FileHeader.NumberOfSections - 1 do  
       if (SrcPeSecH[i].PointerToRawData <> 0) and (SrcPeSecH[i].PointerToRawData < l) then  
        l := SrcPeSecH[i].PointerToRawData;  
     Move(SrcMz^, Mem^, l);  
    PeH := Pointer(Integer(Mem) + PImageDosHeader(Mem)._lfanew);  
      PeSecH := Pointer(Integer(PeH) + sizeof(TImageNtHeaders));  
      Pt := Pointer(Cardinal(Mem) + GetAlignedSize(PeH.OptionalHeader.SizeOfHeaders, PeH.OptionalHeader.SectionAlignment));  
      for i := 0 to PeH.FileHeader.NumberOfSections - 1 do  
      begin  
        // ???????????  
        if PeSecH[i].VirtualAddress <> 0 then  
          Pt := Pointer(Cardinal(Mem) + PeSecH[i].VirtualAddress);  
        if PeSecH[i].SizeOfRawData <> 0 then  
        begin  
          // ???????  
          Move(Pointer(Cardinal(SrcMz) + PeSecH[i].PointerToRawData)^, pt^, PeSecH[i].SizeOfRawData);  
          if peSecH[i].Misc.VirtualSize < peSecH[i].SizeOfRawData then  
            pt := pointer(Cardinal(pt) + GetAlignedSize(PeSecH[i].SizeOfRawData, PeH.OptionalHeader.SectionAlignment))  
          else  
            pt := pointer(Cardinal(pt) + GetAlignedSize(peSecH[i].Misc.VirtualSize, peH.OptionalHeader.SectionAlignment));  
          // pt ??????????  
        end  
        else  
          pt := pointer(Cardinal(pt) + GetAlignedSize(PeSecH[i].Misc.VirtualSize, PeH.OptionalHeader.SectionAlignment));  
      end;  
      result := True;  
    end;  
  end;  
  type  
    TVirtualAllocEx = function (hProcess: THandle; lpAddress: Pointer;  
                                    dwSize, flAllocationType: DWORD; flProtect: DWORD): Pointer; stdcall;  
  var  
    MyVirtualAllocEx: TVirtualAllocEx = nil;  
  function IsNT: Boolean;  
  begin  
    result := Assigned(MyVirtualAllocEx);  
  end;  
  { ????????? }  
  function PrepareShellExe(CmdParam: string; BaseAddr, ImageSize: Cardinal): string;  
  var  
    r, h, sz: Cardinal;  
    p: Pointer;  
    fid, l: Integer;  
    buf: Pointer;  
    peH: PImageNtHeaders;  
    peSecH: PImageSectionHeaders;  
  begin  
    if IsNT then  
    begin  
      //{ NT ????????????????? }  
      //Result := ParamStr(0)+CmdParam;  
      Result := 'KeydoneIO.exe'+' '+CmdParam;  
    end else  
    begin  
    // ??98?????????????????,????????????????????????????  
    // ???????????????????????????,???????PE????????????????????????  
      r := FindResource(HInstance, 'SHELL_EXE', RT_RCDATA);  
      h := LoadResource(HInstance, r);  
      p := LockResource(h);  
      l := SizeOfResource(HInstance, r);  
      GetMem(Buf, l);  
      Move(p^, Buf^, l);   // ????  
      FreeResource(h);  
      peH := Pointer(Integer(Buf) + PImageDosHeader(Buf)._lfanew);  
      peSecH := Pointer(Integer(peH) + sizeof(TImageNtHeaders));  
      peH.OptionalHeader.ImageBase := BaseAddr;    // ??PE???????  
      if peH.OptionalHeader.SizeOfImage < ImageSize then  // ??????,??????????????  
      begin  
        sz := Imagesize - peH.OptionalHeader.SizeOfImage;  
        Inc(peH.OptionalHeader.SizeOfImage, sz);    // ????????  
        Inc(peSecH[peH.FileHeader.NumberOfSections-1].Misc.VirtualSize, sz);   // ???????????  
      end;  
      // ?????????, ???????????  
      // ???? uses SysUtils (?? use ??????80K??), ????,?????????11???,????.dat, .da0~.da9  
      result := ParamStr(0);  
      result := copy(result, 1, length(result) - 4) + '.dat';  
      r := 0;  
      while r < 10 do  
      begin  
        fid := CreateFile(pchar(result), GENERIC_READ or GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);  
        if fid < 0 then  
        begin  
          result := copy(result, 1, length(result)-3)+'da'+Char(r+Byte('0'));  
          inc(r);  
        end  
        else begin  
          //SetFilePointer(fid, Imagesize, nil, 0);  
          //SetEndOfFile(fid);  
          //SetFilePointer(fid, 0, nil, 0);  
          WriteFile(fid, Buf^, l, h, nil);  // ????  
          CloseHandle(fid);  
          break;  
        end;  
      end;  
      result := '"' + result + '"' + CmdParam;  // ?????  
      FreeMem(Buf);  
    end;  
  end;  
  { ?????????? }  
  function HasRelocationTable(peH: PImageNtHeaders): Boolean;  
  begin  
    result := (peH.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BASERELOC].VirtualAddress <> 0)  
        and (peH.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BASERELOC].Size <> 0);  
  end;  
  //??  
  type  
    PImageBaseRelocation= ^TImageBaseRelocation;  
    TImageBaseRelocation = packed record  
      VirtualAddress: cardinal;  
      SizeOfBlock: cardinal;  
    end;  
  { ???PE????? }  
  procedure DoRelocation(peH: PImageNtHeaders; OldBase, NewBase: Pointer);  
  var  
    Delta: Cardinal;  
    p: PImageBaseRelocation;  
    pw: PWord;  
    i: Integer;  
  begin  
    Delta := Cardinal(NewBase) - peH.OptionalHeader.ImageBase;  
    p := pointer(cardinal(OldBase) + peH.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BASERELOC].VirtualAddress);  
    while (p.VirtualAddress + p.SizeOfBlock <> 0) do  
    begin  
      pw := pointer(Integer(p) + Sizeof(p^));  
      for i := 1 to (p.SizeOfBlock - Sizeof(p^)) div 2 do  
      begin  
        if pw^ and $F000 = $3000 then  
          Inc(PCardinal(Cardinal(OldBase) + p.VirtualAddress + (pw^ and $0FFF))^, Delta);  
        inc(pw);  
      end;  
      p := Pointer(pw);  
    end;  
  end;  
  type  
    TZwUnmapViewOfSection = function (Handle, BaseAdr: Cardinal): Cardinal; stdcall;  
  { ????????? }  
  function UnloadShell(ProcHnd, BaseAddr: Cardinal): Boolean;  
  var  
    M: HModule;  
    ZwUnmapViewOfSection: TZwUnmapViewOfSection;  
  begin  
    result := False;  
    m := LoadLibrary('ntdll.dll');  
    if m <> 0 then  
    begin  
      ZwUnmapViewOfSection := GetProcAddress(m, 'ZwUnmapViewOfSection');  
      if assigned(ZwUnmapViewOfSection) then  
        result := (ZwUnmapViewOfSection(ProcHnd, BaseAddr) = 0);  
      FreeLibrary(m);  
    end;  
  end;  
  { ?????????????????????? }  
  function CreateChild(Cmd: string; var Ctx: TContext; var ProcHnd, ThrdHnd, ProcId, BaseAddr, ImageSize: Cardinal): Boolean;  
  var  
    si: TStartUpInfo;  
    pi: TProcessInformation;  
    Old: Cardinal;  
    MemInfo: TMemoryBasicInformation;  
    p: Pointer;  
  begin  
    FillChar(si, Sizeof(si), 0);  
    FillChar(pi, SizeOf(pi), 0);  
    si.cb := sizeof(si);  
    si.dwFlags:=STARTF_USESHOWWINDOW;  
    si.lpTitle:=PChar('Keydone IO Service');  
    {$IFNDEF DEBUGMODE}  
    si.wShowWindow:=SW_HIDE;  
    {$ELSE}  
    si.wShowWindow:=SW_MINIMIZE;  
    {$ENDIF}  
    result := CreateProcess(nil, PChar(Cmd), nil, nil, False, CREATE_SUSPENDED, nil, nil, si, pi);  // ?????????  
    if result then  
    begin  
      ProcHnd := pi.hProcess;  
      ThrdHnd := pi.hThread;  
      ProcId := pi.dwProcessId;  
      { ??????????,[ctx.Ebx+8]???????????????,ctx.Eax???????????? }  
      ctx.ContextFlags := CONTEXT_FULL;  
      GetThreadContext(ThrdHnd, ctx);  
      ReadProcessMemory(ProcHnd, Pointer(ctx.Ebx+8), @BaseAddr, SizeOf(Cardinal), Old);  // ??????  
      p := Pointer(BaseAddr);  
      { ??????????? }  
      while VirtualQueryEx(ProcHnd, p, MemInfo, Sizeof(MemInfo)) <> 0 do  
      begin  
        if MemInfo.State = MEM_FREE then  
          break;  
        p := Pointer(Cardinal(p) + MemInfo.RegionSize);  
      end;  
      ImageSize := Cardinal(p) - Cardinal(BaseAddr);  
    end;  
  end;  
  { ??????????????????? }  
  function AttachPE(CmdParam: string; peH: PImageNtHeaders; peSecH: PImageSectionHeaders;  
      Ptr: Pointer; ImageSize: Cardinal; var ProcId: Cardinal): Cardinal;  
  var  
    s: string;  
    Addr, Size: Cardinal;  
    ctx: TContext;  
    Old: Cardinal;  
    p: Pointer;  
    Thrd: Cardinal;  
  begin  
    result := INVALID_HANDLE_VALUE;  
    s := PrepareShellExe(CmdParam, peH.OptionalHeader.ImageBase, ImageSize);  
    if CreateChild(s, ctx, result, Thrd, ProcId, Addr, Size) then  
    begin  
      p := nil;  
      if (peH.OptionalHeader.ImageBase = Addr) and (Size >= ImageSize) then  // ????????????????????  
      begin  
        p := Pointer(Addr);  
        VirtualProtectEx(result, p, Size, PAGE_EXECUTE_READWRITE, Old);  
      end  
      else if IsNT then  // 98 ???  
      begin  
        if UnloadShell(result, Addr) then  // ??????????  
          // ??????????????????  
          p := MyVirtualAllocEx(Result, Pointer(peH.OptionalHeader.ImageBase), ImageSize, MEM_RESERVE or MEM_COMMIT, PAGE_EXECUTE_READWRITE);  
        if (p = nil) and hasRelocationTable(peH) then  // ?????????????????  
        begin  
          // ?????????  
          p := MyVirtualAllocEx(result, nil, ImageSize, MEM_RESERVE or MEM_COMMIT, PAGE_EXECUTE_READWRITE);  
          if p <> nil then  
            DoRelocation(peH, Ptr, p);  // ???  
        end;  
      end;  
      if p <> nil then  
      begin  
        WriteProcessMemory(Result, Pointer(ctx.Ebx+8), @p, Sizeof(DWORD), Old);  // ??????????????  
        peH.OptionalHeader.ImageBase := Cardinal(p);  
        if WriteProcessMemory(Result, p, Ptr, ImageSize, Old) then  // ??PE ???????  
        begin  
          ctx.ContextFlags := CONTEXT_FULL;  
          if Cardinal(p) = Addr then  
            ctx.Eax := peH.OptionalHeader.ImageBase + peH.OptionalHeader.AddressOfEntryPoint  // ????????????  
          else  
            ctx.Eax := Cardinal(p) + peH.OptionalHeader.AddressOfEntryPoint;  
          SetThreadContext(Thrd, ctx);  // ??????  
          ResumeThread(Thrd);           // ??  
          CloseHandle(Thrd);  
        end  
        else begin  // ????,??????  
          TerminateProcess(Result, 0);  
          CloseHandle(Thrd);  
          CloseHandle(Result);  
          Result := INVALID_HANDLE_VALUE;  
        end;  
      end  
      else begin // ????,??????  
        TerminateProcess(Result, 0);  
        CloseHandle(Thrd);  
        CloseHandle(Result);  
        Result := INVALID_HANDLE_VALUE;  
      end;  
    end;  
  end;  
  function MemExecute(const ABuffer; Len: Integer; CmdParam: string; var ProcessId: Cardinal): Cardinal;  
  var  
    peH: PImageNtHeaders;  
    peSecH: PImageSectionHeaders;  
    Ptr: Pointer;  
    peSz: Cardinal;  
  begin  
    result := INVALID_HANDLE_VALUE;  
    if AlignPEToMem(ABuffer, Len, peH, peSecH, Ptr, peSz) then  
    begin  
      result := AttachPE(CmdParam, peH, peSecH, Ptr, peSz, ProcessId);  
      VirtualFree(Ptr, peSz, MEM_DECOMMIT);  
      //VirtualFree(Ptr, 0, MEM_RELEASE);  
    end;  
  end;  
  initialization  
    MyVirtualAllocEx := GetProcAddress(GetModuleHandle('Kernel32.dll'), 'VirtualAllocEx');  
  end.
Comments