verify local admin

[Patrick Comeau]

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

[L.J. Johnson]

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

[L.J. Johnson]

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

[L.J. Johnson]

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...

[L.J. Johnson]

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...

[Ben Neville]

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...
>
>

[Ben Neville]

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...
>
>