dcsimg
Login | Register   
RSS Feed
Download our iPhone app
TODAY'S HEADLINES  |   ARTICLE ARCHIVE  |   FORUMS  |   TIP BANK
Browse DevX
Sign up for e-mail newsletters from DevX

By submitting your information, you agree that devx.com may send you DevX offers via email, phone and text message, as well as email offers about other products and services that DevX believes may be of interest to you. DevX will process your information in accordance with the Quinstreet Privacy Policy.


Tip of the Day
Language: NT
Expertise: Beginner
Jun 22, 1998

WEBINAR:

On-Demand

Application Security Testing: An Integral Part of DevOps


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 If

End Sub
In a BAS file, insert the following code:

Option Explicit

' Used for error trapping
Private m_lngErrNum                    As Long
Private m_strErrDesc                   As String
Private 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 Long
Private 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 Long
Private Declare Function NetApiBufferFree _
   Lib "netapi32" _
   (ByVal pBuffer As Long) As Long
Private Declare Function GetComputerNameW _
   Lib "kernel32" _
   (lpBuffer As Any, _
    nSize As Long) As Long
Private Declare Function NetGetDCName _
   Lib "netapi32.dll" _
   (Servername As Byte, _
    DomainName As Byte, _
    Buffer As Long) As Long
Private 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 Long
Private Declare Function lstrcpyW _
   Lib "kernel32" _
   (lpString1 As Byte, _
    ByVal lpString2 As Long) As Long
Private 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 class
Private 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 class
Private Const constComputerNameLen     As Long = 15&     ' Maximum computer name length
Private Const wbcErrNoGroupsFound      As Long = 9000 + vbObjectError
Private Const wbcErrCouldNotFindPDC    As Long = 9001 + vbObjectError

' Private member variables
Private m_strUserID                    As String

Public Enum enumSecurityGroupLevel
   NoSecurity = 0
   UserSecurity = 1
   AdminSecurity = 2
   SuperAdminSecurity = 3
End Enum

' This is the error source for this module
Private 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 String
On 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 If

On Error GoTo 0
End 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 Variant
On 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 0
End 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 Variant
On 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 0
End 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 String
On 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_lngBufferPtr

On Error GoTo 0
End 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 String
On 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 0
End Function
DevX Pro
 
Comment and Contribute

 

 

 

 

 


(Maximum characters: 1200). You have 1200 characters left.

 

 

Sitemap
Thanks for your registration, follow us on our social networks to keep up-to-date