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
| 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 objExplorer = WScript.CreateObject ("InternetExplorer.Application")
objExplorer.Navigate "about:blank"
objExplorer.ToolBar = 0
objExplorer.StatusBar = 0
objExplorer.Width = 600
objExplorer.Height = 800
objExplorer.Left = 20
objExplorer.Top = 20
' Temporisation pour laisse le temps à IE de se charger
Do While (objExplorer.Busy)
Wscript.Sleep 200
Loop
' Affichage de l'objet IE à l'ecran
objExplorer.Visible = 1
objExplorer.Document.WriteLn "<title>Logs</Title>"
objExplorer.Document.WriteLn "<body bgcolor=#000066>"
objExplorer.Document.WriteLn "<div><center><font size=2 face=""Arial"" color=white> Autorisations :</div></center>"
' 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
If intControlFlags = 33796 Then
InHer = "Heritage on"
Else
InHer = "Heritage off"
End If
objExplorer.Document.WriteLn "<br><font color=yellow>" & strFolderName & " - " & InHer & "</font><br>"
ACCESS_ALLOWED_ACE_TYPE = &h0
ACCESS_DENIED_ACE_TYPE = &h1
FOLDER_ADD_SUBDIRECTORY = &h000004
FILE_DELETE = &h010000
FILE_DELETE_CHILD = &h000040
FILE_READ_CONTROL = &h020000
' 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
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
XZne = "<br>"
If objACE.AccessMask AND FILE_READ_CONTROL Then
If objACE.AccessMask AND FOLDER_ADD_SUBDIRECTORY Then
If objACE.AccessMask AND FILE_DELETE Then
If objACE.AccessMask AND FILE_DELETE_CHILD Then
XZne = XZne & "Controle Total" & "<br>"
Else
XZne = XZne & "Modification" & "<br>"
End If
Else
XZne = XZne & "Lecture/Ecriture" & "<br>"
End If
Else
XZne = XZne & "Lecture" & "<br>"
End If
Else
XZne = XZne & "Aucun droit" & "<br>"
End If
XZne = XZne & "<br>"
If objACE.AceType = ACCESS_ALLOWED_ACE_TYPE Then
objExplorer.Document.WriteLn DomName & " - " & objACE.Trustee.Name
objExplorer.Document.WriteLn "<br>"
objExplorer.Document.WriteLn "<font color=cyan> Autorisé à : </font><br>"
objExplorer.Document.WriteLn "<font color=Red> " & Xzne & "</font>"
End If
Next
VarUserDACL="NO"
Next
objExplorer.Document.WriteLn vbTab & "<br><font color=tomato>----- FIN DE TRAITEMENT -----</font><br>"
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
'/////////////////////////////////////////////////////////////////////////////////////////////CODE 2///////////////////////////////////////////////////////////////////////////////////////////
Const INT_MAX_LEVEL = 1
Dim ShellO: Set ShellO = CreateObject("WScript.Shell")
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim SListe: Dim Schemin
'Dossier à traiter
Schemin = "C:\" 'Dossier à modifier
'Dossier Bureau de windows + "\"
SListe = ShellO.SpecialFolders("Desktop")
If Right(SListe, 1) <> "\" Then SListe = SListe & "\"
'Ouverture du fichier contenant l'arborescence du répertoire à traiter vers le Bureau
Dim Fichier: Set Fichier = FSO.CreateTextFile(SListe & "Liste.html", 1, True)
strHTML="<body text=white><style type='text/css'>"&_
"a:link {color: #F19105;}"&_
"a:visited {color: #F19105;}"&_
"a:active {color: #F19105;}"&_
"a:hover {color: #FF9900;background-color: rgb(255, 255, 255);}"&_
"</style>"
strHTML=strHTML &"<center><h2><B><tr><font color=Red>Liste des Dossiers et Sous-Dossiers dans C:\ </font></h2></center>"&_
"<center><body bgcolor=#1234568><table border='3' cellpadding='1' style='border-collapse: collapse; font size:11pt' bordercolor='#CCCCCC' width='100%' id='Table1'></center>" & _
"<td><center><strong>Chemin des Dossiers :</strong></center></td>"&_
"<td><center><strong>User</strong></center></td>"&_
"<td><center><strong>Droits</strong></center></td></tr>"
'Fichier.WriteLine (Schemin & "<br>")
Fichier.WriteLine strHTML 'Ecrire la structure du Tableau en HTML
ListerDossier Schemin, Fichier, 0 'Remplissage dynamique des données dans le Tableau
Fichier.WriteLine "</table>" 'ici on ferme notre tableau par la balise </table>
'Fermeture du fichier contenant l'arborescence du répertoire à traiter
Fichier.Close
Function ListerDossier(Schemin, Fichier, intLevel) 'Lister l'arborescence du dossier
On Error Resume Next
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim ObjRep: Set ObjRep = FSO.GetFolder(Schemin) 'dossier
Dim ObjSubRep: Set ObjSubRep = ObjRep.SubFolders 'sous-dossiers
Dim ObjSubRepItem
For Each ObjSubRepItem In ObjSubRep 'Traiter chaque sous-dossiers
Fichier.WriteLine ("<tr><td><a href='" & ObjSubRepItem.Path & "'>" & ObjSubRepItem.Path & "</a></td><td> Users </td><td> " & Xzne & " </td></tr>") 'Ecrire le path dans les lignes du Tableau en HTML
If intLevel < INT_MAX_LEVEL Then ListerDossier ObjSubRepItem.Path, Fichier, intLevel + 1 'traiter les sous-dossiers
Fichier.WriteLine (ObjSubFileItem.Path) 'Ecrire le path dans la liste
Next
End Function |
Problème de doublons dans ce script
BONJOUR
Répondre avec citation
Partager