accesstopic.asp

公司企业网站管理系统全站源码,用于企业内部对网站的管理

				isvote=Rs("isvote")
				PollID=Rs("PollID")
				today=0
				If Passed="1" Then
					Rem 通过审核
					If replyid=id Then
						Set Rs=Dvbbs.Execute("select dateandtime,PostUserid,LockTopic From "& posttable &" Where RootID="& id &" and Boardid=777")
						If Not Rs.EOF Then 
							boardid=rs("LockTopic")
							If datediff("d",rs(0),Now()) =0 Then today=1
							Node.attributes.setNamedItem(XMLDom.createNode(2,"topic","")).text=1
							Node.attributes.setNamedItem(XMLDom.createNode(2,"child","")).text=0
							Node.attributes.setNamedItem(XMLDom.createNode(2,"today","")).text=today
							Node.attributes.setNamedItem(XMLDom.createNode(2,"boardid","")).text=boardid
							Node.attributes.setNamedItem(XMLDom.createNode(2,"stats","")).text="通过审核成功。"
							Dvbbs.Execute("update " & posttable &" set boardid="&boardid&",LockTopic=0 Where RootID="& id &" and ParentID=0 and Boardid=777")
							Dvbbs.Execute("update dv_topic Set boardid="&boardid&",LockTopic=0,Child=0  Where topicid="& id &" and Boardid=777")
							UpdatepostUser  rs(1),boardid,1
							If Rs(1)<>0 Then Dvbbs.Sendmessanger Rs(1),"系统[审核]","您发表的贴子已经通过审核，请<a href=""dispbbs.asp?boardid="& boardid&"&amp;id="&id&""" target=""_blank"">点此查看</a>"
						Else
								Node.attributes.setNamedItem(XMLDom.createNode(2,"topic","")).text=0
								Node.attributes.setNamedItem(XMLDom.createNode(2,"child","")).text=0
								Node.attributes.setNamedItem(XMLDom.createNode(2,"today","")).text=0
								Node.attributes.setNamedItem(XMLDom.createNode(2,"stats","")).text="失败，原因：找不到相关记录，数据可能已经被别的管理人员处理了。"
						End If
					Else
						Set Rs=Dvbbs.Execute("select dateandtime,PostUserid,ParentID,LockTopic From "& posttable &" Where RootID="& id &" and AnnounceID="&replyid&" and  Boardid=777")
						If Not Rs.EOF Then
							If datediff("d",rs(0),Now())=0 Then today=1
							boardid=rs("LockTopic")
							Node.attributes.setNamedItem(XMLDom.createNode(2,"topic","")).text=0
							Node.attributes.setNamedItem(XMLDom.createNode(2,"child","")).text=1
							Node.attributes.setNamedItem(XMLDom.createNode(2,"today","")).text=today
							Node.attributes.setNamedItem(XMLDom.createNode(2,"boardid","")).text=boardid
							Node.attributes.setNamedItem(XMLDom.createNode(2,"stats","")).text="通过审核成功。"
							If Rs("ParentID")=0 Then
								Dvbbs.Execute("update " & posttable &" set boardid="&boardid&",LockTopic=0 Where RootID="& id &" and ParentID=0")
								Dvbbs.Execute("update dv_topic Set boardid="&boardid&",LockTopic=0,Child=0  Where topicid="& id)
								UpdatepostUser  rs(1),boardid,1
								If Rs(1)<>0 Then Dvbbs.Sendmessanger Rs(1),"系统[审核]","您发表的贴子已经通过审核，请<a href=""dispbbs.asp?boardid="& boardid&"&amp;id="&id&""" target=""_blank"">点此查看</a>"
							Else
								Dvbbs.Execute("update " & posttable &" set boardid="&boardid&",LockTopic=0 Where RootID="& id &" and AnnounceID="&replyid )
								Dvbbs.Execute("update dv_topic Set boardid="&boardid&",LockTopic=0,Child=Child+1  Where topicid="& id)
								UpdatepostUser  rs(1),boardid,0
								If Rs(1)<>0 Then Dvbbs.Sendmessanger Rs(1),"系统[审核]","您发表的贴子已经通过审核，请<a href=""dispbbs.asp?boardid="& boardid&"&amp;id="&id&"&amp;skin=1&amp;replyid="&replyid&""" target=""_blank"">点此查看</a>"
							End If
						Else
								Node.attributes.setNamedItem(XMLDom.createNode(2,"topic","")).text=0
								Node.attributes.setNamedItem(XMLDom.createNode(2,"child","")).text=0
								Node.attributes.setNamedItem(XMLDom.createNode(2,"today","")).text=0
								Node.attributes.setNamedItem(XMLDom.createNode(2,"stats","")).text="失败，原因：找不到相关记录,数据可能已经被别的管理人员处理了。"
						End If
					End If
				ElseIf Passed="0" Then
					Rem 删除
					If replyid=id Then
						Set Rs=Dvbbs.Execute("select PostUserid From "& posttable &" Where RootID="& id &"")
						If Not Rs.EOF Then
							If Rs(0)<>0 Then Dvbbs.Sendmessanger Rs(0),"系统[审核]","您发表的贴子未能通过审核，请注意您发表的内容。"
						End If
						If isvote=1 Then
							Dvbbs.Execute("delete From Dv_vote  Where voteid="& PollID &"")
						End If
						Dvbbs.Execute("delete From " & posttable &"  Where RootID="& id &"")
						Dvbbs.Execute("delete From dv_topic Where topicid="& id)
					Else
						Set Rs=Dvbbs.Execute("select ParentID,PostUserid From "& posttable &" Where RootID="& id &" and AnnounceID="&replyid )
						If Not Rs.EOF Then
							If Rs(1)<>0 Then Dvbbs.Sendmessanger Rs(1),"系统[审核]","您发表的贴子未能通过审核，请注意您发表的内容。"
							If  Rs(0) <> 0 Then 
								Dvbbs.Execute("delete From " & posttable &"  Where RootID="& id &" and AnnounceID="&replyid)
							Else
								Dvbbs.Execute("delete From " & posttable &"  Where RootID="& id &"")
								Dvbbs.Execute("delete From dv_topic Where topicid="& id)
								If isvote=1 Then
									Dvbbs.Execute("delete From Dv_vote  Where voteid="& PollID &"")
								End If
							End If
						End If
					End If
					'清除上传附件 2005-12-5 Dv.Yz
					Dvbbs.Execute("UPDATE Dv_Upfile SET F_Flag = 4 WHERE F_AnnounceID = '" & Id & "|" & Replyid & "'")
					Node.attributes.setNamedItem(XMLDom.createNode(2,"topic","")).text=0
					Node.attributes.setNamedItem(XMLDom.createNode(2,"child","")).text=0
					Node.attributes.setNamedItem(XMLDom.createNode(2,"today","")).text=0
					Node.attributes.setNamedItem(XMLDom.createNode(2,"stats","")).text="删除待审核贴成功。"
				Else
					Node.attributes.setNamedItem(XMLDom.createNode(2,"topic","")).text=0
					Node.attributes.setNamedItem(XMLDom.createNode(2,"child","")).text=0
					Node.attributes.setNamedItem(XMLDom.createNode(2,"today","")).text=0
					Node.attributes.setNamedItem(XMLDom.createNode(2,"stats","")).text="待审，您没有对该贴进行处理。"
				End If
			Else
				Node.attributes.setNamedItem(XMLDom.createNode(2,"topic","")).text=0
				Node.attributes.setNamedItem(XMLDom.createNode(2,"child","")).text=0
				Node.attributes.setNamedItem(XMLDom.createNode(2,"today","")).text=0
				Node.attributes.setNamedItem(XMLDom.createNode(2,"stats","")).text="失败，原因：找不到相关记录。"
			End If
		Else
			Node.attributes.setNamedItem(XMLDom.createNode(2,"topic","")).text=0
			Node.attributes.setNamedItem(XMLDom.createNode(2,"child","")).text=0
			Node.attributes.setNamedItem(XMLDom.createNode(2,"today","")).text=0
			Node.attributes.setNamedItem(XMLDom.createNode(2,"stats","")).text="失败，原因：参数错误。"
		End If
		i=i+1
	Next
		Dim allpost,alltopic,alltoday,topic,Child,TmpID
	allpost=0
	alltopic=0
	alltoday=0
	'统计一下更新情况
	For each boardid in Application(Dvbbs.CacheName&"_boardlist").documentElement.selectNodes("board/@boardid")
		Set Node =XMLDom.documentElement.selectNodes("result[@boardid="& boardid.text &"]")
		If Node.length > 0 Then
			topic=0
			Child=0
			today=0
			For Each TmpID in node
				topic=topic+CLng(tmpid.selectSingleNode("@topic").text)
				Child=Child+CLng(tmpid.selectSingleNode("@child").text)
				today=today+CLng(tmpid.selectSingleNode("@today").text)
			Next
			If topic+Child >0 Then
				alltopic=alltopic+topic
				allpost=allpost+topic+Child
				alltoday=alltoday+today
				UpDate_BoardInfoAndCache BoardID.text,topic,Child,today
			End If
		End If
	Next
	If allpost >0 Or alltopic >0 or alltoday >0  Then
		Dvbbs.Execute("update dv_setup Set forum_postNum=forum_postNum+"& allpost &",forum_TopicNum=forum_topicNum +"& alltopic &",Forum_TodayNum=Forum_TodayNum +"& alltoday )
		Dvbbs.loadSetup
	End If
	Tolog("批量审核")
End Sub
Sub View()
	Dim Node,id,replyid,Rs,posttable,SQL
	id=Request("id")
	replyid=Request("replyid")
	If Not IsNumeric(replyid) Or replyid="" Then replyid=0
	If Not IsNumeric(id) Or id="" Then
		Response.redirect "showerr.asp?ErrCodes=<li>请指定所需参数。&action=OtherErr"
	End If
	Id =CLng(id)
	Set rs=Dvbbs.Execute("Select posttable,boardid From Dv_topic Where topicid="&Id)
	If Rs.EOF Then
			Response.redirect "showerr.asp?ErrCodes=<li>记录不存在！&action=OtherErr"
	Else
		posttable=Rs(0)
		If replyid=0 Then
			SQL="Select * From "&posttable & " where rootid="&ID&" and ParentID=0 and Boardid=777"
		Else
			SQL="Select * From "&posttable & " where rootid="&ID&" and AnnounceID="&replyid&"and Boardid=777"
		End If
		Set Rs=Dvbbs.Execute(SQL)
		If Rs.EOF Then
			Response.redirect "showerr.asp?ErrCodes=<li>找不到匹配记录！&action=OtherErr"
		Else
			XMLDom.documentElement.appendChild(Dvbbs.RecordsetToxml(rs,"row","").documentElement.firstChild)
		End If
	End If
End Sub
Sub ShowHTML()
	Dim xslt,proc,XMLStyle
	Set XMLStyle=Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
	XMLStyle.loadxml template.html(2)
	'XMLStyle.load Server.MapPath("inc/AccessTopic.xslt")
	Set XSLT=Server.CreateObject("Msxml2.XSLTemplate" & MsxmlVersion)
	XSLT.stylesheet=XMLStyle
	Set proc = XSLT.createProcessor()
	proc.input = XMLDom
  proc.transform()
  Response.Write  proc.output
	Set XMLDOM=Nothing
	Set XSLt=Nothing
	Set proc=Nothing	
End Sub
Sub accesslist()
	Dim Tableid,posttable
	tableid=Request("tableid")
	If Not IsNumeric(tableid) Then tableid="0"
	If Trim(tableid)="" Then tableid="0"
	Dim i,SQL,node,keyword,tmpsql,Rs,SQL1,Pagesize,Page,pagecount
	keyword=Trim(Request("keyword"))
	If Request("tableid") <> "0" Then
		posttable=LCase(Dvbbs.NowUseBBS)
	Else
		posttable="dv_topic"
	End If
	If tableid <> "0" Then
		For i= 0 to UBound(TableList,2)
			If CStr(TableList(0,i))=tableid Then
				posttable=TableList(1,i)
				Exit For
			End If
		Next
	Else
		For i= 0 to UBound(TableList,2)
			If posttable=LCase(TableList(1,i))  Then
				tableid=TableList(0,i)
				Exit For
			End If
		Next
	End If
	Page=Request("Page")
	If Not IsNumeric(Page) Then Page="1"
	If Page="" Then Page="1"
	Page=CLng(Page)
		'传送参数到xml
	Pagesize=30'手工设置每页最大显示30条
	paramnode.attributes.setNamedItem(XMLDom.createNode(2,"tableid","")).text=tableid
	paramnode.attributes.setNamedItem(XMLDom.createNode(2,"keyword","")).text=keyword
	paramnode.attributes.setNamedItem(XMLDom.createNode(2,"pagesize","")).text=Pagesize
	paramnode.attributes.setNamedItem(XMLDom.createNode(2,"posttable","")).text=posttable
	'根据页面参数产生查询代码
	keyword=Dvbbs.Checkstr(keyword)
	SQl ="Select "
	SQl1 ="Select Count(*) as length From "& posttable
	If tableid="0" Then
		SQL= SQL &"topicid as id,Title as topic,LockTopic as bid,PostUsername as username,PostUserid as userid,PostTable,DateAndTime From "& posttable
		tmpsql="and (title like '%"&keyword&"%' or PostUsername='"&keyword&"') "
	Else
		SQL= SQL &"rootid as id,topic,body,LockTopic as bid,username,PostUserid as userid,AnnounceID as replyID,DateAndTime,ParentID From "& posttable
		tmpsql="and (topic like '%"&keyword&"%' or Username='"&keyword&"') "
	End If
	SQL= SQL &" Where Boardid=777 "
	SQL1= SQL1 &" Where Boardid=777 "
	If Dvbbs.boardid <> 0 Then
		SQL= SQL &"and LockTopic="& Dvbbs.boardid &" "
		SQL1= SQL1 &"and LockTopic="& Dvbbs.boardid &" "
	End If
	If keyword<>"" Then
		SQL= SQL & tmpsql
		SQL1= SQL1 & tmpsql
	End If
	If tableid="0" Then
		SQL= SQL &" order by topicid"
	Else
		SQL= SQL &" order by AnnounceID"
	End If
	Set Rs=Dvbbs.Execute(SQL1)
	paramnode.attributes.setNamedItem(XMLDom.createNode(2,"count","")).text =Rs(0)
	'计算一下当前Page参数是否合法。如果超出范围，强制为最后一页
	If Rs(0) mod Pagesize =0 then
			PageCount= Rs(0) \ Pagesize
	Else
			PageCount= Rs(0) \ Pagesize+1
	End If
	If Page > PageCount Then Page=PageCount
	paramnode.attributes.setNamedItem(XMLDom.createNode(2,"page","")).text=Page
	If Rs(0) <> 0  and Not IsNull(Rs(0))Then
		Set Rs=Dvbbs.Execute(SQL)
		If Not page=1 Then 	Rs.Move(pagesize*(page-1))
		SQL=RS.GetRows(Pagesize)
		Set Node=Dvbbs.ArrayToxml(SQL,rs,"row","datarows")
		XMLDom.documentElement.appendChild(node.documentElement)
	End If
End Sub
Sub LoadTableList()
	Dim Rs
	Set Rs=Dvbbs.Execute("select * from [Dv_TableList]")
	TableList=Rs.GetRows(-1)
	Set XMLDom=Dvbbs.ArrayToxml(TableList,Rs,"posttable","xml")
End Sub
Sub LoadAccessCount()
	Dim Node,SQL
	If Dvbbs.Boardid > 0 Then
		SQL =" and locktopic="& Dvbbs.Boardid
	End If
	XMLDom.documentElement.attributes.setNamedItem(XMLDom.createNode(2,"count","")).text=Dvbbs.Execute("select Count(*) From Dv_topic Where boardid=777 "&SQL)(0)
	For Each Node In XMLDom.documentElement.selectNodes("posttable")
		Node.attributes.setNamedItem(XMLDom.createNode(2,"count","")).text=Dvbbs.Execute("select Count(*) From "& Node.selectSingleNode("@tablename").text &" Where boardid=777 "&SQL)(0)
	Next
End Sub
'更新用户发贴数,积分
Sub UpdatepostUser( UserID,postboardid,istopic)
	Dim Forum_user
	If Not IsObject(Application(dvbbs.CacheName &"_boarddata_" & postboardid)) Then Dvbbs.LoadBoardData postboardid
	Forum_user = Split(Application(Dvbbs.CacheName &"_boarddata_" & postboardid).documentElement.selectSingleNode("boarddata/@board_user").text,",")
	If istopic=1 Then
		Dvbbs.Execute("update [Dv_user] set UserPost=UserPost+1,UserTopic=UserTopic+1,userWealth=userWealth+"&CLng(Forum_user(1))&",userEP=userEP+"&CLng(Forum_user(6))&",userCP=userCP+"&CLng(Forum_user(11))&"  Where UserID="&userID)
	Else
		Dvbbs.Execute("update [Dv_user] set UserPost=UserPost+1,userWealth=userWealth+"&CLng(Forum_user(2))&",userEP=userEP+"&CLng(Forum_user(7))&",userCP=userCP+"&CLng(Forum_user(12))&" Where UserID="&userID)
	End If
End Sub
Sub UpDate_BoardInfoAndCache(BoardID,topic,Child,today)
		Dim UpdateBoardID,parentstr,SQL
		parentstr =Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"&BoardID&"']/@parentstr").text
		If parentstr <> "0" Then 
			UpdateBoardID= parentstr & "," & BoardID	
		Else
			UpdateBoardID=BoardID
		End If
		Dim updateboard,i
		SQL="update Dv_board set PostNum=PostNum+"&topic+Child&",TopicNum=TopicNum+"&topic&" where boardid in ("&UpdateBoardID&")"
		Dvbbs.Execute(sql)
		UpdateBoardID=Split(UpdateBoardID,",")
		For Each updateboard in UpdateBoardID
			If IsObject(Application(Dvbbs.CacheName &"_information_" & updateboard)) Then
				Application(Dvbbs.CacheName &"_information_" & updateboard).documentElement.selectSingleNode("information/@postnum").text=CLng(Application(Dvbbs.CacheName &"_information_" & updateboard).documentElement.selectSingleNode("information/@postnum").text)+topic+Child
				Application(Dvbbs.CacheName &"_information_" & updateboard).documentElement.selectSingleNode("information/@topicnum").text=CLng(Application(Dvbbs.CacheName &"_information_" & updateboard).documentElement.selectSingleNode("information/@topicnum").text)+topic
				Application(Dvbbs.CacheName &"_information_" & updateboard).documentElement.selectSingleNode("information/@todaynum").text=CLng(Application(Dvbbs.CacheName &"_information_" & updateboard).documentElement.selectSingleNode("information/@todaynum").text)+today
			End If
		Next
	End Sub
	Sub Tolog(Info)
		Dvbbs.Execute("Insert Into Dv_Log (l_AnnounceID,l_BoardID,l_touser,l_username,l_content,l_ip,l_type) values (0,"&Dvbbs.BoardID&",'审核贴子','" & Dvbbs.MemberName & "','" & Dvbbs.CheckStr(Info) & "','" & Dvbbs.userTrueIP & "',3)")
	End Sub
%>