制作一个个人搜索引擎(源码).txt我都舍不得欺负的人，哪能让别人欺负？ 一辈子那么长，等你几年算什么我爱的人我要亲手给她幸福 别人我不放心 我想你的时候我一定要找得到你不许你们欺负他！全世界只有我才可以！放弃你，下辈子吧！！制作一个个人搜索引擎（源码）
来源：佚名(127) 2005-3-13 【字体:大 中 小】 切换为 繁體中文 我要收藏或分享到： <% Response.Buffer=True '
' OneFile Search Engine (ofSearch v1.0)
' Copyright ?000 Sixto Luis Santos
' 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 = \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),\' In case the title is empty If FileTitle = \
FileTitle = \End If
Else
' Create an alternate entry name (if no title found) FileTitle = \End If
' Create the entry line with proper formatting
' Add the entry number
OutputLine = \
' Add the document name and link
OutputLine = OutputLine & \href=\& chr(34) & RootFld & replace(Mid(fsFile.Path, rfLen),\
OutputLine = OutputLine & FileTitle & \
' Add the document information
OutputLine = OutputLine & \size=1>
Criteria matched \& MatchCount
& \
OutputLine = OutputLine & FormatNumber(fsFile.Size / 1024,2 ,-1,0,-1) & \OutputLine = OutputLine & \(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(\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 = \End With
RootFolder = Server.MapPath(RootFld)
If Right(RootFld,1) <> \RootFld = RootFld & \End If
If Right(RootFolder, 1) <> \RootFolder = RootFolder & \End If
rfLen = Len(RootFolder) + 1
SearchFiles RootFolder
If MatchedCount = 0 Then
Response.Write \End If
Set Regex = Nothing Set GetTitle = Nothing Set fs = Nothing
End Sub %>
OneFile Search 1.0