asp文件搜索

asp文件搜索

 

 

 

<%
'*************Set newsearch=new SearchFile '声明 *************
'*************newsearch.Folder="F:+E:"'传入搜索源*************
'*************newsearch.keyword="汇编"     '关键词*************
'*************newsearch.Search           '开始搜索*************
'*************Set newsearch=Nothing          '结束*************     
'*************************************************************
Server.ScriptTimeOut =99999   '程序加载的超时设置
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 i
   dim objFd,objFs,objFf
   Set objFd=objFso.GetFolder(Folder)
   Set objFs=objFd.SubFolders
   Set objFf=objFd.Files
   i=0
   '历遍子文件夹
   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

       Dim docContext
       Set objWord = CreateObject("Word.Application")'创建word对象
       'objWord.Visible = True
       Set objDoc = objWord.Documents.Open(FN)'打开word
       docContext=objDoc.content.text
       response.write docContext&"<br/>"
       objDoc.close
       Set objDoc=nothing
       objWord.Quit
       Set objDoc=nothing
       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="搜索">
</form>
<%
dim keyword
keyword=Request.Form("keyword")
if keyword<>"" then
   Set newsearch=new SearchFile
   newsearch.Folders="c:/新建文件夹"         '是绝对路径
'不知道能否跨盘,但统一分区下的其他目录可以比如d:/www/ + d:/web/

   newsearch.keyword=keyword
   newsearch.Search
   Set newsearch=Nothing
   response.Write("<br/>费时："&(timer()-st)*1000&"毫秒")
end if

%>

<input type="file" value="选择文件夹">
</body>
</html>