accesstopic.asp

来自「现在好了」· ASP 代码 · 共 528 行 · 第 1/2 页

ASP
528 行
字号
12
				Set Rs=Nothing 
				Dvbbs.Execute("delete from dv_topic where topicid="&ID)
				Dvbbs.Execute("delete from "&Dvbbs.NowUsebbs&" where rootid="&ID)
				FoundID=ID
				LogCase = "删除审核主题" & LogCase
			Else
				Set Rs = Dvbbs.Execute("SELECT UserName, Body FROM " & Dvbbs.NowUsebbs & " WHERE Announceid = " & Id)
				If Not (Rs.Eof And Rs.Bof) Then
					PostUser = Rs(0)
					LogCase = "《" & Left(Rs(1),26) & "…》"
				End If
				Dvbbs.Execute("delete from "&Dvbbs.NowUsebbs&" where Announceid="&id)
				FoundID=0
				LogCase = "删除审核跟帖" & LogCase
			End If
		'通过审核
		ElseIf cint(request("actiontype"))=1 Then
			LogType = 3
			Set Rs = Dvbbs.Execute("select rootid,dateandtime,PostUserID,locktopic, UserName, Topic from "&Dvbbs.NowUsebbs&" where parentid=0 And Announceid="&id)
			PostID = Id
			If not (rs.eof And rs.bof) Then
				PostUser = Rs(4)
				LogCase = "《" & Left(Rs(5),26) & "…》"
				boardID=Rs("locktopic")
				If BoardID>0 Then
					'如果被审核的是主题帖
					bbsnum=bbsnum+1
					topicnum=topicnum+1
					If datediff("d",rs(1),Now())=0 Then todaynum=todaynum+1
					Dvbbs.Execute("update dv_topic set boardid=locktopic,locktopic=0 where topicid="&rs(0))
					Dvbbs.Execute("update "&Dvbbs.NowUsebbs&" set boardid=locktopic,locktopic=0 where Announceid="&id)
					Dvbbs.Execute("update [dv_user] set userpost=userpost+1,userWealth=userWealth+"&Dvbbs.Forum_user(2)&",UserEP=UserEP+"&Dvbbs.Forum_user(7)&",UserCP=UserCP+"&Dvbbs.Forum_user(12)&" where userid="&rs(2))
				End If
				LogCase = "通过审核主题" & LogCase
			Else
				set trs=Dvbbs.Execute("select rootid,dateandtime,PostUserID,locktopic, UserName, Body from "&Dvbbs.NowUsebbs&" where Announceid="&id)
				If not (trs.eof And trs.bof) Then
					PostUser = Trs(4)
					LogCase = "《" & Left(Trs(5),26) & "…》"
					boardID=TRs("locktopic")
					If BoardID>0 Then
						'更新主题最后回复数据和回复数
						bbsnum=bbsnum+1
						topicnum=topicnum+1
						If datediff("d",trs(1),Now())=0 Then todaynum=todaynum+1
						Dvbbs.Execute("update "&Dvbbs.NowUsebbs&" set boardid=locktopic,locktopic=0 where Announceid="&id)
						Dvbbs.Execute("update [dv_user] set userpost=userpost+1,userWealth=userWealth+"&Dvbbs.Forum_user(2)&",UserEP=UserEP+"&Dvbbs.Forum_user(7)&",UserCP=UserCP+"&Dvbbs.Forum_user(12)&" where userid="&trs(2))
						IsEndReply(trs(0))
					End If
				End If
				LogCase = "通过审核跟帖" & LogCase
			End If
		End If
		'加载论坛事件 2005-5-13 Dv.Yz
		Dvbbs.Execute("Insert Into Dv_Log (l_AnnounceID,l_BoardID,l_touser,l_username,l_content,l_ip,l_type) values (" & PostID & "," & Dvbbs.BoardID & ",'" & Dvbbs.CheckStr(PostUser) & "','" & Dvbbs.MemberName & "','" & Dvbbs.CheckStr(LogCase) & "','" & Dvbbs.UserTrueIP & "',"&LogType&")")
		If BoardId<>0 Then
			update boardid,bbsnum,topicnum,todaynum
		End If
	next
	Set Rs=Nothing
	'更新论坛总数据和版面数据
	'If CInt(request("actiontype"))=1 Then update Dvbbs.boardid,bbsnum,topicnum,todaynum
	Dvbbs.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=Dvbbs.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=Dvbbs.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 & "$" & Dvbbs.boardid
	If istop=0 Then
		Dvbbs.Execute("update dv_topic set LastPost='"&LastPost&"',child=child+1,LastPostTime='"&LastPostTime&"' where topicid="&TopicID)
	Else
		Dvbbs.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
	Dim BoardNode
	BoardNode=GetBoard_info(BoardID,1)
	If BoardNode<>"" Then
		UpdateBoardID= BoardNode & "," & BoardID
	Else
		UpdateBoardID= BoardID
	End If
	'版面最后回复数据
	set trs=Dvbbs.Execute("select top 1 T.title,b.Announceid,b.dateandtime,b.username,b.postuserid,b.rootid from "&Dvbbs.NowUsebbs&" b inner join Dv_Topic T on b.rootid=T.TopicID where b.boardid="&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 & "$" & boardid
	'总版面最后回复数据
	set trs=Dvbbs.Execute("select top 1 T.title,b.Announceid,b.dateandtime,b.username,b.postuserid,b.rootid from "&Dvbbs.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 & "$" & boardid

	Dim SplitUpBoardID,SplitLastPost
	SplitUpBoardID=split(UpdateBoardID,",")
	For i=0 to ubound(SplitUpBoardID)
		set trs=Dvbbs.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
				Dvbbs.Execute("update dv_board set LastPost='"&LastPost&"' where boardid="&SplitUpBoardID(i))
			End If
		End If
	Next
	Dvbbs.Execute("update dv_board set PostNum=PostNum+"&bbsnum&",TopicNum=TopicNum+"&TopicNum&",TodayNum=TodayNum+"&todaynum&" where boardid in ("&UpdateBoardID&")")
	Dvbbs.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
	'更新缓存数据
	Dvbbs.ReloadBoardInfo(UpdateBoardID)
	Dvbbs.ReloadSetupCache CLng(Dvbbs.CacheData(7,0))+TopicNum,7
	Dvbbs.ReloadSetupCache CLng(Dvbbs.CacheData(8,0))+bbsnum,8
	Dvbbs.ReloadSetupCache CLng(Dvbbs.CacheData(9,0))+todaynum,9
	Dvbbs.ReloadSetupCache LastPost_1,15
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=dvbbs.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=dvbbs.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><%=Dvbbs.htmlencode(rs("topic"))%></Th>
</TR>
<TR> 
<TD height=24 class=tablebody1>
<p align=center><a href="dispuser.asp?name=<%=Dvbbs.htmlencode(rs("username"))%>" target=_blank><%=Dvbbs.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
Function GetAllPostTable()
	Dim Rs
	Set Rs=Dvbbs.Execute("select * from [Dv_TableList]")
	GetAllPostTable=Rs.GetRows(-1)
	Set Rs=Nothing
End Function

Function GetBoard_info(BoardID,iStr)
	Dim Nodelist,node
		Set Nodelist=Dvbbs.BoardXML.documentElement.getElementsByTagName("board")
		For Each Node in nodelist
			If Cstr(BoardId)=Node.attributes.getNamedItem("boardid").text Then
				'Set GetBoard_info=Node
				If iStr=0 Then
				GetBoard_Info=Node.attributes.getNamedItem("boardtype").text
				Else
				GetBoard_Info=Node.attributes.getNamedItem("parentstr").text
				End If
				Exit For
			End If		
		Next
		If iStr=0 Then
			'BoardNode.attributes.getNamedItem("parentstr").text
			If GetBoard_Info = "" Then GetBoard_Info = "已被删除的版面"
		End If
End Function
%>
12

accesstopic.asp - 源码说明

本页面展示了「现在好了」中的 accesstopic.asp 源码文件，采用 ASP 编程语言编写，共 528 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

⌨️ 快捷键说明

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