by Mark D (1 Submission)
Category: Windows System Services
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Tue 16th April 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
This will return a list of users and groups on a server. If given the user name and server name, it will also return the groups the user is in.
API Declarations
Private Declare Function NetUserGetGroups Lib "netapi32" _
(lpServer As Byte, _
username As Byte, _
ByVal level As Long, _
lpBuffer As Long, _
ByVal buffsize As Long, _
entriesread As Long, _
totalentries As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(xDest As Any, _
xSource As Any, _
ByVal nBytes As Long)
Private Declare Function NetApiBufferFree Lib "netapi32" _
(ByVal Buffer As Long) As Long
Private Declare Function NetUserEnum Lib "netapi32" _
(servername As Byte, _
ByVal level As Long, _
ByVal filter As Long, _
buff As Long, _
ByVal buffsize As Long, _
entriesread As Long, _
totalentries As Long, _
resumehandle As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As Long
Private Declare Function NetGroupEnum Lib "netapi32" _
(servername As Byte, _
ByVal level As Long, _
buff As Long, _
ByVal buffsize As Long, _
entriesread As Long, _
totalentries As Long, _
resumehandle As Long) As Long
Const ERROR_SUCCESS As Long = 0&
VBcoders
'This module will return primarily three items:
'1. A list of all users
'2. A list of all groups
'3. A list of groups for a user
'The objControl parameter should be a list box
'"The Big Picture"
'Based on the user name given and the server name,
'we will determine which groups they are a part of
Public Function GetUserGroup(objControl As Object, gServerName As String, gUsername As String) As Boolean
Dim bServername() As Byte
Dim bUsername() As Byte
Dim groups() As Long
Dim buff As Long
Dim buffsize As Long
Dim entriesread As Long
Dim totalentries As Long
Dim cnt As Integer
On Error GoTo ErrHandle
buffsize = 10000000
If InStr(gServerName, "\\") = 0 Then
gServerName = "\\" & gServerName
End If
bServername() = gServerName & Chr$(0)
bUsername() = gUsername & Chr$(0)
objControl.Clear
If NetUserGetGroups(bServername(0), bUsername(0), 0, _
buff, buffsize, _
entriesread, _
totalentries) = ERROR_SUCCESS Then
ReDim groups(0 To entriesread - 1) As Long
CopyMemory groups(0), ByVal buff, entriesread * 4
For cnt = 0 To entriesread - 1
objControl.AddItem GetPointerToByteStringW(groups(cnt))
Next cnt
NetApiBufferFree buff
GetUserGroup = True
Exit Function
Else
GetUserGroup = False
End If
ErrHandle:
GetUserGroup = False
End Function
Public Function GetUserList(objControl As Object, gServerName As String) As Boolean
Dim users() As Long
Dim buff As Long
Dim buffsize As Long
Dim entriesread As Long
Dim totalentries As Long
Dim cnt As Integer
Dim bServername() As Byte
Dim lReturn As Long
On Error GoTo ErrHandle
If InStr(gServerName, "\\") = 0 Then
gServerName = "\\" & gServerName
End If
bServername() = gServerName & Chr$(0)
buffsize = 10000000
lReturn = NetUserEnum(bServername(0), 0, _
0, _
buff, buffsize, _
entriesread, _
totalentries, 0&)
If lReturn = ERROR_SUCCESS Then
ReDim users(0 To entriesread - 1) As Long
CopyMemory users(0), ByVal buff, entriesread * 4
objControl.Clear
For cnt = 0 To entriesread - 1
objControl.AddItem GetPointerToByteStringW(users(cnt))
Next cnt
NetApiBufferFree buff
GetUserList = True
Else
'MsgBox "Your error code is: " & lReturn & " good luck finding out what that means!"
GetUserList = False
End If
Exit Function
ErrHandle:
GetUserList = False
End Function
Public Function GetGroupList(objControl As Object, gServerName As String) As Boolean
Dim users() As Long
Dim buff As Long
Dim buffsize As Long
Dim entriesread As Long
Dim totalentries As Long
Dim cnt As Integer
Dim bServername() As Byte
On Error GoTo ErrHandle
If InStr(gServerName, "\\") = 0 Then
gServerName = "\\" & gServerName
End If
bServername() = gServerName & Chr$(0)
buffsize = 10000000
If NetGroupEnum(bServername(0), 0, _
buff, buffsize, _
entriesread, _
totalentries, 0&) = ERROR_SUCCESS Then
ReDim users(0 To entriesread - 1) As Long
CopyMemory users(0), ByVal buff, entriesread * 4
objControl.Clear
For cnt = 0 To entriesread - 1
objControl.AddItem GetPointerToByteStringW(users(cnt))
Next cnt
NetApiBufferFree buff
GetGroupList = True
Else
GetGroupList = False
End If
Exit Function
ErrHandle:
GetGroupList = False
End Function
Private Function GetPointerToByteStringW(lpString As Long) As String
Dim buff() As Byte
Dim nSize As Long
If lpString Then
'its Unicode, so mult. by 2
nSize = lstrlenW(lpString) * 2
If nSize Then
ReDim buff(0 To (nSize - 1)) As Byte
CopyMemory buff(0), ByVal lpString, nSize
GetPointerToByteStringW = buff
End If
End If
End Function
No comments have been posted about This will return a list of users and groups on a server. If given the user name and server name, it. Why not be the first to post a comment about This will return a list of users and groups on a server. If given the user name and server name, it.
