创建进程时指定其父进程

记录一下，以免忘记。

uses Windows, PsAPI, SysUtils;

const
  SE_SECURITY_NAME                     = 'SeSecurityPrivilege';
  PROC_THREAD_ATTRIBUTE_PARENT_PROCESS = $00020000;
  EXTENDED_STARTUPINFO_PRESENT         = $00080000;

type
  PPROC_THREAD_ATTRIBUTE_LIST = Pointer;

  STARTUPINFOEX = packed record
    StartupInfo: TStartupInfo;
    lpAttributeList: PPROC_THREAD_ATTRIBUTE_LIST;
  end;

  { WinVista系统之上才有的几个API }

function InitializeProcThreadAttributeList(lpAttributeList: PPROC_THREAD_ATTRIBUTE_LIST; dwAttributeCount, dwFlags: DWORD; var lpSize: Cardinal): Boolean; stdcall;
  external 'kernel32.dll';

procedure UpdateProcThreadAttribute(lpAttributeList: PPROC_THREAD_ATTRIBUTE_LIST; dwFlags, Attribute: DWORD; var pValue: DWORD; cbSize: Cardinal; pPreviousValue: Pointer;
  pReturnSize: PCardinal); stdcall; external 'kernel32.dll';

procedure DeleteProcThreadAttributeList(lpAttributeList: PPROC_THREAD_ATTRIBUTE_LIST); stdcall; external 'Kernel32.dll';

{ 提升进程权限 }
function EnableDebugPrivilege(PrivName: string; CanDebug: Boolean): Boolean;
var
  TP    : Windows.TOKEN_PRIVILEGES;
  Dummy : Cardinal;
  hToken: THandle;
begin
  OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken);
  TP.PrivilegeCount := 1;
  LookupPrivilegeValue(nil, pchar(PrivName), TP.Privileges[0].Luid);
  if CanDebug then
    TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
  else
    TP.Privileges[0].Attributes := 0;
  Result                        := AdjustTokenPrivileges(hToken, False, TP, SizeOf(TP), nil, Dummy);
  hToken                        := 0;
end;

function GetProcessIDFromProcessName(const ProcessName: WideString): DWORD;
var
  hProcesss   : array [0 .. 100] of DWORD;
  I, J, Count : Cardinal;
  pList       : array of DWORD;
  hProcess    : Cardinal;
  PathFileName: array [0 .. 255] of char;
begin
  Result := 0;
  EnumProcesses(@hProcesss, SizeOf(hProcesss), Count);
  SetLength(pList, Count div SizeOf(DWORD));
  Move(hProcesss, pList[0], Count);

  for I := low(pList) to High(pList) do
  begin
    if (pList[I] = 0) or (pList[I] = 4) then
    begin
      Result := 0;
      Continue;
    end;
    hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, pList[I]);
    GetModuleFileNameEx(hProcess, 0, PathFileName, 255);
    CloseHandle(hProcess);
    J := Pos(LowerCase(ProcessName), LowerCase(PathFileName));
    if J <= 0 then
      Continue;
    Result := pList[I];
    Exit;
  end;
end;

procedure CreateProcessOnParentProcess(ExeName: string);
var
  pi         : TProcessInformation;
  si         : STARTUPINFOEX;
  cbAListSize: Cardinal;
  pAList     : PPROC_THREAD_ATTRIBUTE_LIST;
  hParent    : Cardinal;
begin
  { 提升权限 }
  EnableDebugPrivilege(SE_SECURITY_NAME, True);

  { 进程结构初始化 }
  FillChar(si, SizeOf(si), 0);
  si.StartupInfo.cb          := SizeOf(si);
  si.StartupInfo.dwFlags     := STARTF_USESHOWWINDOW;
  si.StartupInfo.wShowWindow := SW_SHOWDEFAULT;
  FillChar(pi, SizeOf(pi), 0);

  cbAListSize := 0;
  InitializeProcThreadAttributeList(nil, 1, 0, cbAListSize);
  pAList := HeapAlloc(GetProcessHeap(), 0, cbAListSize);
  InitializeProcThreadAttributeList(pAList, 1, 0, cbAListSize);
  hParent := OpenProcess(PROCESS_ALL_ACCESS, False, GetProcessIDFromProcessName('explorer.exe'));
  UpdateProcThreadAttribute(pAList, 0, PROC_THREAD_ATTRIBUTE_PARENT_PROCESS, hParent, 4, nil, nil);
  si.lpAttributeList := pAList;

  { 创建进程 }
  if CreateProcess(PWideChar(ExeName), nil, nil, nil, False, EXTENDED_STARTUPINFO_PRESENT, nil, nil, si.StartupInfo, pi) then
  begin
    CloseHandle(pi.hProcess);
    CloseHandle(pi.hThread);
  end;

  DeleteProcThreadAttributeList(pAList);
  HeapFree(GetProcessHeap(), 0, pAList);
end;

我这里直接指定了父进程是explorer.exe，当然你可以修改了。