Macros-commandes VBA/Gestion des droits et répertoires

Début de la boite de navigation du chapitre

Cet article explique comment, à l'aide des interfaces de programmation de Windows (API Win32), il est possible de lire chaque entrée de la liste de contrôle d'accès (une ACE - Access Control Entry - de l'ACL - Access Control List) d'un répertoire local ou distant avec VBA.

fin de la boite de navigation du chapitre

Autrement dit, pour un répertoire donné, on affiche chaque utilisateur (ou groupe, ou alias) et les droits d'accès associés à cet utilisateur.

Description

Dans cet exemple, plusieurs interfaces de programmation de Windows sont utilisées :

• GetFileSecurity (...)  : Récupère le descripteur de sécurité d'un fichier (ou répertoire).
• GetSecurityDescriptorDacl (...)  : Récupère le descripteur de la liste de contrôle d'accès.
• GetAclInformation (...)  : Récupère la liste de contrôle d'accès.
• GetAce (...)  : Récupère une entrée de la liste (un SID, et un drapeau représentant les droits.
• LookupAccountSid (..)  : Récupère un nom de domaine, de compte et type de compte (utilisateur, alias, groupe, ...) à partir d'un SID (identificateur système).

Dans un premier temps on indique un répertoire (soit local : c:\tmp soit distant : \\serveur1\partage1). Ensuite on récupère pour ce répertoire, et à l'aide des API précédentes la liste de contrôle d'accès associée. Pour chaque entrée de la liste, on analyse le drapeau des droits, puis on récupère le nom du compte que l’on affiche avec une boîte de dialogue simple (message box).

Déclarations préalables

ModuleVBA

Public Const DACL_SECURITY_INFORMATION = &H4

Type Droit
   Nom As String
   Flag As Long
End Type

Public tabRights(21) As Droit

' Structures used by our API calls.
' Refer to the MSDN for more information on how/what these
' structures are used for.
Type ACE_HEADER
   AceType As Byte '1
   AceFlags As Byte '1
   AceSize As Integer '2
End Type

Public Type ACCESS_DENIED_ACE
  Header As ACE_HEADER
  Mask As Long '4
  SidStart As Long
End Type

Type ACCESS_ALLOWED_ACE
   Header As ACE_HEADER
   Mask As Long
   SidStart As Long
End Type

Type ACL_SIZE_INFORMATION
   AceCount As Long
   AclBytesInUse As Long
   AclBytesFree As Long
End Type

'' API calls used within this sample. Refer to the MSDN for more
'' information on how/what these APIs do.
'
'Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'Declare Function LookupAccountName Lib "advapi32.dll" Alias "LookupAccountNameA" (lpSystemName As String, ByVal lpAccountName As String, Sid As Any, cbSid As Long, ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Long) As Long
'Declare Function InitializeSecurityDescriptor Lib "advapi32.dll" (pSecurityDescriptor As SECURITY_DESCRIPTOR, ByVal dwRevision As Long) As Long
Declare Function GetSecurityDescriptorDacl Lib "advapi32.dll" (pSecurityDescriptor As Byte, lpbDaclPresent As Long, pDacl As Long, lpbDaclDefaulted As Long) As Long
Declare Function GetFileSecurityN Lib "advapi32.dll" Alias "GetFileSecurityA" (ByVal lpFileName As String, ByVal RequestedInformation As Long, ByVal pSecurityDescriptor As Long, ByVal nLength As Long, lpnLengthNeeded As Long) As Long
Declare Function GetFileSecurity Lib "advapi32.dll" Alias "GetFileSecurityA" (ByVal lpFileName As String, ByVal RequestedInformation As Long, pSecurityDescriptor As Byte, ByVal nLength As Long, lpnLengthNeeded As Long) As Long
Declare Function GetAclInformation Lib "advapi32.dll" (ByVal pAcl As Long, pAclInformation As Any, ByVal nAclInformationLength As Long, ByVal dwAclInformationClass As Long) As Long
'Public Declare Function EqualSid Lib "advapi32.dll" (pSid1 As Byte, ByVal pSid2 As Long) As Long
'Declare Function GetLengthSid Lib "advapi32.dll" (pSID As Any) As Long
'Declare Function InitializeAcl Lib "advapi32.dll" (pAcl As Byte, ByVal nAclLength As Long, ByVal dwAclRevision As Long) As Long
Declare Function GetAce Lib "advapi32.dll" (ByVal pAcl As Long, ByVal dwAceIndex As Long, pace As Any) As Long
'Declare Function AddAce Lib "advapi32.dll" (ByVal pAcl As Long, ByVal dwAceRevision As Long, ByVal dwStartingAceIndex As Long, ByVal pAceList As Long, ByVal nAceListLength As Long) As Long
'Declare Function AddAccessAllowedAce Lib "advapi32.dll" (pAcl As Byte, ByVal dwAceRevision As Long, ByVal AccessMask As Long, pSID As Byte) As Long
'Public Declare Function AddAccessDeniedAce Lib "advapi32.dll" (pAcl As Byte, ByVal dwAceRevision As Long, ByVal AccessMask As Long, pSID As Byte) As Long
'Declare Function SetSecurityDescriptorDacl Lib "advapi32.dll" (pSecurityDescriptor As SECURITY_DESCRIPTOR, ByVal bDaclPresent As Long, pDacl As Byte, ByVal bDaclDefaulted As Long) As Long
'Declare Function SetFileSecurity Lib "advapi32.dll" Alias "SetFileSecurityA" (ByVal lpFileName As String, ByVal SecurityInformation As Long, pSecurityDescriptor As SECURITY_DESCRIPTOR) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
'Declare Function GetSecurityDescriptorOwner Lib "advapi32.dll" (pSecurityDescriptor As Any, pOwner As Long, lpbOwnerDefaulted As Long) As Long
Declare Function LookupAccountSid Lib "advapi32.dll" Alias "LookupAccountSidA" (ByVal lpSystemName As String, ByVal Sid As Long, ByVal name As String, cbName As Long, ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Long) As Long
'Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Fonction GetFolderInfo

GetFolderInfo

Public Sub GetFolderInfo(sFolderName As String)
    Dim lResult As Long            ' Result of various API calls.
    Dim I As Integer               ' Used in looping.
    Dim bSDBuf() As Byte           ' Buffer that holds the security
    Dim lSizeNeeded As Long           ' Size needed for SD for file.
    Dim lDaclPresent As Long          ' Used in grabbing the DACL from
    Dim lDaclDefaulted As Long        ' Used in grabbing the DACL from
    Dim sACLInfo As ACL_SIZE_INFORMATION  ' Used in grabbing the ACL
    Dim sCurrentACE As ACCESS_ALLOWED_ACE    ' Current ACE.
    Dim pCurrentAce As Long                  ' Our current ACE.
    
    Dim lMask As Long
    Dim pSID As Long
    
    Dim bSuccess As Variant ' Status variable
    
    Dim sAccName As String ' Name of the file owner
    Dim lAccName As Long
    
    Dim sDomName As String ' Name of the first domain for the owner
    Dim lDomName As Long
    
    Dim peUse As Long
    Dim peLbl As String
    
    Dim droits As String
    Dim lNbCar As Long
    
    Dim R
    
    tabRights(0).Nom = "ACCESS_READ"
    tabRights(0).Flag = &H1
    tabRights(1).Nom = "ACCESS_WRITE"
    tabRights(1).Flag = &H2
    tabRights(2).Nom = "ACCESS_CREATE"
    tabRights(2).Flag = &H4
    tabRights(3).Nom = "ACCESS_EXEC"
    tabRights(3).Flag = &H8
    tabRights(4).Nom = "ACCESS_DELETE"
    tabRights(4).Flag = &H10
    tabRights(5).Nom = "ACCESS_ATTRIB"
    tabRights(5).Flag = &H20
    tabRights(6).Nom = "ACCESS_PERM"
    tabRights(6).Flag = &H40
    tabRights(7).Nom = "ACCESS_GROUP"
    tabRights(7).Flag = 32768 ' &H8000
    tabRights(8).Nom = "DELETE"
    tabRights(8).Flag = &H10000
    tabRights(9).Nom = "READ_CONTROL"
    tabRights(9).Flag = &H20000
    tabRights(10).Nom = "WRITE_DAC"
    tabRights(10).Flag = &H40000
    tabRights(11).Nom = "WRITE_OWNER"
    tabRights(11).Flag = &H80000
    tabRights(12).Nom = "SYNCHRONIZE"
    tabRights(12).Flag = &H100000
    tabRights(13).Nom = "ACCESS_SYSTEM_SECURITY"
    tabRights(13).Flag = &H1000000
    tabRights(14).Nom = "MAXIMUM_ALLOWED"
    tabRights(14).Flag = &H2000000
    tabRights(15).Nom = "GENERIC_ALL"
    tabRights(15).Flag = &H10000000
    tabRights(16).Nom = "GENERIC_EXECUTE"
    tabRights(16).Flag = &H20000000
    tabRights(17).Nom = "GENERIC_WRITE"
    tabRights(17).Flag = &H40000000
    tabRights(18).Nom = "SPECIFIC_RIGHTS_ALL"
    tabRights(18).Flag = 65535 ' &HFFFF
    tabRights(19).Nom = "STANDARD_RIGHTS_REQUIRED"
    tabRights(19).Flag = &HF0000
    tabRights(19).Nom = "STANDARD_RIGHTS_ALL"
    tabRights(19).Flag = &H1F0000
    
    lResult = GetFileSecurityN(sFolderName, DACL_SECURITY_INFORMATION, _
       0, 0, lSizeNeeded)
    
    ' Redimension the Security Descriptor buffer to the proper size.
    ReDim bSDBuf(lSizeNeeded)
    
    ' Now get the actual Security Descriptor for the file.
    lResult = GetFileSecurity(sFolderName, DACL_SECURITY_INFORMATION, _
       bSDBuf(0), lSizeNeeded, lSizeNeeded)
       
    ' A return code of zero means the call failed; test for this
    ' before continuing.
    If (lResult = 0) Then
       MsgBox "Error: Unable to Get the File Security Descriptor for " & sFileName
       Exit Sub
    Else
           MsgBox "Success: Ok Getting the File Security Descriptor"
           
        ' You now have the file's SD and a new Security Descriptor
        ' that will replace the current one. Next, pull the DACL from
        ' the SD. To do so, call the GetSecurityDescriptorDacl API
        ' function.
     
        lResult = GetSecurityDescriptorDacl(bSDBuf(0), lDaclPresent, _
           pAcl, lDaclDefaulted)
     
        ' A return code of zero means the call failed; test for this
        ' before continuing.
        If (lResult = 0) Then
           MsgBox "Error: Unable to Get DACL from File Security " _
              & "Descriptor"
           Exit Sub
        End If
     
        ' You have the file's SD, and want to now pull the ACL from the
        ' SD. To do so, call the GetACLInformation API function.
        ' See if ACL exists for this file before getting the ACL
        ' information.
        If (lDaclPresent = False) Then
           MsgBox "Error: No ACL Information Available for this File"
           Exit Sub
        End If
     
        ' Attempt to get the ACL from the file's Security Descriptor.
        lResult = GetAclInformation(pAcl, sACLInfo, Len(sACLInfo), 2&)
     
        ' A return code of zero means the call failed; test for this
        ' before continuing.
        If (lResult = 0) Then
           MsgBox "Error: Unable to Get ACL from File Security Descriptor"
           Exit Sub
        End If
    
         For I = 0 To (sACLInfo.AceCount - 1)
                ' Attempt to grab the next ACE.
                lResult = GetAce(pAcl, I, pCurrentAce)
                
                ' Make sure you have the current ACE under question.
                If (lResult = 0) Then
                    MsgBox "Error: Unable to Obtain ACE (" & I & ")"
                    Exit Sub
                End If
                CopyMemory sCurrentACE, pCurrentAce, LenB(sCurrentACE)
                
                lNbCar = 128
                sAccName = Space(lNbCar)
                sDomName = Space(lNbCar)
                lAccName = lNbCar
                lDomName = lNbCar
                pSID = pCurrentAce + 8  ' sCurrentACE.SidStart
                lMask = sCurrentACE.Mask
                '            MsgBox "ACE" _
                '                 & Chr(13) & Chr(10) & "(Header) AceFlags: " & sCurrentACE.Header.AceFlags _
                '                 & Chr(13) & Chr(10) & "(Header) ACE size: " & sCurrentACE.Header.AceSize _
                '                 & Chr(13) & Chr(10) & "(Header) ACE type: " & sCurrentACE.Header.AceType _
                '                 & Chr(13) & Chr(10) & "MASK : " & lMask _
                '                 & Chr(13) & Chr(10) & "SIDSTART : " & pSID
                
                bSuccess = LookupAccountSid(vbNullString, pSID, sAccName, lAccName, sDomName, lDomName, peUse)
                
                Select Case peUse
                    Case 1: peLbl = "User"
                    Case 2: peLbl = "Group"
                    Case 3: peLbl = "Domain"
                    Case 4: peLbl = "Alias"
                    Case 5: peLbl = "WellKnownGroup"
                    Case 6: peLbl = "DeletedAccount"
                    Case 7: peLbl = "Invalid"
                    Case Else: peLbl = "Unknown"
                End Select
                
                
                droits = ""
                For R = 0 To 19
                    Dim hMaskComp
                    hMaskComp = &H0
                    hMaskComp = (lMask And tabRights(R).Flag)
                    If (hMaskComp = tabRights(R).Flag) Then droits = droits & "-" & tabRights(R).Nom & Chr(10) & Chr(13)
                Next R
                
                If (bSuccess = 0) Then
                    MsgBox ("ERROR : unable to LookupAccountSid " & Chr(13) & Chr(10) & "SID " & pSID)
                Else
                    MsgBox ("(Header) AceFlags: " & sCurrentACE.Header.AceFlags _
                            & Chr(13) & Chr(10) & "(Header) ACE size: " & sCurrentACE.Header.AceSize _
                            & Chr(13) & Chr(10) & "(Header) ACE type: " & sCurrentACE.Header.AceType _
                            & Chr(13) & Chr(10) & "MASK : " & lMask _
                            & Chr(13) & Chr(10) & "SIDSTART : " & pSID _
                            & Chr(13) & Chr(10) & "---------------" & Chr(13) & Chr(10) & _
                            "DOMAIN :" & Left(sDomName, lDomName) & Chr(13) & Chr(10) & _
                            "USER   :" & Left(sAccName, lAccName) & Chr(13) & Chr(10) & _
                            "TYPE   :" & peLbl & Chr(13) & Chr(10) & _
                            "RIGHTS :" & droits)
                End If
          Next I
    End If
    End Sub

NB: Pour sélectionner un répertoire, il est possible d’utiliser l'exemple suivant : mvps.org

Liens externes

• www.allapi.net et www.tek-tips.com Codes sources utilisés comme bases pour la réalisation de cet exemple]