站内搜索引擎

大 | 中 | 小
[不指定 2009/03/09 15:03 | by tommyhu ]
config.asp代码如下:

<%
Const intRecordsPerPage = 10 '每页显示搜索结果的个数
strFilesTypesToSearch = "htm,html,asp,shtml,gif,rar,zip,jpg" '允许搜索的文件类型
strBarredFolders = "cgi_bin,_bin" '禁止搜索的文件夹，用","隔开
strBarredFiles = "adminstation.htm,no_allowed.asp" '禁止搜索的文件，用","隔开
blnEnglishLanguage = True '
intTotalFilesSearched = 0 '
%>



search.asp主搜索文件代码如下:

<% Option Explicit %>
<%
Response.Buffer = False
Dim fsoObject
Dim fldObject
Dim sarySearchWord
Dim strSearchWords
Dim blnIsRoot
Dim strFileURL
Dim strServerPath
Dim intNumFilesShown
Dim intTotalFilesSearched
Dim intTotalFilesFound
Dim intFileNum
Dim intPageLinkLoopCounter
Dim sarySearchResults(1000,2)
Dim intDisplayResultsLoopCounter
Dim intResultsArrayPosition
Dim blnSearchResultsFound
Dim strFilesTypesToSearch
Dim strBarredFolders
Dim strBarredFiles
Dim blnEnglishLanguage
%>
<!--#include file="config.asp"-->
<html>
<head>
<title>25175 站内搜索引擎</title>
<meta name="GENERATOR" content="Microsoft FrontPage 5.0">
<meta name="ProgId" content="FrontPage.Editor.Document">
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<style type="text/css">
<!--
a {text-decoration: none}
a:active {color: #000000}
a:visited {color: #000000}
a:hover {color: #FF0000}
a:link {color: #000000}
body, table, tr, td {font-family: 宋体; font-size: 12px; color: #000000}
-->
</style>
<script  language="JavaScript">
<!-- Hide from older browsers...

//Preload search icon
var search_icon_off = new Image();
search_icon_off.src = "site_search_icon_off.gif";

//Check the form before submitting
function CheckForm () {

//Check for a word to search
if (document.frmSiteSearch.search.value==""){
  alert("请至少输入一个字符进行搜索。");
  document.frmSiteSearch.search.focus();
  return false;
}

return true
}
// -->
</script>
      
</head>
<body bgcolor="#FFFFFF" text="#000000" link="#0000CC" vlink="#0000CC"

alink="#FF0000">
<h3 align="center">25175 站内搜索引擎</h3>
<form method="get" name="frmSiteSearch" action="search.asp"

onSubmit="return CheckForm();">
  <table width="600" border="0" align="center" cellpadding="10"

cellspacing="0" bgcolor="#F2F2F2">
    
    <tr>
      <td class="normal" width="398">
      <input type="TEXT" name="search" maxlength="50" size="36" value="<%

=Request.QueryString("search") %>">
      <input type="submit" value="搜索" name="submit">      </td>
    </tr>
    <tr>
      <td width="398" valign="top" class="normal"> 搜索选项:
        <input type="radio" name="mode" value="allwords" CHECKED> 精确检索
        <input type="radio" name="mode" value="anywords"> 模糊检索</td>
    </tr>
  </table>
</form>

<table width="600" border="0" align="center" cellpadding="0"

cellspacing="10">
  <tr>
    <td>
<%
strSearchWords = Trim(Request.QueryString("search"))
If blnEnglishLanguage = True Then
strSearchWords = Server.HTMLEncode(strSearchWords)
Else
strSearchWords = Replace(strSearchWords, "<", "&lt;", 1, -1, 1)
strSearchWords = Replace(strSearchWords, ">", "&gt;", 1, -1, 1)
End If
sarySearchWord = Split(Trim(strSearchWords), " ")
intFileNum = CInt(Request.QueryString("FileNumPosition"))
intNumFilesShown = intFileNum
Set fsoObject = Server.CreateObject("Scripting.FileSystemObject")
If NOT strSearchWords = "" Then
Set fldObject = fsoObject.GetFolder(Server.MapPath("./"))
strServerPath = fldObject.Path & "\"
blnIsRoot = True
Call SearchFile(fldObject)  
Set fsoObject = Nothing
Set fldObject = Nothing
Call SortResultsByNumMatches(sarySearchResults,

intTotalFilesFound)
Response.Write vbCrLf & " <table width=""100%"" border=""0""

height=""25"" cellspacing=""0"" cellpadding=""0"" bgcolor=""#CCCCCC""

bordercolor=""#808080"" style=""border-collapse: collapse""

align=""center"">"
Response.Write vbCrLf & "    <tr>"
If blnSearchResultsFound = False Then
  Response.Write vbCrLf & "      <td>&nbsp;搜索关键字

<b>" & strSearchWords & "</b>. &nbsp;&nbsp;&nbsp;对不起，没有找到任何相关

结果!</td>"  
Else
  Response.Write vbCrLf & "      <td>&nbsp;搜索关键字  

<b>" & strSearchWords & "</b>. &nbsp;&nbsp;&nbsp;相关的网页有 " &

intFileNum + 1 & " - " & intNumFilesShown & " of " & intTotalFilesFound &

".</td>"    
End If
Response.Write vbCrLf & "   </tr>"
Response.Write vbCrLf & " </table>"

Response.Write vbCrLf & " <table width=""95%"" border=""0""

cellspacing=""1"" cellpadding=""1"" align=""center"">"
Response.Write vbCrLf & "  <tr>"
Response.Write vbCrLf & "   <td>"  

If blnSearchResultsFound = False Then

  'Write HTML displaying the error
  Response.Write vbCrLf & "   <br>"
  Response.Write vbCrLf & "    您搜索的关键是  - <b>"

& strSearchWords & "</b> - 找不到任何与之相匹配的记录. "
     Response.Write vbCrLf & "    <br><br>"
     Response.Write vbCrLf & "    解决方法: "
     Response.Write vbCrLf & "    <br>"
     Response.Write vbCrLf & "    <ul><li>检查下关键字，

是否包含有黄色，反动，违反本国现有法律的字词.<li>试试搜索长一点的关键

字.<li>试试其他相关的关键字.</ul>"
Else
  
  For intDisplayResultsLoopCounter = (intFileNum + 1) to

intNumFilesShown
  
   Response.Write vbCrLf & "      <br>"
   Response.Write vbCrLf & "     " &

sarySearchResults(intDisplayResultsLoopCounter,1)
   Response.Write vbCrLf & "      <br>"
  Next
End If

Response.Write vbCrLf & "     </td>"
Response.Write vbCrLf & "   </tr>"
Response.Write vbCrLf & " </table>"

End If

If intTotalFilesFound > intRecordsPerPage then

Response.Write vbCrLf & " <br>"
Response.Write vbCrLf & " <table width=""100%"" border=""0""

cellspacing=""0"" cellpadding=""0"" align=""center"">"
Response.Write vbCrLf & "    <tr>"
Response.Write vbCrLf & "      <td>"
Response.Write vbCrLf & "  <table width=""100%""

border=""0"" cellpadding=""0"" cellspacing=""0"">"
Response.Write vbCrLf & "    <tr>"
Response.Write vbCrLf & "      <td width=""50%""

align=""center"">"

Response.Write vbCrLf & "  Results Page:&nbsp;&nbsp;"
  
If intNumFilesShown > intRecordsPerPage Then
  Response.Write vbCrLf & "   <a

href="../../../"search.asp?FileNumPosition=" &  intFileNum - intRecordsPerPage  &

"&search=" & Replace(strSearchWords, " ", "+") & "&mode=" &

Request.QueryString("mode") & """ target=""_self"">&lt;&lt;&nbsp;Prev</a>

"          
End If      

If intTotalFilesFound > intRecordsPerPage Then

  For intPageLinkLoopCounter = 1 to CInt((intTotalFilesFound

/ intRecordsPerPage) + 0.5)

   If intFileNum = (intPageLinkLoopCounter *

intRecordsPerPage) - intRecordsPerPage Then
    Response.Write vbCrLf & "    

  " & intPageLinkLoopCounter
   Else
  
    Response.Write vbCrLf & "    

  &nbsp;<a href="../../../"search.asp?FileNumPosition=" &  (intPageLinkLoopCounter

* intRecordsPerPage) - intRecordsPerPage & "&search=" & Replace

(strSearchWords, " ", "+") & "&mode=" & Request.QueryString("mode") & """

target=""_self"">" & intPageLinkLoopCounter & "</a>&nbsp; "  
   End If
  Next
End If
      
If intTotalFilesFound > intNumFilesShown then    
  Response.Write vbCrLf & "  &nbsp;<a

href="../../../"search.asp?FileNumPosition=" &  intNumFilesShown  & "&search=" &

Replace(strSearchWords, " ", "+") & "&mode=" & Request.QueryString("mode")

& """ target=""_self"">Next&nbsp;&gt;&gt;</a>"    
End If          
Response.Write vbCrLf & "      </td>"      
Response.Write vbCrLf & "    </tr>"
Response.Write vbCrLf & "  </table>"  
Response.Write vbCrLf & "     </td>"
Response.Write vbCrLf & "   </tr>"
Response.Write vbCrLf & " </table>"
End If
%>
</td>
  </tr>
</table>

  <div align="center">
    <center>  
  <table width="600" border="0" cellspacing="5" cellpadding="0"

bgcolor="#F2F2F2" style="border-collapse: collapse">
    <tr>
       <td width="100%" height="18">
        <p align="right"><%Response.Write("Powered By - <a

href=""http://www.25175.com"" target=""_blank"">25175.com</a>")%

>&nbsp;&nbsp;
       </td>
      </tr>
    </table>
    </center>
  </div>
</div>
</body>
</html>
<%
Public Sub SearchFile(fldObject)
Dim objRegExp
Dim objMatches
Dim filObject
Dim tsObject
Dim subFldObject
Dim strFileContents
Dim strPageTitle
Dim strPageDescription
Dim strPageKeywords
Dim intSearchLoopCounter
Dim intNumMatches
Dim blnSearchFound

On Error Resume Next
Err.Number = 0
Set objRegExp = New RegExp

If Err.Number <> 0 Then
  Response.Write("<br>服务器不支持该对象。<br>请到麦布官方网

站[www.mybu.net]下载最新版本。")
  Err.Number = 0
End If

For Each filObject in fldObject.Files

  If InStr(1, strFilesTypesToSearch,

fsoObject.GetExtensionName(filObject.Name), vbTextCompare) > 0 Then
   If NOT InStr(1, strBarredFiles, filObject.Name,

vbTextCompare) > 0 Then    
     blnSearchFound = False
      intNumMatches = 0    
      objRegExp.Global = True
      objRegExp.IgnoreCase = True
       Set tsObject = filObject.OpenAsTextStream
       strFileContents = tsObject.ReadAll  
    strPageTitle = GetFileMetaTag("<title>",

"</title>", strFileContents)
    strPageDescription = GetFileMetaTag("<meta

name=""description"" content=""", """>", strFileContents)
     strPageKeywords = GetFileMetaTag("<meta

name=""keywords"" content=""", """>", strFileContents)
     objRegExp.Pattern = "<[^>]*>"
     strFileContents = objRegExp.Replace

(strFileContents,"")
     strFileContents = strFileContents & " " &

strPageTitle & " " & strPageDescription & " " & strPageKeywords

      If Request.QueryString("mode") =

"allwords" then blnSearchFound = True
      For intSearchLoopCounter = 0 to

UBound(sarySearchWord)
       objRegExp.Pattern = "\b" &

sarySearchWord(intSearchLoopCounter) & "\b"
       Set objMatches =

objRegExp.Execute(strFileContents)
          If objMatches.Count > 0

Then
        intNumMatches =

intNumMatches + objMatches.Count
           If

Request.QueryString("mode") = "anywords" then blnSearchFound = True
          Else
           If

Request.QueryString("mode") = "allwords" then blnSearchFound = False
          End If
         Next
        End If

        intTotalFilesSearched =

intTotalFilesSearched + 1
        If strPageTitle = "" Then strPageTitle =

"No Title"
        If strPageDescription = "" Then

strPageDescription = "该网页没有特别说明！"
        If blnSearchFound = True Then
     intTotalFilesFound =

intTotalFilesFound + 1
     If  intNumFilesShown <

(intRecordsPerPage + intFileNum) and intTotalFilesFound > intNumFilesShown

Then
      intNumFilesShown =

intNumFilesShown + 1
     End If
            intResultsArrayPosition =

intResultsArrayPosition + 1
            blnSearchResultsFound = True
     If blnIsRoot = True Then
      sarySearchResults

(intResultsArrayPosition,1) = "<a href="../../../"./" &  filObject.Name & """

target=""_blank"">" & strPageTitle & "</a>"
            Else
             sarySearchResults

(intResultsArrayPosition,1) = "<a href="../../../"./" & strFileURL  &

fldObject.Name & "/" & filObject.Name & """ target=""_self"">" &

strPageTitle & "</a>"              

      
      
     End If    


     sarySearchResults

(intResultsArrayPosition,1) = sarySearchResults(intResultsArrayPosition,1)

& vbCrLf & "        <br>" & strPageDescription
     sarySearchResults

(intResultsArrayPosition,1) = sarySearchResults(intResultsArrayPosition,1)

& vbCrLf & "        <font color=""#0000FF""><br>搜索结果 " & intNumMatches

& " &nbsp;-&nbsp; 最后更新 " & FormatDateTime(filObject.DateLastModified,

VbLongDate) & " &nbsp;-&nbsp; 大小 " & CInt(filObject.Size / 1024) &

"kb</font>"
     sarySearchResults

(intResultsArrayPosition,2) = intNumMatches
          End If
        tsObject.Close
   End If
Next

Set objRegExp = Nothing
  
For Each subFldObject In FldObject.SubFolders
  If NOT InStr(1, strBarredFolders, subFldObject.Name,

vbTextCompare) > 0 Then
   blnIsRoot = False
   strFileURL = fldObject.Path & "\"
   strFileURL = Replace(strFileURL, strServerPath,

"")
   strFileURL = Replace(strFileURL, "\", "/")
   strFileURL = Server.URLEncode(strFileURL)
   strFileURL = Replace(strFileURL, "%2F", "/")
   Call SearchFile(subFldObject)
  End If
Next
Set filObject = Nothing
Set tsObject = Nothing
Set subFldObject = Nothing
End Sub

Private Sub SortResultsByNumMatches(ByRef sarySearchResults, ByRef

intTotalFilesFound)

Dim intArrayGap
Dim intIndexPosition
Dim intTempResultsHold  
Dim intTempNumMatchesHold
Dim intPassNumber

For intPassNumber = 1 To intTotalFilesFound
  For intIndexPosition = 1 To (intTotalFilesFound -

intPassNumber)
   If sarySearchResults(intIndexPosition,2) <

sarySearchResults((intIndexPosition+1),2) Then
    intTempResultsHold = sarySearchResults

(intIndexPosition,1)
    intTempNumMatchesHold = sarySearchResults

(intIndexPosition,2)
    sarySearchResults(intIndexPosition,1) =

sarySearchResults((intIndexPosition+1),1)
    sarySearchResults(intIndexPosition,2) =

sarySearchResults((intIndexPosition+1),2)
    sarySearchResults((intIndexPosition+1),1)

= intTempResultsHold
    sarySearchResults((intIndexPosition+1),2)

= intTempNumMatchesHold  
   End If
  Next  
Next    
End Sub

Private Function GetFileMetaTag(ByRef strStartValue, ByRef strEndValue,

ByVal strFileContents)

Dim intStartPositionInFile
Dim intEndPositionInFile

intStartPositionInFile = InStr(1, LCase(strFileContents),

strStartValue, 1)
If intStartPositionInFile = 0 And InStr(strStartValue, "name=")

Then
  strStartValue = Replace(strStartValue, "name=", "http-

equiv=")
  intStartPositionInFile = InStr(1, LCase(strFileContents),

strStartValue, 1)  
End If

If NOT intStartPositionInFile = 0 Then
  intStartPositionInFile = intStartPositionInFile + Len

(strStartValue)
  intEndPositionInFile = InStr(intStartPositionInFile,

LCase(strFileContents), strEndValue, 1)
  GetFileMetaTag = Trim(Mid(strFileContents,

intStartPositionInFile, (intEndPositionInFile - intStartPositionInFile)))
Else
  GetFileMetaTag = ""
          
End If

End Function
%>

代码打包下载：25175/25175_upload/2006_11/06111821332505.rar

Tags:
ASP | 评论(0) | 引用(0) | 阅读(4175)
发表评论
表情
emotemotemotemotemotemotemotemotemotemotemotemot
打开HTML
打开UBB
打开表情
隐藏
记住我
昵称   密码   游客无需密码 网址   电邮  [注册]