制作一个个人搜索引擎(源码)
类别: ASP教程 
<%
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 = " <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
%>
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 = " <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
%>
- 上一篇: 制作一个简单的服务器端控制
- 下一篇: 用SQL SERVER为WEB浏览器提供图像1
