UAC(User Account Control)の状態を取得する

Windows Vistaで導入されたUAC(User Account Control)が有効になっているかどうかはレジストリのHKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\SystemのEnableLUA(DWORD値)が0かどうかで判断できます(0はUAC無効、1はUAC有効)。一方でUACが有効のときにそのプロセスが管理者権限に昇格しているかどうかはOpenProcessToken (ja)でカレントプロセスのハンドルからアクセストークンを取得し、GetTokenInformation (ja)でTokenInformationClassにTokenElevationを指定して取得したTOKEN_ELEVATION構造体のTokenIsElevatedが0かどうかで判断できます(0は昇格していない、非0は昇格している)。

まずプロセスが管理者権限に昇格しているかどうかを判定する処理です。Windows.pasのTTokenInformationClassのTokenElevationやTOKEN_ELEVATION構造体の定義はDelphi 2009で追加されたものなので、それ以前のバージョンでは独自に定義する必要があります。

{$IF (NOT DEFINED(CONDITIONALEXPRESSIONS)) OR (RTLVersion < 20.0)}
type
  TTokenInformationClass = (TokenUser = 1,
                            TokenGroups,
                            TokenPrivileges,
                            TokenOwner,
                            TokenPrimaryGroup,
                            TokenDefaultDacl,
                            TokenSource,
                            TokenType,
                            TokenImpersonationLevel,
                            TokenStatistics,
                            TokenRestrictedSids,
                            TokenSessionId,
                            TokenGroupsAndPrivileges,
                            TokenSessionReference,
                            TokenSandBoxInert,
                            TokenAuditPolicy,
                            TokenOrigin,
                            TokenElevationType,
                            TokenLinkedToken,
                            TokenElevation,
                            TokenHasRestrictions,
                            TokenAccessInformation,
                            TokenVirtualizationAllowed,
                            TokenVirtualizationEnabled,
                            TokenIntegrityLevel,
                            TokenUIAccess,
                            TokenMandatoryPolicy,
                            TokenLogonSid,
                            MaxTokenInfoClass);
  {$EXTERNALSYM TTokenInformationClass}

  PTokenElevation = ^TTokenElevation;
  _TOKEN_ELEVATION = record
    TokenIsElevated: DWORD;
  end;
  {$EXTERNALSYM _TOKEN_ELEVATION}
  TTokenElevation = _TOKEN_ELEVATION;
  TOKEN_ELEVATION = _TOKEN_ELEVATION;
  {$EXTERNALSYM TOKEN_ELEVATION}

function GetTokenInformation(TokenHandle: THandle;
                             TokenInformationClass: TTokenInformationClass;
                             TokenInformation: Pointer;
                             TokenInformationLength: DWORD;
                             var ReturnLength: DWORD): BOOL; stdcall;
  external advapi32 name 'GetTokenInformation';
{$EXTERNALSYM GetTokenInformation}
{$IFEND}

function IsProcessTokenElevated(ProcessHandle: THandle): Boolean;
var
  TokenHandle: THandle;
  TE: TOKEN_ELEVATION;
  dwLength: DWORD;
begin

  Result := False;

  if OpenProcessToken(ProcessHandle,TOKEN_QUERY,TokenHandle) = False then
  begin
    Exit;
  end;

  try
    if GetTokenInformation(TokenHandle,TokenElevation,
                           @TE,SizeOf(TE),dwLength) = False then
    begin
      Exit;
    end;

  finally
    CloseHandle(TokenHandle);
  end;

  Result := (TE.TokenIsElevated <> 0);

end;

これを使用して、レジストリの値をチェックし、UACが有効ならIsProcessTokenElevatedで管理者権限に昇格しているかどうかを確認します。

type
  TUACStatus = (usNoUAC,           // UAC is not implemented
                usUACDisabled,     // UAC is disabled
                usUACEnabled,      // UAC is enabled
                usUACRunAsAdmin);  // UAC is enabled and process token is elevated

function GetUACStatus: TUACStatus;
var
  ReadValue: Integer;
begin

  Result := usNoUAC;

  if CheckWin32Version(6,0) = False then
  begin
    // Windows 2000 or XP: UAC is not implemented
    Exit;
  end;

  with TRegistry.Create do
  begin
    try
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKeyReadOnly('\Software\Microsoft\Windows\CurrentVersion\Policies\System') = False then
      begin
        raise ERegistryException.Create('Error: Cannot open registry key.');
      end;

      try
        ReadValue := ReadInteger('EnableLUA');
        if ReadValue = 0 then
        begin
          Result := usUACDisabled;
        end
        else
        begin
          Result := usUACEnabled;
        end;

      finally
        CloseKey;
      end;

    finally
      Free;
    end;
  end;

  if Result = usUACEnabled then
  begin
    if IsProcessTokenElevated(GetCurrentProcess) = True then
    begin
      Result := usUACRunAsAdmin;
    end;
  end;

end;

GetUACStatusの戻値がusUACEnabledの場合、REGEDITのように実行時に管理者権限を要求するプロセスを起動するときにUACの確認ダイアログが開くことになります(usNoUAC/usUACDisabledならUACは動作せず、usUACRunAsAdminなら既に昇格済なので確認されない)。

UACが有効かどうかとプロセスが昇格しているかは別々に取得するようにしたほうがいいのかもしれませんが、UAC有効でなければプロセスの昇格も起きないので、ここでは1つにまとめました。

元ねたはDisplay UAC Status - Sysinternals Forums - Page 1とEternalWindowsのセキュリティ / セキュリティコンテキスト / UAC。