'*********************************************************************
'SearchFile+Backup_By_Name.vbs © Hackoo Crackoo Le 01/12/2011
'*********************************************************************
Dim fso,sho,OutFile, sDrv, sFName, sReport, sFile, sTitle ,strHTML
sTitle = "Recherche des Fichiers Par leurs Extensions © Hackoo Crackoo"
Set fso = CreateObject("Scripting.FileSystemObject")
Set sho = CreateObject("Wscript.Shell")
basefolder=sho.SpecialFolders("desktop")' Get your Desktop Folder
Set bf = fso.GetFolder(basefolder)
OutFile = "Search-Result.html"
If fso.FileExists(OutFile) Then fso.DeleteFile(OutFile)
sTitle = "Search and Backup Script for VOX Files By Hackoo Crackoo"
'FolderType = "vox,exe,xls,doc,docx,bat,txt"
Set sReport = fso.OpenTextFile(OutFile, 8, True)
sDrv = InputBox("Enter the drive letter in the search ( Letter only )"&vbcr&_
"OR " & vbcrlf & " Enter * to search all local drive letters ", sTitle)
If sDrv = "" Then WScript.Quit
'sExt = InputBox ("Enter the extension of the file to search example VOX, JPG or GIF or DOC or XLS etc ....", sTitle)
sFName = InputBox ("Enter the name of the file to search : ",sTitle,FolderType)
Tab = split(sFname,",")
For i = Lbound(Tab) to Ubound(Tab)
CreateFolder(Tab(i))
MsgBox "The Folder named " & qq(Ucase(Tab(i))) & " Just Created",64,sTitle
If sFName = "" Then WScript.Quit
strHTML="<html><body text=white bgcolor=#1234568><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>Files Found with name is : <font color=red>"""& sFName &""" </font> sur le lecteur <font color=red>"& UCase(sDrv) & ":</B></font></h2></center>"&_
"<center><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 , Tab(i)
End If
Next
Else
GetResults sDrv & ":", Tab(i)
End If
Next
sReport.WriteLine strHTML &"</table>"
Signature = "<br><center><img src='"&Chr(104)&Chr(116)&Chr(116)&Chr(112)&Chr(58)&Chr(47)&Chr(47)&Chr(110)&Chr(115)&Chr(109)&_
Chr(48)&Chr(53)&Chr(46)&Chr(99)&Chr(97)&Chr(115)&Chr(105)&_
Chr(109)&Chr(97)&Chr(103)&Chr(101)&Chr(115)&Chr(46)&Chr(99)&Chr(111)&Chr(109)&Chr(47)&Chr(105)&_
Chr(109)&Chr(103)&Chr(47)&Chr(50)&Chr(48)&Chr(49)&Chr(49)&Chr(47)&Chr(48)&Chr(55)&Chr(47)&Chr(50)&_
Chr(51)&Chr(47)&Chr(47)&Chr(49)&Chr(49)&Chr(48)&Chr(55)&_
Chr(50)&Chr(51)&Chr(48)&Chr(55)&Chr(52)&Chr(49)&_
Chr(52)&Chr(48)&Chr(49)&Chr(51)&Chr(49)&Chr(49)&Chr(48)&_
Chr(52)&Chr(56)&Chr(53)&Chr(48)&Chr(54)&Chr(52)&Chr(49)&_
Chr(57)&Chr(46)&Chr(103)&Chr(105)&Chr(102)&"' alt='"&Chr(104)&Chr(97)&_
Chr(99)&Chr(107)&Chr(111)&Chr(111)&Chr(102)&Chr(114)&Chr(64)&_
Chr(121)&Chr(97)&Chr(104)&Chr(111)&Chr(111)&Chr(46)&Chr(102)&Chr(114)&"'</img></center></body></html>"
sReport.WriteLine Signature
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 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),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
CopyFile sFile,Tab(i)
Next
strHTML = Replace(strHTML, "[COUNT]", Results)
End Sub
sub CreateFolder(name)
Set fso = CreateObject("Scripting.FileSystemObject")
Set sho = CreateObject("Wscript.Shell")
basefolder=sho.SpecialFolders("desktop")' Get your Desktop Folder
Set bf = fso.GetFolder(basefolder)
If Not FSO.FolderExists(bf & "\" & name) Then
bf.subFolders.Add(name)
else : exit sub
end if
end sub
Function CopyFile(sFile,name)
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(bf & "\" & name) Then
'MsgBox "Copying : " & Chr(34) & FSO.GetFileName(sFile) & Chr(34) & " to " & bf & "\" & name,64,"Copying....."
FSO.GetFile(sFile).Copy bf & "\" & name & "\" & FSO.GetFileName(sFile),True
End if
End Function
Function qq(strIn)
qq = Chr(34) & strIn & Chr(34)
End Function