标题: [原创] VBS全盘查找文件(2011年3月17日更新) [打印本页]
作者: batman 时间: 2009-4-6 19:20 标题: VBS全盘查找文件(2011年3月17日更新)
本次更新了程序对大、小写字母的兼容性-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 时间: 2009-4-6 21:30 标题: 再接一个按时间查找的
- '全盘查找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 时间: 2010-3-16 05:49
全盘找不能。子目录下或多级目录好像不支持呀
作者: key123lxf 时间: 2010-8-4 20:52
全盘找不能。子目录下或多级目录好像不支持呀
作者: chaoxuanhacker 时间: 2010-9-6 14:29
不行了。还得改进啊。 我怎么找不到我要的QQ。EXE啊?哎~~!
作者: ydg881203 时间: 2010-10-16 09:35
全盘查找并运行!!!- 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 时间: 2010-10-16 09:36 标题: 回复 5楼 的帖子
- 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
复制代码
欢迎光临 批处理之家 (http://bbs.bathome.net/) |
Powered by Discuz! 7.2 |