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

发布时间：2010/03/18　　来源：网络　　点击次数：106次

<%
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 = "&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>(.| )*</title>"
End With
RootFolder = Server.MapPath(RootFld)
If Right(RootFld,1) <> "/" Then
RootFld = RootFld & "/"
End If
If Right(RootFolder, 1) <> "" Then
    RootFolder = RootFolder & ""