Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const TOKEN_READ As Long = &H20008
Private Const SECURITY_BUILTIN_DOMAIN_RID As Long = &H20&
Private Const DOMAIN_ALIAS_RID_ADMINS As Long = &H220&
Private Const SECURITY_NULL_SID_AUTHORITY As Long = &H0
Private Const SECURITY_WORLD_SID_AUTHORITY As Long = &H1
Private Const SECURITY_LOCAL_SID_AUTHORITY As Long = &H2
Private Const SECURITY_CREATOR_SID_AUTHORITY As Long = &H3
Private Const SECURITY_NON_UNIQUE_AUTHORITY As Long = &H4
Private Const SECURITY_NT_AUTHORITY As Long = &H5
'TOKEN_INFORMATION_CLASS enums for TOKEN_GROUPS
Private Const TokenUser As Long = 1
Private Const TokenGroups As Long = 2
Private Const TokenPrivileges As Long = 3
Private Const TokenOwner As Long = 4
Private Const TokenPrimaryGroup As Long = 5
Private Const TokenDefaultDacl As Long = 6
Private Const TokenSource As Long = 7
Private Const TokenType As Long = 8
Private Const TokenImpersonationLevel As Long = 9
Private Const TokenStatistics As Long = 10
Private Const TokenRestrictedSids As Long = 11
Private Const TokenSessionId As Long = 12
Private Const TokenGroupsAndPrivileges As Long = 13
Private Const TokenSessionReference As Long = 14
Private Const TokenSandBoxInert As Long = 15
Private Type SID_IDENTIFIER_AUTHORITY
Value(6) As Byte
End Type
Private Type SID_AND_ATTRIBUTES
Sid As Long
Attributes As Long
End Type
Private Type TOKEN_GROUPS
GroupCount As Long
Groups(500) As SID_AND_ATTRIBUTES
End Type
Private Declare Function LookupAccountSid Lib "advapi32.dll" _
Alias "LookupAccountSidA" _
(ByVal lpSystemName As String, _
ByVal Sid As Long, _
ByVal name As String, _
cbName As Long, _
ByVal ReferencedDomainName As String, _
cbReferencedDomainName As Long, _
peUse As Long) As Long
Private Declare Function AllocateAndInitializeSid Lib "advapi32.dll" _
(pIdentifierAuthority As SID_IDENTIFIER_AUTHORITY, _
ByVal nSubAuthorityCount As Byte, _
ByVal nSubAuthority0 As Long, _
ByVal nSubAuthority1 As Long, _
ByVal nSubAuthority2 As Long, _
ByVal nSubAuthority3 As Long, _
ByVal nSubAuthority4 As Long, _
ByVal nSubAuthority5 As Long, _
ByVal nSubAuthority6 As Long, _
ByVal nSubAuthority7 As Long, _
lpPSid As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" _
(ByVal ProcessHandle As Long, _
ByVal DesiredAccess As Long, _
TokenHandle As Long) As Long
Private Declare Function GetTokenInformation Lib "advapi32.dll" _
(ByVal TokenHandle As Long, _
ByVal TokenInformationClass As Long, _
TokenInformation As Any, _
ByVal TokenInformationLength As Long, _
ReturnLength As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Sub FreeSid Lib "advapi32.dll" _
(pSid As Any)
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Sub Command1_Click()
If IsAdministrator() Then
MsgBox "Current user is member of the Administrator's group", _
vbInformation, "IsAdministrator Demo"
Else
MsgBox "User is not a member of the Administrator's group", _
vbInformation, "IsAdministrator Demo"
End If
End Sub
Private Function IsAdministrator() As Long
Dim hProcessID As Long
Dim hToken As Long
Dim res As Long
Dim cbBuff As Long
Dim tiLen As Long
Dim TG As TOKEN_GROUPS
Dim SIA As SID_IDENTIFIER_AUTHORITY
Dim lSid As Long
Dim cnt As Long
Dim sAcctName1 As String
Dim sAcctName2 As String
Dim cbAcctName As Long
Dim sDomainName As String
Dim cbDomainName As Long
Dim peUse As Long
tiLen = 0
'obtain handle to process. 0 indicates failure;
'may return -1 for current process (and is valid)
hProcessID = GetCurrentProcess()
If hProcessID <> 0 Then
'obtain a handle to the access
'token associated with the process
If OpenProcessToken(hProcessID, TOKEN_READ, hToken) = 1 Then
'retrieve specified information
'about an access token. The first
'call to GetTokenInformation fails
'since the buffer size is unspecified.
'On failure the correct buffer size
'is returned (cbBuff), and a subsequent call
'is made to return the data.
res = GetTokenInformation(hToken, _
TokenGroups, _
TG, _
tiLen, _
cbBuff)
If res = 0 And cbBuff > 0 Then
tiLen = cbBuff
res = GetTokenInformation(hToken, _
TokenGroups, _
TG, _
tiLen, _
cbBuff)
If res = 1 And tiLen > 0 Then
'The SID_IDENTIFIER_AUTHORITY (SIA) structure
'represents the top-level authority of a
'security identifier (SID). By specifying
'we want admins (by setting the value of
'the fifth item to SECURITY_NT_AUTHORITY),
'and passing the relative identifiers (RID)
'DOMAIN_ALIAS_RID_ADMINS and
'SECURITY_BUILTIN_DOMAIN_RID, we obtain
'the SID for the administrators account
'in lSid
SIA.Value(5) = SECURITY_NT_AUTHORITY
res = AllocateAndInitializeSid(SIA, 2, _
SECURITY_BUILTIN_DOMAIN_RID, _
DOMAIN_ALIAS_RID_ADMINS, _
0, 0, 0, 0, 0, 0, _
lSid)
If res = 1 Then
'Now obtain the name of the account
'pointed to by lSid above (ie
'"Administrators"). Note vbNullString
'is passed as lpSystemName indicating
'the SID is looked up on the local computer.
'
'Re sDomainName: On Win NT+ systems, the
'domain name returned for most accounts in
'the local computer's security database is
'the computer's name as of the last start
'of the system (backslashes excluded). If
'the computer's name changes, the old name
'continues to be returned as the domain
'name until the system is restarted.
'
'On Win NT+ Server systems, the domain name
'returned for most accounts in the local
'computer's security database is the
'name of the domain for which the server is
'a domain controller.
'
'Some accounts are predefined by the system.
'The domain name returned for these accounts
'is 'BUILTIN'.
'
'sAcctName is the value of interest in this
'exercise.
sAcctName1 = Space$(255)
sDomainName = Space$(255)
cbAcctName = 255
cbDomainName = 255
res = LookupAccountSid(vbNullString, _
lSid, _
sAcctName1, _
cbAcctName, _
sDomainName, _
cbDomainName, _
peUse)
If res = 1 Then
'In the call to GetTokenInformation above,
'the TOKEN_GROUP member was filled with
'the SIDs of the defined groups.
'
'Here we take each SID from the token
'group and retrieve the name of the account
'corresponding to the SID. If a SID returns
'the same name retrieved above, the user under
'which the process is run is a member of the
'admin group.
For cnt = 0 To TG.GroupCount - 1
sAcctName2 = Space$(255)
sDomainName = Space$(255)
cbAcctName = 255
cbDomainName = 255
res = LookupAccountSid(vbNullString, _
TG.Groups(cnt).Sid, _
sAcctName2, _
cbAcctName, _
sDomainName, _
cbDomainName, _
peUse)
If sAcctName1 = sAcctName2 Then
IsAdministrator = True
Exit For
End If 'if sAcctName1 = sAcctName2
Next
End If 'if res = 1 (LookupAccountSid)
FreeSid ByVal lSid
End If 'if res = 1 (AllocateAndInitializeSid)
CloseHandle hToken
End If 'if res = 1
End If 'if res = 0 (GetTokenInformation)
End If 'if OpenProcessToken
CloseHandle hProcessID
End If 'if hProcessID (GetCurrentProcess)
End Function |