On Error Resume Next '忽略所有錯誤 Dim filename '聲明變量 Dim re Set re=New RegExp '建立正則表達式對象實例 re.Pattern="^([a-z]|[A-Z])+\:\\\w+\.vbs$" If re.Test(WScript.ScriptFullName)=False Then MsgBox "請在磁盤根目錄下運行本程序，否則搜索結果可能會不正確！",,"MessageBox" WScript.Quit End If re.Pattern="^([A-Za-z0-9_]|[^\x00-\xff])+\.[a-zA-Z]{1,4}$" '聲明正則表達式的匹配模式，主要用來檢驗用戶輸入的文件名是否正確 Do filename=InputBox("請輸入你要搜索的文件名：","MessageBox") If filename="" Then WScript.Quit '如果輸入為空則退出腳本 If re.Test(filename)=False Then MsgBox "請輸入合法的文件名！",,"MessageBox" End If Loop While re.Test(filename)=False '直到用戶輸入正確的文件名時才跳出循環。 Set re=Nothing Dim ie Set ie=WScript.CreateObject("internetexplorer.application") '建立IE對象，用來顯示搜索狀態 ie.menubar=0 '不顯示IE對象菜單欄 ie.AddressBar=0 '不顯示IE對象地址欄 ie.ToolBar=0 '不顯示IE對象工具欄 ie.StatusBar=0 '不顯示IE對象狀態欄 ie.FullScreen=1 '全屏化IE對象 ie.Width=640 '設置IE對象寬度 ie.Height=120 '設置IE對象高度 ie.Resizable=0 '設置IE對象大小是否可以被改動 ie.Navigate "about:blank" '設置IE對象默認指向的頁面 ie.Left=Fix((ie.Document.parentwindow.screen.availwidth-ie.Width)/2) '設置IE對象左邊距 ie.top=Fix((ie.document.parentwindow.screen.availheight-ie.height)/2) '設置IE對象右邊距 ie.visible=1 '設置IE對象是否可視 With ie.Document '以下為在IE對象中寫入頁面，跟一般的HTML沒有區別 .write "html>" .write "head>" .write "title>文件掃描狀態/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"">正在啟動搜索程序。。。/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 '定義文件系統對象變量 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 '計數器變量 Dim result result="C:\搜索結果.html" '搜索結果保存文件變量 '一個過程，用來遍歷硬盤文件 Function search(path) Set objfolder=fso.getfolder(path) '獲得當前路徑 Set objfiles=objfolder.Files '獲得當前路徑下的所有文件集合 For Each objfile In objfiles '開始遍歷文件集合 ie.Document.getElementById("middle").innerHTML=objfile.Path '用到IE對象的文檔對象模型，將當前搜索的文件路徑寫入ID為middle的DIV中 If objfile.Name=filename Then '如果當前文件名與用戶輸入的文件名一致 i=i+1 '計數器加一 str=str objfile.Path "br>" Set objtextfile=fso.OpenTextFile(result,2,True) '創建文本流對象，文件名為變量result所存儲的字符串 objtextfile.Write(str) '將變量str中的文件路徑寫入html文件中 objtextfile.Close '關閉文本流對象 Set objtextfile=Nothing '銷毀對象 End If If i>0 Then ie.Document.getElementById("header").innerHTML="找到 " i " 個匹配，詳細信息已保存在 """ result """ 文件中。。。" Else ie.Document.getElementById("header").innerHTML="正在執行文件搜索。。。" End If WScript.Sleep(20) Next Set objsubfolders=objfolder.SubFolders '得到當前路徑下的所有文件夾的集合 For Each objsubfolder In objsubfolders '遍歷文件夾 nowpath=path "\" objsubfolder.Name '得到新的文件路徑 search nowpath '調用函數自身，從新的路徑開始搜索 Next End Function Set fso=CreateObject("scripting.filesystemobject") Set objdrives=fso.Drives '取得當前計算機的所有磁盤驅動器 For Each objdrive In objdrives '遍歷磁盤 search objdrive '調用函數 Next '結束時顯示的信息 ie.Document.getElementById("header").innerHTML="掃描已結束。。。" If i>0 Then ie.Document.getElementById("middle").innerHTML="請打開 """ result """ 查看詳細搜索結果！" Else ie.Document.getElementById("middle").innerHTML="沒有找到要搜索的文件！" End If '銷毀對象變量，釋放內存空間 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
