gusucode.com > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告) > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告)\13学生论坛ASPAC\BBS\AccessTopic.asp

    <!--#include file="conn.asp"-->
<!-- #include file="inc/const.asp" -->
<!-- #include file="inc/dv_clsother.asp" -->
<%
Mybbs.Loadtemplates("")
Mybbs.stats="帖子审核"
Mybbs.Nav
If Mybbs.BoardID=0 Then
	Mybbs.Head_var 2,0,"",""
Else
	Mybbs.Head_var 1,Mybbs.Board_Data(4,0),"",""
End If
Dim currentPage,Rs,SQl,i
Dim AdminLockTopic
Dim p,announceIDRange1,announceIDRange2,tableclass
Dim bBoardEmpty
bBoardEmpty=False
AdminLockTopic=False 
If (Mybbs.master or Mybbs.superboardmaster or Mybbs.boardmaster) And Cint(Mybbs.GroupSetting(36))=1 Then
	AdminLockTopic=True 
Else 
	AdminLockTopic=False 
End If
If Cint(Mybbs.GroupSetting(36))=1 And Mybbs.UserGroupID>3 Then
	AdminLockTopic=True 
End If 
If Mybbs.FoundUserPer And Cint(Mybbs.GroupSetting(36))=1 Then
	AdminLockTopic=true
ElseIf Mybbs.FoundUserPer And Cint(Mybbs.GroupSetting(36))=0 Then
	AdminLockTopic=False 
End If 
If Not AdminLockTopic Then Response.redirect "showerr.asp?ErrCodes=<li>您没有在本版面审核帖子的权限。&action=OtherErr"
currentPage=request("page")

If currentpage="" or not IsNumeric(currentpage) Then
	currentpage=1
Else
	currentpage=clng(currentpage)
End If

If request("action")="freetopic" Then
	freetopic()
ElseIf request("action")="dispaudit" Then
	View()
Else
	main()
End If

Mybbs.activeonline()
Mybbs.footer()

Sub main()
	Dim totalrec,ii,page_count
	Dim n,pi
	Dim rs1,sql1
%>
<BR>
<TABLE cellPadding=1 cellSpacing=1 class=tableborder1 align=center>
<form action="?action=freetopic" method=post name=batch>
<input type=hidden value="<%=Mybbs.boardid%>" name=boardid>
<TR align=middle>
<Th height=25 width=32 id=tabletitlelink>选项</th>
<Th width=*>主 题</Th>
<Th width=80>作 者</Th>
</TR>
<%
	Set Rs=server.createobject("adodb.recordset")
	If Mybbs.boardid=0 Then
		sql="select AnnounceID,boardID,UserName,Topic,DateAndTime,RootID,layer,orders,Expression,body,PostUserID,locktopic,parentid from "& Mybbs.NowUseBBS &" where BoardID=777 Order by AnnounceID Desc"
	Else
		sql="select AnnounceID,boardID,UserName,Topic,DateAndTime,RootID,layer,orders,Expression,body,PostUserID,locktopic,parentid from "& Mybbs.NowUseBBS &" where BoardID=777 And locktopic="&Mybbs.boardid&" Order by AnnounceID Desc"
	End If
	If Not IsObject(Conn) Then ConnectionDatabase
	Rs.Open Sql,Conn,1,1
	If rs.eof And rs.bof Then
		Response.Write "<tr><td colSpan=3 width=100% class=tablebody1 height=25>&nbsp;暂无审核内容</td></tr>"
	Else
		rs.PageSize = cint(Mybbs.Forum_Setting(11))
		rs.AbsolutePage=currentpage
		page_count=0
		totalrec=rs.recordcount
		Do While Not Rs.Eof and (not page_count = rs.PageSize)
			page_count=page_count+1
			If rs("layer")= 1 Then
				tableclass="tablebody1"
			Else
				tableclass="tablebody2"
			End If
			Response.Write "<TR align=middle><TD class=tablebody2 width=32 height=27 class="&tableclass&">"
			Response.Write "<input type=checkbox name=Announceid value="""&rs("Announceid")&""">"
			Response.Write "</TD><TD align=left class=tablebody1 width=* class="&tableclass&">"

			Response.Write "<img src=skins/default/topicface/"&rs("Expression")&"> "
			If Rs("ParentID")>0 Then GetTopic(Rs("RootID"))
			Response.Write "<a href='accesstopic.asp?action=dispaudit&boardID="& Mybbs.boardID &"&ID="&cstr(rs("RootID"))&"&replyID="&Cstr(rs("announceID"))&"' target=_blank>"

			If Rs("topic")="" or isnull(rs("topic")) Then
				If Len(rs("body"))>50 Then
					Response.Write Mybbs.htmlencode(replace(left(rs("body"),50),chr(10),""))
				Else
					Response.Write Mybbs.htmlencode(replace(rs("body"),chr(10),""))
				End If 
			Else
				If len(rs("Topic"))>50 Then 
					Response.Write Mybbs.htmlencode(left(rs("Topic"),50))
				Else 
					Response.Write Mybbs.htmlencode(rs("Topic"))
				End If
			End If
			Response.Write "&nbsp;("&rs("dateandtime")&")</TD>"
			Response.Write "<TD class=tablebody2 width=80 class="&tableclass&"><a href=""dispuser.asp?id="& rs("postuserid") &""" target=_blank>"& Mybbs.htmlencode(rs("username")) &"</a></TD>"

			Response.Write "</TR>"
		Rs.MoveNext   
		Loop
	End If

	Rs.Close
	Set Rs=Nothing
	If totalrec mod Mybbs.Forum_Setting(11)=0 Then
		n= totalrec \ Mybbs.Forum_Setting(11)
	Else
   		n= totalrec \ Mybbs.Forum_Setting(11)+1
	End If
	If currentpage-1 mod 10=0 Then
		p=(currentpage-1) \ 10
	Else
		p=(currentpage-1) \ 10
	End If
	Dim pagelist,pagelistbit
%>
<TR align=middle>
<Td height=25 class=tablebody2 colspan=3>&nbsp;请选择要操作的内容：<input name="actiontype" value="1" type=radio checked>通过审核&nbsp;<input name="actiontype" value="2" type=radio>删除帖子&nbsp;<input name=submit value="执行" type=submit onclick="{if(confirm('您确定执行的操作吗?')){return true;}return false;}"></Td>
</TR>
</table>

<table border=0 cellpadding=0 cellspacing=3 width="<%=Mybbs.mainsetting(0)%>" align="center">
</form>
<form method=post action="accesstopic.asp">
<tr>
<td valign=middle>页次：<b><%= currentPage %></b>/<b><%= n %></b>页 每页<b><%= Mybbs.Forum_Setting(11) %></b> 主题数<b><%= totalrec %></b></td>
<td valign=middle><div align=right >分页：
<%
	If currentPage=1 Then
	Response.Write "<font face=webdings color="&Mybbs.mainsetting(1)&">9</font>   "
	Else
	Response.Write "<a href='?boardid="&Mybbs.boardid&"&page=1&action="&request("action")&"' title=首页><font face=webdings>9</font></a>   "
	End If
	If p*10>0 Then Response.Write "<a href='?boardid="&Mybbs.boardid&"&page="&Cstr(p*10)&"&action="&request("action")&"' title=上十页><font face=webdings>7</font></a>   "
	Response.Write "<b>"
	for ii=p*10+1 to P*10+10
		   If ii=currentPage Then
	          Response.Write "<font color="&Mybbs.mainsetting(1)&">"+Cstr(ii)+"</font> "
		   Else
		      Response.Write "<a href='?boardid="&Mybbs.boardid&"&page="&Cstr(ii)&"&action="&request("action")&"'>"+Cstr(ii)+"</a>   "
		   End If
		If ii=n Then exit for
		'p=p+1
	next
	Response.Write "</b>"
	If ii<n Then Response.Write "<a href='?boardid="&Mybbs.boardid&"&page="&Cstr(ii)&"&action="&request("action")&"' title=下十页><font face=webdings>8</font></a>   "
	If currentPage=n Then
	Response.Write "<font face=webdings color="&Mybbs.mainsetting(1)&">:</font>   "
	Else
	Response.Write "<a href='?boardid="&Mybbs.boardid&"&page="&Cstr(n)&"&action="&request("action")&"' title=尾页><font face=webdings>:</font></a>   "
	End If
%>
转到:<input type=text name=Page size=3 maxlength=10  value='<%= currentpage %>'><input type=submit value=Go name=submit>
</div></td></tr>
<input type=hidden name=BoardID value='<%= Mybbs.BoardID %>'>
</form></table>
<%
End sub

Function GetTopic(TopicID)
	Dim Trs
	Set Trs=Mybbs.Execute("Select Title,BoardID From Dv_Topic Where TopicID="&TopicID)
	If Not(TRs.Eof And TRs.Bof) Then
		Response.Write "[<a href=dispbbs.asp?boardid="&trs(1)&"&id="&TopicID&" target=_blank>主题帖："&Mybbs.HtmlEncode(Left(Trs(0),16))&"</a>] "
	Else
		Response.Write "[未找到相关主题] "
	End If
	Set Trs=Nothing
End Function

Sub freetopic()

	If request.form("announceid")="" Then Response.redirect "showerr.asp?ErrCodes=<li>请指定相关帖子。&action=OtherErr"
	Dim id,trs,ars
	Dim FoundID,MyID
	Dim bbsnum,topicnum,todaynum
	Dim haveaudit
	bbsnum=0
	topicnum=0
	todaynum=0
	for i=1 to request.form("Announceid").count
		ID=replace(request.form("Announceid")(i),"'","")
		If Not IsNumeric(ID) Then
			ID = 0
		Else
			ID = Clng(ID)
		End If
		'删除
		If request("actiontype")=2 Then
			Set Rs=Mybbs.Execute("select rootid from "&Mybbs.NowUsebbs&" where parentid=0 And Announceid="&id)
			If not (rs.eof And rs.bof) Then
				ID=Rs(0)
				Set Rs=Nothing 
				Mybbs.Execute("delete from dv_topic where topicid="&ID)
				Mybbs.Execute("delete from "&Mybbs.NowUsebbs&" where rootid="&ID)
				FoundID=ID
			Else
				Mybbs.Execute("delete from "&Mybbs.NowUsebbs&" where Announceid="&id)
				FoundID=0
			End If
		'通过审核
		ElseIf cint(request("actiontype"))=1 Then
			Set Rs=Mybbs.Execute("select rootid,dateandtime,PostUserID from "&Mybbs.NowUsebbs&" where parentid=0 And Announceid="&id)
			If not (rs.eof And rs.bof) Then
				'如果被审核的是主题帖
				bbsnum=bbsnum+1
				topicnum=topicnum+1
				If datediff("d",rs(1),Now())=0 Then todaynum=todaynum+1
				Mybbs.Execute("update dv_topic set boardid=locktopic,locktopic=0 where topicid="&rs(0))
				Mybbs.Execute("update "&Mybbs.NowUsebbs&" set boardid=locktopic,locktopic=0 where Announceid="&id)
				Mybbs.Execute("update [dv_user] set userpost=userpost+1,userWealth=userWealth+"&Mybbs.Forum_user(2)&",UserEP=UserEP+"&Mybbs.Forum_user(7)&",UserCP=UserCP+"&Mybbs.Forum_user(12)&" where userid="&rs(2))
			Else
				set trs=Mybbs.Execute("select rootid,dateandtime,PostUserID from "&Mybbs.NowUsebbs&" where Announceid="&id)
				If not (trs.eof And trs.bof) Then
				'更新主题最后回复数据和回复数
				bbsnum=bbsnum+1
				topicnum=topicnum+1
				If datediff("d",trs(1),Now())=0 Then todaynum=todaynum+1
				Mybbs.Execute("update "&Mybbs.NowUsebbs&" set boardid=locktopic,locktopic=0 where Announceid="&id)
				Mybbs.Execute("update [dv_user] set userpost=userpost+1,userWealth=userWealth+"&Mybbs.Forum_user(2)&",UserEP=UserEP+"&Mybbs.Forum_user(7)&",UserCP=UserCP+"&Mybbs.Forum_user(12)&" where userid="&trs(2))
				IsEndReply(trs(0))
				End If
			End If
		End If
	next
	Set Rs=Nothing
	'更新论坛总数据和版面数据
	If CInt(request("actiontype"))=1 Then update Mybbs.boardid,bbsnum,topicnum,todaynum
	Mybbs.Dvbbs_Suc("<li>帖子操作成功.")
End Sub 

'是否最后回复
Function IsEndReply(TopicID)
	isEndReply=false
	Dim trs
	Dim LastPostInfo,iTotalUseTable
	Dim LastTopic,body,LastRootid,LastPostTime,LastPostUser
	Dim LastPost,uploadpic_n,LastPostUserID,LastID,istop
	set trs=Mybbs.Execute("select LastPost,PostTable,istop from dv_Topic where Topicid="&Topicid)
	If not (trs.eof And trs.bof) Then
		LastPostInfo=split(trs(0),"$")
		iTotalUseTable=trs(1)
		istop=trs(2)
	End If
	set trs=Mybbs.Execute("select top 1 topic,body,Announceid,dateandtime,username,PostUserid,rootid from "&iTotalUseTable&" where (Not BoardID In (444,777)) And RootID="&TopicID&" order by Announceid desc")
	If not(trs.eof And trs.bof) Then
		body=trs(1)
		LastRootid=trs(2)
		LastPostTime=trs(3)
		LastPostUser=replace(trs(4),"$","")
		LastTopic=left(replace(body,"$",""),20)
		LastPostUserID=trs(5)
		LastID=trs(6)
	Else
		LastTopic="无"
		LastRootid=0
		LastPostTime=now()
		LastPostUser="无"
		LastPostUserID=0
		LastID=0
	End If
	LastPost=LastPostUser & "$" & LastRootid & "$" & LastPostTime & "$" & replace(left(replace(LastTopic,"'",""),20),"$","") & "$" & LastPostInfo(4) & "$" & LastPostUserID & "$" & LastID & "$" & Mybbs.boardid
	If istop=0 Then
		Mybbs.Execute("update dv_topic set LastPost='"&LastPost&"',child=child+1,LastPostTime='"&LastPostTime&"' where topicid="&TopicID)
	Else
		Mybbs.Execute("update dv_topic set LastPost='"&LastPost&"',child=child+1 where topicid="&TopicID)
	End If
	set trs=Nothing
End Function


'更新论坛总数据和版面数据
Function update(boardid,bbsnum,topicnum,todaynum)
	Dim lastpost_1,trs
	Dim LastTopic,LastRootid,LastPostTime,LastPostUser
	Dim LastPost,uploadpic_n,Lastpostuserid,Lastid
	Dim UpdateBoardID
	'本论坛和上级论坛ID
	UpdateBoardID=Mybbs.Board_Data(3,0) & "," & Mybbs.BoardID
	'版面最后回复数据
	set trs=Mybbs.Execute("select top 1 T.title,b.Announceid,b.dateandtime,b.username,b.postuserid,b.rootid from "&Mybbs.NowUsebbs&" b inner join Dv_Topic T on b.rootid=T.TopicID where b.boardid="&Mybbs.boardid&" order by b.announceid desc")
	If not(trs.eof And trs.bof) Then
		Lasttopic=replace(left(replace(trs(0),"'",""),15),"$","")
		LastRootid=trs(1)
		LastPostTime=trs(2)
		LastPostUser=trs(3)
		LastPostUserid=trs(4)
		Lastid=trs(5)
	Else
		LastTopic="无"
		LastRootid=0
		LastPostTime=now()
		LastPostUser="无"
		LastPostUserid=0
		Lastid=0
	End If
	set trs=Nothing
	LastPost=LastPostUser & "$" & LastRootid & "$" & LastPostTime & "$" & LastTopic & "$" & uploadpic_n & "$" & LastPostUserID & "$" & LastID & "$" & Mybbs.boardid
	'总版面最后回复数据
	set trs=Mybbs.Execute("select top 1 T.title,b.Announceid,b.dateandtime,b.username,b.postuserid,b.rootid from "&Mybbs.NowUsebbs&" b inner join Dv_Topic T on b.rootid=T.TopicID order by b.announceid desc")
	If not(trs.eof And trs.bof) Then
		Lasttopic=replace(left(replace(trs(0),"'",""),15),"$","")
		LastRootid=trs(1)
		LastPostTime=trs(2)
		LastPostUser=trs(3)
		LastPostUserid=trs(4)
		Lastid=trs(5)
	Else
		LastTopic="无"
		LastRootid=0
		LastPostTime=now()
		LastPostUser="无"
		LastPostUserid=0
		Lastid=0
	End If
	LastPost_1=LastPostUser & "$" & LastRootid & "$" & LastPostTime & "$" & LastTopic & "$" & uploadpic_n & "$" & LastPostUserID & "$" & LastID & "$" & Mybbs.boardid

	Dim SplitUpBoardID,SplitLastPost
	SplitUpBoardID=split(UpdateBoardID,",")
	For i=0 to ubound(SplitUpBoardID)
		set trs=Mybbs.Execute("select LastPost from dv_board where boardid="&SplitUpBoardID(i))
		If not (trs.eof And trs.bof) Then
			SplitLastPost=split(trs(0),"$")
			If isnull(SplitLastPost(1)) Then SplitLastPost(1)=0
			If ubound(SplitLastPost)=7 And clng(LastRootID)<>clng(SplitLastPost(1)) Then
				Mybbs.Execute("update dv_board set LastPost='"&LastPost&"' where boardid="&SplitUpBoardID(i))
			End If
		End If
	Next
	Mybbs.Execute("update dv_board set PostNum=PostNum+"&bbsnum&",TopicNum=TopicNum+"&TopicNum&",TodayNum=TodayNum+"&todaynum&" where boardid in ("&UpdateBoardID&")")
	Mybbs.Execute("update dv_setup set  Forum_PostNum=Forum_PostNum+"&bbsnum&",Forum_TopicNum=Forum_TopicNum+"&TopicNum&",Forum_TodayNum=Forum_TodayNum+"&todaynum&",Forum_LastPost='"&LastPost_1&"'")
	set trs=Nothing
End Function


Sub View()
	dim AnnounceID,replyid
	dim username
	If request("id")="" Then
		Response.redirect "showerr.asp?ErrCodes=<li>请指定所需参数。&action=OtherErr"
	ElseIf Not IsNumeric(request("id")) Then
		Response.redirect "showerr.asp?ErrCodes=<li>请指定所需参数。&action=OtherErr"
	Else
		AnnounceID=request("id")
	End If
	If request("replyid")="" Then
		Response.redirect "showerr.asp?ErrCodes=<li>请指定所需参数。&action=OtherErr"
	ElseIf Not IsNumeric(request("replyid")) Then
		Response.redirect "showerr.asp?ErrCodes=<li>请指定所需参数。&action=OtherErr"
	Else
		replyid=request("replyid")
	End If
	Set Rs=server.createobject("adodb.recordset")
	set rs=Mybbs.execute("select posttable from dv_topic where topicid="&announceid)
	If rs.eof and rs.bof Then
		Response.redirect "showerr.asp?ErrCodes=<li>没有找到相关信息&action=OtherErr"
	end if
	dim tablename
	tablename=rs(0)
	set rs=Mybbs.execute("select * from "&tablename&" where announceid="&replyid)
	if rs.eof and rs.bof then
		Response.redirect "showerr.asp?ErrCodes=<li>没有找到相关信息&action=OtherErr"
	end if
%>

<table cellpadding=3 cellspacing=1 border=0 align=center class=tableborder1>
<TBODY> 
<TR align=middle> 
<Th height=24><%=Mybbs.htmlencode(rs("topic"))%></Th>
</TR>
<TR> 
<TD height=24 class=tablebody1>
<p align=center><a href="dispuser.asp?name=<%=Mybbs.htmlencode(rs("username"))%>" target=_blank><%=Mybbs.htmlencode(rs("username"))%></a> 发布于 <%=rs("dateandtime")%></p>
    <blockquote>   
      <br>   
<%
response.Write server.htmlencode(rs("body"))
%>
    </blockquote>
</TD>
</TR>
<TR align=middle> 
<TD height=24 class=tablebody2> </TD>
</TR>
</TBODY>
</TABLE>
    </td>
  </tr>
</table>
<%
rs.close
Set rs=nothing
End Sub
%>