| 
 | 
         
          | 如何使用FSO搜索硬盘文件 |   
          | 来源:转载   人气:1807   录入时间:2007-11-8 |   
          | <%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%> <%
 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>www.china-u.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>
 
 
 |   
          |  |  
 
 |