如何用FileSystemObject组件来做一个站内搜索?_编程10000问

searchpage.htm
' 搜索页面.

<html><?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" />

<head>
        <title>千花飞舞之站内搜索引擎</title>
    </head>
    <body>
        <CENTER>
            <FORM METHOD=POST ACTION="searchresult.asp">

    <TABLE BGCOLOR="#BLUE" BORDER="0">
      <tr>                       
        <td ROWSPAN="3" BGCOLOR="#BLUE" 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="#BLUE" 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>
</DL>
</body></html>

searchresult.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>

 

 

[1]

时间: 2024-10-23 19:34:56

如何用FileSystemObject组件来做一个站内搜索?_编程10000问的相关文章

如何做一个密码“生成器”?_编程10000问

randompassword.asp<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /> <% Dim i, intNum, intUpper, intLower, intRand, strPartPass, genPassword genPassword = \"\" Randomize ' 用Randomize生成随机种子. For i = 1

如何制作一个文本文件编辑器?_编程10000问

newdoc.asp<%@ Language=VBScript %><script id=DebugDirectives runat=server language=javascript>//Set these to true to enable debugging or tracing@set @debug=false@set @trace=false</script><html><head><META name=VI60_default

如何制作一个Web日程安排表?_编程10000问

chunfeng.asp<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /> ' 该页面可以看到已安排了哪些事情,并在底部链接可按月前后翻动. ' 该代码包含获得数据连接的函数,如果数据源一旦有变化,则只有一个位置需要编辑连接信息(服务器.用户和口令).   <@ LANGUAGE="VBscript"   ENABLESESSIONSTATE =

如何创建一个PDF文件?_编程10000问

  <%Option ExplicitSub CheckXlDriver()      On Error Resume Next       Dim vConnString      Dim oConn, oErr       vConnString = "DRIVER={Microsoft Excel Driver (*.xls)};DBQ=NUL:"      ' 连接NUL.       Set oConn = CreateObject("ADODB.Connec

如何读取一个.ini文件?_编程10000问

<OBJECT ID="agobjOraSession" RUNAT="Server" PROGID="OracleInProcServer.XOraSession" SCOPE="Application"></OBJECT><script LANGUAGE=VBScript RUNAT=Server>Const CONST_FL_NAME = "\GetAttributeCode

使用过lucene.net的进来帮忙看一下,做过站内搜索的帮忙看一下

问题描述 新手,想改一下站内搜索,以前用的是sqlserver的全文索引,想改为lucene.net,建立完了索引,用的是lucene.net2.9.2,配合盘古分词器,能搜,但是结果不是很让人满意.想问下关于如何优化搜索结果的问题举例来说吧,假如我搜"程序员的自我修养",开头基本还算匹配,一共找出一万多条数据,但是后面的数据,都是匹配一个字的,例如"程序员的自我修养"把"大千的世界无奇不有"也给匹配出来了.也就是"的"字都给

如何做一个检索结果带链接的检索?_编程10000问

如何做一个检索结果带链接的检索?<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /> <% data=request.form("search_data") ' 从FORM变量集得到要查询的文件名称所要包含的字符串 p=search_folder(data,"http://jack/cgi-bin","c:\intels

如何制作一个防止多次刷新计数的图片计数器?_编程10000问

请问如何做一个专业的图片计数器? <% countlong=8     ' 定义计数器位数. On Error Resume Next     ' 忽略所有的错误. count=server.mappath(count.txt) set cou = server.createobject(scripting.filesystemobject) set out=cou.opentextfile(count,1,false,false) counter=out.readline out.close

如何做一个计数器并让人家申请使用?_编程10000问

第一步,创建一个计数器(最简单的数字计数器,不是图片式的): <% @language="vbscript" %>  <%  set fsFilesys=CreateObject("Scripting.FileSystemObject") set myText=fsFilesys.OpenTextFile(Server.MapPath("/count")&"\count.txt")count=myTe