Recherche des fichiers par leurs extensions

Télécharger le projet
Commenter

Description

SearchFileByExt.vbs : Est un Vbscript pour rechercher des fichiers par leurs extensions et générer le Résultat de recherche dans un Tableau en HTML en citant les informations sur ces fichiers tels que leurs Chemins ,la date de création,la date de modification,la Taille et leurs attributs et affichage des miniatures de diffrentes types d'images lors de la recherche; Càd si la Recherche comporte des fichiers images elles seront affichées en miniatures !

Source / Exemple : 


'SearchFileByExt.vbs © Hackoo Le 15/06/2011 : C'est un Vbscript pour rechercher des fichiers par leurs extensions
'et générer le Résultat de recherche dans un Tableau en HTML en citant les informations
'sur ces fichiers tels que leurs Chemins ,la date de création,la date de modification,la Taille et leurs attributs 
'et affichage des miniatures de diffrentes types d'images lors de la recherche
'Càd si la Recherche comporte des fichiers images elles seront affichées en miniatures
Dim fso, OutFile, sDrv, sFName, sReport, sFile, sTitle ,strHTML
sTitle = "Recherche des Fichiers Par leurs Extensions © Hackoo"
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 dans toutes les lettres de lecteur local)", sTitle)
If sDrv = "" Then WScript.Quit

sFName = InputBox ("Entrez l'extension du fichier à rechercher exemple JPG ou bien GIF ou bien DOC ou bien XLS etc ....", 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 l'extension 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,racine
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set dc = fso.Drives
	For Each d in dc
		racine = d.Driveletter & ":"
		If d.IsReady Then
		GetResults racine , sFName	
		End If
	Next
Else
GetResults sDrv & ":", sFName
End If
sReport.WriteLine strHTML &"</table></body></html>"
Wscript.CreateObject("WScript.Shell").Run OutFile

Sub GetResults(drv, fname)  
On Error Resume Next
Dim sWQL, oFile, sAttrib,sFilePath,size
ext = Array("png","jpg","jpeg","gif","bmp","psd","tif")
sWQL = "select * from cim_datafile where Drive='" & _
drv & "' AND Extension = '" & 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),0) & " Ko" 'Taille en Ko 
SizeMo = Round(FormatNumber(f.Size)/(1048576),0) & " Mo" 'Taille en Mo 
SizeGo = Round(FormatNumber(f.Size)/(1073741824),0) & " Go" 'Taille en Go 
 
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 "

If UCase(ext(0)) = UCase(fso.GetExtensionName(oFile.Name)) or UCase(ext(1)) = UCase(fso.GetExtensionName(oFile.Name))or UCase(ext(2)) = UCase(fso.GetExtensionName(oFile.Name)) or UCase(ext(3)) = UCase(fso.GetExtensionName(oFile.Name)) or UCase(ext(4)) = UCase(fso.GetExtensionName(oFile.Name)) or UCase(ext(5)) = UCase(fso.GetExtensionName(oFile.Name)) or UCase(ext(6)) = UCase(fso.GetExtensionName(oFile.Name)) Then

ImgFileName = oFile.Name
strHTML=strHTML & "<tr><td><center><a target=_Blank href='"& sFilePath &"'>"&ImgFileName&"<br><img src='"& sFilePath &"' border=1 height=50 width=80></center></td><td><center>" & f.DateCreated & "</center></td>" & _
"<td><center>" & f.DateLastModified & "</center></td><td><center>"& Size & "</center></td>"&_
"<td><center>" & sAttrib & "</center></td></tr>"
else
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>"
end if
Next
strHTML = Replace(strHTML, "[COUNT]", Results)
End Sub

Conclusion :


Vos Commentaires et vos Remarques sont les Bienvenus !
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_hackoo)