Check is user has Administrator Privileges 1

[dgschnei]

How can find out if the user has administrator privileges using VB and/or VB script?

If the user does not have administrator privileges, I simply want to display a message and quit.

Thanks

PS:
I can get the user's name and computer name using
VBA.Environ("USERNAME&quot, Function GetUserName using advapi32.dll, Function GetComputerName using kernel32...

 

[suoirotciv]

Hope this will help

Just use the IsAdministrator Function
===================================================
Option Explicit
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
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 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
hProcessID = GetCurrentProcess()

If hProcessID <> 0 Then
If OpenProcessToken(hProcessID, TOKEN_READ, hToken) = 1 Then
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

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

sAcctName1 = Space$(255)
sDomainName = Space$(255)
cbAcctName = 255
cbDomainName = 255
res = LookupAccountSid(vbNullString, _
lSid, _
sAcctName1, _
cbAcctName, _
sDomainName, _
cbDomainName, _
peUse)

If res = 1 Then

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

 

[redhelix]

Does anyone know how to perform the same task in VBSCRIPT? I have a large network and need to check for blank local Administrator passwords.

Thanks in advance,
BK

 

[mrmovie]

we have looked on MS site and have found documentation which points to the user being able to create stuff in the root of the registry.

you could iterate through the members of the local admin group but then you would have to recursively check each group in a group as well, it can be done though.

anyway, we have found the registry approach is good enough

 

[mharcourt]

Try this and replace the <MachineName> and <UserName> in the script. Don't forget to add error checking for the WMI connection.

Set objWMIService = GetObject(&quot;winMgmts:\\&quot; & <Machine Name> &&quot;\root\cimv2&quot
For Each objItem In objWMIService.ExecQuery(&quot;ASSOCIATORS OF {Win32_Group.Domain='BUILTIN',Name='Administrators'} Where AssocClass=Win32_GroupUser&quot
On Error Resume Next
If InStr(1,objItem.Caption,<User Name>,vbTextCompare) Then
MsgBox &quot;User Local Admin Group&quot;
End If
Next

Set objWMIService = Nothing