1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55
| Sub forceauth(ByVal strreppath)
Dim objADsSec, objSecDesc, objDACL, ace, objSousRep
Dim objACESys, objACEuser, struser
'AccessMask
Const FULL_CONTROL = &H1F01FF '14 permissions
'ACE flags
Const OBJECT_INHERIT_ACE = &H1 'propage aux objets enfants
Const CONTAINER_INHERIT_ACE = &H2 'propage aux dossiers enfants
'ACE types
Const ACCESS_ALLOWED_ACE_TYPE = &H0 'type : "Autoriser"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objRep = objFSO.GetFolder(strreppath)
Set objADsSec = CreateObject("ADsSecurity")
' Pour chaque sous-répertoire
For Each objSousRep In objRep.SubFolders
struser = objSousRep.Name
Set objSecDesc = objADsSec.GetSecurityDescriptor("FILE://" & objSousRep.Path)
Set objDACL = objSecDesc.DiscretionaryAcl
' On supprime les anciennes ACE
For Each ace In objDACL
objDACL.RemoveAce ace
Next
objSecDesc.DiscretionaryAcl = objDACL
objADsSec.SetSecurityDescriptor (objSecDesc)
'On crée les ACE pour l'utilisateur "SYSTEM" et l"utilisateur du domaine
Set objACESys = CreateObject("AccessControlEntry")
objACESys.Trustee = "SYSTEM"
objACESys.AccessMask = FULL_CONTROL
' La ligne suivante "devrait" faire hériter les objets enfants....
objACESys.AceFlags = OBJECT_INHERIT_ACE + CONTAINER_INHERIT_ACE
objACESys.AceType = ACCESS_ALLOWED_ACE_TYPE
Set objACEuser = CreateObject("AccessControlEntry")
objACEuser.Trustee = "DOMAINE\" & struser
objACEuser.AccessMask = FULL_CONTROL
objACEuser.AceFlags = OBJECT_INHERIT_ACE + CONTAINER_INHERIT_ACE
objACEuser.AceType = ACCESS_ALLOWED_ACE_TYPE
objDACL.AddAce (objACESys)
objDACL.AddAce (objACEuser)
objSecDesc.DiscretionaryAcl = objDACL
' On applique les ACE
objADsSec.SetSecurityDescriptor (objSecDesc)
Next
Set objADsSec = Nothing
Set objSecDesc = Nothing
Set objDACL = Nothing
Set objACESys = Nothing
Set objACEuser = Nothing
End Sub |
Partager