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 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200
|
SelDir = ""
SelectDir
Sub SelectDir
SelDir = B("Choisissez un dossier")
If IsNull(SelDir) Then
MsgBox "Sélection invalide"
else
Affich
End If
End Sub
Sub Affich
Set objExcel = CreateObject("Excel.Application")
Set ObjFso = CreateObject("Scripting.FileSystemObject")
objExcel.Visible = True
objExcel.Workbooks.Add()
objExcel.Cells(1, 1).Value = "Extraction des sécurités de " & SelDir & " du : " & FormatDateTime(Now, vbLongDate)
objExcel.Cells(1, 1).Font.Bold = True
objExcel.Cells(1, 1).Font.Size = 10
objExcel.Cells(1, 1).Font.ColorIndex = 3
' Ajout des titres de colonnes
objExcel.Cells(3, 1).Value = "Nom du partage"
objExcel.Cells(3, 2).Value = "Héritage"
objExcel.Cells(3, 3).Value = "Utilisateur"
objExcel.Cells(3, 4).Value = "Autorisation"
objExcel.Cells(3, 5).Value = "Droits"
i = 3
' Création de l'objet collection de repertoires
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(SelDir)
' Création de la collection des sous répertoires
Set colSubfolders = objFolder.SubFolders
' Parcours des sous répertoires
For Each objSubFolder in colSubfolders
strFolderName = objFolder & "\" & objSubfolder.Name
i = i + 1
objExcel.Cells(i, 1).Value = strFolderName
If intControlFlags = 33796 Then
objExcel.Cells(i, 2).Value = "Inheritance on"
Else
objExcel.Cells(i, 2).Value = "Inheritance off"
End If
SE_DACL_PRESENT = &h4
ACCESS_ALLOWED_ACE_TYPE = &h0
ACCESS_DENIED_ACE_TYPE = &h1
FILE_ALL_ACCESS = &h1f01ff
FOLDER_ADD_SUBDIRECTORY = &h000004
FILE_DELETE = &h010000
FILE_DELETE_CHILD = &h000040
FOLDER_TRAVERSE = &h000020
FILE_READ_ATTRIBUTES = &h000080
FILE_READ_CONTROL = &h020000
FOLDER_LIST_DIRECTORY = &h000001
FILE_READ_EA = &h000008
FILE_SYNCHRONIZE = &h100000
FILE_WRITE_ATTRIBUTES = &h000100
FILE_WRITE_DAC = &h040000
FOLDER_ADD_FILE = &h000002
FILE_WRITE_EA = &h000010
FILE_WRITE_OWNER = &h080000
' Instanciation de l'objet permettant de lire les DACLs
Set objWMIService = GetObject("winmgmts:")
Set objFolderSecuritySettings = objWMIService.Get("Win32_LogicalFileSecuritySetting='" & strFolderName & "'")
intRetVal = objFolderSecuritySettings.GetSecurityDescriptor(objSD)
intControlFlags = objSD.ControlFlags
' Teste si l'objet peut admettre des paramètres de sécurité
If intControlFlags AND SE_DACL_PRESENT Then
arrACEs = objSD.DACL
' Affiche les DACLs des sous repertoires
For Each objACE in arrACEs
' On affiche le DACL en cours et on met en évidence les autorisations existantes
If Len(objACE.Trustee.Domain) > 0 Then
DomName = objACE.Trustee.Domain
Else
DomName = "Local"
End If
objExcel.Cells(i, 3).Value = DomName & " - " & objACE.Trustee.Name
If objACE.AceType = ACCESS_ALLOWED_ACE_TYPE Then
objExcel.Cells(i, 4).Value = "Allowed"
Else
If objACE.AceType = ACCESS_DENIED_ACE_TYPE Then
objExcel.Cells(i, 4).Value = "Denied"
End If
End If
j = 4
If objACE.AccessMask AND FILE_ALL_ACCESS Then
j = j + 1
objExcel.Cells(i, j).Value = "FILE_ALL_ACCESS"
End If
If objACE.AccessMask AND FILE_APPEND_DATA Then
j = j + 1
objExcel.Cells(i, j).Value = "FILE_APPEND_DATA"
End If
If objACE.AccessMask AND FILE_DELETE Then
j = j + 1
objExcel.Cells(i, j).Value = "FILE_DELETE"
End If
If objACE.AccessMask AND FILE_DELETE_CHILD Then
j = j + 1
objExcel.Cells(i, j).Value = "FILE_DELETE_CHILD"
End If
If objACE.AccessMask AND FILE_EXECUTE Then
j = j + 1
objExcel.Cells(i, j).Value = "FILE_EXECUTE"
End If
If objACE.AccessMask AND FILE_READ_ATTRIBUTES Then
j = j + 1
objExcel.Cells(i, j).Value = "FILE_READ_ATTRIBUTES"
End If
If objACE.AccessMask AND FILE_READ_CONTROL Then
j = j + 1
objExcel.Cells(i, j).Value = "FILE_READ_CONTROL"
End If
If objACE.AccessMask AND FILE_READ_DATA Then
j = j + 1
objExcel.Cells(i, j).Value = "FILE_READ_DATA"
End If
If objACE.AccessMask AND FILE_READ_EA Then
j = j + 1
objExcel.Cells(i, j).Value = "FILE_READ_EA"
End If
If objACE.AccessMask AND FILE_SYNCHRONIZE Then
j = j + 1
objExcel.Cells(i, j).Value = "FILE_SYNCHRONIZE"
End If
If objACE.AccessMask AND FILE_WRITE_ATTRIBUTES Then
j = j + 1
objExcel.Cells(i, j).Value = "FILE_WRITE_ATTRIBUTES"
End If
If objACE.AccessMask AND FILE_WRITE_DAC Then
j = j + 1
objExcel.Cells(i, j).Value = "FILE_WRITE_DAC"
End If
If objACE.AccessMask AND FILE_WRITE_DATA Then
j = j + 1
objExcel.Cells(i, j).Value = "FILE_WRITE_DATA"
End If
If objACE.AccessMask AND FILE_WRITE_EA Then
j = j + 1
objExcel.Cells(i, j).Value = "FILE_WRITE_EA"
End If
If objACE.AccessMask AND FILE_WRITE_OWNER Then
j = j + 1
objExcel.Cells(i, j).Value = "FILE_WRITE_OWNER"
End If
i = i + 1
Next
Else
objExcel.Cells(i, 1).Value = "No DACL present in security descriptor"
End If
Next
i = i + 1
objExcel.Cells(i, 1).Value = "****** Fin du rapport ******"
objExcel.Cells(i, 1).Font.Bold = True
objExcel.Cells(i, 1).Font.Size = 10
objExcel.Cells(i, 1).Font.ColorIndex = 3
End Sub
Function B(Msg)
On Error Resume Next
Dim a,f,i,w
Set a=WScript.CreateObject("Shell.Application")
Set f=a.BrowseForFolder(&H0&,Msg,&h1&)
B=f.ParentFolder.ParseName(f.Title).Path
If Err.Number<>0 Then
B=Null
If f.Title="Desktop" Then B=w.SpecialFolders("Desktop")
i=InStr(f.Title, ":")
If i>0 Then B=Mid(f.Title,i-1,2) & "\"
End If
End Function |
Partager