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=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
' 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
objExplorer.Document.WriteLn "<br>"
objExplorer.Document.WriteLn "<font color=cyan> Autorisé à : </font><br>"
objExplorer.Document.WriteLn "<font color=Red> " & Xzne & "</font>"
Else
If objACE.AceType = ACCESS_DENIED_ACE_TYPE Then
objExplorer.Document.WriteLn vbTab & "<br><font color=tomato> Vous est interdit : </font><br>"
objExplorer.Document.WriteLn "<font color=Red> " & 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]
------------------------------------------------------------------------------------------------------------------------
