verify local admin


DevX Home    Today's Headlines   Articles Archive   Tip Bank   Forums   

Results 1 to 7 of 7

Thread: verify local admin

Hybrid View

  1. #1
    Patrick Comeau Guest

    verify local admin

    Could anybody let me know how to verify if a logged user is a Local admin?
    Thanks
    Patrick



  2. #2
    L.J. Johnson Guest

    Re: verify local admin

    Patrick,

    > Could anybody let me know how to verify if a logged user is a Local admin?


    The following code should do the job...

    ***************************************************************

    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



  3. #3
    L.J. Johnson Guest

    Re: verify local admin

    Patrick,

    Oh, FYI, this only works on NT/W2K. If you need to check from Win9x, you
    will need to either (1) run this code as a component on a NT machine
    (server) as ActiveX exe via DCOM or as a DLL running under MTS, or (2) thunk
    down to 16-bit on the Win9x machine.

    --
    L.J. Johnson, Slightly Tilted Software
    Microsoft MVP (Visual Basic)
    LJJohnson@SlightlyTiltedSoftware.com or LJJohnson@mvps.org
    <http://www.SlightlyTiltedSoftware.com>
    Ask The NT Pro at <http://www.devx.com/gethelp>

    "L.J. Johnson" <LJJohnson@SlightlyTiltedSoftware.com> wrote in message
    news:3ab97a77@news.devx.com...



  4. #4
    Ben Neville Guest

    Re: verify local admin

    Another method can be found at
    http://www.netfokus.dk/vbadmincode/codevb.html

    This method checks context via your token which means you do not have to
    enumerate a users groups from the domain controller.

    Rgds
    Ben

    "L.J. Johnson" <LJJohnson@SlightlyTiltedSoftware.com> wrote in message
    news:3ab97cd4$1@news.devx.com...
    > Patrick,
    >
    > Oh, FYI, this only works on NT/W2K. If you need to check from Win9x, you
    > will need to either (1) run this code as a component on a NT machine
    > (server) as ActiveX exe via DCOM or as a DLL running under MTS, or (2)

    thunk
    > down to 16-bit on the Win9x machine.
    >
    > --
    > L.J. Johnson, Slightly Tilted Software
    > Microsoft MVP (Visual Basic)
    > LJJohnson@SlightlyTiltedSoftware.com or LJJohnson@mvps.org
    > <http://www.SlightlyTiltedSoftware.com>
    > Ask The NT Pro at <http://www.devx.com/gethelp>
    >
    > "L.J. Johnson" <LJJohnson@SlightlyTiltedSoftware.com> wrote in message
    > news:3ab97a77@news.devx.com...
    >
    >




  5. #5
    L.J. Johnson Guest

    Re: verify local admin

    Patrick,

    > Could anybody let me know how to verify if a logged user is a Local admin?


    The following code should do the job...

    ***************************************************************

    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



  6. #6
    L.J. Johnson Guest

    Re: verify local admin

    Patrick,

    Oh, FYI, this only works on NT/W2K. If you need to check from Win9x, you
    will need to either (1) run this code as a component on a NT machine
    (server) as ActiveX exe via DCOM or as a DLL running under MTS, or (2) thunk
    down to 16-bit on the Win9x machine.

    --
    L.J. Johnson, Slightly Tilted Software
    Microsoft MVP (Visual Basic)
    LJJohnson@SlightlyTiltedSoftware.com or LJJohnson@mvps.org
    <http://www.SlightlyTiltedSoftware.com>
    Ask The NT Pro at <http://www.devx.com/gethelp>

    "L.J. Johnson" <LJJohnson@SlightlyTiltedSoftware.com> wrote in message
    news:3ab97a77@news.devx.com...



  7. #7
    Ben Neville Guest

    Re: verify local admin

    Another method can be found at
    http://www.netfokus.dk/vbadmincode/codevb.html

    This method checks context via your token which means you do not have to
    enumerate a users groups from the domain controller.

    Rgds
    Ben

    "L.J. Johnson" <LJJohnson@SlightlyTiltedSoftware.com> wrote in message
    news:3ab97cd4$1@news.devx.com...
    > Patrick,
    >
    > Oh, FYI, this only works on NT/W2K. If you need to check from Win9x, you
    > will need to either (1) run this code as a component on a NT machine
    > (server) as ActiveX exe via DCOM or as a DLL running under MTS, or (2)

    thunk
    > down to 16-bit on the Win9x machine.
    >
    > --
    > L.J. Johnson, Slightly Tilted Software
    > Microsoft MVP (Visual Basic)
    > LJJohnson@SlightlyTiltedSoftware.com or LJJohnson@mvps.org
    > <http://www.SlightlyTiltedSoftware.com>
    > Ask The NT Pro at <http://www.devx.com/gethelp>
    >
    > "L.J. Johnson" <LJJohnson@SlightlyTiltedSoftware.com> wrote in message
    > news:3ab97a77@news.devx.com...
    >
    >




Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
HTML5 Development Center
 
 
FAQ
Latest Articles
Java
.NET
XML
Database
Enterprise
Questions? Contact us.
C++
Web Development
Wireless
Latest Tips
Open Source


   Development Centers

   -- Android Development Center
   -- Cloud Development Project Center
   -- HTML5 Development Center
   -- Windows Mobile Development Center