如何用FileSystemObject组件来做一个站内搜索?_编程10000问教程-查字典教程网
如何用FileSystemObject组件来做一个站内搜索?
如何用FileSystemObject组件来做一个站内搜索?
发布时间:2016-12-29 来源:查字典编辑
摘要:searchpage.htm'搜索页面.千花飞舞之站内搜索引擎高度敏感搜索返回结果详细信息简短信息只返回连接102550必须包含:图片Zip...

searchpage.htm

' 搜索页面.

<html>

<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 = "" 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]

相关阅读
推荐文章
猜你喜欢
附近的人在看
推荐阅读
拓展阅读
  • 大家都在看
  • 小编推荐
  • 猜你喜欢
  • 最新编程10000问学习
    热门编程10000问学习
    编程开发子分类