[原创] VBS全盘查找文件（2011年3月17日更新）

batman

本次更新了程序对大、小写字母的兼容性－batman 2009年4月7日
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

'全盘查找文件
dim path,allfiles,newpath,nowpath,inputfile,jiegou,choice
on error resume next
do
allfiles="查找出来的文件如下："
filename=inputbox("请输入你要查找的文件：")
if filename=false then
   wcript.quit
   else
   set wshshell=createobject("wscript.shell")
   set objfso=createobject("scripting.filesystemobject")
   set objdrives=objfso.drives
        for each objdrive in objdrives
             wshshell.popup "正在查找盘符"&objdrive,1
             search objdrive
        next
   if allfiles<>"查找出来的文件如下：" then 
      jiegou=allfiles&vbcrlf
      else
      jiegou="没有找到要查找的文件，"&vbcrlr&"请确信其存在。"
   end if
   wsh.echo "查找结束,"&jiegou
   set objdrives=nothing
   set objfiles=nothing
   set objfolders=nothing
   set objfso=nothing
   set wshshell=nothing
end if
choice=msgbox ("是否需要再次查找？",vbyesno)
loop while choice=vbyes
function search(path)
     set objfolders=objfso.getfolder(path).subfolders
     for each objfolder in objfolders
          nowpath=path&"\"&objfolder.name
          set objfiles=objfso.getfolder(nowpath).files
          for each objfile in objfiles
               if lcase(objfile.name)=lcase(filename) then allfiles=allfiles&vbcrlf&objfile
          next
          newpath=path&"\"&objfolder.name
          search newpath
      next    
end function
复制代码

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
本次更新修正了以前的所有错误，并加入了硬盘判断以及搜索时的盘符选择，并大幅度简化了代码--batman 2011年3月17日

 
Do While input = ""
   input = InputBox ("请输入要查找的文件：")
Loop
Set fso = CreateObject ("scripting.filesystemobject")
Set ws = CreateObject ("wscript.shell")
Dim vbstr, choice
For Each drive In fso.Drives
    If drive.DriveType = 2 Then
       choice = "0"
       choice = MsgBox ("是否查找" & Left (drive, 1) & "盘", vbYesNo)
       If choice = "6" Then
          ws.Popup "正在查找" & Left (drive, 1) & "盘，请稍候。。。", 2
          search drive & "\"
       End If 
    End if   
Next
If vbstr = "" Then vbstr = "没有找到要查找的文件“" & input & "”，请确信它的确存在"
MsgBox vbstr, 0, "查找结果"
Set fso = Nothing
Set ws = Nothing
Function search (path)
   On Error Resume Next
   For Each file In fso.GetFolder (path).Files
       If LCase (file.name) = LCase (input) Then vbstr = vbstr & file & vbCrLf
   Next 
   For Each folder In fso.GetFolder (path).subfolders
       search folder
   Next
End Function
复制代码

--------------------------------------------------------------------------------------------------------------------------
本次更新至模糊查找--batman 2011年3月17日

Do While input = ""
   input = InputBox ("请输入要查找的文件，如文件输入不全则执行模糊查找：")
Loop
Set fso = CreateObject ("scripting.filesystemobject")
Set ws = CreateObject ("wscript.shell")
Dim vbstr, choice
For Each drive In fso.Drives
    If drive.DriveType = 2 Then
       choice = "0"
       choice = MsgBox ("是否查找" & Left (drive, 1) & "盘", vbYesNo)
       If choice = "6" Then
          ws.Popup "正在查找" & Left (drive, 1) & "盘，请稍候。。。", 2
          search drive & "\"
       End If
    End if   
Next
If vbstr = "" Then vbstr = "没有找到要查找的文件“" & input & "”，请确信它的确存在"
fso.CreateTextFile ("temp.txt", 1, 0).Write vbstr
ws.Run "temp.txt", 1, 0
Set fso = Nothing
Set ws = Nothing
Function search (path)
   On Error Resume Next
   For Each file In fso.GetFolder (path).Files
       If Replace (LCase (file.name), LCase (input), "") <> LCase (file.name) Then vbstr = vbstr & file & vbCrLf
   Next 
   For Each folder In fso.GetFolder (path).subfolders
       search folder
   Next
End Function
复制代码

[ 本帖最后由 batman 于 2011-3-17 18:49 编辑 ]

batman

'全盘查找N天内创建的文件
dim path,newpath,nowpath,todays,jiegou
on error resume next
todays=inputbox("请输入回溯的天数：")
if todays=false then
   wcript.quit
   else
   set wshshell=createobject("wscript.shell")
   set objfso=createobject("scripting.filesystemobject")
   set objtext=objfso.opentextfile(wshshell.currentdirectory&"\temp.txt",2,true)
   objtext.writeline "下面为系统在"&todays&"天内创建的文件："
   set objdrives=objfso.drives
   for each objdrive in objdrives
        search objdrive
   next
   objtext.close
   wshshell.popup "查找结束",2
   wshshell.run(wshshell.currentdirectory&"\temp.txt")
   wsh.sleep 1000
   objfso.deletefile(wshshell.currentdirectory&"\temp.txt")
   set objdrives=nothing
   set objfiles=nothing
   set objfolders=nothing
   set objfso=nothing
   set wshshell=nothing
end if
function search(path)
     set objfolders=objfso.getfolder(path).subfolders
     for each objfolder in objfolders
          nowpath=path&"\"&objfolder.name
          set objfiles=objfso.getfolder(nowpath).files
          for each objfile in objfiles
               if objfile.datecreated>=dateadd("d",-todays,date) then objtext.writeline objfile
          next
          newpath=path&"\"&objfolder.name
          search newpath
      next    
end function
复制代码

[ 本帖最后由 batman 于 2009-4-6 21:31 编辑 ]

hbwhyin

全盘找不能。子目录下或多级目录好像不支持呀

key123lxf

全盘找不能。子目录下或多级目录好像不支持呀

chaoxuanhacker

不行了。还得改进啊。 我怎么找不到我要的QQ。EXE啊？哎~~！

ydg881203

全盘查找并运行！！！

dim ws
Set ws=CreateObject("wscript.shell")
for each x in getobject("winmgmts:").execquery("select * from CIM_DataFile where FileName = '要找的文件名，例如：Ang' and Extension = '要找文件的扩展名，例如：exe'")
str = x.name
'ws.run """"& str & """"
ws.run chr(34) & str & chr(34)
next
复制代码

ydg881203

dim ws
Set ws=CreateObject("wscript.shell")
for each x in getobject("winmgmts:").execquery("select * from CIM_DataFile where FileName = 'qq' and Extension = 'exe'")
str = x.name
'ws.run """"& str & """"
ws.run chr(34) & str & chr(34)
next
复制代码