Chercher fichier avec son nom

Version imprimable

20/05/2011, 11h11
Lexounet

Chercher fichier avec son nom

Bonjours,

Encore moi je fais mon stage sur le vbs et comme je découvre ce language alors pendant 2 mois ca va poser des question :) :ccool:

Je cherche un script qui me donne la liste des chemins des fichiers avec le nom que je lui donne en paramètre et me dresser une liste dans un tableau html txt que sais-je ^^

j'ai trouvé nul part une source d'aide

Citation:

Envoyé par Lexounet

Bonjours,
Encore moi je fais mon stage sur le vbs et comme je découvre ce language alors pendant 2 mois ca va poser des question :) :ccool:
Je cherche un script qui me donne la liste des chemins des fichiers avec le nom que je lui donne en paramètre et me dresser une liste dans un tableau html txt que sais-je ^^
j'ai trouvé nul part une source d'aide

:salut:
Voila c'est un script trouvé dans le Net qui va t'aider a assimiler mieux je crois. Mais tu as un travail supplémentaire à faire c'est de le traduire en français et de l'adapter a ton Projet ;) et n'oublies pas de présenter tes modifications.
Bonne Programmation :pc:

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
' FileInfo.vbs  Quickly search your drive for specified file name and return
' path, version, size and date information.  Can search a specified drive, or
' or all drives.  Use only the file name, not the extension.  Requires WMI,
' which is included with Windows 2000 and Windows XP.  For Windows 95, 98, ME
' and NT4, WMI can be downloaded at
' http://msdn.microsoft.com/downloads/sdks/wmi/download.asp
' © Bill James - wgjames@mvps.org - Released 14 Nov 2002 - Revised 16 Nov 2002
 
Option Explicit
Dim fso, OutFile, sDrv, sFName, sReport, sFile, sTitle
sTitle = "FileInfo.vbs © Bill James"
Set fso = CreateObject("Scripting.FileSystemObject")
OutFile = "C:\searched.txt"
If fso.FileExists(OutFile) Then fso.DeleteFile(OutFile)
Set sReport = fso.OpenTextFile(OutFile, 8, True)
 
sDrv = InputBox("Enter drive letter to search (letter only)" & vbcrlf & _
                vbcrlf & "(Enter * to search all local drive letters)", sTitle)
If sDrv = "" Then WScript.Quit
sFName = InputBox ("Enter file name to search for (no extension)", sTitle)
If sFName = "" Then WScript.Quit
 
If sDrv = "*" Then
  Dim Drive
  For Each Drive in fso.Drives
    If Drive.DriveType = 2 Then
      GetResults Drive, sFName
    End If
  Next
Else
  GetResults sDrv & ":", sFName
End If
 
sReport.Close
Set sReport = Nothing
 
Dim f, ra, Results
Set f = fso.OpenTextFile(OutFile)
On Error Resume Next
ra =  f.ReadAll
If Err Then
  Results = 0
End If
On Error GoTo 0
 
f.Close
Set f = Nothing
Set fso = Nothing
 
If Results > 0 Then
  Wscript.CreateObject("WScript.Shell").Run OutFile
Else
  MsgBox "No matches found for " & chr(34) & sFName & chr(34) & " on " & sDrv,, sTitle
End If
 
Sub GetResults(drv, fname)
  Dim sWQL, oFile, sAttrib
  sWQL = "select * from cim_datafile where Drive='" & _
         drv & "' AND FileName = '" & fname & "'"
  For Each oFile In GetObject("winmgmts:").execquery(sWQL)
    Results = Results + 1
    sFile = oFile.Name
    Set f = fso.GetFile(sFile)
    sReport.WriteLine sFile & vbcrlf & "Version: " & _
      fso.GetFileVersion(sFile) & vbcrlf & "Created: " & _
      f.DateCreated & vbcrlf & "Modified: " & f.DateLastModified & _
      vbcrlf & "Size: " & FormatNumber(f.Size, 0) & " bytes"
    If oFile.Archive Then sAttrib = "Archive "
    If oFile.Compressed Then sAttrib = sAttrib & "Compressed "
    If oFile.Encrypted Then sAttrib = sAttrib & "Encrypted "
    If oFile.Hidden Then sAttrib = sAttrib & "Hidden "
    If oFile.System Then sAttrib = sAttrib & "System "
    If NOT oFile.Writeable Then sAttrib = sAttrib & "ReadOnly "
    If sAttrib <> "" Then sReport.WriteLine "Attributes: " & sAttrib & vbcrlf
    sAttrib = ""
  Next
End Sub
 
' Revisions
'   15 Nov 2002 - Added MsgBox if no search matches found.
'   16 Nov 2002 - Added file attributes to the report

20/05/2011, 14h46
Lexounet

Ligne 15 (permission refusée) problème code ou de droits ?
20/05/2011, 15h13
hackoofr

Citation:

Envoyé par Lexounet

Ligne 15 (permission refusée) problème code ou de droits ?

Pour moi ça marche sans aucune erreur ; Peut être tu as laisser le fichier ouvert ou quelque chose comme ça :koi:
20/05/2011, 15h15
Lexounet

Non, rien de différent je le sauvegarde dans un .vbs avec notepad ++ je le save et je le lance et erreur
20/05/2011, 15h28
hackoofr

Citation:

Envoyé par Lexounet

Non, rien de différent je le sauvegarde dans un .vbs avec notepad ++ je le save et je le lance et erreur

C'est quoi comme paramètres que tu as dû entrer dans le InputBox :koi:
20/05/2011, 15h39
Lexounet

j'ai rien pu rentrer ca bug avant
20/05/2011, 15h45
hackoofr

Citation:

Envoyé par Lexounet

j'ai rien pu rentrer ca bug avant

Télécharge-le alors du site de l'auteur sous le nom Find File Information peut-être l'erreur est dû du copier/coller :koi:
et c'est quoi ton système d'exploitation déja :koi:
20/05/2011, 15h57
Lexounet

win pro sp3

:salut:
Voila j'ai modifié le script précédent pour générer le résultat dans un tableau en HTML en affichant aussi le nombre total des fichiers trouvés ;)
Essaye-le et j’espère qu'il va marcher maintenant chez toi :ccool:

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
86
87
88
89
90
91
92
93
94
' FileSearch.vbs :C'est un Vbscript pour rechercher des fichiers par leurs noms
' Mise à jour Par Hackoo pour générer le Résultat de recherche dans un Tableau en HTML le 21/05/2011 
On Error Resume Next
Dim fso, OutFile, sDrv, sFName, sReport, sFile, sTitle ,strHTML
sTitle = "Recherche des Fichiers Par leurs Noms"
Set fso = CreateObject("Scripting.FileSystemObject")
OutFile = "C:\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> dans 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 Drive
  For Each Drive in fso.Drives
    If Drive.DriveType = 2 Then
      GetResults Drive, sFName
    End If
  Next
Else
  GetResults sDrv & ":", sFName
End If
 
sReport.Close
Set sReport = Nothing
 
Dim f, ra, Results
Set f = fso.OpenTextFile(OutFile)
On Error Resume Next
ra =  f.ReadAll
If Err Then
  Results = 0
End If
On Error GoTo 0
 
f.Close
Set f = Nothing
Set fso = Nothing
 
If Results > 0 Then
  Wscript.CreateObject("WScript.Shell").Run OutFile
Else
  MsgBox "Désolé il n'y a Aucune Instance pour le fichier " & chr(34) & sFName & chr(34) & " Sur " & Ucase(sDrv) & ":",48, sTitle
End If
 
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)
    Size =  FormatNumber(f.Size, 0)/1024 & " Ko"  
	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) 
  sReport.WriteLine strHTML &"</table></body></html>"
  sReport.Close
End Sub

23/05/2011, 08h45
Lexounet

Cet objet ne gère pas cette propriété ou cette méthode :'Close'
Ligne 57

Code:

f.Close

:salut:
Voila j'ai encore modifié le code et j’espère qu'il va marcher pour vous 8-)

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
Dim fso, OutFile, sDrv, sFName, sReport, sFile, sTitle ,strHTML
sTitle = "Recherche des Fichiers Par leurs Noms"
Set fso = CreateObject("Scripting.FileSystemObject")
OutFile = "C:\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)
Size =  Round(FormatNumber(f.Size, 0)/1024,2) & " Ko"  
 
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

26/05/2011, 08h44
Lexounet

quand ca veux pas ca veux pas... :?

Code:

Set sReport = fso.OpenTextFile(OutFile, 8, True)

Permission refusée
26/05/2011, 09h00
hackoofr

Citation:

Envoyé par Lexounet

quand ca veux pas ca veux pas... :?

Code:

Set sReport = fso.OpenTextFile(OutFile, 8, True)

Permission refusée

Bonjour ;
Tu n'as pas essayer de le tester dans un autre poste ou bien un autre système d'exploitation :koi:
J'ai testé ce dernier script sur Vista et XP SP3 et il marche sans problème :ccool:
26/05/2011, 09h04
Lexounet

C'est pour le boulot, donc j'ai ce poste, et pas un autre ceci dis : comme je n'ai pas acces à tous les dossiers de l'entreprise, et que j'ai pas tous les droits...
je regarderais ce midi at home :mrgreen:

Ps MERCI ^^

Donc si je comprends bien tu n'as pas de droits d'écrire sur le lecteur C:\ car tu es loggé avec un utilisateur qui a un accès limité comme un invité par exemple donc essaye de modifier l'endroit de l'enregistrement du fichier dans un fichier temporaire dans le dossier temp ou bien dans le dossier AppData ou bien dans le même endroit d’exécution du script.

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
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

Ca marche, mais je savais pas que tu avait fais tous les attributs aussi :ccool:
en faite faudrais maintenant le combiné avec le code recherche dossier & sous dossier pour qu'aprés chaqu'un de c'est dossier et sous dossier ils me disent si je peut écrire lire etc...

Code : de recherche avec choix de profondeur

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
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 : précédent avec attributs

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
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 : 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:

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
181
182
183
184
185
186
 
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