Récupération des utilisateurs et de leurs groupes pour nt4

Commenter

Contenu du snippet

Récupere dans une table access existante tous les utilisateurs et leurs groupes.

Source / Exemple : 


Option Compare Database
Option Explicit

Const Server = "\\MonServeur"
Const UsersTable = "Users"
Const FieldUser = "UserName"
Const FieldGroup = "GroupName"

' Level 0 - Ne retourne que le nom des comptes...
' The bufptr parameter (NetUserEnum) points to
' an array of USER_INFO_0 structures.
Private Type USER_INFO_0
  usri0_name As Long
End Type

Private Type GROUP_USERS_INFO_0
  grui0_name As Long
End Type

' Enumerates domain controller account data on a domain controller.
Private Const FILTER_SERVER_TRUST_ACCOUNT = &H20&
Private Const MAX_PREFERRED_LENGTH = -1&
Private Const NERR_SUCCESS = 0
Private Const NERR_InvalidComputer = 53
' Enumerates global user account data on a computer.
Private Const FILTER_NORMAL_ACCOUNT = &H2&
' More entries are available. Specify a large enough
' buffer to receive all entries.
Private Const ERROR_MORE_DATA = 234&

Private Declare Function apiNetUserEnum _
    Lib "Netapi32.dll" Alias "NetUserEnum" _
    (ByVal ServerName As Long, _
    ByVal Level As Long, _
    ByVal filter As Long, _
    bufptr As Long, _
    ByVal PrefMaxLen As Long, _
    entriesread As Long, _
    totalentries As Long, _
    resume_handle As Long) _
    As Long

Public Declare Function NetUserGetGroups _
    Lib "Netapi32.dll" _
        (ByVal lpServer As Long, _
        ByVal UserName As Long, _
        ByVal Level As Long, _
        lpBuffer As Long, _
        ByVal PrefMaxLen As Long, _
        lpEntriesRead As Long, _
        lpTotalEntries As Long) As Long

' moves memory either forward or backward, aligned or unaligned,
' in 4-byte blocks, followed by any remaining bytes
Private Declare Sub sapiCopyMem _
    Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As Any, _
    Source As Any, _
    ByVal Length As Long)

' function frees the memory that the NetApiBufferAllocate
' function allocates.
Private Declare Function apiNetAPIBufferFree _
    Lib "Netapi32.dll" Alias "NetApiBufferFree" _
    (ByVal buffer As Long) _
    As Long

' Retrieves the length of the specified wide string.
Private Declare Function apilstrlenW _
    Lib "kernel32" Alias "lstrlenW" _
    (ByVal lpString As Long) _
    As Long

Sub Test()
    RecupUsersGroups Server, UsersTable
    MsgBox "Récupération Terminée"
End Sub

Sub RecupUsersGroups(ServerName As String, TableName As String)
    CurrentDb.Execute "Delete * from " & TableName
    fEnumServerUsers ServerName
End Sub

Sub UserGroupsList(UserName As String, StrDomaine As String, TableName As String)
Dim GroupObj As Object
Dim UserObj As Object
Dim Matb As Recordset
    Set UserObj = GetObject("WinNT://" & StrDomaine & "/" & UserName)
    Set Matb = CurrentDb.OpenRecordset(TableName, dbOpenDynaset)
    For Each GroupObj In UserObj.Groups
        Matb.AddNew
        Matb.Fields(0) = UserName
        Matb.Fields(1) = GroupObj.Name
        Matb.Update
    Next
    Matb.Close
    Set UserObj = Nothing
End Sub

Function fEnumServerUsers(strServerName As String) As Boolean
' -------------------------------
'         NT / WIN2000 ONLY
' -------------------------------
' Enumerates all Global accounts on a NT
' server, LEVEL_0
' if len(strServerName)=0,
' assume local machine
'
'On Error GoTo ErrHandler
Dim abytServerName() As Byte
Dim pBuf As Long
Dim pTmpBuf As USER_INFO_0
Dim dwLevel As Long
Dim dwPrefMaxLen As Long
Dim dwEntriesRead As Long
Dim dwTotalEntries As Long
Dim dwResumeHandle As Long
Dim i As Long
Dim dwTotalCount As Long
Dim nStatus As Long
    ' assume MAX_PREFERRED_LENGTH
    dwPrefMaxLen = MAX_PREFERRED_LENGTH
    abytServerName = strServerName & vbNullChar
    dwLevel = 0 ' Level 0 call
    Do
        'only global users
        nStatus = apiNetUserEnum(VarPtr(abytServerName(0)), _
                            dwLevel, _
                            FILTER_NORMAL_ACCOUNT, _
                            pBuf, _
                            dwPrefMaxLen, _
                            dwEntriesRead, _
                            dwTotalEntries, _
                            dwResumeHandle)
        ' If the call succeeds,
        If ((nStatus = NERR_SUCCESS) Or (nStatus = ERROR_MORE_DATA)) Then
            ' Loop through the entries.
            For i = 0 To dwEntriesRead - 1
                sapiCopyMem pTmpBuf, ByVal (pBuf + (i * 4)), Len(pTmpBuf) ' 4=len(USER_INFO_0)
                ' Print the name of the user account.
                fEnumGroupsUsers strServerName, fStrFromPtrW(pTmpBuf.usri0_name)
                ' Keep a count of accounts enumerated
                dwTotalCount = dwTotalCount + 1
            Next
        End If
        ' free the associated memory
        apiNetAPIBufferFree pBuf
        pBuf = 0
    Loop While (nStatus = ERROR_MORE_DATA)
    If Not (pBuf = 0) Then apiNetAPIBufferFree pBuf
    fEnumServerUsers = True
ExitHere:
    Exit Function
ErrHandler:
    fEnumServerUsers = False
    Resume ExitHere
End Function

Function fEnumGroupsUsers(strServerName As String, UserName As String) As Boolean
'On Error GoTo ErrHandler
Dim abytServerName() As Byte
Dim abytUserName() As Byte
Dim pBuf As Long
Dim pTmpBuf As GROUP_USERS_INFO_0
Dim dwLevel As Long
Dim dwPrefMaxLen As Long
Dim dwEntriesRead As Long
Dim dwTotalEntries As Long
Dim i As Long
Dim dwTotalCount As Long
Dim nStatus As Long
Dim Matb As Recordset
    Set Matb = CurrentDb.OpenRecordset(UsersTable, dbOpenDynaset)
    ' assume MAX_PREFERRED_LENGTH
    dwPrefMaxLen = MAX_PREFERRED_LENGTH
    abytServerName = strServerName & vbNullChar
    abytUserName = UserName & vbNullChar
    dwLevel = 0 ' Level 0 call
    Do
        'only global users
        'nStatus = NetUserGetGroups(strServerName, _
                            UserName,
        nStatus = NetUserGetGroups(VarPtr(abytServerName(0)), _
                            VarPtr(abytUserName(0)), _
                            dwLevel, _
                            pBuf, _
                            dwPrefMaxLen, _
                            dwEntriesRead, _
                            dwTotalEntries)
        ' If the call succeeds,
        If ((nStatus = NERR_SUCCESS) Or (nStatus = ERROR_MORE_DATA)) Then
            ' Loop through the entries.
            For i = 0 To dwEntriesRead - 1
                sapiCopyMem pTmpBuf, ByVal (pBuf + (i * 4)), Len(pTmpBuf) ' 4=len(USER_INFO_0)
                ' Print the name of the user account.
                Matb.AddNew
                Matb.Fields(FieldUser) = UserName
                Matb.Fields(FieldGroup) = fStrFromPtrW(pTmpBuf.grui0_name)
                Matb.Update
                ' Keep a count of accounts enumerated
                dwTotalCount = dwTotalCount + 1
            Next
        End If
        ' free the associated memory
        apiNetAPIBufferFree pBuf
        pBuf = 0
    Loop While (nStatus = ERROR_MORE_DATA)
    If Not (pBuf = 0) Then apiNetAPIBufferFree pBuf
    fEnumGroupsUsers = True
ExitHere:
    Matb.Close
    Exit Function
ErrHandler:
    fEnumGroupsUsers = False
    Resume ExitHere
End Function

Private Function fStrFromPtrW(pBuf As Long) As String
Dim lngLen As Long
Dim abytBuf() As Byte
    ' Get the length of the string at the memory location
    lngLen = apilstrlenW(pBuf) * 2
    ' if it's not a ZLS
    If lngLen Then
        ReDim abytBuf(lngLen)
        ' then copy the memory contents
        ' into a temp buffer
        sapiCopyMem abytBuf(0), ByVal pBuf, lngLen
        ' return the buffer
        fStrFromPtrW = abytBuf
    End If
End Function

Conclusion :


Remplacer les consantes :
Const Server = "\\MonServeur"
Const UsersTable = "Users"
Const FieldUser = "UserName"
Const FieldGroup = "GroupName"
Par vos valeurs en fonction du nom de votre serveur, du nom de votre table et des noms de champs.

Exemple d'utilisation avec la sub Test

Bon dev à tous

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.