📄 search.asp

📁 BBS源码利用ASP的一个功能齐全的BBS论坛源码
💻 ASP
字号:
<!--#include file="inc.asp"-->
<!--#include file="inc/Page_Cls.asp"-->
<%
Dim Action,Key,strPageInfo
If Not BBS94KK.Founduser Then BBS94KK.GotoErr(10)
If BBS94KK.BoardID >0 Then BBS94KK.CheckBoard()
Call BBS94KK.Head("论坛搜索")
Key=GetKey("Key")
Action=Lcase(Request.querystring("Action"))
If Key="" Then Action=""
If Action="topic" Then
	SearchList()
Else
	Main()
End If
BBS94KK.Footer()
Set BBS94KK=Nothing


Sub ListTop()
	Dim Temp
	Temp=BBS94KK.Template.ReadTemplate("各项列表顶部")
	Temp=Replace(Temp,"{标题}","搜索关键字 <u>"&Key&"</U>" )
	Response.Write Temp
End Sub

Sub ListBottom()
	Dim Temp
	Temp=BBS94KK.Template.ReadTemplate("各项列表底部")
	Temp=Replace(Temp,"{分页}",strPageInfo)
	Response.Write Temp
End Sub
'''''''''''''''添加''''''''''2005-5-26

Function CheckKey(Keys)
	Keys=Left(Keys,20) '最多20个字符
	Keys=Replace(Keys,"#","")
	Keys=Replace(Keys,"  "," ")
	Keys=Replace(Keys,"]","")
	Keys=Replace(Keys,"[","[[]")
	Keys=Replace(Keys,"%","[%]")
CheckKey=Replace(Keys,"_","[_]")
End Function

Function SplitKey(Col,Key)
Dim KeyNum,Keys
	Keys=Split(Key," ")
	For KeyNum=0 To Ubound(Keys)
		SplitKey=SplitKey&Col&" like '%"&CheckKey(Keys(KeyNum))&"%' Or "
	Next
SplitKey="("&Left(SplitKey,Len(SplitKey)-4)&")"
End Function

''''''''''''''''''结束
Sub SearchList()
	Dim intPageNow,arr_Rs,i,Pages,TopicImg,Conut,page
	Dim SType,STime,SQLwhere
	Dim Temp,TopicS,Caption,Content,Facepic,Moodpic,LastRe,RePageUrl,UploadType,RePage,leftn,ii,NoShow,IsSearchInfo
	SType=BBS94KK.CheckNum(Request.querystring("SType"))
	STime=BBS94KK.CheckNum(Request.querystring("STime"))
'修改开始2005-5-26
	If SType=1 Then
		Sqlwhere=SplitKey("Name",Key)
	ElseIf SType=2 Then
		Sqlwhere=SplitKey("Caption",Key)
	ElseIf SType=3 Then
		Sqlwhere=SplitKey("Caption",Key)&" or "&SplitKey("Name",Key)
	Else
		BBS94KK.GotoErr(1)
	End If
	If STime<>0 Then Sqlwhere=Sqlwhere&" And DATEDIFF('d',[AddTime],'"&BBS94KK.NowBbsTime&"')<"&STime
	If BBS94KK.BoardID >0 Then
	Sqlwhere=sqlwhere&" And (BoardID="&BBS94KK.BoardID&" or TopType=5)"
	End If
	Sqlwhere=Sqlwhere&" and SqlTableID="&BBS94KK.TB&" and IsDel=False"
	IsSearchInfo=False
	intPageNow = Request.QueryString("page")
	Set Pages = New Cls_PageView
	Pages.strTableName = "[KK_Topic]"
	Pages.strPageUrl = "?Action="&Action&"&Key="&Key&"&SType="&SType&"&TB="&BBS94KK.TB&"&STime="&STime&"&BoardID="&BBS94KK.BoardID
	Pages.strFieldsList = "TopicID,Face,Caption,Name,TopType,IsGood,AddTime,BoardID,LastTime,Hits,LastReply,UploadType,IsVote,ReplyNum,SqlTableID,IsLock"
	Pages.strCondiction = SqlWhere
	Pages.strOrderList = "TopicID desc"
	Pages.strPrimaryKey = "TopicID"
	Pages.intPageSize = Int(BBS94KK.BbsCache(31))
	Pages.intPageNow = intPageNow
	Pages.strCookiesName = "Search"&SType&STime&BBS94KK.BoardID&BBS94KK.TB
	Pages.Reloadtime=0
	Pages.strPageVar = "page"
	Pages.InitClass
	Arr_Rs = Pages.arrRecordInfo
	strPageInfo = Pages.strPageInfo
	Set Pages = nothing
	If IsArray(Arr_Rs) Then
	TopicImg=Split(BBS94KK.Template.ReadTemplate("帖子状态图片"),"|")
	NoShow=BBS94KK.NoShowTopic()'禁止显示VIP、认证
	For i = 0 to UBound(Arr_Rs, 2)
	If InStr(NoShow,","&Arr_Rs(7,I)&",")=0 Then
		IsSearchInfo=True
		Facepic="<img src='pic/face/"&Arr_Rs(1,i)&".gIf'>"
		Moodpic=TopicImg(6)
		If Arr_Rs(13,i) > Int(BBS94KK.BbsCache(29)) Then Moodpic=TopicImg(5)
		If Arr_Rs(5,i) Then Moodpic=TopicImg(3)'精华
		If Arr_Rs(15,i) Then Moodpic=TopicImg(7)'锁定
		If Arr_Rs(12,i) Then Moodpic=TopicImg(4)'投票
		If Arr_Rs(4,i)=5 Then Moodpic=TopicImg(0)'总顶
		If Arr_Rs(4,i)=4 Then Moodpic=TopicImg(1)'区顶
		If Arr_Rs(4,i)=3 Then Moodpic=TopicImg(2)'顶
		UploadType=""
		If Arr_Rs(11,i)<>"" Then Uploadtype="<img src='pic/filetype/"&Arr_Rs(11,i)&".gif' border=0> "
		LastRe=split(Arr_Rs(10,i),"|")
		RePage=(Arr_Rs(13,i)+1)\10
		If RePage<(Arr_Rs(13,i)+1)/10 Then RePage=RePage+1
		RePageUrl="Show.asp?id="&Arr_Rs(0,i)&"&BoardID="&Arr_Rs(7,i)&"&TB="&Arr_Rs(14,i)&""
		leftn=50
		If RePage>4 Then leftn=36
		If Repage>10 Then leftn=30
		Caption=UploadType
		Caption=Caption&"<a href="&Repageurl&" title='主题发布时间："&Arr_Rs(6,i)&"<br>最后回复内容："&BBS94KK.Fun.StrLeft(LastRe(1),20)&"'>"& Replace(BBS94KK.Fun.StrLeft(Arr_Rs(2,i),leftn),Key,"<font color=red>"&Key&"</font>")&"</a>"
		If Repage>1 Then
		Caption=Caption&" [<img src='images/gopage.gif' width=10 height=12> "
		If RePage<=5 Then
			For ii=2 To RePage
				Caption=Caption&"<a href='"&RePageurl&"&page="&ii&"'>"&ii&"</a> "
			Next
		Else
			For ii=2 To 4
				Caption=Caption&"<a href='"&RePageurl&"&page="&ii&"'>"&ii&"</a> "
			Next
				Caption=Caption&"... <a href='"&RePageurl&"&page="&RePage&"'>"&RePage&"</a> "
		End If
		Caption=Caption&" ]"
		End If
		If Datediff("n",Arr_Rs(8,i),BBS94KK.NowbbsTime)<=180 Then Caption=Caption&TopicImg(8)
		Temp=BBS94KK.Template.ReadTemplate("主题列表")
		Temp=Replace(Temp,"{状态}",Moodpic)
		Temp=Replace(Temp,"{主题}",Caption)
		Temp=Replace(Temp,"{表情}",Facepic)
		Temp=Replace(Temp,"{用户名称}","<a href='UserInfo.asp?name="&Arr_Rs(3,i)&"' title='查看 "&Arr_Rs(3,i)&" 的资料'>"&Replace(Arr_Rs(3,i),Key,"<font color=red>"&Key&"</font>")&"</a>")
		Temp=Replace(Temp,"{回复数}",Arr_Rs(13,i))
		Temp=Replace(Temp,"{点击数}",Arr_Rs(9,i))
		Temp=Replace(Temp,"{最后时间}","<font title='时间："&FORMATDATETIME(Arr_Rs(8,i),3)&"'>"&FORMATDATETIME(Arr_Rs(8,i),1)&"</font>")
		Temp=Replace(Temp,"{回复用户名称}",LastRe(0))
		TopicS=TopicS&Temp
	End If
	Next
	End If
	If IsSearchInfo Then
		ListTop()
		Response.Write(TopicS)
		ListBottom()
	Else
		Caption="论坛搜索"
		Content="<div style='margin: 10;line-height:150%'>关键字<font color='red'> "&BBS94KK.Fun.HtmlCode(key)&" </font>找不到任何结果！&nbsp;&nbsp;&nbsp;&nbsp;<li><a href=javascript:history.go(-1)>返回上一页</a><li><a href=Search.asp>重新高级搜索</a><div>"
		Call BBS94KK.ShowTable(Caption,Content)
	End If
End Sub

Sub Main()
	Dim Caption,Content
	Content="<form method='get' style='margin:0'><tr><td width='30%' height=30 align='right'>搜索关键字：</td><td width='70%'>&nbsp;<input type='text' name='Key' size=52></td></tr>"&_
	"<tr><td height='30' align='right'>搜索类型：</td><td width='61%'>&nbsp;<input type='radio' value='1' name='SType'> 按帖子作者 <input type='radio' name='SType' checked value='2'> 按帖子主题 <input type='radio' value='3' name='SType'>两者均搜</td></tr>"&_
	"<tr><td height='30' align='right'>搜索日期范围：</td><td >&nbsp;<select size='1' name='STime'><option selected value='0'>所有日期</option><option value='1'>1天以来</option><option value='2'>2天以来</option><option value='7'>7天以来</option><option value='15'>15天以来</option><option value='30'>30天以来</option></select></td></tr>"&_
	"<tr><td height='30' align='right'>搜索数据表范围：</td><td>&nbsp;"&TBList&"</td></tr>"&_
	"<tr><td height='30' align='right'>搜索的论坛：</td><td>&nbsp;<select name='BoardID'><option value='0'>搜索全部论坛</option>"& BBS94KK.BoardIDList(0,0)&"</select></td></tr>"&_
	"<tr><td height='30' align='center' colspan='2'><input type='submit' value=' 开 始 搜 索 '><input type='hidden' value='Topic' name='Action'></td></tr></form>"
	Caption="论坛搜索"
	Call BBS94KK.ShowTable(Caption,Content)
End Sub
Function GetKey(str)
	Str=Request.querystring(str)
	Str=Replace(str,"'","")
	Str=Replace(str,chr(34)&chr(34),"")
	str=Replace(str,"[","[[]")
	GetKey=str
End Function
Function TBList()
	Dim AllTable,I,Temp
	AllTable=Split(BBS94KK.BBSTable(0),",")
	For i=0 To uBound(AllTable)
		Temp=Temp&"<option value='"&AllTable(i)&"' " 
		If AllTable(i)=BBS94KK.TB Then Temp=Temp&"selected"
		Temp=Temp&">数据表 "&AllTable(i)&"</option>"
	next
	TBList="<select name='TB'>"&Temp&"</select>"
End Function
%>
💿 文件大小 447 K
👤 上传用户 csytml
📂 所属分类通讯编程文档
🏷️ 相关标签

#BBS #ASP #源码 #论坛
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -