您的位置:首页网页设计ASP实例 → 如何使用FSO搜索硬盘文件

如何使用FSO搜索硬盘文件

时间:2004/11/7 3:03:00来源:本站整理作者:蓝点我要评论(0)

 

<%@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("关键字不能为空
")
 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("关键字不能包含/\:|&
")
 Exit Function   '如果包含有这个则退出
  end if
  '多路径搜索
  dim i
  for i=0 to ubound(Folders)
    Call GetAllFile(Folders(i))  '调用循环递归函数
  next
  Response.Write("共搜索到"&Counter&"个结果")
 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,"$1")   '设置关键字的显示颜色
'***************************该部分可以根据需要修改输出************************************
     OutPut=""&OutPut&"
"
  Response.Write(OutPut)  '输出匹配的结果
'*************************************可修改部分结束**************************************
  ColorOn=1    '加入计数器的数目
   else
     ColorOn=0
   end if
   Set objReg=Nothing
 End Function
End Class
'************************结束类SearchFile**********************
%>



www.knowsky.com

 

 


  关键词:
 
 
  高级搜索帮助


<%
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("
费时:"&(timer()-st)*1000&"毫秒")
end if

 

%>

 

 

相关阅读 Windows错误代码大全 Windows错误代码查询激活windows有什么用Mac QQ和Windows QQ聊天记录怎么合并 Mac QQ和Windows QQ聊天记录Windows 10自动更新怎么关闭 如何关闭Windows 10自动更新windows 10 rs4快速预览版17017下载错误问题Win10秋季创意者更新16291更新了什么 win10 16291更新内容windows10秋季创意者更新时间 windows10秋季创意者更新内容kb3150513补丁更新了什么 Windows 10补丁kb3150513是什么

文章评论
发表评论

热门文章 没有查询到任何记录。

最新文章 迅雷新手完全入门手册 asp下面javascript上传图片限制格式大小方法告诉大家网页弹出窗口应用总结ASP常见错误类型大全asp常见错误分析和解决办法

人气排行 总是弹出visual studio 实时调试器 三种解决SQLSERVER存储过程及调用详解Asp获取真实IP地址ASP中连接Mssql的几种方法一个简单好用的UBB编辑器(含代码)如何用Split将字符串转换为数组并获取数组下ASP防止表单重复提交的办法告诉你免费的简单聊天室源代码