制作一个个人搜索引擎（源码） -pc6资讯

您的位置：首页 → 精文荟萃 → 软件资讯 → 制作一个个人搜索引擎（源码）

制作一个个人搜索引擎（源码） 时间：2004/10/7 19:18:00来源：本站整理作者：蓝点我要评论(0)

<%

Response.Buffer=True

'

' OneFile Search Engine (ofSearch v1.0)

' Copyright ?000 Sixto Luis Santos

' 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),"","",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 = "  " & DocMatchCount & ". "

                ' Add the document name and link

                OutputLine = OutputLine & ""

                OutputLine = OutputLine & FileTitle & ""

                ' Add the document information

                OutputLine = OutputLine & "
  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) & "
"

                ' 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 = "(.|\n)*"

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 "  No Matches Found.
"

End If

Set Regex = Nothing

Set GetTitle = Nothing

Set fs = Nothing



End Sub

%>

OneFile Search 1.0



Search for	<input type="text" size="20" value="<%=request.querystring("query")%>" name="query">




<font face="Tahoma,Arial" size="1" color="#FFFFFF">Tip:

Search by using <a

href="http://msdn.microsoft.com/scripting/default.htm?/scripting/VBScript/doc/jsgrpregexpsyntax.htm">Regula

r Expresions.

<%

If Trim(Request.QueryString("query")) <> "" Then

%>

  Your search for<%

=Request.QueryString("query")%>found the following documents:

<%

    Response.Flush

    Search Request.QueryString("query")

    If DocCount > 0 Then

%>

  (The search criteria "<%=request.querystring("query")%>" found <%=matchedcount%> times in <%

=DocMatchCount%> of <%=doccount%> documents.)

<%

   End If

End If

%>

<%

Response.End

%>

文章评论

查看所有0条评论>>