刚写的应用于某软件的全文检索程序
来源:互联网 发布:淘宝帐篷哪家好 编辑:程序博客网 时间:2024/04/29 07:56
<p> <!--#include file=function/conn.asp-->
<br>
<%
keyWord=trim(request("oKey"))
sType=trim(request("oType"))
if keyWord="" or keyWord="关键字…" then
Response.Write "请输入关键字!"
Response.End()
end if
if sType="" then
Response.Write "请选择查询信息类别"
Response.End()
end if
dim ftsTable '要查询信息的储存表名
dim ftsFolder '要查询信息的储存文件夹
if sType="1" then
ftsTable="tb_bzxx"
ftsFolder=fjroot
elseif sType="2" then
ftsTable="tb_other"
ftsFolder=fjroot_other
elseif sType="3" then
ftsTable="tb_info"
ftsFolder=fjroot_info
else
Response.Write "出错了!"
Response.End
end if
sql=""
if sType="1" then
sql="select bz_xuhao as xuhao,bz_name as bname,bz_code as bcode,bz_htm as htm from " & ftsTable
elseif sType="2" then
sql="select p_xuhao as xuhao,p_name as bname,p_code as bcode,p_htm as htm from " & ftsTable
elseif sType="3" then
sql="select info_id as xuhao,info_htm,info_type as htm from " & ftsTable
else
Response.Write "出错了!"
Response.End
end if
Call OPenConn() ' 打开数据库连接
set fso=server.CreateObject("scripting.filesystemobject")
set rs=server.createobject("adodb.recordset")
dim oPattern
oPattern="<p>|<p(.*)>|</p>"
'如果是查询第三种信息(其他信息),则先将所有的信息类别取出来,放到数组中。
dim infoType()
if sType="3" then
rs.Open "select type_id,type_name from tb_info_type order by type_id desc",adocon,3,1
if rs.RecordCount<=0 then
CloseRs rs
Call CloseConn
Response.Write "出错了!"
Response.End()
end if
redim infoType(clng(rs(0)))
do while not rs.EOF
infoType(clng(rs(0)))=rs(1)
rs.MoveNext
loop
rs.Close()
end if
%>
<h4 ALIGN= "CENTER" STYLE= "COLOR:#000080" > 标准信息系统全文检索结果
关键字: <span style= "color:#ff0000" > <%=KEYWORD%>
</span><br>
</h4>
<hr>
<table width= "600" >
<tr>
<td style= "font-size:12;color:000000;line-height:1.8" > <%
'进行检索
rs.Open sql,adocon,3,1
if rs.RecordCount>0 then
sCount=0
do while not rs.EOF
findPos=0
htm=rs("htm")
if htm<>"" then
vpath=ftsFolder & "/" & rs("xuhao") & "/" & htm
filePath=Server.MapPath(vpath)
if fso.FileExists(filepath) then
set oFile=fso.GetFile(filepath)
set oFilestream=oFile.openastextstream(1)
oFileInfo=""
if not oFilestream.atendofstream then
oFileInfo=FilterHTML(FilterBr(trim(oFilestream.readall)))
if oFileInfo<>"" then
findPos=instr(1,oFileInfo,keyWord,1)
'查到了数据,需要显示
if findPos>0 then
Response.Write "<a href='" & vpath & "' target='_blank'>"
if sType="1" or sType="2" then
Response.Write "<span style='font-weight:bold;font-size:13;color:0000ff'>" & rs("bname") & " ( " & rs("bcode") & " ) </span></a><br>"
else
Response.Write "<span style='font-weight:bold;font-size:13;color:0000ff''>" & infotype(clng(rs("info_Type"))) & " </span></a><br>"
end if
if findPos>50 then
Response.Write "…" & replace(mid(oFileInfo,findPos-50,200),keyWord,"<span style='color:ff0000'>" & keyWord & "</span>",1,-1,1) & "…"
else
Response.Write replace(mid(oFileInfo,1,200),keyWord,"<span style='color:ff0000'>" & keyWord & "</span>",1,-1,1)& "…"
end if
Response.Write "<br><br>"
sCount=sCount+1
end if
end if
end if
end if
end if
rs.MoveNext
loop
end if
Response.Write " <SPAN STYLE='COLOR:#000080'>共搜索到 " & sCount & " 条信息!</SPAN>"
'过滤掉文本中的html标记和空格
Function FilterHTML(str)
Dim re
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
re.Pattern="<(.[^>]*)>| "
str=re.Replace(str,"")
set re=Nothing
FilterHTML=str
End Function
function FilterBr(str)
FilterBr=replace(str,vbcrlf," ")
FilterBr=replace(str,"<br>"," ")
end function
%>
</td>
</tr>
</table>
</body>
</html>
- 刚写的应用于某软件的全文检索程序
- GeoName的全文检索
- 全文检索的方式
- 全文检索的基本原理
- SQLite的全文检索
- 全文检索的基本原理
- 全文检索的基本原理
- 全文检索的基本原理
- 全文检索的基本原理
- 全文检索的基本原理
- 全文检索的原理
- 全文检索的基本原理
- 全文检索的基本原理
- 全文检索的基本原理
- 全文检索的基本原理
- 全文检索的基本原理
- 全文检索的基本原理
- 帮一个网友写的全文检索的例子
- 搜索提示
- Eclipse 3.0.1插件方案(Java、c#版)
- 在线播放器代码大全
- Java学习从入门到精通
- iis支持FSO的设置
- 刚写的应用于某软件的全文检索程序
- 每个开发人员现在应该下载的十种必备工具
- 中国动画腾飞的关键所在 (转)
- 考试的心情
- 一个很好的JAVASCRIPT例子[转载]
- OPC技术讨论QQ群(7198555,7523729)
- MySQL+VBB问题:mysql 错误: mysql 错误: Illegal mix of collations (latin1_bin,IMPLICIT) and (latin1_swedish_
- 学习,是一条漫长的道路 (蔡学墉)
- 以後可以用來記學習隨筆