// Nico Bendlin

unit TokenTools;

interface 

uses 
  Windows; 

function CheckTokenMembership(TokenHandle: THandle; SidToCheck: PSID; 
  out IsMember: BOOL): BOOL; stdcall; 
function SHTestTokenMembership(hToken: THandle; ulRID: ULONG): BOOL; stdcall; 
function IsUserAnAdmin(): BOOL; stdcall; 

implementation 

function GetAdvApi32Lib(): HMODULE; 
const 
  ModuleName = 'ADVAPI32'; 
{$WRITEABLECONST ON} 
const 
  ModuleHandle: HMODULE = HMODULE(nil); 
{$WRITEABLECONST OFF} 
begin 
  Result := ModuleHandle; 
  if Result = HMODULE(nil) then 
  begin 
    Result := LoadLibrary(ModuleName); 
    if Result <> HMODULE(nil) then 
      ModuleHandle := Result; 
  end; 
end; 

function CheckTokenMembership(TokenHandle: THandle; SidToCheck: PSID; 
  out IsMember: BOOL): BOOL; 
type 
  TFNCheckTokenMembership = function(TokenHandle: THandle; SidToCheck: PSID; 
    out IsMember: BOOL): BOOL; stdcall; 
{$WRITEABLECONST ON} 
const 
  Initialized: Integer = 0; 
  RealApiFunc: TFNCheckTokenMembership = nil; 
{$WRITEABLECONST OFF} 
type 
  TAceHeader = packed record 
    AceType : Byte; 
    AceFlags: Byte; 
    AceSize : Word; 
  end; 
  TAccessAllowedAce = packed record 
    Header  : TAceHeader; 
    Mask    : ACCESS_MASK; 
    SidStart: DWORD; 
  end; 
const 
  ACL_REVISION = 2; 
  DesiredAccess = 1; 
  GenericMapping: TGenericMapping = ( 
    GenericRead   : STANDARD_RIGHTS_READ; 
    GenericWrite  : STANDARD_RIGHTS_WRITE; 
    GenericExecute: STANDARD_RIGHTS_EXECUTE; 
    GenericAll    : STANDARD_RIGHTS_ALL 
  ); 
var 
  ClientToken: THandle; 
  ProcessToken: THandle; 
  SecurityDescriptorSize: Cardinal; 
  SecurityDescriptor: PSecurityDescriptor; 
  Dacl: PACL; 
  PrivilegeSetBufferSize: ULONG; 
  PrivilegeSetBuffer: packed record 
    PrivilegeSet: TPrivilegeSet; 
    Buffer: array [0..2] of TLUIDAndAttributes; 
  end; 
  GrantedAccess: ACCESS_MASK; 
  AccessStatus: BOOL; 
begin 
  if Initialized = 0 then 
  begin 
    RealApiFunc := TFNCheckTokenMembership( 
      GetProcAddress(GetAdvApi32Lib(), 'CheckTokenMembership')); 
    InterlockedIncrement(Initialized); 
  end; 
  if Assigned(RealApiFunc) then 
    Result := RealApiFunc(TokenHandle, SidToCheck, IsMember) 
  else 
  begin 
    Result := False; 
    IsMember := False; 
    ClientToken := THandle(nil); 
    try 
      if TokenHandle <> THandle(nil) then 
        ClientToken := TokenHandle 
      else if not OpenThreadToken(GetCurrentThread(), TOKEN_QUERY, False, 
        ClientToken) then 
      begin 
        ClientToken := THandle(nil); 
        if GetLastError() = ERROR_NO_TOKEN then 
        begin 
          if OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY or 
            TOKEN_DUPLICATE, ProcessToken) then 
          try 
            if not DuplicateToken(ProcessToken, SecurityImpersonation, 
              @ClientToken) then 
            begin 
              ClientToken := THandle(nil); 
            end; 
          finally 
            CloseHandle(ProcessToken); 
          end; 
        end; 
      end; 
      if ClientToken <> THandle(nil) then 
      begin 
        SecurityDescriptorSize := SizeOf(TSecurityDescriptor) + 
          SizeOf(TAccessAllowedAce) + SizeOf(TACL) + 
          3 * GetLengthSid(SidToCheck); 
        SecurityDescriptor := PSecurityDescriptor( 
          LocalAlloc(LMEM_ZEROINIT, SecurityDescriptorSize)); 
        if SecurityDescriptor <> nil then 
        try 
          if InitializeSecurityDescriptor(SecurityDescriptor, 
            SECURITY_DESCRIPTOR_REVISION) then 
          begin 
            if SetSecurityDescriptorOwner(SecurityDescriptor, SidToCheck, 
              False) then 
            begin 
              if SetSecurityDescriptorGroup(SecurityDescriptor, SidToCheck, 
                False) then 
              begin 
                Dacl := PACL(SecurityDescriptor); 
                Inc(PSecurityDescriptor(Dacl)); 
                if InitializeAcl(Dacl^, 
                  SecurityDescriptorSize - SizeOf(TSecurityDescriptor), 
                  ACL_REVISION) then 
                begin 
                  if AddAccessAllowedAce(Dacl^, ACL_REVISION, DesiredAccess, 
                    SidToCheck) then 
                  begin 
                    if SetSecurityDescriptorDacl(SecurityDescriptor, True, Dacl, 
                      False) then 
                    begin 
                      PrivilegeSetBufferSize := SizeOf(PrivilegeSetBuffer); 
                      Result := AccessCheck(SecurityDescriptor, ClientToken, 
                        DesiredAccess, GenericMapping, 
                        PrivilegeSetBuffer.PrivilegeSet, PrivilegeSetBufferSize, 
                        GrantedAccess, AccessStatus); 
                      if Result then 
                        IsMember := AccessStatus and 
                          (GrantedAccess = DesiredAccess); 
                    end; 
                  end; 
                end; 
              end; 
            end; 
          end; 
        finally 
          LocalFree(HLOCAL(SecurityDescriptor)); 
        end; 
      end; 
    finally 
      if (ClientToken <> THandle(nil)) and 
        (ClientToken <> TokenHandle) then 
      begin 
        CloseHandle(ClientToken); 
      end; 
    end; 
  end; 
end; 

function GetShell32Lib(): HMODULE; 
const 
  ModuleName = 'SHELL32'; 
{$WRITEABLECONST ON} 
const 
  ModuleHandle: HMODULE = HMODULE(nil); 
{$WRITEABLECONST OFF} 
begin 
  Result := ModuleHandle; 
  if Result = HMODULE(nil) then 
  begin 
    Result := LoadLibrary(ModuleName); 
    if Result <> HMODULE(nil) then 
      ModuleHandle := Result; 
  end; 
end; 

function SHTestTokenMembership(hToken: THandle; ulRID: ULONG): BOOL; stdcall; 
type 
  TFNSHTestTokenMembership = function(hToken: THandle; ulRID: ULONG): BOOL; stdcall; 
{$WRITEABLECONST ON} 
const 
  Initialized: Integer = 0; 
  RealApiFunc: TFNSHTestTokenMembership = nil; 
{$WRITEABLECONST OFF} 
const 
  SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5)); 
  SECURITY_BUILTIN_DOMAIN_RID = $00000020; 
var 
  SidToCheck: PSID; 
begin 
  if Initialized = 0 then 
  begin 
    RealApiFunc := TFNSHTestTokenMembership( 
      GetProcAddress(GetShell32Lib(), 'SHTestTokenMembership')); 
    InterlockedIncrement(Initialized); 
  end; 
  if Assigned(RealApiFunc) then 
    Result := RealApiFunc(hToken, ulRID) 
  else 
  begin 
    Result := AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2, 
      SECURITY_BUILTIN_DOMAIN_RID, ulRID, 0, 0, 0, 0, 0, 0, SidToCheck); 
    if Result then 
    try 
      if not CheckTokenMembership(THandle(nil), SidToCheck, Result) then 
        Result := False; 
    finally 
      FreeSid(SidToCheck); 
    end; 
  end; 
end; 

function IsUserAnAdmin(): BOOL; 
const 
  DOMAIN_ALIAS_RID_ADMINS = $00000220; 
type 
  TFNIsUserAnAdmin = function(): BOOL; stdcall; 
{$WRITEABLECONST ON} 
const 
  Initialized: Integer = 0; 
  RealApiFunc: TFNIsUserAnAdmin = nil; 
{$WRITEABLECONST OFF} 
begin 
  if Initialized = 0 then 
  begin 
    RealApiFunc := TFNIsUserAnAdmin( 
      GetProcAddress(GetShell32Lib(), 'IsUserAnAdmin')); 
    InterlockedIncrement(Initialized); 
  end; 
  if Assigned(RealApiFunc) then 
    Result := RealApiFunc() 
  else 
    Result := SHTestTokenMembership(THandle(nil), DOMAIN_ALIAS_RID_ADMINS); 
end; 

end.