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