查找文件

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
'建立IE對象,用來顯示搜索狀態
Dim ie
Set ie=WScript.CreateObject("internetexplorer.application")        
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對象左邊距
ie.Left=Fix((ie.Document.parentwindow.screen.availwidth-ie.Width)/2)
'設置IE對象右邊距        
ie.top=Fix((ie.document.parentwindow.screen.availheight-ie.height)/2)        
ie.visible=1         '設置IE對象是否可視
'以下爲在IE對象中寫入頁面,跟一般的HTML沒有區別
With ie.Document
         .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         '開始遍歷文件集合
                 '將當前搜索的文件路徑寫入ID爲middle的DIV中
                 ie.Document.getElementById("middle").innerHTML=objfile.Path
                 '如果當前文件名與用戶輸入的文件名一致
                 If objfile.Name=filename Then
                         i=i+1         '計數器加一
                         str=str & objfile.Path & "<br>"
                         '創建文本流對象,文件名爲變量result所存儲的字符串
                         Set objtextfile=fso.OpenTextFile(result,2,True)        
                         '將變量str中的文件路徑寫入html文件中
                         objtextfile.Write(str)
                         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
發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章