list.asp

功能强大的一个b/s工作站

<!--#include file="conn.asp"-->
<!-- #include file="inc/const.asp" -->
<!-- #include file="inc/char_board.asp" -->
<!-- #include file="inc/new_thread.asp" -->
<%
response.buffer=true
'=========================================================
' File: list.asp
' Version:5.0
' Date: 2002-9-20
' Script Written by satan
'=========================================================
' Copyright (C) 2001,2002 AspSky.Net. All rights reserved.
' Web: http://www.aspsky.net,http://www.dvbbs.net
' Email: [e-mail],[e-mail]
'=========================================================

Dim currentPage,tl,limitime
Dim Fast_action
Dim reBoard_Setting,BoardCount,k,ColSpanNum
Dim Board_Count
Dim TdTableWidth
Dim master_3,master_4
dim onlinenum,guestnum
Dim LastPost,Lastuser,LastID
dim LastTime,LastUserid,LastRootid,body
dim Pnum,p,replynum
dim totalrec,ii,page_count
dim n,pi
dim call_info
dim RsTopic
dim cmd,AllTopNum,RsTop
AllTopNum=0
Fast_action=false

if boardmaster or master or superboardmaster then
	Fast_action=true
else
	Fast_action=false
end if

if BoardID="" or (not isInteger(BoardID)) or BoardID="0" then
	Errmsg=Errmsg+"<br>"+"<li>错误的版面参数！请确认您是从有效的连接进入。"
	founderr=true
else
	BoardID=clng(BoardID)
end if
if cint(Board_Setting(2))=1 then
	if not founduser then
		Errmsg=Errmsg+"<br>"+"<li>本论坛为认证论坛，请<a href=login.asp>登陆</a>并确认您的用户名已经得到管理员的认证后进入。"
		founderr=true
	else
		if chkboardlogin(boardid,membername)=false then
		Errmsg=Errmsg+"<br>"+"<li>本论坛为认证论坛，请确认您的用户名已经得到管理员的认证后进入。"
		founderr=true
		end if
	end if
end if
if cint(Board_Setting(1))=1 then
	if Cint(GroupSetting(37))=0 then
		Errmsg=ErrMsg+"<Br>"+"<li>您没有权限进入隐含论坛！"
		founderr=true
	end if
end if
if founderr then
	call nav()
	call head_var(2,0,"","")
	call dvbbs_error()
else
	call nav()
	if Cint(Board_Setting(43))=0 then
	stats="帖子列表"
	else
	stats="论坛列表"
	end if
	call head_var(1,BoardDepth,0,0)
	call main()
	if founderr then call dvbbs_error()
end if
call footer()

sub main()
currentPage=request("page")
if currentpage="" or not isInteger(currentpage) then
	currentpage=1
else
	currentpage=clng(currentpage)
end if
if request("selTimeLimit")="all" then
	tl=""
elseif request("selTimeLimit")="" then
	tl=""
else
	limitime=request("selTimeLimit")
	tl=" and dateandtime>='"&cstr(cdate(now()-limitime))&"' "
end if
stats=boardtype & "帖子列表"
call activeonline()
onlinenum=online(boardid)
guestnum=guest(boardid)
if trim(boardmasterlist)<>"" then
	master_1=split(boardmasterlist, "|")
	for i = 0 to ubound(master_1)
	master_2=""+master_2+"<a href=""dispuser.asp?name="+master_1(i)+""" target=_blank title=点击查看该版主资料>"+master_1(i)+"</a>&nbsp;"
	next
else
	master_2="无版主"
end if

response.write "<TABLE cellSpacing=0 cellPadding=0 width="&Forum_body(12)&" border=0 align=center>"&_
	"<tr>"&_
	"<td align=center width=100% valign=middle>"&_
	"<SCRIPT LANGUAGE='JavaScript' SRC='js/fader.js' TYPE='text/javascript'></script>"&_
	"<SCRIPT LANGUAGE='JavaScript' TYPE='text/javascript'>"&_
	"prefix="""";"&_
	"arNews = ["""
myCache.name="AnnounceMents"&BoardID
if myCache.valid then
	response.write myCache.value
else
Dim AnnounceMent_list
sql="select top 1 title,addtime from bbsnews where boardid="&boardid&"  order by id desc"
set rs=conn.execute(sql)
if rs.bof and rs.eof then
	AnnounceMent_list="<b><a href='announcements.asp?boardid="& boardid &"' target=_blank><ACRONYM TITLE='当前没有公告'>当前没有公告</ACRONYM></a></b> ("& now() &")"
else
	AnnounceMent_list="<b><a href='announcements.asp?boardid="& boardid &"' target=_blank>"& rs("title") &"</a></b> ("& rs("addtime") &")"
end if
set rs=nothing
myCache.add AnnounceMent_list,dateadd("n",60,now)
response.write AnnounceMent_list
end if
response.write ""","""",""欢迎光临"&Forum_info(0)&" "&boardtype&""","""",""严禁恶意使用粗言秽语，违者经劝告无效，立即封ID。"",""""]"&_
	"</SCRIPT>"&_
	"<div id=""elFader"" style=""position:relative;visibility:hidden; height:16"" ></div>"&_
	"</td>"&_
	"</tr>"&_
	"</table>"
%>
<script>
function loadThreadFollow(t_id,b_id){
	var targetImg =eval("document.all.followImg" + t_id);
	var targetDiv =eval("document.all.follow" + t_id);
	
	if ("object"==typeof(targetImg)){
		if (targetDiv.style.display!='block'){
			targetDiv.style.display="block";
			targetImg.src="<%=Forum_info(7)&Forum_boardpic(16)%>";
			if (targetImg.loaded=="no"){
				document.frames["hiddenframe"].location.replace("loadtree1.asp?boardid="+b_id+"&rootid="+t_id);
			}
		}else{
			targetDiv.style.display="none";
			targetImg.src="<%=Forum_info(7)&Forum_boardpic(15)%>";
		}
	}
}
</script>
<iframe width=0 height=0 src="" id="hiddenframe"></iframe>
<%
k=0
Dim cBoardID
dim simdisp
simdisp=false
Response.Cookies("BoardList").expires= date+7
cBoardID= Request("cBoardid")
if isnumeric(cBoardID) then
	if request("CatLog")="N" then
	Response.Cookies("BoardList")(cBoardID & "BoardID")= "NotShow"
	else
	Response.Cookies("BoardList")(cBoardID & "BoardID")= "Show"
	end if
end if
if request.cookies("BoardList")(boardid & "BoardID")<>"NNotShow" then
if BoardParentID=0 then
sql="select * from board where (depth<="&Boarddepth&"+"&forum_setting(5)&" and ParentStr like '%"&BoardID&"%') or boardid="&boardid&" order by orders"
else
sql="select * from board where (depth<="&Boarddepth&"+"&forum_setting(5)&" and ParentStr like '%"&BoardParentStr&","&boardid&"%') or boardid="&boardid&" order by orders"
end if
'response.write sql
set rs=server.createobject("adodb.recordset")
rs.open sql,conn,1,1
if not (rs.eof and rs.bof) then BoardCount=rs.recordcount
if BoardCount>1 then
do while not rs.eof
k=k+1
reBoard_Setting=split(rs("Board_setting"),",")
if rs("BoardMaster")<>"" and not isnull(rs("BoardMaster")) then
	master_3=split(rs("BoardMaster"), "|")
	for i = 0 to ubound(master_3)
	if i>6 then
		master_4=master_4
	else
		master_4=master_4 & "<a href=dispuser.asp?name="&master_3(i)&" target=_blank>"&master_3(i)&"</a>&nbsp;"
	end if
	next
	if i>7 then master_4=master_4 & "<font color=gray>More...</font>"
else
	master_4="暂无"
end if
if rs("ParentID")=0 or rs("boardid")=boardid then
	if request.cookies("BoardList")(rs("boardid") & "BoardID")="NotShow" then
		ColSpanNum=reBoard_Setting(41)
		simdisp=true
	elseif request.cookies("BoardList")(rs("boardid") & "BoardID")="Show" then
		simdisp=false
		ColSpanNum=2
	else
		if Cint(reBoard_Setting(39))=1 then
			ColSpanNum=reBoard_Setting(41)
			simdisp=true
		else
			simdisp=false
			ColSpanNum=2
		end if
	end if
		'数码修改-增加头部皮肤
		%>
		<!--#include file="skintop.asp"-->
		<%
		'数码修改-增加头部皮肤
	response.write "<table cellspacing=1 cellpadding=0 align=center class=tableBorder1>"
	response.write "<TR><Th colSpan="&ColSpanNum&" height=25 align=left id=TableTitleLink>&nbsp;"
	if simdisp then
		response.write "<a href=""?BoardID="&rs("boardid")&"&cBoardid="&rs("boardid")&"&Catlog=Y"" title=""展开论坛列表""><img src="""&Forum_info(7)&Forum_boardpic(15)&""" border=0></a><a href=list.asp?boardid="&rs("boardid")&" title=进入本分类论坛>"&rs("boardtype")&"</a>&nbsp;<a href=""?BoardID="&rs("boardid")&"&Catlog=NN"">[完全关闭]</a>"
	else
		response.write "<a href=""?BoardID="&rs("boardid")&"&cBoardid="&rs("boardid")&"&Catlog=N"" title=""关闭论坛列表""><img src="""&Forum_info(7)&Forum_boardpic(16)&""" border=0></a><a href=list.asp?boardid="&rs("boardid")&" title=进入本分类论坛>"&rs("boardtype")&"</a>&nbsp;<a href=""?BoardID="&rs("boardid")&"&Catlog=NN"">[完全关闭]</a>"
	end if
	response.write "</Th></TR>"
	Board_Count=0
else
	if simdisp then
		call main_1_boardlist_2()
	else
		call main_1_boardlist_1()
	end if
end if
master_4=""
rs.movenext
if k<BoardCount then
	if rs("parentid")=0 and Board_count<ColSpanNum and simdisp then
		for i=Board_Count+1 to ColSpanNum
			response.write "<td class=tablebody1 width="""&TdTableWidth&"%"">&nbsp;</td>"
		next
		response.write "</tr>"
	end if
	if rs("parentid")=0 then
		response.write "</table"
		'数码修改-增加脚部皮肤
		%>
      	<!--#include file="skinbottom.asp"-->
      	<%
		response.write "<BR><BR>"
		'数码修改-增加脚部皮肤结束
		simdisp=false
		ColSpanNum=2
	end if
else
	if Board_count<ColSpanNum and simdisp then
		for i=Board_Count+1 to ColSpanNum
			response.write "<td class=tablebody1 width="""&TdTableWidth&"%"">&nbsp;</td>"
		next
		response.write "</tr>"
	end if
end if
loop
response.write "</table>"
		'数码修改-增加脚部皮肤
		%>
      	<!--#include file="skinbottom.asp"-->
      	<%
		response.write "<BR>"
		'数码修改-增加脚部皮肤结束
end if
rs.close
set rs=nothing
response.write "<BR>"
end if
if currentpage=1 then
myCache.name="AllTopNum"
if myCache.valid then
	if myCache.value>0 then
	set RsTop=server.createobject("adodb.recordset")
	sql="select TopicID,boardid,title,postusername,postuserid,dateandtime,child,hits,votetotal,lastpost,lastposttime,istop,isvote,isbest,locktopic,Expression from topic where istop=2 and locktopic<2  ORDER BY lastposttime desc"
	RsTop.open sql,conn,1,1
	if RsTop.eof and RsTop.bof then
		AllTopNum=0
	else
		AllTopNum=RsTop.recordcount
	end if
	myCache.add AllTopNum,dateadd("n",60,now)
	end if 'end by value
else
	set RsTop=server.createobject("adodb.recordset")
	sql="select 	TopicID,boardid,title,postusername,postuserid,dateandtime,child,hits,votetotal,lastpost,lastposttime,istop,isvote,isbest,locktopic,Expression from topic where istop=2 and locktopic<2  ORDER BY lastposttime desc"
	RsTop.open sql,conn,1,1
	if RsTop.eof and RsTop.bof then
		AllTopNum=0
	else
		AllTopNum=RsTop.recordcount
	end if
	myCache.add AllTopNum,dateadd("n",60,now)
end if 'end by valid
end if 'end by page

if limitime="" then
	totalrec=lasttopicnum
else
	set rs=conn.execute("select count(topicid) from topic where boardID="&cstr(boardID)&" "&tl&"")
	totalrec=rs(0)
end if
set RsTopic=server.createobject("adodb.recordset")
if IsAudit=1 then
if not founduser then userid=0
sql="select TopicID,boardid,title,postusername,postuserid,dateandtime,child,hits,votetotal,lastpost,lastposttime,istop,isvote,isbest,locktopic,Expression from topic where boardID="&boardid&" and istop<2 and (locktopic<2 or (locktopic=3 and PostUserID="&userid&")) ORDER BY istop desc,lastposttime desc"
else
sql="select TopicID,boardid,title,postusername,postuserid,dateandtime,child,hits,votetotal,lastpost,lastposttime,istop,isvote,isbest,locktopic,Expression from topic where boardid="&boardid&" and istop<2 and locktopic<2 order by istop desc,lastposttime desc"
end if

RsTopic.open sql,conn,1
if RsTopic.eof and RsTopic.bof and Cint(Board_Setting(43))=0 and AllTopNum=0 then
	call BoardEmpty()
elseif not (RsTopic.eof and RsTopic.bof) or (Cint(Board_Setting(43))=0 and AllTopNum>0) then
	call listinfo()
end if
end sub

sub main_1_boardlist_1()

if (Cint(reBoard_Setting(1))=1 and Cint(GroupSetting(37))=1) or Cint(reBoard_Setting(1))=0 then
response.write "<TR><TD align=middle width=100% class=tablebody1><table width=""100%"" cellspacing=0 cellpadding=0>"
LastPostInfo=split(rs("LastPost"),"$")
if not isdate(LastPostInfo(2)) then LastPostInfo(2)=Now()
'=========================BoardInfo============================
response.write "<TR><TD align=middle width=46 class=tablebody1>"
if reBoard_Setting(0)=1 then
	if datediff("h",lastlogin,LastPostInfo(2))=0 then
	response.write "<img src="&Forum_info(7)&Forum_pic(15)&" alt=有新帖子>"
	else
	response.write "<img src="&Forum_info(7)&Forum_pic(14)&" alt=无新帖子>"
	end if
else
	if datediff("h",lastlogin,LastPostInfo(2))=0 then
	response.write "<img src="&Forum_info(7)&Forum_pic(7)&" alt=有新帖子>"
	else
	response.write "<img src="&Forum_info(7)&Forum_pic(6)&" alt=无新帖子>"
	end if
end if

response.write "</TD>"&_
	"<TD width=1 bgcolor="&Forum_body(27)&">"&_
	"<TD vAlign=top width=* class=tablebody1>"&_
	"<TABLE cellSpacing=0 cellPadding=2 width=100% border=0>"&_
	"<tr><td class=tablebody1 width=*><a href=list.asp?boardid="&rs(0)&">"&_
	"<font color="&Forum_body(14)&">"&rs("boardtype")&"</font></a>"
if rs("child")>0 then
response.write "(<font title=""有"&rs("child")&"个下属论坛"">"&rs("child")&"</font>)"
end if
response.write "</td>"&_
	"<td width=40 rowspan=2 align=center class=tablebody1>"
if rs("indeximg")<>"" then
	response.write "<table align=left><tr><td><a href=list.asp?boardid="&rs("boardid")&"><img src="&rs("indeximg")&" align=top border=0></a></td><td width=20></td></tr></table>"
end if
response.write "</td><td width=200 rowspan=2 class=tablebody1>"
if Cint(reBoard_Setting(2))=1 then
response.write "认证论坛，请认证用户进入浏览"
else
response.write "主题：<a href=""dispbbs.asp?Boardid="&LastPostInfo(7)&"&ID="&LastPostInfo(6)&"&replyID="&LastPostInfo(1)&"&skin=1"">"&htmlencode(left(LastPostInfo(3),10))&"..</a><BR>作者：<a href=""dispuser.asp?id="&htmlencode(LastPostInfo(5))&""" target=_blank>"&htmlencode(LastPostInfo(0))&"</a><BR>日期：" & FormatDateTime(LastPostInfo(2),1) & "