list.asp

BBS源码 利用ASP的一个功能齐全的BBS论坛源码

<!--#include file="Inc.asp"-->
<!--#include file="Inc/Page_Cls.asp"-->
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<%
'------------------------------
'版权所有：就是快快 94KK.com
'------------------------------
Dim PageString,strPageInfo
	If Request("find")<>"" then Response.Redirect"Search.asp?key="&Request("find")&"&SType=2&STime=0&tb="&BBS94KK.TB&"&BoardID="&BBS94KK.BoardID&"&Action=Topic"
	BBS94KK.CheckBoard()
	BBS94KK.Head("")
	If BBS94KK.BoardChild>0 Then PageString=ShowBoard()
	If BBS94KK.BoardDepth>0 Then
	PageString=PageString&ShowListTop()&ShowTopic()&ShowListBottom()
	Else
	PageString=PageString&BBS94KK.Template.ReadTemplate("首页图例")
	End If
	Response.Write(PageString)
	BBS94KK.Footer()
	Set BBS94KK=Nothing
	
'获得下级论坛
Function ShowBoard()
	Dim Temp,i,BoardTop,BoardList,BoardBottom,BoardStr
	BoardTop=BBS94KK.Template.ReadTemplate("分区表格")
	BoardList=BBS94KK.Template.ReadTemplate("版块列表")
	BoardBottom=BBS94KK.Template.ReadTemplate("分区底部表格")
	For i=0 To Ubound(BBS94KK.Board_Rs,2)
		Temp=""
		If Int(BBS94KK.Board_Rs(1,i))=BBS94KK.BoardID Then
			Temp = Temp & Replace(BoardTop,"{分类名称}",BBS94KK.Board_Rs(3,i))
		ElseIf BBS94KK.Board_Rs(2,i)=BBS94KK.BoardID Then
			Temp=BoardList
			Temp=BBS94KK.GetBoardInfo(Temp,i)
		End If
		BoardStr=BoardStr & Temp
	Next
	ShowBoard = BoardStr& BoardBottom & VbCrlf
End Function

Function Showonline()
	Dim Temp,BoardOnline,BoardUserOnline
	Temp=BBS94KK.Template.ReadTemplate("版块在线")
	Temp=Replace(Temp,"{在线列表}","<span id=showon></span>")
	BoardOnline=BBS94KK.Execute("select count(ID) from [KK_online] where BoardID="&BBS94KK.BoardID)(0)
	Temp=Replace(Temp,"{在线信息}","论坛总在线：<b>"&BBS94KK.AllOnlineNum&"</b>人，本版在线：<b>"&BoardOnline&"</b>人，本版有<b> "&BBS94KK.UserOnlineNum&"</b> 会员和 <b>"&BoardOnline-BBS94KK.UserOnlineNum&"</b> 游客在线。本版今日帖子<Font color=red>"&BBS94KK.BoardTodayNum&"</Font>篇 ")
	If Session(BBS94KK.CacheName&"online")="1" then
		Temp=Replace(Temp,"{在线列表开关}","<a target='hiddenframe' href='online.asp?BoardID="&BBS94KK.BoardID&"' onClick='ShowOnline();' ><span id='Showtxt'>关闭详细列表</span></a>")
		Temp=Temp&"<iframe name='hiddenframe' frameborder='0'  height='0' src='online.asp?BoardID="&BBS94KK.BoardID&"&id=1' id='hiddenframe'></iframe>"
	Else
		Temp=Replace(Temp,"{在线列表开关}","<a target='hiddenframe' href='online.asp?BoardID="&BBS94KK.BoardID&"' onClick='ShowOnline();' ><span id='Showtxt'>显示详细列表</span></a>")
		Temp=Temp&"<iframe name='hiddenframe' frameborder='0' height='0' id='hiddenframe'></iframe>"	
	End If
	ShowOnline=Temp
End Function

Function ShowListTop()
	Dim Temp,Button
	Button=""
	If BBS94KK.BoardType<>2 Or BBS94KK.MyAdmin=1 Or (BBS94KK.MyAdmin=3 And BBS94KK.IsBoardAdmin) Then
		Button="<a href='say.asp?BoardID="&BBS94KK.BoardID&"'>"&Trim(Replace(BBS94KK.Template.ReadTemplate("发帖图片"),VbCrlf,""))&"</a> <a href='Say.asp?action=vote&BoardID="&BBS94KK.BoardID&"'>"&Trim(Replace(BBS94KK.Template.ReadTemplate("发投票图片"),VbCrlf,""))&"</a>"
	End If
	Temp=BBS94KK.Template.ReadTemplate("主题列表顶部")
	Temp=Replace(Temp,"{发帖按钮}",Button)
	Temp=Replace(Temp,"{版主}",BBS94KK.Boardadmin)
	Temp=Replace(Temp,"{版块ID}",BBS94KK.BoardID)
	Temp=Replace(Temp,"{数据表ID}",BBS94KK.TB)
	Temp=Replace(Temp,"{公告}",BBS94KK.Placard(BBS94KK.BoardID))
	If BBS94KK.BbsCache(15)="0" then Temp=Replace(Temp,"{显示在线}",ShowOnline()) Else Temp=Replace(Temp,"{显示在线}","")
	ShowListTop=Temp
End Function
Function ShowListBottom()
	Dim Temp
	Temp=BBS94KK.Template.ReadTemplate("主题列表底部")
	Temp=Replace(Temp,"{分页}",strPageInfo)
	Temp=Replace(Temp,"{版块下拉列表}",BBS94KK.BoardList(2))
	ShowListBottom=Temp
End Function
Function ShowTopic()
	Dim intPageNow,arr_Rs,i,Pages,TopicImg,Conut,page
	Dim Temp,TopicS,Caption,Facepic,Moodpic,LastRe,RePageUrl,UploadType,RePage,leftn,ii
	intPageNow = Request.QueryString("page")
	Set Pages = New Cls_PageView
	Pages.strTableName = "[KK_Topic]"
	Pages.strPageUrl = "?BoardID="&BBS94KK.BoardID
	Pages.strFieldsList = "TopicID,Face,Caption,Name,TopType,IsGood,AddTime,BoardID,LastTime,Hits,LastReply,UploadType,IsVote,ReplyNum,SqlTableID,IsLock"
	Pages.strCondiction = "(BoardID="&BBS94KK.BoardID&" or TopType=4 or TopType=5) And IsDel=False "
	Pages.strOrderList = "TopType desc,LastTime desc"
	Pages.strPrimaryKey = "TopicID"
	Pages.intPageSize = Int(BBS94KK.BbsCache(31))
	Pages.intPageNow = intPageNow
	Pages.strCookiesName = "BBSList"&BBS94KK.BoardID'客户端记录总数
	'Pages.Reloadtime=3'每三分钟更新Cookies
	Pages.InitClass
	Arr_Rs = Pages.arrRecordInfo
	strPageInfo = Pages.strPageInfo
	Set Pages = nothing
	If IsArray(Arr_Rs) Then
	TopicImg=Split(BBS94KK.Template.ReadTemplate("帖子状态图片"),"|")
	For i = 0 to UBound(Arr_Rs, 2)
	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)'顶
	If Arr_Rs(4,i)<>4 or (Arr_Rs(4,i)=4 And InStr(BBS94KK.BoardRoots,"|"&Arr_Rs(7,i)&"|"))>0 Then
	Facepic="<img src='pic/face/"&Arr_Rs(1,i)&".gIf'>"
	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="&BBS94KK.BoardID&"&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&"><font color="&replacecolor(Arr_Rs(2,i))&"><span title='主题发布时间："&Arr_Rs(6,i)&"<br>最后回复内容："&LastRe(1)&"'>"&BBS94KK.Fun.StrLeft(Arr_Rs(2,i),leftn)&"</span></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)&" 的资料'>"&Arr_Rs(3,i)&"</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
	ShowTopic=TopicS
End Function

function replacecolor(title)
dim startc,endc,lenc,tmp,titlecolor
startc=instr(title,"[")
endc=instr(title,"]")
lenc=endc-startc
if lenc=3 and startc>0 then
tmp=mid(title,startc,lenc+1)
select case tmp
case"[原创]"
titlecolor="blue"
case"[公告]"
titlecolor="red"
case"[分享]"
titlecolor="#800000"
case"[贴图]"
titlecolor="#2f4f4f"
case"[注意]"
titlecolor="#cc00cc"
case"[求助]"
titlecolor="#ff6600"
case"[推荐]"
titlecolor="green"
case"[转帖]"
titlecolor="#666633"
case"[建议]"
titlecolor="#990000"
case"[下载]"
titlecolor="black"
case"[讨论]"
titlecolor="red"
case"[灌水]"
titlecolor="#000080"
case else
titlecolor="#3399ff" 
end select
end if
replacecolor=titlecolor
end function
%>