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

发表于:2007-06-30来源:作者:点击数: 标签:
用ASP做一个TOP COOL的站内搜索。 该搜索引擎由一个HTM文件一个ASP文件组成,主要是运用FILESYSTEMOBJECT组件来达到目的,功能强大,修改界面以后可以直接拿来使用,当然加上一点自己的东西就更加好了。 searchpage.htm 该HTM文件用来传入条件 HTML> HEAD> T
     用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>
  
  

原文转自:http://www.ltesting.net