一个硬盘文件搜索的Asp源码

原创 2005年04月28日 12:31:00
可能具有一定的危害性,请不要用于非法企图,否则后果自负
<%
'**************************代码源自网络***********************
'******************可能具有一定的危害性,请不要用于非法企图,否则后果自负*******************
'**********************修改:Blue2004***********************
'*************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 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="d:/web +d:/xydown/soft" '是绝对路径
'不知道能否跨盘,但统一分区下的其他目录可以比如d:/www/ + d:/web/

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

%>

</body>
</html>

asp源码,网络硬盘

  • 2009年03月25日 19:48
  • 804KB
  • 下载

asp.net 写一个RMB金额大写转换器(源码)

using System; using System.Collections.Generic; using System.Linq; using System.Web; using Syste...

Asp.net网络硬盘系统源码

  • 2010年05月15日 19:42
  • 278KB
  • 下载

图解understand分析一个asp.net办公系统源码

源码下载; http://pan.baidu.com/s/1o7OEMc6 321.rar 总结结构;业务层,数据库访问工厂,实体层,数据库访问接口,sqlserver数据库访问层,...

POP Forums 一个asp.net论坛的源码

  • 2007年12月11日 20:10
  • 1.33MB
  • 下载

ASP.NET MVC5+EF6+EasyUI 后台管理系统(32)-swfupload多文件上传[附源码]

系列目录 文件上传这东西说到底有时候很痛,原来的asp.net服务器控件提供了很简单的上传,但是有回传,还没有进度条提示。这次我们演示利用swfupload多文件上传,项目上文件上传是比不可少的,大...
  • ymnets
  • ymnets
  • 2017年11月29日 08:39
  • 12

带SQL注入的一个ASP网站源码

  • 2016年12月29日 10:54
  • 47.51MB
  • 下载
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:一个硬盘文件搜索的Asp源码
举报原因:
原因补充:

(最多只允许输入30个字)