<%@LANGUAGE="VBSCR<%
dim st
st=timer()
'*************************************************************
'*************搜索硬盤文件的類SearchFile         *************
'*************調用方法:                          *************
'*************Set newsearch=new SearchFile '聲明 *************
'*************newsearch.Folder="F:+E:"'傳入搜索源*************
'*************newsearch.keyWord="匯編"    '關鍵詞*************
'*************newsearch.Search          '開始搜索*************
'*************Set newsearch=Nothing         '結束*************     
'*************************************************************
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>m.survivalescaperooms.com</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>