IS Administrator

Question:
Can I check if the user running the application has either local machine or domain administrative privileges? I have a piece of code which does this in C++ , but I require it for VB 5.0.

Answer:
The following code should work for you:

In a form, create Command1, and an array of 2 labels named Label1:

Private Sub Command1_Click()      If Module1.CheckLocalAdmin() = True Then      Me.Label1(0).Caption = " Is Local Admin"   Else      Me.Label1(0).Caption = " Is *NOT* Local Admin"   End If   If Module1.CheckPDCAdmin() = True Then      Me.Label1(1).Caption = " Is PDC Admin"   Else      Me.Label1(1).Caption = " Is *NOT* PDC Admin"   End IfEnd Sub

In a BAS file, insert the following code:

Option Explicit' Used for error trappingPrivate m_lngErrNum                    As LongPrivate m_strErrDesc                   As StringPrivate m_strErrSource                 As String' Win32 NetAPIs.Private Declare Function NetUserGetGroups _   Lib "netapi32.dll" _   (Servername As Byte, _    username As Byte, _    ByVal level As Long, _    Buffer As Long, _    ByVal prefmaxlen As Long, _    entriesread As Long, _    totalentries As Long) As LongPrivate Declare Function NetUserGetLocalGroups _   Lib "netapi32.dll" _   (Servername As Byte, _    username As Byte, _    ByVal level As Long, _    ByVal flags As Long, _    Buffer As Long, _    ByVal prefmaxlen As Long, _    entriesread As Long, _    totalentries As Long) As LongPrivate Declare Function NetApiBufferFree _   Lib "netapi32" _   (ByVal pBuffer As Long) As LongPrivate Declare Function GetComputerNameW _   Lib "kernel32" _   (lpBuffer As Any, _    nSize As Long) As LongPrivate Declare Function NetGetDCName _   Lib "netapi32.dll" _   (Servername As Byte, _    DomainName As Byte, _    Buffer As Long) As LongPrivate Declare Sub CopyMem _   Lib "kernel32" Alias "RtlMoveMemory" _   (pTo As Any, _    uFrom As Any, _    ByVal lSize As Long)Private Declare Function lstrlenW _   Lib "kernel32" _   (ByVal lpString As Long) As LongPrivate Declare Function lstrcpyW _   Lib "kernel32" _   (lpString1 As Byte, _    ByVal lpString2 As Long) As LongPrivate Declare Function GetUserName _   Lib "advapi32.dll" Alias "GetUserNameA" _   (ByVal lpBuffer As String, _    nSize As Long) As Long  ' Specific known errors for API calls used'     by this classPrivate Const ERROR_ACCESS_DENIED      As Long = 5&Private Const ERROR_INVALID_NAME       As Long = 123&Private Const ERROR_MORE_DATA          As Long = 234&Private Const NERR_BASE                As Long = 2100&Private Const NERR_Success             As Long = 0&Private Const NERR_GroupNotFound       As Long = NERR_BASE + 120&Private Const NERR_UserNotFound        As Long = NERR_BASE + 121&Private Const NERR_InvalidComputer     As Long = NERR_BASE + 251&Private Const NERR_DCNotFound          As Long = NERR_BASE + 353&Private Const LG_INCLUDE_INDIRECT      As Long = 1&Private Const UNLEN                    As Long = 256&' Private constants for this classPrivate Const constComputerNameLen     As Long = 15&     ' Maximum computer name lengthPrivate Const wbcErrNoGroupsFound      As Long = 9000 + vbObjectErrorPrivate Const wbcErrCouldNotFindPDC    As Long = 9001 + vbObjectError' Private member variablesPrivate m_strUserID                    As StringPublic Enum enumSecurityGroupLevel   NoSecurity = 0   UserSecurity = 1   AdminSecurity = 2   SuperAdminSecurity = 3End Enum' This is the error source for this modulePrivate Const m_constErrSource         As String = "MyProject" & ".clsNetGroups"' *******************************************************' Inputs       : N/A' Outputs      : Boolean: TRUE if a Local Admin, FALSE otherwise' Description  : Determine if current user is a local admininstrator' *******************************************************Public Function CheckLocalAdmin() As Boolean   Dim p_strPDCName     As String   Dim p_strUserID      As String   Dim p_vntRtn         As Variant   Dim p_lngNumItems    As Long   Dim p_lngLoop        As Long      ' Default to not admin (ie, FALSE)   CheckLocalAdmin = False      ' Get the current user   p_strUserID = GetCurrentUserID()      ' Get the groups this user belongs to   p_vntRtn = GetNTUserLocalGroups(p_strUserID)      ' Get the upper bounds of the group variant array   On Error Resume Next   p_lngNumItems = UBound(p_vntRtn)   If Err.Number <> 0 Then      Exit Function   End If   On Error GoTo 0      ' Check for Administrator rights   For p_lngLoop = 0 To p_lngNumItems      If UCase$(Trim$(p_vntRtn(p_lngLoop))) = "ADMINISTRATORS" Then         CheckLocalAdmin = True      End If   Next p_lngLoop   End Function' *******************************************************' Inputs       : N/A' Outputs      : Boolean: TRUE if a Domain Admin, FALSE otherwise' Description  : Determine if current user is a domain admin' *******************************************************Public Function CheckPDCAdmin() As Boolean   Dim p_strPDCName     As String   Dim p_strUserID      As String   Dim p_vntRtn         As Variant   Dim p_lngNumItems    As Long   Dim p_lngLoop        As Long      ' Default to not admin (ie, FALSE)   CheckPDCAdmin = False      ' Get the PDC name   p_strPDCName = GetPDC("", "")      ' Get the current user   p_strUserID = GetCurrentUserID()      ' Get the groups this user belongs to   p_vntRtn = GetNTUserGlobalGroups(p_strUserID, p_strPDCName)      ' Get the upper bounds of the group variant array   On Error Resume Next   p_lngNumItems = UBound(p_vntRtn)   If Err.Number <> 0 Then      Exit Function   End If   On Error GoTo 0      ' Check for Administrator rights   For p_lngLoop = 0 To p_lngNumItems      If UCase$(Trim$(p_vntRtn(p_lngLoop))) = "DOMAIN ADMINS" Then         CheckPDCAdmin = True      End If   Next p_lngLoop   End Function' *******************************************************' Inputs       : N/A' Outputs      : String: The UserID of the current logged-on user' Description  : Return the UserID of the current user'              :     that has logged onto NT' *******************************************************Private Function GetCurrentUserID() As StringOn Error Resume Next                   ' Don't accept errors here   Const p_constProcName               As String = "GetNTUserLocalGroups"   Dim p_strName                       As String   Dim p_lngNameLen                    As Long      ' Assume failure   GetCurrentUserID = ""   p_lngNameLen = UNLEN + 1   p_strName = String$(p_lngNameLen, Chr$(0))   If GetUserName(p_strName, p_lngNameLen) <> 0 Then      GetCurrentUserID = Mid$(p_strName, 1, p_lngNameLen - 1)   End IfOn Error GoTo 0End Function' *******************************************************' Inputs       : ByVal xi_strUserID:String   - UserID of current user' Outputs      : Variant: Array of NT group names' Description  : Pass in a userID and PDC, return a variant array'              :     of groups that this user belongs to' *******************************************************Private Function GetNTUserLocalGroups(ByVal xi_strUserID As String) As VariantOn Error Resume Next                   ' Don't accept errors here   Const p_constProcName               As String = "GetNTUserLocalGroups"   Dim p_bytUserName()                 As Byte   Dim p_bytServerName()               As Byte   Dim p_astrGroups()                  As String   Dim p_alngGroups()                  As Long   Dim p_strTmp                        As String   Dim p_lngRtn                        As Long   Dim p_lngBuffer                     As Long   Dim p_lngEntriesRead                As Long   Dim p_lngEntriesTotal               As Long   Dim p_lngLevel                      As Long   Dim p_lngBufferPtr                  As Long   Dim p_lngLoop                       As Long   Dim p_lngFlags                      As Long      ' Convert the user name to a byte array   p_bytUserName = xi_strUserID & vbNullChar      ' Convert the PDC name to a byte array   p_bytServerName = vbNullChar & vbNullChar      ' Get the groups   p_lngLevel = 0&   p_lngBufferPtr = 4096   p_lngFlags = LG_INCLUDE_INDIRECT   p_lngRtn = NetUserGetLocalGroups(p_bytServerName(0), _                                    p_bytUserName(0), _                                    p_lngLevel, _                                    p_lngFlags, _                                    p_lngBuffer, _                                    p_lngBufferPtr, _                                    p_lngEntriesRead, _                                    p_lngEntriesTotal)         ' Check for errors   If p_lngRtn = NERR_Success Then      ReDim p_alngGroups(0 To p_lngEntriesRead - 1) As Long      ReDim p_astrGroups(0 To p_lngEntriesRead - 1) As String      CopyMem p_alngGroups(0), ByVal p_lngBuffer, p_lngEntriesRead * 4      For p_lngLoop = 0 To p_lngEntriesRead - 1         p_astrGroups(p_lngLoop) = PointerToStringW(p_alngGroups(p_lngLoop))      Next p_lngLoop   Else      ' Do your own error handling here      m_lngErrNum = wbcErrNoGroupsFound            Select Case p_lngRtn         Case ERROR_ACCESS_DENIED            p_strTmp = "Access denied -- insufficient rights to run NetUserGetGroups function."         Case NERR_UserNotFound            p_strTmp = "User not found: " & xi_strUserID         Case Else            p_strTmp = "Unknown error: " & CStr(p_lngRtn)      End Select   End If      ' ------------------------------------------   ' Free the buffer   ' ------------------------------------------   If p_lngBuffer Then      NetApiBufferFree p_lngBuffer   End If      ' ------------------------------------------   ' Set the return value   ' ------------------------------------------   GetNTUserLocalGroups = p_astrGroups   On Error GoTo 0End Function' *******************************************************' Inputs       : ByVal xi_strUserID:String   - UserID of current user'              : ByVal xi_strPDCName:String  - PDC of domain (can be blank)' Outputs      : Variant: Array of NT group names' Description  : Pass in a userID and PDC, return a variant array'              :     of groups that this user belongs to' *******************************************************Private Function GetNTUserGlobalGroups(ByVal xi_strUserID As String, _                                       ByVal xi_strPDCName As String) As VariantOn Error Resume Next                   ' Don't accept errors here   Const p_constProcName               As String = "GetNTUserGlobalGroups"   Dim p_bytUserName()                 As Byte   Dim p_bytServerName()               As Byte   Dim p_astrGroups()                  As String   Dim p_alngGroups()                  As Long   Dim p_strTmp                        As String   Dim p_lngRtn                        As Long   Dim p_lngBuffer                     As Long   Dim p_lngEntriesRead                As Long   Dim p_lngEntriesTotal               As Long   Dim p_lngLevel                      As Long   Dim p_lngBufferPtr                  As Long   Dim p_lngLoop                       As Long      ' Convert the user name to a byte array   p_bytUserName = xi_strUserID & vbNullChar      ' Convert the PDC name to a byte array   If Len(Trim$(xi_strPDCName)) = 0 Then      p_bytServerName = vbNullChar   Else      If InStr(xi_strPDCName, "\") = 1 Then         p_bytServerName = xi_strPDCName & vbNullChar      Else         p_bytServerName = "\" & xi_strPDCName & vbNullChar      End If   End If      ' Get the groups   p_lngLevel = 0&   p_lngBufferPtr = 4096   p_lngRtn = NetUserGetGroups(p_bytServerName(0), _                               p_bytUserName(0), _                               p_lngLevel, _                               p_lngBuffer, _                               p_lngBufferPtr, _                               p_lngEntriesRead, _                               p_lngEntriesTotal)         ' Check for errors   If p_lngRtn = NERR_Success Then      ReDim p_alngGroups(0 To p_lngEntriesRead - 1) As Long      ReDim p_astrGroups(0 To p_lngEntriesRead - 1) As String      CopyMem p_alngGroups(0), ByVal p_lngBuffer, p_lngEntriesRead * 4      For p_lngLoop = 0 To p_lngEntriesRead - 1         p_astrGroups(p_lngLoop) = PointerToStringW(p_alngGroups(p_lngLoop))      Next p_lngLoop   Else      ' Do your own error handling here      m_lngErrNum = wbcErrNoGroupsFound            Select Case p_lngRtn         Case ERROR_ACCESS_DENIED            p_strTmp = "Access denied -- insufficient rights to run NetUserGetGroups function."         Case NERR_InvalidComputer            p_strTmp = "Invalid computer name for PDC: " & xi_strPDCName         Case NERR_UserNotFound            p_strTmp = "User not found: " & xi_strUserID         Case Else            p_strTmp = "Unknown error: " & CStr(p_lngRtn)      End Select   End If      ' Free the buffer   If p_lngBuffer Then      NetApiBufferFree p_lngBuffer   End If      ' Set the return value   GetNTUserGlobalGroups = p_astrGroups   On Error GoTo 0End Function' *******************************************************' Inputs       : ByVal xi_strServer:String   -- Name of server'              : ByVal xi_strDomain:String   -- Name of the domain'              : ByRef xo_strPDC_Name:String -- output, name of PDC' Outputs      : Long: Zero if successful, non-zero otherwise' Description  : Get the PDC of the current machine' *******************************************************Private Function GetPDC(ByVal xi_strServer As String, _                        ByVal xi_strDomain As String) As StringOn Error Resume Next                   ' Don't accept error here   Const p_constProcName               As String = "GetPDC"   Dim p_strTmp                        As String   Dim p_lngRtn                        As Long   Dim p_lngBufferPtr                  As Long   Dim p_astrTmp(100)                  As Byte   Dim p_abytServerName()              As Byte   Dim p_abytDomainName()              As Byte       ' Move to byte array   p_abytServerName = xi_strServer & vbNullChar   p_abytDomainName = xi_strDomain & vbNullChar               ' Get the name of the PDC   p_lngRtn = NetGetDCName(p_abytServerName(0), _                           p_abytDomainName(0), _                           p_lngBufferPtr)      ' Set the return value (zero is success)   If p_lngRtn = 0 Then      GetPDC = True   Else      GetPDC = False         ' Do your own error handling here      m_lngErrNum = wbcErrCouldNotFindPDC      Select Case p_lngRtn         Case NERR_DCNotFound            p_strTmp = "Could not find the domain controller for the current domain."         Case ERROR_INVALID_NAME            p_strTmp = "Invalid name for PDC -- the name could not be found."         Case Else            p_strTmp = "Unknown error: " & CStr(p_lngRtn)      End Select      m_strErrDesc = p_strTmp      m_strErrSource = m_constErrSource & "." & p_constProcName            On Error GoTo 0      Err.Raise m_lngErrNum, m_strErrSource, m_strErrDesc   End If        ' Translate the name   If p_lngRtn = 0 Then      GetPDC = PointerToStringW(p_lngBufferPtr)   Else      GetPDC = ""   End If      ' Free the buffer   NetApiBufferFree p_lngBufferPtrOn Error GoTo 0End Function' *******************************************************' Inputs       : ByVal xi_lngStrPtr:Long  -- Pointer to a string' Outputs      : String: Translated string' Description  : When passed a pointer to a string,'              :     return that string' *******************************************************Private Function PointerToStringW(ByVal xi_lngStrPtr As Long) As StringOn Error Resume Next                   ' Don't accept error here   Dim p_abytBuffer()                  As Byte   Dim p_lngLength                     As Long      If xi_lngStrPtr Then            p_lngLength = lstrlenW(xi_lngStrPtr) * 2            If p_lngLength Then         ReDim p_abytBuffer(0 To (p_lngLength - 1)) As Byte         CopyMem p_abytBuffer(0), ByVal xi_lngStrPtr, p_lngLength         PointerToStringW = p_abytBuffer      End If      End If   On Error GoTo 0End Function
Share the Post:
Share on facebook
Share on twitter
Share on linkedin

Overview

Recent Articles: