asp的站內搜尋功能

來源:互聯網
上載者:User
下面代碼可以全部複製粘貼到一個search.asp檔案中,就能夠實現靜態頁面的全文檢索索引功能了。適合於頁面數較少的網站,估計超過100個頁面效能就很差了。

<%
Head = "站內搜尋"
SearchString = Request("SearchString")
count=0

'把目前的目錄的實際路徑轉換為虛擬路徑
Function UnMapPath( Path )
    UnMapPath = Replace(Mid(Path, Len(Server.MapPath("/")) + 1), "", "/")
End Function


Function SearchFile( f, s, title )
   Set fo = fs.OpenTextFile(f)
   content = fo.ReadAll
   fo.Close
   SearchFile = InStr(1, content, S, vbTextCompare) > 0 
   If SearchFile Then
      pos1 = InStr(1, content, "<TITLE>", vbTextCompare)
      pos2 = InStr(1, content, "</TITLE>", vbTextCompare)
      title = ""
      If pos1 > 0 And pos2 > 0 Then
         title = Mid( content, pos1 + 7, pos2 - pos1 - 7 )
      End If
   End If
End Function

Function FileLink( f, title )
   vPath = UnMapPath( f.Path )
   If title = "" Then title = f.Name
   FileLink = "<A HREF=""" &  vPath & """>" & title & "</A>"
   FileLink = "<UL>·" & FileLink & "</UL>"
End Function

Sub SearchFolder( fd, s ) 
   found = False  
   For each f In fd.Files
      pos = InStrRev(f.Path, "." )
      If pos > 0 Then
         ext = Mid(f.Path, pos + 1 )
      Else
         ext = ""
      End If
      If LCase(ext) = "htm" Then
         If SearchFile( f, s, title ) Then
            Response.Write FileLink(f, title)
            count=count+1
            ' Response.Write cstr(count)
         End If
      End If
   Next

   For each sfd In fd.SubFolders
      SearchFolder sfd, s
   Next
End Sub
%>
<html>

<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb_2312-80">
<title><%=Head%></title>
</head>

<body bgcolor="#FFFFFF">

<h1><%=Head%></h1>

<hr>

<!-- 注意search.asp為本檔案,可根據需要修改!-->

<form action="search.asp" method="Get"> 
    <p>請輸入欲搜尋的內容: <input type="text"
    size="20" name="SearchString" value="<%=SearchString%>"> <input
    type="submit" value="搜尋"> </p>
</form>
<%
Set fs = Server.CreateObject("Scripting.FileSystemObject")
Set fd = fs.GetFolder( Server.MapPath("./") )   '設定開始搜尋的路徑(將遍曆其所有子目錄,當前設定為search.asp所在目錄)!

If SearchString <> "" Then
   Response.Write "<H2>搜尋<font color=red>" & SearchString & "</font>結果如下:</H2><P>"
   SearchFolder fd,SearchString
End If
%>
<hr>
</body>
</html>


相關文章

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.