Update: la funzione postata precedente conteneva un bel po' di errori; posto una versione corretta:
codice:
Option Explicit
Private Declare Function NetUserEnum Lib "netapi32" (ByVal servername As Long, ByVal level As Long, ByVal filter As Long, ByRef bufptr As Long, ByVal prefmaxlen As Long, ByRef entriesread As Long, ByRef totalentries As Long, ByRef resume_handle As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Private Declare Function NetApiBufferFree Lib "netapi32" (ByVal buffer As Long) As Long
Public Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Const FILTER_NORMAL_ACCOUNT = &H2&
Private Const MAX_PREFERRED_LENGTH = -1&
Public Function GetUserNames() As String()
Dim bufptr As Long, dwerr As Long 'puntatore al buffer, codice di errore
Dim entriesread As Long, totalentries As Long 'numero di utenti letti, numero di utenti totali
Dim counter As Long 'contatore per il for
Dim ptr As Long 'pseudo-puntatore
dwerr = NetUserEnum(0, 0, FILTER_NORMAL_ACCOUNT, bufptr, MAX_PREFERRED_LENGTH, entriesread, totalentries, ByVal 0) 'ottiene i puntatori ai nomi degli utenti nella memoria puntata da bufptr
Select Case dwerr 'gestione errori
Case 0 'NERR_Success
'continua
Case 8 'ERROR_ACCESS_DENIED
Err.Raise 70, "GetUserNames", "NetUserEnum returned ERROR_ACCESS_DENIED. You don't have the permission to enumerate users."
Case Else 'altro
If bufptr <> 0 Then NetApiBufferFree bufptr 'se è stato allocato qualcosa libera la memoria
Err.Raise 51, "GetUserNames", "NetUserEnum returned " & LTrim(CStr(dwerr)) & "."
End Select
If bufptr = 0 Then Err.Raise 51, "GetUserNames", "NetUserEnum haven't allocated the buffer." 'se non è stato allocato niente notifica l'errore
ReDim usernames(entriesread - 1) As String 'array dinamico delle dimensioni corrette
For counter = 0 To entriesread - 1 'copia dei nomi utente dal buffer al normale array VB6
CopyMemory VarPtr(ptr), bufptr + counter * 4, 4 'dereferenzia il puntatore contenuto in bufptr + counter * 4; il risultato è in ptr
usernames(counter) = Space$(lstrlenW(ptr)) 'alloca una stringa di dimensione uguale a quella da copiare
CopyMemory StrPtr(usernames(counter)), ptr, Len(usernames(counter)) * 2 'copia la stringa dal buffer all'array VB
Next
dwerr = NetApiBufferFree(bufptr) 'libera la memoria allocata dalle NetApi
If dwerr <> 0 Then Err.Raise 51, "GetUserNames", "NetAPIBufferFree returned " & LTrim(CStr(dwerr)) & "." 'gestione errori
GetUserNames = usernames
End Function