如何让Delphi中CreateProcess以管理员权限运行并捕获输出？

我用Delphi执行命令行程序时，选了CreateProcess来做，因为要捕获它的输出显示在Memo里。但现在有个问题：这个要执行的程序必须以管理员权限运行才能正常工作——在管理员权限的cmd里跑它是没问题的。我知道ShellExecute可以设lpVerb为'runas'来提权，但我得用CreateProcess来抓输出。本来以为主程序以管理员权限跑的话，CreateProcess启动的子进程会继承权限，但实际不是这么回事。请问怎么让CreateProcess启动的进程拥有管理员权限？

当前能正常启动命令行但没管理员权限的代码如下：

var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  Handle: Boolean;
begin
  with SA do begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
  try
    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;
    Handle := CreateProcess(nil, PWideChar('cmd.exe /C ' + CommandLine),
                            nil, nil, True, 0, nil,
                            PWideChar(WorkDir), SI, PI);

解决办法 #

CreateProcess本身没有直接指定管理员权限的参数，要实现需求可以从这两个方向入手：

1. 先给主程序提权，再启动子进程

如果你的主程序没以管理员权限运行，得先请求提升权限，再启动子进程。可以调用ShellExecuteEx加runas动词，启动一个提权后的自身程序实例，然后在这个实例里用CreateProcess启动目标程序并抓输出。

2. 主程序已提权但子进程没继承？检查目标程序的manifest

要是主程序已经是管理员权限，但子进程没拿到，大概率是目标程序的manifest文件里设了requestedExecutionLevel为asInvoker——这会强制子进程用调用者的默认权限跑，不继承管理员权限。这种情况要么改目标程序的manifest，要么用ShellExecuteEx（带runas）启动它，同时结合管道抓输出。

具体实现：用ShellExecuteEx提权+管道抓输出

因为CreateProcess没法直接触发UAC弹窗提权，所以可以用ShellExecuteEx启动提权后的cmd，同时把输出重定向到管道，这样既能提权又能抓输出。修改后的代码示例：

var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  SEI: TShellExecuteInfo;
  CmdLine: string;
  WorkDir: string;
begin
  CmdLine := '你的目标命令行程序路径及参数';
  WorkDir := '你的工作目录';

  // 创建输出管道
  FillChar(SA, SizeOf(SA), 0);
  SA.nLength := SizeOf(SA);
  SA.bInheritHandle := True;
  SA.lpSecurityDescriptor := nil;
  if not CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0) then
  begin
    ShowMessage('创建管道失败');
    Exit;
  end;

  try
    // 设置StartupInfo用于重定向输出
    FillChar(SI, SizeOf(SI), 0);
    SI.cb := SizeOf(SI);
    SI.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
    SI.wShowWindow := SW_HIDE;
    SI.hStdOutput := StdOutPipeWrite;
    SI.hStdError := StdOutPipeWrite;

    // 配置ShellExecuteEx参数，触发UAC提权
    FillChar(SEI, SizeOf(SEI), 0);
    SEI.cbSize := SizeOf(SEI);
    SEI.fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_NO_UI;
    SEI.lpVerb := 'runas'; // 提权关键参数
    SEI.lpFile := 'cmd.exe';
    SEI.lpParameters := PWideChar('/C ' + CmdLine);
    SEI.lpDirectory := PWideChar(WorkDir);
    SEI.nShow := SW_HIDE;

    if ShellExecuteEx(@SEI) then
    begin
      PI.hProcess := SEI.hProcess;
      PI.hThread := SEI.hThread;
      // 这里要加读取管道输出并写入Memo的代码
      // 注意：必须在单独线程里读取，不然会卡死主线程
      // 示例可以用ReadFile循环读取StdOutPipeRead，再把内容Append到Memo
    end
    else
    begin
      ShowMessage('启动进程失败，错误码：' + IntToStr(GetLastError));
    end;
  finally
    // 记得关闭所有句柄
    CloseHandle(StdOutPipeWrite);
    CloseHandle(StdOutPipeRead);
    CloseHandle(PI.hProcess);
    CloseHandle(PI.hThread);
  end;
end;

注意点

• 读取管道输出一定要开单独线程，不然主线程会被阻塞，程序直接假死。
• 如果用户点了UAC弹窗的“取消”，ShellExecuteEx会返回失败，要做好错误处理。
• 管道的bInheritHandle必须设为True，不然子进程没法往管道里写输出。

内容的提问来源于stack exchange，提问作者Some1Else