一個硬碟檔案搜尋的Asp源碼

來源:互聯網
上載者:User
硬碟 可能具有一定的危害性,請不要用於非法企圖,否則後果自負
<%
'**************************代碼源自網路***********************
'******************可能具有一定的危害性,請不要用於非法企圖,否則後果自負*******************
'**********************修改:Blue2004***********************
'*************Setnewsearch=newSearchFile'聲明*************
'*************newsearch.Folder="F:+E:"'傳入搜尋源*************
'*************newsearch.keyword="彙編"'關鍵詞*************
'*************newsearch.Search'開始搜尋*************
'*************Setnewsearch=Nothing'結束*************
'*************************************************************
Server.ScriptTimeOut=99999'程式載入的逾時設定
ClassSearchFile
dimFolders'傳入絕對路徑,多重路徑使用+號串連,不能有空格
dimkeyword'傳入關鍵詞
dimobjFso'定義全域變數
dimCounter'定義全域變數,搜尋結果的數目
'*****************初始化**************************************
PrivateSubClass_Initialize
 SetobjFso=Server.CreateObject("Scripting.FileSystemObject")
 Counter=0'初始化計數器
EndSub
'************************************************************
PrivateSubClass_Terminate
 SetobjFso=Nothing
EndSub
'**************公有成員,調用的方法***************************
FunctionSearch
 Folders=split(Folders,"+")'轉化為數組
 keyword=trim(keyword)'去掉前後空格
 ifkeyword=""then
 Response.Write("<fontcolor='red'>關鍵字不可為空</font><br/>")
exitFunction
 endif
 '判斷是否包含非法字元
 flag=instr(keyword,"")orinstr(keyword,"/")
 flag=flagorinstr(keyword,":")
 flag=flagorinstr(keyword,"|")
 flag=flagorinstr(keyword,"&")
 
 ifflagthen'關鍵字中不能包含/:|&
 Response.Write("<fontcolor='red'>關鍵字不能包含/:|&</font><br/>")
ExitFunction'如果包含有這個則退出
 endif
 '多重路徑搜尋
 dimi
 fori=0toubound(Folders)
 CallGetAllFile(Folders(i))'調用迴圈遞迴函式
 next
 Response.Write("共搜尋到<fontcolor='red'>"&Counter&"</font>個結果")
EndFunction
'***************曆遍檔案和檔案夾******************************
PrivateFunctionGetAllFile(Folder)
 dimobjFd,objFs,objFf
 SetobjFd=objFso.GetFolder(Folder)
 SetobjFs=objFd.SubFolders
 SetobjFf=objFd.Files
 '曆遍子檔案夾
 dimstrFdName'聲明子檔案夾名
 '*********曆遍子檔案夾******
 onerrorresumenext
 ForEachOneDirInobjFs
 strFdName=OneDir.Name
'系統檔案夾不在曆遍之列
 IfstrFdName<>"Config.Msi"EQVstrFdName<>"RECYCLED"EQVstrFdName<>"RECYCLER"EQVstrFdName<>"SystemVolumeInformation"Then
 SFN=Folder&""&strFdName'絕對路徑
 CallGetAllFile(SFN)'調用遞迴
EndIf
 Next
 dimstrFlName
 '**********曆遍檔案********
 ForEachOneFileInobjFf
 strFlName=OneFile.Name
'desktop.ini和folder.htt隱藏的系統檔案不在列取範圍
 IfstrFlName<>"desktop.ini"EQVstrFlName<>"folder.htt"Then
 FN=Folder&""&strFlName
 Counter=Counter+ColorOn(FN)
EndIf
 Next
 '***************************
 '關閉各對象執行個體
 SetobjFd=Nothing
 SetobjFs=Nothing
 SetobjFf=Nothing
EndFunction
'*********************產生匹配模式***********************************
PrivateFunctionCreatePattern(keyword)
 CreatePattern=keyword
 CreatePattern=Replace(CreatePattern,".",".")
 CreatePattern=Replace(CreatePattern,"+","+")
 CreatePattern=Replace(CreatePattern,"(","(")
 CreatePattern=Replace(CreatePattern,")",")")
 CreatePattern=Replace(CreatePattern,"[","[")
 CreatePattern=Replace(CreatePattern,"]","]")
 CreatePattern=Replace(CreatePattern,"{","{")
 CreatePattern=Replace(CreatePattern,"}","}")
 CreatePattern=Replace(CreatePattern,"*","[^/]*")'*號匹配
 CreatePattern=Replace(CreatePattern,"?","[^/]{1}")'?號匹配
 CreatePattern="("&CreatePattern&")+"'整體匹配
EndFunction
'**************************搜尋並使關鍵字上色*************************
PrivateFunctionColorOn(FileName)
 dimobjReg
 SetobjReg=newRegExp
 objReg.Pattern=CreatePattern(keyword)
 objReg.IgnoreCase=True
 objReg.Global=True
 retVal=objReg.Test(FileName)'進行搜尋測試,如果通過則上色並輸出
 ifretValthen
 OutPut=objReg.Replace(FileName,"<fontcolor='#FF0000'>$1</font>")'設定關鍵字的顯示顏色
'***************************該部分可以根據需要修改輸出************************************
 OutPut="<ahref='#'>"&OutPut&"</a><br/>"
 Response.Write(OutPut)'輸出匹配的結果
'*************************************可修改部分結束**************************************
 ColorOn=1'加入計數器的數目
 else
 ColorOn=0
 endif
 SetobjReg=Nothing
EndFunction

相關文章

E-Commerce Solutions

Leverage the same tools powering the Alibaba Ecosystem

Learn more >

Apsara Conference 2019

The Rise of Data Intelligence, September 25th - 27th, Hangzhou, China

Learn more >

Alibaba Cloud Free Trial

Learn and experience the power of Alibaba Cloud with a free trial worth $300-1200 USD

Learn more >

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。