Arborécence liste de droits

Lexounet · 26 Mai 2011

Bonjours,

J'ai un code *.vbs qui me liste les dossiers et sous dossier dans un tableau dans une page html, mais maintenant on me demande qu'à coté de cette liste dans une nouvelle case dans le tableau je dresse la liste des droits de ce dossier
J'ai déjà galéré sur ce sujet à la 1ère étape, et là çà recommence car j'ai fais des recherche mais rien de concluant, en plus connaissant ce code depuis maintenant Lundi, je cherche à combiné c'est 2 codes dans les régle de l'art !!

CODE 1

[cpp]Const INT_MAX_LEVEL = 2

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=strHTML &"<center><h2>Liste des Dossiers et Sous-Dossiers dans C:\ </h2></center>" & _
"<table border='3' cellpadding='10' style='border-collapse: collapse; font size:11pt' bordercolor='#CCCCCC' width='100%' id='Table1'>" & _
"<tr><td>Chemin des Dossiers :</td></tr>"
'Fichier.WriteLine (Schemin & " ")
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></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[/cpp]

ET CODE 2

[cpp]
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> 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 " " & strFolderName & " - " & InHer & " "
'
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
XZne = " "
If objACE.AccessMask AND FILE_ALL_ACCESS Then
XZne = XZne & "Contrôle total" & " "
End If
If objACE.AccessMask AND FILE_APPEND_DATA Then
XZne = XZne & "Création de dossier / Ajout de données" & " "
End If
If objACE.AccessMask AND FILE_DELETE Then
XZne = XZne & "Suppression" & " "
End If
If objACE.AccessMask AND FILE_DELETE_CHILD Then
XZne = XZne & "Suppression de sous-dossier & fichier" & " "
End If
If objACE.AccessMask AND FILE_EXECUTE Then
XZne = XZne & "Parcours du dossier / éxécuter le fichier" & " "
End If
If objACE.AccessMask AND FILE_READ_ATTRIBUTES Then
XZne = XZne & "Attributs de lecture" & " "
End If
If objACE.AccessMask AND FILE_READ_CONTROL Then
XZne = XZne & "Autorisation de lecture" & " "
End If
If objACE.AccessMask AND FILE_READ_DATA Then
XZne = XZne & "Liste du dossier / lecture de données" & " "
End If
If objACE.AccessMask AND FILE_READ_EA Then
XZne = XZne & "Lecture des attributs étendus" & " "
End If
If objACE.AccessMask AND FILE_SYNCHRONIZE Then
XZne = XZne & "Synchronize" & " "
End If
If objACE.AccessMask AND FILE_WRITE_ATTRIBUTES Then
XZne = XZne & "Attributs d'ecriture" & " "
End If
If objACE.AccessMask AND FILE_WRITE_DAC Then
XZne = XZne & "Modification des autorisations" & " "
End If
If objACE.AccessMask AND FILE_WRITE_DATA Then
XZne = XZne & "Création de Fichier / écriture de données" & " "
End If
If objACE.AccessMask AND FILE_WRITE_EA Then
XZne = XZne & "Ecriture d'attributs étendus" & " "
End If
If objACE.AccessMask AND FILE_WRITE_OWNER Then
XZne = XZne & "Appropriation" & " "
End If

XZne = XZne & " "

objExplorer.Document.WriteLn DomName & " - " & objACE.Trustee.Name

If objACE.AceType = ACCESS_ALLOWED_ACE_TYPE Then

objExplorer.Document.WriteLn " "
objExplorer.Document.WriteLn "      Autorisé à : "
objExplorer.Document.WriteLn "            " & Xzne & ""
Else
If objACE.AceType = ACCESS_DENIED_ACE_TYPE Then
objExplorer.Document.WriteLn vbTab & "       Vous est interdit : "
objExplorer.Document.WriteLn "            " & Xzne & ""

End If
End If
Next

VarUserDACL="NO"

Else
WScript.Echo "No DACL present in security descriptor"
End If
Next

objExplorer.Document.WriteLn vbTab & " ----- FIN DE TRAITEMENT ----- "

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[/cpp]

Lexounet · 27 Mai 2011

personne de courageux en vbs ?

Thore · 29 Mai 2011

Question pour quoi n'utilise tu pas l'AD et une intérogation de celle-ci pour cela ?

Lexounet · 30 Mai 2011

Parceque je ne sais pas faire... j'ai trouvé ce script sur internet qui me donne l'effet voulu, donc j'ai pris ça ^^

Thore · 31 Mai 2011

si tu exporte l'ad sous fichier xml tu as la réponde a ta demande !
il faut que tu exploite le fichier xml avec un tableur excel, cal (open office) le meilleur c'est Quatro Pro !

Arborécence liste de droits

Lexounet

Lexounet

Thore

Lexounet

Thore