如何使用 Delphi2007 运行非提升的进程

Question

我有一个类似安装程序的应用程序，我必须在 Vista 上以提升的方式运行。但是从那里我必须开始一个非提升的新过程。任何提示如何使用 Delphi2007 做到这一点？

Answer 1

我找到了一个 excellent example for C++ 并将其改编为 Delphi：

unit MediumIL;

interface

uses
  Winapi.Windows;

function CreateProcessMediumIL(lpApplicationName: PWChar; lpCommandLine: PWChar; lpProcessAttributes: PSecurityAttributes; lpThreadAttributes: PSecurityAttributes; bInheritHandle: BOOL; dwCreationFlags: DWORD; lpEnvironment: LPVOID; lpCurrentDirectory: PWChar; const lpStartupInfo: TStartupInfoW; var lpProcessInformation: TProcessInformation): DWORD;

implementation

type
  TOKEN_MANDATORY_LABEL = record
    Label_: SID_AND_ATTRIBUTES;
  end;

  PTOKEN_MANDATORY_LABEL = ^TOKEN_MANDATORY_LABEL;

  TTokenMandatoryLabel = TOKEN_MANDATORY_LABEL;
  PTokenMandatoryLabel = ^TTokenMandatoryLabel;

  TCreateProcessWithTokenW = function (hToken: THandle; dwLogonFlags: DWORD; lpApplicationName: LPCWSTR; lpCommandLine: LPWSTR; dwCreationFlags: DWORD; lpEnvironment: LPVOID; lpCurrentDirectory: LPCWSTR; const lpStartupInfo: TStartupInfoW; out lpProcessInfo: TProcessInformation): BOOL; stdcall;

const
  SECURITY_MANDATORY_UNTRUSTED_RID = $00000000;
  SECURITY_MANDATORY_LOW_RID = $00001000;
  SECURITY_MANDATORY_MEDIUM_RID = $00002000;
  SECURITY_MANDATORY_HIGH_RID = $00003000;
  SECURITY_MANDATORY_SYSTEM_RID = $00004000;
  SECURITY_MANDATORY_PROTECTED_PROCESS_RID = $00005000;

function GetShellWindow: HWND; stdcall; external 'user32.dll' name 'GetShellWindow';

// writes Integration Level of the process with the given ID into dwProcessIL
// returns Win32 API error or 0 if succeeded
function GetProcessIL(dwProcessID: DWORD; var dwProcessIL: DWORD): DWORD;
label
  _CleanUp;
var
  hProcess: THandle;
  hToken: THandle;
  dwSize: DWORD;
  pbCount: PByte;
  pdwProcIL: PDWORD;
  pTIL: PTokenMandatoryLabel;
  dwError: DWORD;
begin
  dwProcessIL := 0;

  pTIL := nil;

  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION, False, dwProcessID);
  if (hProcess = 0) then
    goto _CleanUp;

  if (not OpenProcessToken(hProcess, TOKEN_QUERY, hToken)) then
    goto _CleanUp;

  if (not GetTokenInformation(hToken, TokenIntegrityLevel, nil, 0, dwSize) and (GetLastError() <> ERROR_INSUFFICIENT_BUFFER)) then
    goto _CleanUp;

  pTIL := HeapAlloc(GetProcessHeap(), 0, dwSize);
  if (pTIL = nil) then
    goto _CleanUp;

  if (not GetTokenInformation(hToken, TokenIntegrityLevel, pTIL, dwSize, dwSize)) then
    goto _CleanUp;

  pbCount := PByte(GetSidSubAuthorityCount(pTIL^.Label_.Sid));
  if (pbCount = nil) then
    goto _CleanUp;

  pdwProcIL := GetSidSubAuthority(pTIL^.Label_.Sid, pbCount^ - 1);
  if (pdwProcIL = nil) then
    goto _CleanUp;

  dwProcessIL := pdwProcIL^;
  SetLastError(ERROR_SUCCESS);

  _CleanUp:
  dwError := GetLastError();
  if (pTIL <> nil) then
    HeapFree(GetProcessHeap(), 0, pTIL);
  if (hToken <> 0) then
    CloseHandle(hToken);
  if (hProcess <> 0) then
    CloseHandle(hProcess);
  Result := dwError;
end;

// Creates a new process lpApplicationName with the integration level of the Explorer process (MEDIUM IL)
// If you need this function in a service you must replace FindWindow() with another API to find Explorer process
// The parent process of the new process will be svchost.exe if this EXE was run "As Administrator"
// returns Win32 API error or 0 if succeeded
function CreateProcessMediumIL(lpApplicationName: PWChar; lpCommandLine: PWChar; lpProcessAttributes: PSecurityAttributes; lpThreadAttributes: PSecurityAttributes; bInheritHandle: BOOL; dwCreationFlags: DWORD; lpEnvironment: LPVOID; lpCurrentDirectory: PWChar; const lpStartupInfo: TStartupInfoW; var lpProcessInformation: TProcessInformation): DWORD;
label
  _CleanUp;
var
  hProcess: THandle;
  hToken: THandle;
  hToken2: THandle;
  bUseToken: BOOL;
  dwCurIL: DWORD;
  dwErr: DWORD;
  f_CreateProcessWithTokenW: TCreateProcessWithTokenW;
  hProgman: HWND;
  dwExplorerPID: DWORD;
  dwError: DWORD;
begin
  bUseToken := False;

  // Detect Windows Vista, 2008, Windows 7 and higher
  if (GetProcAddress(GetModuleHandleA('Kernel32'), 'GetProductInfo') <> nil) then
  begin
    dwErr := GetProcessIL(GetCurrentProcessId(), dwCurIL);
    if (dwErr <> 0) then
    begin
      Result := dwErr;
      Exit;
    end;
      if (dwCurIL > SECURITY_MANDATORY_MEDIUM_RID) then
        bUseToken := True;
  end;

  // Create the process normally (before Windows Vista or if current process runs with a medium IL)
  if (not bUseToken) then
  begin
    if (not CreateProcessW(lpApplicationName, lpCommandLine, lpProcessAttributes, lpThreadAttributes, bInheritHandle, dwCreationFlags, lpEnvironment, lpCurrentDirectory, lpStartupInfo, lpProcessInformation)) then
    begin
      Result := GetLastError();
      Exit;
    end;

    CloseHandle(lpProcessInformation.hThread);
    CloseHandle(lpProcessInformation.hProcess);
    Result := ERROR_SUCCESS;
    Exit;
  end;

  f_CreateProcessWithTokenW := GetProcAddress(GetModuleHandleA('Advapi32'), 'CreateProcessWithTokenW');

  if (not Assigned(f_CreateProcessWithTokenW)) then // This will never happen on Vista!
  begin
    Result := ERROR_INVALID_FUNCTION;
    Exit;
  end;

  hProgman := GetShellWindow();

  dwExplorerPID := 0;
  GetWindowThreadProcessId(hProgman, dwExplorerPID);

  // ATTENTION:
  // If UAC is turned OFF all processes run with SECURITY_MANDATORY_HIGH_RID, also Explorer!
  // But this does not matter because to start the new process without UAC no elevation is required.
  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION, False, dwExplorerPID);
  if (hProcess = 0) then
    goto _CleanUp;

  if (not OpenProcessToken(hProcess, TOKEN_DUPLICATE, hToken)) then
    goto _CleanUp;

  if (not DuplicateTokenEx(hToken, TOKEN_ALL_ACCESS, nil, SecurityImpersonation, TokenPrimary, hToken2)) then
    goto _CleanUp;

  if (not f_CreateProcessWithTokenW(hToken2, 0, lpApplicationName, lpCommandLine, dwCreationFlags, lpEnvironment, lpCurrentDirectory, lpStartupInfo, lpProcessInformation)) then
    goto _CleanUp;

  SetLastError(ERROR_SUCCESS);

  _CleanUp:
  dwError := GetLastError();
  if (hToken <> 0) then
    CloseHandle(hToken);
  if (hToken2 <> 0) then
    CloseHandle(hToken2);
  if (hProcess <> 0) then
    CloseHandle(hProcess);
  CloseHandle(lpProcessInformation.hThread);
  CloseHandle(lpProcessInformation.hProcess);
  Result := dwError;
end;

end.

要在您的项目中使用它，只需使用单元 MediumIL：

uses MediumIL;

…

procedure TForm1.FormCreate(Sender: TObject);
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin
  ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
  ZeroMemory(@ProcessInfo, SizeOf(ProcessInfo));
  CreateProcessMediumIL('C:\Windows\notepad.exe', nil, nil, nil, False, 0, nil, nil, StartupInfo, ProcessInfo);
end;

Answer 2

这篇博文很详细，很有用

http://developersoven.blogspot.com/2007/02/leveraging-vistas-uac-with-delphi-part.html

我们的想法是使用低权限的应用程序和高权限的 COM Dll。然后，当您需要提升时，您只需启动 COM。帖子中包含完整的 MPL 源链接。

Answer 3

请注意确定这是否会有所帮助，但在 c#.net 中有类似的问题here，但它可能会为您提供一些线索，或者您可以尝试使用 Delphi 的端口。

只是提示尽量不要在应用程序文件名中包含更新/安装/设置，因为 vista 会自动将安全图标添加到那里的 exe 中。

Answer 4

您可以使用CreateProcessWithLogonW() API 调用：

function CreateProcessWithLogonW(lpUsername: PWideChar; lpDomain: PWideChar;
  lpPassword: PWideChar; dwLogonFlags: DWORD; lpApplicationName: PWideChar;
  lpCommandLine: PWideChar; dwCreationFlags: DWORD; lpEnvironment: Pointer;
  lpCurrentDirectory: PWideChar; const lpStartupInfo: TStartupInfo;
  var lpProcessInformation: TProcessInformation): BOOL; stdcall;
  external 'advapi32.dll' name 'CreateProcessWithLogonW';



procedure RunAs(AUsername, APassword, ADomain, AApplication: string);
const
  LOGON_WITH_PROFILE = $00000001;
var
  si: TStartupInfo;
  pi: TProcessInformation;
begin
  ZeroMemory(@si, SizeOf(si));
  si.cb := SizeOf(si);
  si.dwFlags := STARTF_USESHOWWINDOW;
  si.wShowWindow := SW_NORMAL;
  ZeroMemory(@pi, SizeOf(pi));

  if not CreateProcessWithLogonW(PWideChar(WideString(AUsername)),
    PWideChar(WideString(ADomain)), PWideChar(WideString(APassword)),
    LOGON_WITH_PROFILE, nil, PWideChar(WideString(AApplication)),
    0, nil, nil, si, pi)
  then
    RaiseLastOSError;

  CloseHandle(pi.hThread);
  CloseHandle(pi.hProcess);
end;

Answer 5

Aaron Margosis 的以下文章正好涵盖了这个主题：FAQ: How do I start a program as the desktop user from an elevated app?

基本思想是获取shell进程的用户令牌，即explorer.exe，从中制作一个主令牌，最后用该令牌启动新进程。

本文包含一些 C++ 代码，这些代码应该很容易转换为 Delphi。它还包括以下列出该方法的详细列表：

1. 在您当前的令牌中启用 SeIncreaseQuotaPrivilege
2. 获取代表桌面外壳的 HWND (GetShellWindow)
3. 获取与该窗口关联的进程的进程 ID (PID) (GetWindowThreadProcessId)
4. 打开该进程 (OpenProcess)
5. 从该进程获取访问令牌 (OpenProcessToken)
6. 使用该令牌创建一个主令牌 (DuplicateTokenEx)
7. 使用该主令牌 (CreateProcessWithTokenW) 启动新进程

Answer 6

我想添加到上面的Elçins answer：

如果代码行：

  if (not DuplicateTokenEx(hToken, TOKEN_ALL_ACCESS, nil, SecurityImpersonation, TokenPrimary, hToken2)) then
goto _CleanUp;

返回错误5 (Access Denied)，然后TOKEN_ALL_ACCESS 需要ORed 和TOKEN_ADJUST_SESSIONID (0x100)。

在 Delphi 2010 上，将 LPVOID 更改为 POINTER。