Private Declare Function NetWkstaUserEnum Lib "netapi32" (ByVal lpServer As String, ByVal Level As Long, lpBuffer As Long, ByVal PrefMaxLen As Long, lpEntriesRead As Long, lpTotalEntries As Long, Resume_Handle 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 NetApiBufferFree Lib "netapi32" (ByVal pBuffer As Long) As Long
Private Const ERROR_MORE_DATA = 234
Private Type WKSTA_USER_INFO_0
wkui0_username As Long
End Type
Private Const ERROR_ACCESS_DENIED As Long = 5
Private Const ERROR_BAD_NETPATH As Long = 53
Private Const ERROR_INVALID_PARAMETER As Long = 87
Private Const ERROR_NOT_SUPPORTED As Long = 50
Private Const ERROR_INVALID_NAME As Long = 123
Public Function GetCompUsers(ByVal ServerName As String, ByRef sUsers() As String, ByRef lCount As Long) As Boolean
Dim lpBuffer As Long
Dim lpUsers() As WKSTA_USER_INFO_0
Dim nRead As Long
Dim nTotal As Long
Dim retVal As Long
Dim i As Long
Dim hResume As Long
GetCompUsers = False
lCount = 0
Erase sUsers
If Len(ServerName) = 0 Then
ServerName = vbNullString
Else
If Left(ServerName, 2) <> "\\" Then
ServerName = "\\" & ServerName
End If
ServerName = StrConv(ServerName, vbUnicode)
End If
hResume = 0
Do
retVal = NetWkstaUserEnum(ServerName, 0, lpBuffer, &H4000, nRead, nTotal, hResume)
If retVal = 0 Or retVal = ERROR_MORE_DATA Then
lCount = lCount + nRead
GetCompUsers = True
If nRead > 0 Then
ReDim lpUsers(0 To nRead - 1)
ReDim Preserve sUsers(0 To lCount - 1)
CopyMem lpUsers(0), ByVal lpBuffer, nRead * Len(lpUsers(0))
For i = 0 To nRead - 1
sUsers(lCount - nRead + i) = PointerToStringW(lpUsers(i).wkui0_username)
Next i
End If
DoEvents
Else
ReDim sUsers(0)
Select Case retVal
Case ERROR_ACCESS_DENIED
sUsers(0) = "Error :
Access Denied"
Case ERROR_BAD_NETPATH
sUsers(0) = "Error : Bad Network Path"
Case ERROR_NOT_SUPPORTED
sUsers(0) = "Error : Not Supported"
Case ERROR_INVALID_NAME
sUsers(0) = "Error : Invalid Name"
Case Else
sUsers(0) = "Error : " & retVal & vbCrLf & "Ask Frans to include this error description"
End Select
lCount = 1
End If
Loop While retVal = ERROR_MORE_DATA
' Clean up
If lpBuffer Then
retVal = NetApiBufferFree(lpBuffer)
End If
End Function