devxlogo

IS Administrator

IS Administrator

Why Trust Us

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
devxblackblue

About Our Editorial Process

At DevX, we’re dedicated to tech entrepreneurship. Our team closely follows industry shifts, new products, AI breakthroughs, technology trends, and funding announcements. Articles undergo thorough editing to ensure accuracy and clarity, reflecting DevX’s style and supporting entrepreneurs in the tech sphere.

See our full editorial policy.

About Our Journalist

Charlie Frank

Charlie has over a decade of experience in website administration and technology management. As the site admin, he oversees all technical aspects of running a high-traffic online platform, ensuring optimal performance, security, and user experience.
View Author
Show More