用ASP做一个TOP COOL的站内搜索

  该搜索引擎由一个HTM文件一个ASP文件组成,主要是运用FILESYSTEMOBJECT组件来达到目的,功能强大,修改界面以后可以直接拿来使用,当然加上一点自己的东西就更加好了。

  searchpage.htm

  该HTM文件用来传入条件

  <HTML>

  <HEAD>

  <TITLE>ASP搜索引擎范例</TITLE>

  </HEAD>

  <BODY>

  <CENTER>

  <FORM METHOD=POST ACTION="search.asp">

  <TABLE BGCOLOR="#CC6633" BORDER="0">

  <TR>

  <TD ROWSPAN="3" BGCOLOR="#CC6633" width="21" nowrap> </TD>

  <TD width="363" nowrap> <FONT COLOR="#FFFFFF">

  <INPUT TYPE="text" NAME="SearchText" SIZE="22">

  <INPUT TYPE="checkbox" NAME="Case">

  高度敏感</FONT> </TD>

  <TD ROWSPAN="3" width="10">

  <INPUT TYPE="submit" VALUE="确定">

  <P>

  <INPUT TYPE="reset" VALUE="清除">

  </TD>

  <TD ROWSPAN="3" BGCOLOR="#CC6633" width="28"> </TD>

  </TR>

  <TR>

  <TD width="363" nowrap> <FONT COLOR="#FFFFFF"> 返回结果

  <SELECT name="rLength" >

  <option value="200" selected>长信息 </option>

  <option value="100">短信息</option>

  <option value="0">只返回连接</option>

  </SELECT>

  <SELECT NAME="rResults">

  <OPTION VALUE="10" SELECTED>10

  <OPTION VALUE="25">25

  <OPTION VALUE="50">50

  </SELECT>

  </FONT>

  </TD>

  </TR>

  <TR>

  <TD width="363" nowrap> <FONT COLOR="#FFFFFF"> 必须包括:

  <INPUT TYPE="checkbox" NAME="iImage">

  图片

  <INPUT TYPE="checkbox" NAME="iZips">

  Zip格式

  <INPUT TYPE="checkbox" NAME="iJavaS"> JavaScript

  </FONT>

  </TD>

  </TR>

  </TABLE>

  </FORM>

  </CENTER>

  <DL>

  <DD> </DD>

  </DL>

  </BODY>

  </HTML>

  ------------------------------------------------------------------------

  显示结果的ASP程序

  search.asp

  <HTML>

  <HEAD>

  <TITLE>'<%=Request("SearchText")%>'的搜索结果</TITLE>

  </HEAD>

  <BODY>

  <B>'<%=Request("SearchText")%>'的搜索结果</B><BR>

  <%

  Const fsoForReading = 1

  Dim objFile, objFolder, objSubFolder, objTextStream

  Dim bolCase, bolFileFound, bolTagFound

  Dim strCount, strDeTag, strExt, strFile, strContent, strRoot, strTag, strText, strTitle, strTitleL

  Dim reqImage, reqJavaS, reqLength, reqNumber, reqZip

  strFile = ".asp .htm .html .js .txt .css"

  strRoot = "/"

  strText = Request("SearchText")

  strTag = Chr(37) & Chr(62)

  bolFileFound = False

  bolTagFound = False

  If Request("Case") = "on" Then bolCase = 0 Else bolCase = 1

  If Request("iImage") = "on" Then reqImage = "<IMG" Else reqImage = ""

  If Request("iZips") = "on" Then reqZips = ".zip" Else reqImage = ""

  If Request("iJavaS") = "on" Then reqJavaS = "JavaScript" Else reqImage = ""

  If Request("rResults") = "10" Then reqNumber = 10

  If Request("rResults") = "25" Then reqNumber = 25

  If Request("rResults") = "50" Then reqNumber = 50

  reqLength = Request("rLength")

  Set objFSO = Server.CreateObject("Scripting.FileSystemObject")

  Set objFolder = objFSO.GetFolder(Server.MapPath(strRoot))

  schSubFol(objFolder)

  Sub schSubFol(objFolder)

  For Each objFile in objFolder.Files

  If strCount + 1 > reqNumber or strText = "" Then Exit Sub

  If Response.IsClientConnected Then

  Set objTextStream = objFSO.OpenTextFile(objFile.Path,fsoForReading)

  strContent = objTextStream.ReadAll

  If InStr(1, strContent, strTag, bolCase) Then

  Else

  If Mid(objFile.Name, Len(objFile.Name) - 1, 1) = "." Then strExt = Mid(objFile.Name, Len(objFile.Name) - 1, 2)

  If Mid(objFile.Name, Len(objFile.Name) - 2, 1) = "." Then strExt = Mid(objFile.Name, Len(objFile.Name) - 2, 3)

  If Mid(objFile.Name, Len(objFile.Name) - 3, 1) = "." Then strExt = Mid(objFile.Name, Len(objFile.Name) - 3, 4)

  If Mid(objFile.Name, Len(objFile.Name) - 4, 1) = "." Then strExt = Mid(objFile.Name, Len(objFile.Name) - 4, 5)

  If InStr(1, strContent, strText, bolCase) And _

  InStr(1, strContent, reqImage, 1) And _

  InStr(1, strContent, reqZips, 1) And _

  InStr(1, strContent, reqJavaS, 1) And _

  Instr(1, strFile, strExt, 1) Then

  If InStr(1, strContent, "<TITLE>", 1) Then strTitle = Mid(strContent, InStr(1, strContent, "<TITLE>", 1) + 7, InStr(1, strContent, "</TITLE>", 1)) Else strTitle = "未命名"

  strCount = strCount + 1

  Response.Write "<DL><DT><B><I>"& strCount &"</I></B> - <A HREF=" & objFile.Path & ">" & strTitle & "</A></A></DT><BR><DD>"

  strTitleL = InStr(1, strContent, "</TITLE>", 1) - InStr(1, strContent, "<TITLE>", 1) + 7

  strDeTag = ""

  bolTagFound = False

  Do While InStr(strContent, "<")

  bolTagFound = True

  strDeTag = strDeTag & " " & Left(strContent, InStr(strContent, "<") - 1)

  strContent = MID(strContent, InStr(strContent, ">") + 1)

  Loop

  strDeTag = strDeTag & strContent

  If Not bolTagFound Then strDeTag = strContent

  If reqLength = "0" Then Response.Write objFile.Path & "</DD></DL>" Else Response.Write Mid(strDeTag, strTitleL, reqLength) & "...<BR><b><FONT SIZE='2'>URL: " & objFile.Path & " - 上次修改时间: " & objFile.DateLastModified & " - " & FormatNumber(objFile.Size / 1024) & "Kbytes</FONT></b></DD></DL>"

  bolFileFound = True

  End If

  objTextStream.Close

  End If

  End If

  Next

  End Sub

  For Each objSubFolder in objFolder.SubFolders

  schSubFol(objSubFolder)

  Next

  If Not bolFileFound then Response.Write "没有匹配结果"

  If bolFileFound then Response.Write "<B>搜索结束</B>"

  Set objTextStream = Nothing

  Set objFolder = Nothing

  Set objFSO = Nothing

  %>

  </BODY></HTML>