Delphi：需要时提示用户账户控制（UAC）权限提升

Question

Delphi：需要时提示用户账户控制（UAC）权限提升

delphiuacelevation

40

我们需要在运行时更改HKEY_LOCAL_MACHINE的一些设置。

在运行时，是否可以提示需要uac提升权限，或者我必须启动第二个提升了权限的进程来完成“脏工作”？

- Vegar

我在著名的Jedi Lib中看到了一篇很好的文章。 - Hugues Van Landeghem

Jedi示例中“提升应用程序的部分”依赖于COM对象，并调用该对象。使用COM对象的缺点是必须编写COM对象，甚至更糟糕的是：在用户计算机上注册它。更容易的方法是通过命令行、共享内存或命名管道传递指令。 - Ian Boyd

如果你必须使用凭据或大量数据，使用命令行传递指令会相当棘手。不应使用命名管道，因为它可以从计算机上的任何地方连接。而是使用管道句柄并将其发送到新进程（可以通过CreateProcess继承句柄）。要小心使用共享内存，因为它可能打开漏洞（主要是缓冲区溢出）。提升的进程必须仔细检查输入。 - ChristianWimmer

4个回答

22

您不能“提升”现有进程。在UAC下，提升的进程具有不同的令牌、不同的LUID、不同的强制完整性级别和不同的组成员。这种级别的更改无法在运行中的进程中进行——如果可以发生这种情况，那将是一个安全问题。

您需要启动一个提升的第二个进程来执行工作，或者通过创建在提升的dllhost中运行的COM对象来执行工作。 http://msdn.microsoft.com/en-us/library/bb756922.aspx 提供了一个“RunAsAdmin”函数和一个“CoCreateInstanceAsAdmin”函数的示例。

编辑：我刚刚看到您的标题中有“Delphi”。显然，我列出的所有内容都是本地的，但如果Delphi提供类似于ShellExecute的功能访问权限，您应该能够从链接中适应代码。

- Michael

2

我会研究一下。Delphi是本地的，并且提供对win32 api的完全访问，包括ShellExecute()。谢谢。 - Vegar

19

一个示例可直接使用的代码:

用法示例:

unit Unit1;

interface

uses
  Windows{....};

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    procedure StartWait;
    procedure EndWait;
  end;

var
  Form1: TForm1;

implementation

uses
  RunElevatedSupport;

{$R *.dfm}

const
  ArgInstallUpdate     = '/install_update';
  ArgRegisterExtension = '/register_global_file_associations';

procedure TForm1.FormCreate(Sender: TObject);
begin
  Label1.Caption := Format('IsAdministrator: %s',        [BoolToStr(IsAdministrator, True)]);
  Label2.Caption := Format('IsAdministratorAccount: %s', [BoolToStr(IsAdministratorAccount, True)]);
  Label3.Caption := Format('IsUACEnabled: %s',           [BoolToStr(IsUACEnabled, True)]);
  Label4.Caption := Format('IsElevated: %s',             [BoolToStr(IsElevated, True)]);

  Button1.Caption := 'Install updates';
  SetButtonElevated(Button1.Handle);
  Button2.Caption := 'Register file associations for all users';
  SetButtonElevated(Button2.Handle);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  StartWait;
  try
    SetLastError(RunElevated(ArgInstallUpdate, Handle, Application.ProcessMessages));
    if GetLastError <> ERROR_SUCCESS then
      RaiseLastOSError;
  finally
    EndWait;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  StartWait;
  try
    SetLastError(RunElevated(ArgRegisterExtension, Handle, Application.ProcessMessages));
    if GetLastError <> ERROR_SUCCESS then
      RaiseLastOSError;
  finally
    EndWait;
  end;
end;

function DoElevatedTask(const AParameters: String): Cardinal;

  procedure InstallUpdate;
  var
    Msg: String;
  begin
    Msg := 'Hello from InstallUpdate!' + sLineBreak +
           sLineBreak +
           'This function is running elevated under full administrator rights.' + sLineBreak +
           'This means that you have write-access to Program Files folder and you''re able to overwrite files (e.g. install updates).' + sLineBreak +
           'However, note that your executable is still running.' + sLineBreak +
           sLineBreak +
           'IsAdministrator: '        + BoolToStr(IsAdministrator, True) + sLineBreak +
           'IsAdministratorAccount: ' + BoolToStr(IsAdministratorAccount, True) + sLineBreak +
           'IsUACEnabled: '           + BoolToStr(IsUACEnabled, True) + sLineBreak +
           'IsElevated: '             + BoolToStr(IsElevated, True);
    MessageBox(0, PChar(Msg), 'Hello from InstallUpdate!', MB_OK or MB_ICONINFORMATION);
  end;

  procedure RegisterExtension;
  var
    Msg: String;
  begin
    Msg := 'Hello from RegisterExtension!' + sLineBreak +
           sLineBreak +
           'This function is running elevated under full administrator rights.' + sLineBreak +
           'This means that you have write-access to HKEY_LOCAL_MACHINE key and you''re able to write keys and values (e.g. register file extensions globally/for all users).' + sLineBreak +
           'However, note that this is usually not a good idea. It is better to register your file extensions under HKEY_CURRENT_USER\Software\Classes.' + sLineBreak +
           sLineBreak +
           'IsAdministrator: '        + BoolToStr(IsAdministrator, True) + sLineBreak +
           'IsAdministratorAccount: ' + BoolToStr(IsAdministratorAccount, True) + sLineBreak +
           'IsUACEnabled: '           + BoolToStr(IsUACEnabled, True) + sLineBreak +
           'IsElevated: '             + BoolToStr(IsElevated, True);
    MessageBox(0, PChar(Msg), 'Hello from RegisterExtension!', MB_OK or MB_ICONINFORMATION);
  end;

begin
  Result := ERROR_SUCCESS;
  if AParameters = ArgInstallUpdate then
    InstallUpdate
  else
  if AParameters = ArgRegisterExtension then
    RegisterExtension
  else
    Result := ERROR_GEN_FAILURE;
end;

procedure TForm1.StartWait;
begin
  Cursor := crHourglass;
  Screen.Cursor := crHourglass;
  Button1.Enabled := False;
  Button2.Enabled := False;
  Application.ProcessMessages;
end;

procedure TForm1.EndWait;
begin
  Cursor := crDefault;
  Screen.Cursor := crDefault;
  Button1.Enabled := True;
  Button2.Enabled := True;
  Application.ProcessMessages;
end;

initialization
  OnElevateProc := DoElevatedTask;
  CheckForElevatedTask;
end.

并支持单元本身：

unit RunElevatedSupport;

{$WARN SYMBOL_PLATFORM OFF}
{$R+}

interface

uses
  Windows;

type
  TElevatedProc        = function(const AParameters: String): Cardinal;
  TProcessMessagesMeth = procedure of object;

var
  // Warning: this function will be executed in external process.
  // Do not use any global variables inside this routine!
  // Use only supplied AParameters.
  OnElevateProc: TElevatedProc;

// Call this routine after you have assigned OnElevateProc
procedure CheckForElevatedTask;

// Runs OnElevateProc under full administrator rights
function RunElevated(const AParameters: String; const AWnd: HWND = 0; const AProcessMessages: TProcessMessagesMeth = nil): Cardinal; overload;

function  IsAdministrator: Boolean;
function  IsAdministratorAccount: Boolean;
function  IsUACEnabled: Boolean;
function  IsElevated: Boolean;
procedure SetButtonElevated(const AButtonHandle: THandle);


implementation

uses
  SysUtils, Registry, ShellAPI, ComObj;

const
  RunElevatedTaskSwitch = '0CC5C50CB7D643B68CB900BF000FFFD5'; // some unique value, just a GUID with removed '[', ']', and '-'

function CheckTokenMembership(TokenHandle: THANDLE; SidToCheck: Pointer; var IsMember: BOOL): BOOL; stdcall; external advapi32 name 'CheckTokenMembership';

function RunElevated(const AParameters: String; const AWnd: HWND = 0; const AProcessMessages: TProcessMessagesMeth = nil): Cardinal; overload;
var
  SEI: TShellExecuteInfo;
  Host: String;
  Args: String;
begin
  Assert(Assigned(OnElevateProc), 'OnElevateProc must be assigned before calling RunElevated');

  if IsElevated then
  begin
    if Assigned(OnElevateProc) then
      Result := OnElevateProc(AParameters)
    else
      Result := ERROR_PROC_NOT_FOUND;
    Exit;
  end;


  Host := ParamStr(0);
  Args := Format('/%s %s', [RunElevatedTaskSwitch, AParameters]);

  FillChar(SEI, SizeOf(SEI), 0);
  SEI.cbSize := SizeOf(SEI);
  SEI.fMask := SEE_MASK_NOCLOSEPROCESS;
  {$IFDEF UNICODE}
  SEI.fMask := SEI.fMask or SEE_MASK_UNICODE;
  {$ENDIF}
  SEI.Wnd := AWnd;
  SEI.lpVerb := 'runas';
  SEI.lpFile := PChar(Host);
  SEI.lpParameters := PChar(Args);
  SEI.nShow := SW_NORMAL;

  if not ShellExecuteEx(@SEI) then
   RaiseLastOSError;
  try

    Result := ERROR_GEN_FAILURE;
    if Assigned(AProcessMessages) then
    begin
      repeat
        if not GetExitCodeProcess(SEI.hProcess, Result) then
          Result := ERROR_GEN_FAILURE;
        AProcessMessages;
      until Result <> STILL_ACTIVE;
    end
    else
    begin
      if WaitForSingleObject(SEI.hProcess, INFINITE) <> WAIT_OBJECT_0 then
        if not GetExitCodeProcess(SEI.hProcess, Result) then
          Result := ERROR_GEN_FAILURE;
    end;

  finally
    CloseHandle(SEI.hProcess);
  end;
end;

function IsAdministrator: Boolean;
var
  psidAdmin: Pointer;
  B: BOOL;
const
  SECURITY_NT_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
  SECURITY_BUILTIN_DOMAIN_RID  = $00000020;
  DOMAIN_ALIAS_RID_ADMINS      = $00000220;
  SE_GROUP_USE_FOR_DENY_ONLY  = $00000010;
begin
  psidAdmin := nil;
  try
    // Создаём SID группы админов для проверки
    Win32Check(AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2,
      SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0,
      psidAdmin));

    // Проверяем, входим ли мы в группу админов (с учётов всех проверок на disabled SID)
    if CheckTokenMembership(0, psidAdmin, B) then
      Result := B
    else
      Result := False;
  finally
    if psidAdmin <> nil then
      FreeSid(psidAdmin);
  end;
end;

{$R-}

function IsAdministratorAccount: Boolean;
var
  psidAdmin: Pointer;
  Token: THandle;
  Count: DWORD;
  TokenInfo: PTokenGroups;
  HaveToken: Boolean;
  I: Integer;
const
  SECURITY_NT_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
  SECURITY_BUILTIN_DOMAIN_RID  = $00000020;
  DOMAIN_ALIAS_RID_ADMINS      = $00000220;
  SE_GROUP_USE_FOR_DENY_ONLY  = $00000010;
begin
  Result := Win32Platform <> VER_PLATFORM_WIN32_NT;
  if Result then
    Exit;

  psidAdmin := nil;
  TokenInfo := nil;
  HaveToken := False;
  try
    Token := 0;
    HaveToken := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, Token);
    if (not HaveToken) and (GetLastError = ERROR_NO_TOKEN) then
      HaveToken := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, Token);
    if HaveToken then
    begin
      Win32Check(AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2,
        SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0,
        psidAdmin));
      if GetTokenInformation(Token, TokenGroups, nil, 0, Count) or
         (GetLastError <> ERROR_INSUFFICIENT_BUFFER) then
        RaiseLastOSError;
      TokenInfo := PTokenGroups(AllocMem(Count));
      Win32Check(GetTokenInformation(Token, TokenGroups, TokenInfo, Count, Count));
      for I := 0 to TokenInfo^.GroupCount - 1 do
      begin
        Result := EqualSid(psidAdmin, TokenInfo^.Groups[I].Sid);
        if Result then
          Break;
      end;
    end;
  finally
    if TokenInfo <> nil then
      FreeMem(TokenInfo);
    if HaveToken then
      CloseHandle(Token);
    if psidAdmin <> nil then
      FreeSid(psidAdmin);
  end;
end;

{$R+}

function IsUACEnabled: Boolean;
var
  Reg: TRegistry;
begin
  Result := CheckWin32Version(6, 0);
  if Result then
  begin
    Reg := TRegistry.Create(KEY_READ);
    try
      Reg.RootKey := HKEY_LOCAL_MACHINE;
      if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Policies\System', False) then
        if Reg.ValueExists('EnableLUA') then
          Result := (Reg.ReadInteger('EnableLUA') <> 0)
        else
          Result := False
      else
        Result := False;
    finally
      FreeAndNil(Reg);
    end;
  end;
end;

function IsElevated: Boolean;
const
  TokenElevation = TTokenInformationClass(20);
type
  TOKEN_ELEVATION = record
    TokenIsElevated: DWORD;
  end;
var
  TokenHandle: THandle;
  ResultLength: Cardinal;
  ATokenElevation: TOKEN_ELEVATION;
  HaveToken: Boolean;
begin
  if CheckWin32Version(6, 0) then
  begin
    TokenHandle := 0;
    HaveToken := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, TokenHandle);
    if (not HaveToken) and (GetLastError = ERROR_NO_TOKEN) then
      HaveToken := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, TokenHandle);
    if HaveToken then
    begin
      try
        ResultLength := 0;
        if GetTokenInformation(TokenHandle, TokenElevation, @ATokenElevation, SizeOf(ATokenElevation), ResultLength) then
          Result := ATokenElevation.TokenIsElevated <> 0
        else
          Result := False;
      finally
        CloseHandle(TokenHandle);
      end;
    end
    else
      Result := False;
  end
  else
    Result := IsAdministrator;
end;

procedure SetButtonElevated(const AButtonHandle: THandle);
const
  BCM_SETSHIELD = $160C;
var
  Required: BOOL;
begin
  if not CheckWin32Version(6, 0) then
    Exit;
  if IsElevated then
    Exit;

  Required := True;
  SendMessage(AButtonHandle, BCM_SETSHIELD, 0, LPARAM(Required));
end;

procedure CheckForElevatedTask;

  function GetArgsForElevatedTask: String;

    function PrepareParam(const ParamNo: Integer): String;
    begin
      Result := ParamStr(ParamNo);
      if Pos(' ', Result) > 0 then
        Result := AnsiQuotedStr(Result, '"');
    end;

  var
    X: Integer;
  begin
    Result := '';
    for X := 1 to ParamCount do
    begin
      if (AnsiUpperCase(ParamStr(X)) = ('/' + RunElevatedTaskSwitch)) or
         (AnsiUpperCase(ParamStr(X)) = ('-' + RunElevatedTaskSwitch)) then
        Continue;

      Result := Result + PrepareParam(X) + ' ';
    end;

    Result := Trim(Result);
  end;

var
  ExitCode: Cardinal;
begin
  if not FindCmdLineSwitch(RunElevatedTaskSwitch) then
    Exit;

  ExitCode := ERROR_GEN_FAILURE;
  try
    if not IsElevated then
      ExitCode := ERROR_ACCESS_DENIED
    else
    if Assigned(OnElevateProc) then
      ExitCode := OnElevateProc(GetArgsForElevatedTask)
    else
      ExitCode := ERROR_PROC_NOT_FOUND;
  except
    on E: Exception do
    begin
      if E is EAbort then
        ExitCode := ERROR_CANCELLED
      else
      if E is EOleSysError then
        ExitCode := Cardinal(EOleSysError(E).ErrorCode)
      else
      if E is EOSError then
      else
        ExitCode := ERROR_GEN_FAILURE;
    end;
  end;

  if ExitCode = STILL_ACTIVE then
    ExitCode := ERROR_GEN_FAILURE;
  TerminateProcess(GetCurrentProcess, ExitCode);
end;

end.

- Alex

2

通常，在您的EXE名称中放置“Setup”或“Install”文本足以使Windows自动以提升的权限运行，并且如果您正在编写设置实用程序，则非常值得这样做，因为这很容易实现。

但是，我现在在Windows 7上遇到了问题，当未作为管理员登录时，手动运行时必须使用右键单击“以管理员身份运行”（通过Wise安装向导运行程序仍然可以），这让我很烦恼。

不过，我发现Delphi 10.1 Berlin在项目选项|应用程序下有一个非常易于使用的新选项。只需勾选启用管理员特权，清单就会为您完成，非常简单！

注意：请确保您仅通过单独的设置程序进行此类更改，始终以提升的权限运行应用程序可能会导致其他问题，例如电子邮件，其中默认邮件配置文件不再被拾取。

编辑：2018年1月：自2017年8月撰写本答案以来，似乎已经推出了许多Windows更新，现在需要用户右键单击并以管理员身份运行几乎所有内容，即使是使用Wise构建的安装exe。甚至Outlook也不能正常安装而不以管理员身份运行。似乎没有自动提升的功能了。

- Maya

1

Windows有启发式功能，试图捕捉那些未向其设置/安装可执行文件添加强制的程序集清单（表示requireAdministrator）的不良开发人员。这些启发式功能可以通过组策略关闭（就像我所做的那样）。正确的答案是遵循Windows应用规则：所有可执行文件都必须有程序集清单。同时：安装应用程序的正确方法是通过MSI。然后，Windows Installer技术会知道是否需要提升权限，并自行询问。但是，如果您想要自己的setup.exe，则必须有一个清单。 - Ian Boyd

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Ian Boyd · Accepted Answer

我会建议你以提升的方式重新启动自己，并传递命令行参数指示你想要执行哪些提升操作。然后，你可以直接跳转到相应的表单，或者只是保存你的HKLM内容。

function RunAsAdmin(hWnd: HWND; filename: string; Parameters: string): Boolean;
{
    See Step 3: Redesign for UAC Compatibility (UAC)
    http://msdn.microsoft.com/en-us/library/bb756922.aspx

    This code is released into the public domain. No attribution required.
}
var
    sei: TShellExecuteInfo;
begin
    ZeroMemory(@sei, SizeOf(sei));
    sei.cbSize := SizeOf(TShellExecuteInfo);
    sei.Wnd := hwnd;
    sei.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI;
    sei.lpVerb := PChar('runas');
    sei.lpFile := PChar(Filename); // PAnsiChar;
    if parameters <> '' then
        sei.lpParameters := PChar(parameters); // PAnsiChar;
    sei.nShow := SW_SHOWNORMAL; //Integer;

    Result := ShellExecuteEx(@sei);
end;

微软提供的另一种解决方案是创建一个进程外的COM对象（使用专门创建的CoCreateInstanceAsAdmin函数）。我不喜欢这个想法，因为你必须编写并注册一个COM对象。

注意：没有“CoCreateInstanceAsAdmin” API调用。它只是一些代码漂浮在周围。这里是我找到的Delphi版本。它显然基于一个技巧，在通常隐藏的代码内部调用CoGetObject时，给一个类GUID字符串加上“Elevation:Administrator!new:”前缀：

function CoGetObject(pszName: PWideChar; pBindOptions: PBindOpts3; 
      const iid: TIID; ppv: PPointer): HResult; stdcall; external 'ole32.dll';

procedure CoCreateInstanceAsAdmin(const Handle: HWND; 
      const ClassID, IID: TGuid; PInterface: PPointer);
var
   BindOpts: TBindOpts3;
   MonikerName: WideString;
   Res: HRESULT;
begin
   //This code is released into the public domain. No attribution required.
   ZeroMemory(@BindOpts, Sizeof(TBindOpts3));
   BindOpts.cbStruct := Sizeof(TBindOpts3);
   BindOpts.hwnd := Handle;
   BindOpts.dwClassContext := CLSCTX_LOCAL_SERVER;

   MonikerName := 'Elevation:Administrator!new:' + GUIDToString(ClassID);

   Res := CoGetObject(PWideChar(MonikerName), @BindOpts, IID, PInterface);
   if Failed(Res) then 
      raise Exception.Create(SysErrorMessage(Res));
end;

另一个问题：你如何处理在Windows XP中以标准用户身份运行的人？