Liste droit Dossier

Le
lexounet Hors ligne
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

Merci à vous

Code : de recherche avec choix de profondeur

[code]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><B><font color=red>Liste des Dossiers et Sous-Dossiers dans C: </font></B></h2></center>" & _
"<table border='3' cellpadding='10' style='border-collapse: collapse; font size:11pt' bordercolor='#CCCCCC' width='100%' id='Table1'>" & _
"<tr><td><strong>Chemin des Dossiers :</strong></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></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[/code]

Code : précédent avec attributs

[code]Dim fso, OutFile, sDrv, sFName, sReport, sFile, sTitle ,strHTML
sTitle = "Recherche des Fichiers Par leurs Noms"
Set fso = CreateObject("Scripting.FileSystemObject")
OutFile = "Recherche.html"
If fso.FileExists(OutFile) Then fso.DeleteFile(OutFile)

Set sReport = fso.OpenTextFile(OutFile, 8, True)
sDrv = InputBox("Entrez la lettre du lecteur à la recherche (lettre seulement)" & vbcrlf&_
"ou bien " & vbcrlf & "(Saisissez * pour rechercher toutes les lettres de lecteur local)", sTitle)
If sDrv = "" Then WScript.Quit

sFName = InputBox ("Entrez le nom du fichier à rechercher (sans extension)", sTitle)
If sFName = "" Then WScript.Quit

strHTML="<html><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> <font color=Red>[COUNT] </font>Fichiers Trouvés dont le Nom est <font color=red>"""& sFName &""" </font> sur le lecteur <font color=red>"& UCase(sDrv) & ":</B></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 :</strong></center></td>"&_
"<td><center><strong>Date de Création :</strong></center></td>"& _
"<td><center><strong>Date de Modification :</strong></center></td>"&_
"<td><center><strong>Taille :</strong></center></td>"&_
"<td><center><strong>Attributs:</strong></center></td>"

If sDrv = "*" Then
Dim d, dc, s, n ,u,racine
Set fso = CreateObject("Scripting.FileSystemObject")
Set dc = fso.Drives
For Each d in dc
racine = d.Driveletter & ":"
GetResults racine , sFName
Next
Else
GetResults sDrv & ":", sFName
End If
sReport.WriteLine strHTML &"</table></body></html>"
Wscript.CreateObject("WScript.Shell").Run OutFile

Sub GetResults(drv, fname)
Dim sWQL, oFile, sAttrib,sFilePath,size
sWQL = "select * from cim_datafile where Drive='" & _
drv & "' AND FileName = '" & fname & "'"
Results = 0
For Each oFile In GetObject("winmgmts:").execquery(sWQL)
Results = Results + 1
sFile = oFile.Name
Set f = fso.GetFile(sFile)

SizeKo = Round(FormatNumber(f.Size)/(1024),1) & " Ko" 'Taille en Ko avec 1 chiffre après la Virgule
SizeMo = Round(FormatNumber(f.Size)/(1048576),1) & " Mo"'Taille en Mo avec 1 chiffre après la Virgule
SizeGo = Round(FormatNumber(f.Size)/(1073741824),1) & " Go" 'Taille en Go avec 1 chiffre après la Virgule

If f.size < 1024 Then
Size = f.size & " Octets"
elseif f.size < 1048576 Then
Size = SizeKo
elseif f.size < 1073741824 Then
Size = SizeMo
else
Size = SizeGo
end if
sFilePath = f.Path
If oFile.Archive Then sAttrib = "Archive "
If oFile.Compressed Then sAttrib = sAttrib & " Compressé "
If oFile.Encrypted Then sAttrib = sAttrib & " Crypté "
If oFile.Hidden Then sAttrib = sAttrib & " Caché "
If oFile.System Then sAttrib = sAttrib & " Système "
If oFile.Readable Then sAttrib = sAttrib & " Lecture "
If oFile.Writeable Then sAttrib = sAttrib & " Ecriture "
strHTML=strHTML & "<tr><td><a target=_Blank href='" & sFilePath & "'>" & _
sFilePath & "</a></td><td><center>" & f.DateCreated & "</center></td>" & _
"<td><center>" & f.DateLastModified & "</center></td><td><center>"& Size & "</center></td>"&_
"<td><center>" & sAttrib & "</center></td></tr>"
Next
strHTML = Replace(strHTML, "[COUNT]", Results)
End Sub[/code]

Code : de plus j'ai trouvé ça qui correspond plus a mes attentes au niveau attributs mais je na sais pas comment le présenté dans le tableau (code 1)

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

XZne = XZne & "<br>"

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

If objACE.AceType = ACCESS_ALLOWED_ACE_TYPE Then

objExplorer.Document.WriteLn "<br>"
objExplorer.Document.WriteLn "<font color=cyan>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Autorisé à : </font><br>"
objExplorer.Document.WriteLn "<font color=Red>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;" & Xzne & "</font>"
Else
If objACE.AceType = ACCESS_DENIED_ACE_TYPE Then
objExplorer.Document.WriteLn vbTab & "<br><font color=tomato>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Vous est interdit : </font><br>"
objExplorer.Document.WriteLn "<font color=Red>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;" & Xzne & "</font>"

End If
End If
Next

VarUserDACL="NO"

Else
WScript.Echo "No DACL present in security descriptor"
End If
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]
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Publicité
Poster une réponse
Anonyme