On Error Resume Next '忽略所有錯(cuò)誤 Dim filename '聲明變量 Dim re Set re=New RegExp '建立正則表達(dá)式對(duì)象實(shí)例 re.Pattern="^([a-z]|[A-Z])+/:///w+/.vbs$" If re.Test(WScript.ScriptFullName)=False Then MsgBox "請(qǐng)?jiān)诖疟P(pán)根目錄下運(yùn)行本程序，否則搜索結(jié)果可能會(huì)不正確！",,"MessageBox" WScript.Quit End If re.Pattern="^([A-Za-z0-9_]|[^/x00-/xff])+/.[a-zA-Z]{1,4}$" '聲明正則表達(dá)式的匹配模式，主要用來(lái)檢驗(yàn)用戶輸入的文件名是否正確 Do filename=InputBox("請(qǐng)輸入你要搜索的文件名：","MessageBox") If filename="" Then WScript.Quit '如果輸入為空則退出腳本 If re.Test(filename)=False Then MsgBox "請(qǐng)輸入合法的文件名！",,"MessageBox" End If Loop While re.Test(filename)=False '直到用戶輸入正確的文件名時(shí)才跳出循環(huán)。 Set re=Nothing Dim ie Set ie=WScript.CreateObject("internetexplorer.application") '建立IE對(duì)象，用來(lái)顯示搜索狀態(tài) ie.menubar=0 '不顯示IE對(duì)象菜單欄 ie.AddressBar=0 '不顯示IE對(duì)象地址欄 ie.ToolBar=0 '不顯示IE對(duì)象工具欄 ie.StatusBar=0 '不顯示IE對(duì)象狀態(tài)欄 ie.FullScreen=1 '全屏化IE對(duì)象 ie.Width=640 '設(shè)置IE對(duì)象寬度 ie.Height=120 '設(shè)置IE對(duì)象高度 ie.Resizable=0 '設(shè)置IE對(duì)象大小是否可以被改動(dòng) ie.Navigate "about:blank" '設(shè)置IE對(duì)象默認(rèn)指向的頁(yè)面 ie.Left=Fix((ie.Document.parentwindow.screen.availwidth-ie.Width)/2) '設(shè)置IE對(duì)象左邊距 ie.top=Fix((ie.document.parentwindow.screen.availheight-ie.height)/2) '設(shè)置IE對(duì)象右邊距 ie.visible=1 '設(shè)置IE對(duì)象是否可視 With ie.Document '以下為在IE對(duì)象中寫(xiě)入頁(yè)面，跟一般的HTML沒(méi)有區(qū)別 .write "<html>" .write "<head>" .write "<title>文件掃描狀態(tài)</title>" .write "<meta http-equiv=""content-type"" content=""text/html;charset=gb2312"">" .write "<style><!--" .write "body { background:#000000;text-align:center;margin:0px auto; }" .write "* { font-family:Arial;font-size:9pt;color:#00cc00;line-height:140%; }" .write "a:link,ahover,a:visited { text-decoration:none; }" .write "#scanstatus { text-align:left;margin:15px; }" .write "#header { width:100%;height:20px; }" .write "#middle { width:100%;height:50px; }" .write "#footer { width:100%;height:20px;text-align:right; }" .write "--></style>" .write "</head>" .write "<body scroll=no>" .write "<div id=""scanstatus"">" .write "<div id=""header"">正在啟動(dòng)搜索程序。。。</div>" .write "<div id=""middle""></div>" .write "<div id=""footer""><a href=""#"" onclick=""window.close()"">退出程序</a></div>" .write "</div>" .write "</body>" .write "</html>" End With '定義文件系統(tǒng)對(duì)象變量 Dim fso Dim objfolder Dim objsubfolders Dim objsubfolder Dim objfiles Dim objfile Dim objdrives Dim objdrive Dim objtextfile Dim str:str="" Dim i:i=0 '計(jì)數(shù)器變量 Dim result result="E:/搜索結(jié)果.html" '搜索結(jié)果保存文件變量 '一個(gè)過(guò)程，用來(lái)遍歷硬盤(pán)文件 Function search(path) Set objfolder=fso.getfolder(path) '獲得當(dāng)前路徑 Set objfiles=objfolder.Files '獲得當(dāng)前路徑下的所有文件集合 For Each objfile In objfiles '開(kāi)始遍歷文件集合 ie.Document.getElementById("middle").innerHTML=objfile.Path '用到IE對(duì)象的文檔對(duì)象模型，將當(dāng)前搜索的文件路徑寫(xiě)入ID為middle的DIV中 If objfile.Name=filename Then '如果當(dāng)前文件名與用戶輸入的文件名一致 i=i+1 '計(jì)數(shù)器加一 str=str & objfile.Path & "<br>" Set objtextfile=fso.OpenTextFile(result,2,True) '創(chuàng)建文本流對(duì)象，文件名為變量result所存儲(chǔ)的字符串 objtextfile.Write(str) '將變量str中的文件路徑寫(xiě)入html文件中 objtextfile.Close '關(guān)閉文本流對(duì)象 Set objtextfile=Nothing '銷毀對(duì)象 End If If i>0 Then ie.Document.getElementById("header").innerHTML="找到 " & i & " 個(gè)匹配，詳細(xì)信息已保存在 """ & result & """ 文件中。。。" Else ie.Document.getElementById("header").innerHTML="正在執(zhí)行文件搜索。。。" End If WScript.Sleep(20) Next Set objsubfolders=objfolder.SubFolders '得到當(dāng)前路徑下的所有文件夾的集合 For Each objsubfolder In objsubfolders '遍歷文件夾 nowpath=path & "/" & objsubfolder.Name '得到新的文件路徑 search nowpath '調(diào)用函數(shù)自身，從新的路徑開(kāi)始搜索 Next End Function Set fso=CreateObject("scripting.filesystemobject") Set objdrives=fso.Drives '取得當(dāng)前計(jì)算機(jī)的所有磁盤(pán)驅(qū)動(dòng)器 For Each objdrive In objdrives '遍歷磁盤(pán) search objdrive '調(diào)用函數(shù) Next '結(jié)束時(shí)顯示的信息 ie.Document.getElementById("header").innerHTML="掃描已結(jié)束。。。" If i>0 Then ie.Document.getElementById("middle").innerHTML="請(qǐng)打開(kāi) """ & result & """ 查看詳細(xì)搜索結(jié)果！" Else ie.Document.getElementById("middle").innerHTML="沒(méi)有找到要搜索的文件！" End If '銷毀對(duì)象變量，釋放內(nèi)存空間 Set objdrives=Nothing Set objfiles=Nothing Set objfile=Nothing Set objdrive=Nothing Set objfolders=Nothing Set objfolder=Nothing Set objsubfolders=Nothing Set objsubfolder=Nothing Set fso=Nothing
