Delphi: запрашивать повышение уровня контроля учетных записей при необходимости

Question

Нам нужно изменить некоторые настройки на HKEY_LOCAL_MACHINE во время выполнения.

Можно ли запрашивать повышение уровня UAC, если это необходимо во время выполнения, или мне нужно запустить второй процесс с повышенными правами для выполнения "грязной работы"?

Answer 1

я бы перезапустил себя как повышенный, передав параметры командной строки, указывающие, что повышенный уровень вы хотите сделать. Затем вы можете перейти прямо к соответствующей форме или просто сохранить свои материалы 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;

Другим предлагаемым Microsoft решением является создание COM-объекта вне процесса (с помощью специально созданной функции CoCreateInstanceAsAdmin). Мне не нравится эта идея, потому что вы должны написать и зарегистрировать COM-объект.

---

Примечание: Нет вызова API "CoCreateInstanceAsAdmin". Это просто какой-то код, плавающий вокруг. Вот версия Dephi, ради которой я споткнулся. По-видимому, он основан на приеме префикса строки класса с префиксом " Elevation: Administrator! New: ", когда обычно скрытый код внутренне вызывает CoGetObject :

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?

Answer 2

Вы не можете "поднять" существующий процесс. Повышенные процессы в UAC имеют другой токен с другим LUID, другим обязательным уровнем целостности и различным членством в группах. Изменения такого уровня не могут быть выполнены в работающем процессе - и это могло бы стать проблемой безопасности, если бы это могло произойти.

Вам нужно запустить второй процесс с повышенными правами, который бы выполнял эту работу, или путем создания COM-объекта, который запускается на повышенном хосте dll.

http://msdn.microsoft.com/en-us/library/bb756922.aspx содержит пример функции «RunAsAdmin» и функции «CoCreateInstanceAsAdmin».

РЕДАКТИРОВАТЬ: Я только что увидел "Delphi" в вашем названии. Все, что я перечислил, очевидно, является нативным, но если Delphi предоставляет доступ к функциональности, подобной ShellExecute, вы сможете адаптировать код по ссылке.

Answer 3

образец готового к использованию кода :

Пример использования:

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.

Answer 4

Обычно размещения текста «Setup» или «Install» в имени вашего EXE-файла достаточно, чтобы Windows автоматически запускалась с повышенными привилегиями, и это стоит делать, если вы пишете утилиту установки, поскольку это так просто. делать.

Теперь у меня проблемы с Windows 7, когда вы не вошли в систему как администратор, и мне приходится использовать правый щелчок «Запуск от имени администратора» при запуске вручную (запуск программы с помощью мастера установки Wise все еще работает)

Я вижу, что в Delphi 10.1 Berlin появилась очень простая в использовании новая опция в разделе Параметры проекта | Заявка. Просто установите флажок Включить права администратора, и манифест для вас готов, так просто!

NB. Убедитесь, что вы делаете подобные изменения только через отдельную программу установки, так как постоянное выполнение приложения с повышенными привилегиями может вызвать проблемы с другими вещами, например с электронной почтой, когда почтовый профиль по умолчанию больше не выбирается.

Редактировать: январь 2018 года: с момента написания этого ответа в августе 2017 года, похоже, появилось много обновлений Windows, которые теперь требуют от пользователя щелчка правой кнопкой мыши и запуска от имени администратора практически на всем, даже на встроенном exe-сборке. с мудрым. Даже Outlook больше не устанавливается должным образом без запуска от имени администратора. Кажется, больше нет автоматизированной отметки.