Problème de permission lors du parcours d'une arborescence

Version imprimable

Bonjour,

j'ai créé un script pour parcourrir une arborescence et identifier les "gros fichiers". Voici le code associé :
Code:

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 option explicit 'Variables Dim Racine, InfoRep Dim Size, NbFic Dim FSO 'Initialisation NbFic = 0 Set FSO = CreateObject("Scripting.FileSystemObject") ' Choix du répertoire/volume à auditer Racine = InputBox("Nom du volume ou sous-répertoire racine ?","Question") Set InfoRep = fso.GetFolder(Racine) 'Appel de la fonction de parcours récursif ShowSubFolders InfoRep WScript.Echo "Nombre de fichiers : " & NbFic Function ShowSubFolders(Folder) Dim fic, fichiers, Subfolder ' Liste des fichiers dans le répertoire courant On Error Resume Next Set fichiers = Folder.Files If Err.number <> 0 Then wscript.Echo "Erreur pour lister les fichiers sous : " & Folder.path End If Err.clear On Error Goto 0 For Each fic In fichiers On Error Resume Next ' Recherche de la taille du fichier Size = fic.Size If fic.Size > 10000000 Then NbFic = NbFic + 1 End If Next ' Parcours récursif des sous-répertoires For Each Subfolder in Folder.SubFolders ShowSubFolders Subfolder Next End function
Mon problème :
Lorsque mon script arrive dans un sous-répertoire où je n'ai pas les droits d'accès (Parcours du dossier, Liste du dossier, Attribus de lecture), il s'arrête avec le message d'erreur suivant :

Code:

Erreur d'exécution Microsoft VBScript: Permission refusée

Bien que je vérifie le retour de la fonction

Code:

Set fichiers = Folder.Files

, la gestion d'erreur n'en tient pas compte.

Ma question :
Comment puis-je vérifier avant de parcourir un sous-répertoire, que j'ai les droits d'accès pour le faire, puisque visiblement VBS ne gère pas ce type d'erreur ?

J'ai vu qu'il existe des méthodes de type "GetPermission", mais je n'arrive pas à les utiliser. Avez-vous une piste ?

Merci.

:?

12/12/2006, 19h43
omen999

Citation:

la gestion d'erreur n'en tient pas compte

explication ici:http://www.microsoft.com/technet/scr....mspx?mfr=true
conclusion: utiliser wmi 8-)
15/12/2006, 07h54
fledev

Citation:

conclusion: utiliser wmi

bonjour et merci, mais puis-je avoir un début de piste.
J'ai jeté un oeil aux classes WMI comme Win32_Directory ou CIM_Datafie, mais je n'ai pas compris comment utiliser ces outils, en terme de gestion des permissions.

Merci.

WMI n'est pas adapté...

Bonjour,

j'ai réécrit le code du précédent script et fait appel à WMI à la place des objets "Scripting.FileSystemObject", pour ne plus être bloqué par les problèmes de permissions.

Voici le nouveau code :

Code:

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
 
option explicit
 
'Variables
Dim Racine
Dim Size, NbFic
 
Dim strComputer, strNewPathCourant, strPathCourant
Dim objWMIService, objRep, objRep2, objFic
Dim colSousRep, colSousRep2,colFic
Dim arrRepPath
Dim i
 
 
'Initialisation
NbFic = 0
 
 
' Choix du répertoire/volume à auditer
Racine = InputBox("Nom du volume ou sous-répertoire racine ?","Question")
 
' Recherche des fichiers et sous-répertoire
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
 
Set colSousRep = objWMIService.ExecQuery _
    ("Associators of {Win32_Directory.Name='" & Racine & "'} " _
        & "Where AssocClass = Win32_Subdirectory " _
            & "ResultRole = PartComponent")
 
' Ajout d'un "\" a chaque "\" du PATH courant
arrRepPath = Split(Racine, "\")
strNewPathCourant = ""
For i = 1 to Ubound(arrRepPath)
    strNewPathCourant = strNewPathCourant & "\\" & arrRepPath(i)
Next
strPathCourant = strNewPathCourant & "\\"
 
' Traitement des fichiers du répertoire Racine
Set colFic = objWMIService.ExecQuery _
    ("Select * from CIM_DataFile where Path = '" & strPathCourant & "'")
 
For Each objFic in colFic
		Size = objFic.filesize
		If Size > 10000000 Then
			NbFic = NbFic + 1
		End If
Next
 
'Appel de la fonction de parcours récursif
For Each objRep in colSousRep
    ShowSubFolders Racine
Next
 
Sub ShowSubFolders(Racine)
	' Recherche des fichiers et sous-répertoires
    Set colSousRep2 = objWMIService.ExecQuery _
        ("Associators of {Win32_Directory.Name='" & Racine & "'} " _
            & "Where AssocClass = Win32_Subdirectory " _
                & "ResultRole = PartComponent")
    For Each objRep2 in colSousRep2
        Racine = objRep2.Name
        arrRepPath = Split(Racine, "\")
        strNewPathCourant = ""
        For i = 1 to Ubound(arrRepPath)
            strNewPathCourant = strNewPathCourant & "\\" & arrRepPath(i)
        Next
        strPathCourant = strNewPathCourant & "\\"
 
        Set colFic = objWMIService.ExecQuery _
            ("Select * from CIM_DataFile where Path = '" & strPathCourant & "'")
 
        For Each objFic in colFic
			Size = objFic.filesize
		If Size > 10000000 Then
				NbFic = NbFic + 1
			End If
        Next
 
        ShowSubFolders Racine
    Next
End Sub
 
 
WScript.Echo "Nombre de fichiers : " & NbFic

Le problème de permissions est bien contourné. :lol:

Par contre, le temps d'exécution est un catastrophe!!! :aie:

Le nouveau script s'exécuté en plus de 6 minutes là où le précédent durait 6 secondes. J'ai lancé le nouveau script pour parcourrir mon disque C: et il tourne depuis plus de 3 jours...

Je pense qu'il est préférable de rester sur la première version du script et vérifier les droits d'accès à chaque sous-répertoire.
La question est donc

Citation:

comment vérifier que l'utilisateur qui exécute le script a les droits d'accès au contenu d'un sous-répertoire, avant de le parcourrir ?

MERCI.