快精灵印艺坊 您身边的文印专家
广州名片 深圳名片 会员卡 贵宾卡 印刷 设计教程
产品展示 在线订购 会员中心 产品模板 设计指南 在线编辑
 首页 名片设计   CorelDRAW   Illustrator   AuotoCAD   Painter   其他软件   Photoshop   Fireworks   Flash  

 » 彩色名片
 » PVC卡
 » 彩色磁性卡
 » 彩页/画册
 » 个性印务
 » 彩色不干胶
 » 明信片
   » 明信片
   » 彩色书签
   » 门挂
 » 其他产品与服务
   » 创业锦囊
   » 办公用品
     » 信封、信纸
     » 便签纸、斜面纸砖
     » 无碳复印纸
   » 海报
   » 大篇幅印刷
     » KT板
     » 海报
     » 横幅

制作一个个人搜索引擎(源码)

<%
Response.Buffer=True

\\\'
\\\' OneFile Search Engine (ofSearch v1.0)
\\\' All Rights Reserved
\\\'
\\\' Note:
\\\' This program is freeware. This program is NOT in the Public Domain.
\\\' You can freely use this program in your own site.
\\\'
\\\' You cannot re-distribute the code, by any means,
\\\' without the express written authorization by the author.
\\\'
\\\' Use this program at your own risk.
\\\'


\\\' Globals --------------------------------------
\\\' ----------------------------------------------

Const ValidFiles = "htmltxt"
Const RootFld = "./"

Dim Matched
Dim Regex
Dim GetTitle
Dim fs
Dim rfLen
dim RootFolder
Dim DocCount
Dim DocMatchCount
Dim MatchedCount

\\\' ----------------------------------------------
\\\' Procedure: SearchFiles()
\\\' ----------------------------------------------
Public Sub SearchFiles(FolderPath)
Dim fsFolder
Dim fsFolder2
Dim fsFile
Dim fsText
Dim FileText
Dim FileTitle
Dim FileTitleMatch
Dim MatchCount
Dim OutputLine

\\\' Get the starting folder
Set fsFolder = fs.GetFolder(FolderPath)
\\\' Iterate thru every file in the folder
For Each fsFile In fsFolder.Files
\\\' Compare the current file extension with the list of valid target files
If InStr(1, ValidFiles, Right(fsFile.Name, 3), vbTextCompare) > 0 Then
DocCount = DocCount + 1
\\\' Open the file to read its content
Set fsText = fsFile.OpenAsTextStream
FileText = fsText.ReadAll
\\\' Apply the regex search and get the count of matches found
MatchCount = Regex.Execute(FileText).Count
MatchedCount = MatchedCount + MatchCount
If MatchCount > 0 Then
DocMatchCount = DocMatchCount + 1
\\\' Apply another regex to get the html document\\\'s title
Set FileTitleMatch = GetTitle.Execute(FileText)
If FileTitleMatch.Count > 0 Then
\\\' Strip the title tags
FileTitle = Trim(replace(Mid(FileTitleMatch.Item(0),8),"</title>","",1,1,1))
\\\' In case the title is empty
If FileTitle = "" Then
FileTitle = "No Title (" & fsFile.Name & ")"
End If
Else
\\\' Create an alternate entry name (if no title found)
FileTitle = "No Title (" & fsFile.Name & ")"
End If
\\\' Create the entry line with proper formatting
\\\' Add the entry number
OutputLine = "&nbsp;&nbsp;<b>" & DocMatchCount & ".</B>&nbsp;"
\\\' Add the document name and link
OutputLine = OutputLine & "<A href=" & chr(34) & RootFld & replace(Mid(fsFile.Path,
rfLen),"","/") & chr(34) & "><B>"
OutputLine = OutputLine & FileTitle & "</B></a>"
\\\' Add the document information
OutputLine = OutputLine & "<font size=1><br>&nbsp;&nbsp;Criteria matched " & MatchCount
& " times - Size: "
OutputLine = OutputLine & FormatNumber(fsFile.Size / 1024,2 ,-1,0,-1) & "K bytes"
OutputLine = OutputLine & " - Last Modified: " & formatdatetime
(fsFile.DateLastModified,vbShortDate) & "</Font><br>"
\\\' Display entry
Response.Write OutputLine
Response.Flush
End If
fsText.Close
End If
Next

\\\' Iterate thru each subfolder and recursively call this procedure
For Each fsFolder2 In fsFolder.SubFolders
SearchFiles fsFolder2.Path
Next

Set FileTitleMatch = Nothing
Set fsText = Nothing
Set fsFile = Nothing
Set fsFolder2 = Nothing
Set fsFolder = Nothing
End Sub

\\\' ----------------------------------------------
\\\' Procedure: Search()
\\\' ----------------------------------------------
Sub Search(SearchString)
Dim i
Dim fKeys
Dim fItems

Set fs = CreateObject("Scripting.FileSystemObject")
Set GetTitle = New RegExp
Set Regex = New RegExp

With Regex
.Global = True
.IgnoreCase = True
.Pattern = Trim(SearchString)
End With
With GetTitle
.Global = False
.IgnoreCase = True
.Pattern = "<title>(.|n)*</title>"
End With

RootFolder = Server.MapPath(RootFld)

If Right(RootFld,1) <> "/" Then
RootFld = RootFld & "/"
End If

If Right(RootFolder, 1) <> "" Then
RootFolder = RootFolder & ""
End If
rfLen = Len(RootFolder) + 1

SearchFiles RootFolder

If MatchedCount = 0 Then
Response.Write "&nbsp;&nbsp;<B>No Matches Found.</b><BR>"
End If

Set Regex = Nothing
Set GetTitle = Nothing
Set fs = Nothing

End Sub

%>
<HTML>
<HEAD>
<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
<meta http-equiv="Content-Language" content="en-us">
<TITLE>OneFile Search 1.0</TITLE>
</HEAD>
<body bgcolor="#FFFFFF" link="#660000" vlink="#008000">
<Font Face="Tahoma,Arial" Size="2">
<table border="0" width="100%" cellspacing="0" cellpadding="0">
<tr>
<td width="100%" colspan="2"></td>
</tr>
<tr>
<td width="50%" bgcolor="#000000">
<Form method="Get">
<table border="0" width="100%">
<tr>
<td width="33%" align="right"><font color="#FFFFFF" size="2" face="Tahoma,Arial"><b>Search
for&nbsp;</b></font></td>
<td width="33%"><input type="text" size="20" value="<%=Request.QueryString("query")%>"
name="query"></td>
<td width="34%"><input type="submit" name="Search" Value="Search"></td>
</tr>
</table>
</Form>
</td>
<td width="50%" bgcolor="#000000"></td>
</tr>
<tr>
<td width="100%" colspan="2" bgcolor="#000000"></td>
</tr>
<tr>
<td width="50%" bgcolor="#808080">
<table border="0" width="100%">
<tr>
<td width="33%" align="right"><font face="Tahoma,Arial" size="1"
color="#FFFFFF"><b>Tip:</b></font></td>
<td width="67%"><font color="#FFFFFF" face="Tahoma,Arial" size="1">Search by using <a
href="http://msdn.microsoft.com/scripting/default.htm?
/scripting/VBScript/doc/jsgrpregexpsyntax.htm">Regula
r Expresions</a>.</font></td>
</tr>
</table>
</td>
<td width="50%" bgcolor="#808080"></td>
</tr>
</table>

<%
If Trim(Request.QueryString("query")) <> "" Then
%>
<hr>
<table border="0" width="100%" bgcolor="#808080" cellspacing="0" cellpadding="0">
<tr>
<td width="100%"><Font Color="#FFFFFF" Size="2">&nbsp;&nbsp;Your search for <B><%
=Request.QueryString("query")%></B> found the following documents:</Font></td>
</tr>
</table>
<BR><BR>
<%
Response.Flush
Search Request.QueryString("query")
If DocCount > 0 Then
%>
<BR>
<Font Size=1>
&nbsp;&nbsp;(The search criteria "<%=Request.QueryString("query")%>" found <%=MatchedCount%> times in <%
=DocMatchCount%> of <%=DocCount%> documents.)
</font>
<%
End If
End If
%>
<BR><BR>
<hr><div align="center">
<Font size=1>
OneFile Search Engine v1.0<br>
Copyright?000 <a href="mailto:sixtos@prtc.net">Sixto Luis Santos</a>.
All Rights Reserved
</Font></div>

</Font>
</body>
</html>

<%
Response.End
%>
返回类别: 教程
上一教程: 一些不长见的ASP调用存储过程的技巧
下一教程: ASP查询XML的代码,实现了无刷新、模糊查询功能

您可以阅读与"制作一个个人搜索引擎(源码)"相关的教程:
· 使用ASP建设私人搜索引擎
· 用ASP制作强盛的搜索引擎
· 用ASP实现对WEB搜索引擎INDEX SERVER的访问
· 为你的ASP程序制作一个编译组件(中)
· 使用ASP建设私人的搜索引擎
    微笑服务 优质保证 索取样品