硬碟檔案搜尋代碼(ASP類)

來源:互聯網
上載者:User

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>

<%

dim st

st=timer()

'*************************************************************

'*************搜尋硬碟檔案的類SearchFile *************

'*************調用方法: *************

'*************Set newsearch=new SearchFile '聲明 *************

'*************newsearch.Folder="F:+E:"'傳入搜尋源*************

'*************newsearch.keyword="彙編" '關鍵詞*************

'*************newsearch.Search '開始搜尋*************

'*************Set newsearch=Nothing '結束*************

'*************Copyright(c)醉雨梧桐小站 *************

'*************http://btyz.51web.cn/ *************

'*************************************************************

Class SearchFile

dim Folders '傳入絕對路徑,多重路徑使用+號串連,不能有空格

dim keyword '傳入關鍵詞

dim objFso '定義全域變數

dim Counter '定義全域變數,搜尋結果的數目

'*****************初始化**************************************

Private Sub Class_Initialize

Set objFso=Server.CreateObject("Scripting.FileSystemObject")

Counter=0 '初始化計數器

End Sub

'************************************************************

Private Sub Class_Terminate

Set objFso=Nothing

End Sub

'**************公有成員,調用的方法***************************

Function Search

Folders=split(Folders,"+") '轉化為數組

keyword=trim(keyword) '去掉前後空格

if keyword="" then

Response.Write("<font color='red'>關鍵字不可為空</font><br/>")

exit Function

end if

'判斷是否包含非法字元

flag=instr(keyword,"\") or instr(keyword,"/")

flag=flag or instr(keyword,":")

flag=flag or instr(keyword,"|")

flag=flag or instr(keyword,"&")

if flag then '關鍵字中不能包含\/:|&

Response.Write("<font color='red'>關鍵字不能包含/\:|&</font><br/>")

Exit Function '如果包含有這個則退出

end if

'多重路徑搜尋

dim i

for i=0 to ubound(Folders)

Call GetAllFile(Folders(i)) '調用迴圈遞迴函式

next

Response.Write("共搜尋到<font color='red'>"&Counter&"</font>個結果")

End Function

'***************曆遍檔案和檔案夾******************************

Private Function GetAllFile(Folder)

dim objFd,objFs,objFf

Set objFd=objFso.GetFolder(Folder)

Set objFs=objFd.SubFolders

Set objFf=objFd.Files

'曆遍子檔案夾

dim strFdName '聲明子檔案夾名

'*********曆遍子檔案夾******

on error resume next

For Each OneDir In objFs

strFdName=OneDir.Name

'系統檔案夾不在曆遍之列

If strFdName<>"Config.Msi" EQV strFdName<>"RECYCLED" EQV strFdName<>"RECYCLER" EQV strFdName<>"System Volume Information" Then

SFN=Folder&"\"&strFdName '絕對路徑

Call GetAllFile(SFN) '調用遞迴

End If

Next

dim strFlName

'**********曆遍檔案********

For Each OneFile In objFf

strFlName=OneFile.Name

'desktop.ini和folder.htt不在列取範圍

If strFlName<>"desktop.ini" EQV strFlName<>"folder.htt" Then

FN=Folder&"\"&strFlName

Counter=Counter+ColorOn(FN)

End If

Next

'***************************

'關閉各對象執行個體

Set objFd=Nothing

Set objFs=Nothing

Set objFf=Nothing

End Function

'*********************產生匹配模式***********************************

Private Function CreatePattern(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&")+" '整體匹配

End Function

'**************************搜尋並使關鍵字上色*************************

Private Function ColorOn(FileName)

dim objReg

Set objReg=new RegExp

objReg.Pattern=CreatePattern(keyword)

objReg.IgnoreCase=True

objReg.Global=True

retVal=objReg.Test(FileName) '進行搜尋測試,如果通過則上色並輸出

if retVal then

OutPut=objReg.Replace(FileName,"<font color='#FF0000'>$1</font>") '設定關鍵字的顯示顏色

'***************************該部分可以根據需要修改輸出************************************

OutPut="<a href='#'>"&OutPut&"</a><br/>"

Response.Write(OutPut) '輸出匹配的結果

'*************************************可修改部分結束**************************************

ColorOn=1 '加入計數器的數目

else

ColorOn=0

end if

Set objReg=Nothing

End Function

End Class

'************************結束類SearchFile**********************

%>

<html>

<head>

<meta http-equiv="Content-Type" content="text/html; charset=gb2312">

<title>Media搜尋</title>

</head>

<body>

<form name="form1" method="post" action="<% =Request.ServerVariables("PATH_INFO")%>">

關鍵詞:

<input name="keyword" type="text" id="keyword">

<input type="submit" name="Submit" value="搜尋">

<a href="help.htm" target="_blank">進階搜尋協助</a>

</form>

<%

dim keyword

keyword=Request.Form("keyword")

if keyword<>"" then

Set newsearch=new SearchFile

newsearch.Folders="E:\Media+F:"

newsearch.keyword=keyword

newsearch.Search

Set newsearch=Nothing

response.Write("<br/>費時:"&(timer()-st)*1000&"毫秒")

end if

%>

</body>

</html>

相關文章

聯繫我們

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

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

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.