制作一个个人搜索引擎（源码）

核心提示：<%Response.Buffer=True'' OneFile Search Engine (ofSearch v1.0)' Copyright ?000 Sixto Luis Santos <sixtos@PRtc.net>' All Rights Reserved

<%
Response.Buffer=True

'
' OneFile Search Engine (ofSearch v1.0)
' Copyright ?000 Sixto Luis Santos <sixtos@PRtc.net>
' 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 = "　<b>" & DocMatchCount & ".</B> "
　　　　　　　　' 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>　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 "　<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 </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">　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>
　(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
%>