Enumerate all Groups a User Belongs To (NT or 2000)

Category:

Network/Internet

Type:

Snippets

Difficulty:

Advanced

Author:

Intelligent Solutions Inc.

Version Compatibility: Visual Basic 6

More information:

Refer to code comments for explanation.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
Option Explicit Private Declare Function NetUserGetGroups Lib "netapi32" _ (lpServer As Any, UserName As Byte, ByVal Level As Long, _ lpBuffer As Long, ByVal PrefMaxLen As Long, lpEntriesRead As _ Long, lpTotalEntries As Long) As Long Private Declare Function NetUserGetLocalGroups _ Lib "Netapi32.dll" (lpServer As Any, UserName As Byte, _ ByVal Level As Long, ByVal Flags As Long, lpBuffer As Long, _ ByVal MaxLen As Long, lpEntriesRead As Long, _ lpTotalEntries As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" (Destination As Any, Source As Any, _ ByVal Length As Long) Private Declare Function lstrlenW Lib "kernel32" _ (ByVal lpString As Long) As Long Private Declare Function NetApiBufferFree Lib "netapi32" _ (ByVal pBuffer As Long) As Long

Code:

Public Function GetUserGroups(ByVal ServerName As String, _
  ByVal UserName As String, Optional bLocalGroups _
  As Boolean = False) As String()

'******************************************************
'DESCRIPTION:   RETURNS A STRING ARRAY OF NT GROUPS A GIVEN
'               USER BELONGS TO ON A GIVEN SERVER

'PARAMETERS:

'ServerName:    Name of Server
'UserName:      Name of User
'bLocalGroups  (Optional): if True returns local groups. Defaults
'               to false, meaning that global groups are returned

'RETURNS:       If Successful, a string array of each NT group
'               UserName belongs to on ServerName.  Otherwise,
'               returns a 1 element array with "" as the only
'               element

'REQUIRES:
'                -- Windows NT4 or Windows 2000

'                -- VB 6 because string array is returned
'                   (though it would be easy to modify for VB5)
'               --  Assumes Option Base 1 is not set

'EXAMPLE:       dim sUserArray() as String, iCtr as integer
'               sUserArray = GetUserGroups("MyServer", "JoeUser")
'               If sUserArray(0) <> "" then
'                 For iCtr = 0 to Ubound(sUserArray)
'                   debug.print sUserArray(ictr)
'                 Next
'               End if
'***********************************************************

Dim bytUser() As Byte
Dim bytServer() As Byte

Dim lBuffer As Long
Dim lEntries As Long
Dim lMaxLen As Long
Dim lTotalEntries As Long
Dim lRet As Long
Dim lGroups() As Long
Dim sGroups() As String
Dim bytBuffer() As Byte
Dim iCtr As Integer
Dim lLen As Long

If bLocalGroups Then
    ServerName = vbNullChar
Else
    If Left(ServerName, 2) <> "\\" Then ServerName = _
   "\\" & ServerName

End If

bytServer = ServerName & vbNullChar
bytUser = UserName & vbNullChar

If bLocalGroups Then
 lRet = NetUserGetLocalGroups(bytServer(0), bytUser(0), 0, 0, _
   lBuffer, 1024, lMaxLen, lTotalEntries)

Else
 lRet = NetUserGetGroups(bytServer(0), bytUser(0), 0, _
   lBuffer, 1024, lMaxLen, lTotalEntries)

End If
    
If lRet = 0 And lMaxLen > 0 Then
      ReDim lGroups(lMaxLen - 1) As Long
      ReDim sGroups(lMaxLen - 1) As String
      CopyMemory lGroups(0), ByVal lBuffer, lMaxLen * 4
      For iCtr = 0 To lMaxLen - 1
          lLen = lstrlenW(lGroups(iCtr)) * 2
           If lLen > 0 Then
                ReDim bytBuffer(lLen - 1) As Byte
                CopyMemory bytBuffer(0), ByVal lGroups(iCtr), _
                   lLen
                sGroups(iCtr) = bytBuffer
                
            End If
      Next
Else
        ReDim sGroups(0) As String
End If
 
If lBuffer > 0 Then NetApiBufferFree (lBuffer)
GetUserGroups = sGroups

End Function