用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>

　　推荐阅读

　　asp读取xml文件

复制代码代码如下:strSourceFile = Server.MapPath(dataxml&"/Advertisement/"&id&"/adv.xml") Set objXML =Server.CreateObject("Microsoft.XMLDOM") '创建一个XML对像 objXML.load(strSourceFile) '>>>详细阅读

本文标题：用ASP做一个TOP COOL的站内搜索

地址：http://www.17bianji.com/kaifa2/ASP/32963.html

1/2 1