%
If Not Dvbbs.master and Not Dvbbs.Superboardmaster Then Response.redirect "showerr.asp?ErrCodes=
您没有权限浏览本页。&action=OtherErr"
Server.ScriptTimeOut=999999
Dim maxcount
Dvbbs.LoadTemplates("query")
Dim XMLDom,TableList
Dim bid,keyword,tableid,posttable
Dvbbs.stats="回收站管理"
Response.Write Dvbbs.mainhtml(18)
Dvbbs.nav()
Dvbbs.Head_var 2,0,"",""
LoadTableList()
If Not Dvbbs.ChkPost() Then Dvbbs.AddErrCode(16)
Dvbbs.Showerr
If Request("action")="manage" Then
Manage_Main()
ElseIf Request("action")="view" Then
View()
ElseIf Request("action")="delpic" Then
If Not Dvbbs.Master Then
Response.redirect "showerr.asp?ErrCodes=只有管理员才可以在回收站中删除贴子.&action=OtherErr"
Response.End
Else
delpic()
End If
ElseIf Request("action")="alldel" Then
If session("flag")<>"" Or Not Dvbbs.Master Then
alldel
Else
Response.redirect "showerr.asp?ErrCodes=本操作要管理员身份并登录了后台放可完成。&action=OtherErr"
Response.End
End If
Else
Main()
End If
ShowHTML()
If Request.Form("maxcount")<>"" and Request("action")="alldel" Then
DoDel()
End If
Dvbbs.footer()
Sub Dodel()
If Request.form("dv_submit")="" Then Exit Sub
Dim i,Rs,SQL,k,isvote,PollID
Response.Flush
Response.Write ""
Response.Flush
Set Rs=Dvbbs.Execute("SELECT Top " & Maxcount & " TopicId, PostTable,isvote,PollID From Dv_Topic Where BoardId = 444 ORDER BY TopicId")
If Rs.Eof Then
DelAllRepost()
Response.Write ""
Response.Flush
Else
SQL=Rs.GetRows(-1)
maxcount=UBound(SQL,2)+1
k = maxcount \ 100
For i=0 to maxcount-1
isvote=SQL(2,i)
PollID=SQL(3,i)
Dvbbs.Execute("DELETE FROM " & Sql(1,i) & " WHERE RootId = " & Sql(0,i))
Dvbbs.Execute("DELETE From Dv_Topic WHERE TopicId = " & Sql(0,i))
If isvote=1 Then
Dvbbs.Execute("delete From Dv_vote Where voteid="& PollID &"")
End If
Response.Write ""
Response.Flush
If k > 0 Then
If (i+1) mod k = 0 Or (i+1)= maxcount Then
Response.Write ""
Response.Flush
End If
Else
If (i+1)= maxcount Then
Response.Write ""
Response.Flush
End If
End If
Next
Set Rs=Dvbbs.Execute("SELECT Count(*) From Dv_Topic Where BoardId = 444")
If Not IsNull(Rs(0)) and Rs(0) <> 0 Then
Response.Write ""
Tolog("删除"&i&"个主题")
Else
Tolog("删除"&i&"个主题,主题回收站被清空。")
DelAllRepost()
Response.Write ""
Response.Flush
End If
Response.Write ""
Response.Flush
End If
End Sub
Sub DelAllRepost()
Dim i,tmp
For i= 0 to UBound(TableList,2)
Conn.Execute "Delete From "& TableList(1,i) &" where BoardID=444",tmp
Response.Write ""
Response.Flush
Tolog("彻底删除表"& TableList(1,i) &" 中的被删回复"&tmp&"个")
Next
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 alldel()
Dim Node
Set Node = XMLDom.documentElement.appendChild(XMLDom.createNode(1,"param",""))
Node.attributes.setNamedItem(XMLDom.createNode(2,"action","")).text=Request("action")
maxcount=Request.Form("maxcount")
If maxcount="" Then maxcount=500
If Not IsNumeric(maxcount) Then maxcount=500
If CLng(maxcount) < 500 Then maxcount=500
Node.attributes.setNamedItem(XMLDom.createNode(2,"maxcount","")).text=maxcount
End Sub
Sub delpic()
Dim Node,id,replyid,rs,posttable,Boardid,sql,title,isvote,PollID
Set Node = XMLDom.documentElement.appendChild(XMLDom.createNode(1,"param",""))
Node.attributes.setNamedItem(XMLDom.createNode(2,"action","")).text=Request("action")
id=Request("id")
replyid=Request("replyid")
If Not IsNumeric(id) Then
Response.redirect "showerr.asp?ErrCodes=参数错误&action=OtherErr"
Response.End
End If
If replyid <>"" Then
If Not IsNumeric(replyid) Then
Response.redirect "showerr.asp?ErrCodes=参数错误&action=OtherErr"
Response.End
End If
End If
Set rs=Dvbbs.Execute("Select posttable,boardid,title,isvote,PollID From Dv_topic Where topicid="&Id)
If Rs.EOF Then
Response.redirect "showerr.asp?ErrCodes=记录不存在&action=OtherErr"
Exit Sub
Response.End
End If
Boardid=Rs("Boardid")
posttable=Rs("posttable")
title=Rs("title")
isvote=Rs("isvote")
PollID=Rs("PollID")
If replyid="" Then
If Boardid<>444 Then
Response.redirect "showerr.asp?ErrCodes=此主题不在回收站中,不能删除!&action=OtherErr"
Exit Sub
Response.End
End If
Dvbbs.Execute("delete From "&posttable&" Where RootID ="&ID)
Dvbbs.Execute("delete From dv_topic where topicid ="&ID)
Tolog("删除主题:"&title)
Else
Set Rs=Dvbbs.Execute("select ParentID From " &posttable &" where AnnounceID=" &CLng(replyid))
If Rs.EOF Then
Response.redirect "showerr.asp?ErrCodes=记录不存在&action=OtherErr"
Exit Sub
Response.End
Else
If Rs(0)=0 Then
If Boardid<>444 Then
Response.redirect "showerr.asp?ErrCodes=此主题不在回收站中,不能删除!&action=OtherErr"
Exit Sub
Response.End
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)
Tolog("删除主题:"&title)
Else
Dvbbs.Execute("delete From "&posttable&" Where RootID ="&ID &" and AnnounceID=" &CLng(replyid))
Tolog("删除主题:"&title&"的回复一条")
End If
End If
End If
End Sub
Sub Manage_Main()
Dim Node,Rs,posttable,Child,boardid,LockTopic,topic
Set Node = XMLDom.documentElement.appendChild(XMLDom.createNode(1,"param",""))
Node.attributes.setNamedItem(XMLDom.createNode(2,"action","")).text=Request("action")
Dim id,rootid,AnnounceID,TmpID
TmpID=replace(Replace(Request("id"),"_","")," ","")
tmpid=split(TmpID,",")
For each id in tmpid
If Not IsNumeric(id) Then
Response.redirect "showerr.asp?ErrCodes=参数错误&action=OtherErr"
Exit For
Response.End
End If
Next
For each tmpid in Request("id")
Set Node = XMLDom.documentElement.appendChild(XMLDom.createNode(1,"result",""))
id=Split(tmpid,"_")
rootid=CLng(id(0))
AnnounceID=id(1)
If AnnounceID="" Then AnnounceID=rootid
Node.attributes.setNamedItem(XMLDom.createNode(2,"rootid","")).text=rootid
Node.attributes.setNamedItem(XMLDom.createNode(2,"announceid","")).text=AnnounceID
Rem 检查主题表是否有记录,并且取得其主贴状态
Set Rs=Dvbbs.Execute("select Boardid,LockTopic,PostTable From Dv_topic Where topicid="& rootid &" and boardid<> 777")
If Rs.EOF Then
Node.attributes.setNamedItem(XMLDom.createNode(2,"topic","")).text=0
Node.attributes.setNamedItem(XMLDom.createNode(2,"child","")).text=0
Node.attributes.setNamedItem(XMLDom.createNode(2,"stats","")).text="失败,原因:找不到相关记录。"
Else
posttable=Rs("posttable")
LockTopic=Rs("boardid")
boardid=rs("LockTopic")
If AnnounceID=rootid Then 'AnnounceID=rootid说明要还原的是主题
If LockTopic=444 Then
Set Rs=Dvbbs.Execute("Select Count(*) From " & posttable &" where RootID="& Rootid &" and boardid<> 777")
Child=Rs(0)
If IsNull(Child) Then Child=1
Child=Child-1
Node.attributes.setNamedItem(XMLDom.createNode(2,"topic","")).text=1
Node.attributes.setNamedItem(XMLDom.createNode(2,"child","")).text=Child
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="& Rootid &" and boardid<> 777")
Dvbbs.Execute("update dv_topic Set boardid="&boardid&",LockTopic=0,Child="&Child&" Where topicid="& rootid)
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,"stats","")).text="失败,原因:主题不在回收站中。"
End If
Else
Set Rs=Dvbbs.Execute("Select ParentID From " & posttable &" where RootID="& Rootid &" and AnnounceID="& AnnounceID &" and boardid=444")
If Rs.EOF Then
Node.attributes.setNamedItem(XMLDom.createNode(2,"topic","")).text=0
Node.attributes.setNamedItem(XMLDom.createNode(2,"child","")).text=0
Node.attributes.setNamedItem(XMLDom.createNode(2,"stats","")).text="失败,原因:此贴不在回收站中。"
Else
If Rs(0)=0 Then '主题贴,还原单个主题贴。跟贴不还原。
Child=0
If LockTopic <> 444 Then
boardid=LockTopic
End If
Dvbbs.Execute("update dv_topic Set boardid="&boardid&",LockTopic=0,Child="&Child&" Where topicid="& rootid)
Dvbbs.Execute("update " & posttable &" set boardid="&boardid&",LockTopic=0 Where RootID="& Rootid &" and AnnounceID="& AnnounceID)
Node.attributes.setNamedItem(XMLDom.createNode(2,"topic","")).text=1
Node.attributes.setNamedItem(XMLDom.createNode(2,"child","")).text=Child
Node.attributes.setNamedItem(XMLDom.createNode(2,"boardid","")).text=boardid
Node.attributes.setNamedItem(XMLDom.createNode(2,"stats","")).text="成功。"
Else
If LockTopic <> 444 Then
boardid=LockTopic
Dvbbs.Execute("update " & posttable &" set boardid="&boardid&",LockTopic=0 Where RootID="& Rootid &" and AnnounceID="& AnnounceID)
Dvbbs.Execute("update dv_topic Set boardid="&boardid&",LockTopic=0,Child=Child+1 Where topicid="& rootid)
Node.attributes.setNamedItem(XMLDom.createNode(2,"topic","")).text=0
Node.attributes.setNamedItem(XMLDom.createNode(2,"child","")).text=1
Node.attributes.setNamedItem(XMLDom.createNode(2,"boardid","")).text=boardid
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,"stats","")).text="失败,原因:主题贴还在回收站中,请先还原主题。"
End If
End If
End If
End If
End If
Next
Dim allpost,alltopic
allpost=0
alltopic=0
'统计一下更新情况
For each boardid in Application(Dvbbs.CacheName&"_sboardlist").documentElement.selectNodes("board/@boardid")
Set Node =XMLDom.documentElement.selectNodes("result[@boardid="& boardid.text &"]")
If Node.length > 0 Then
topic=0
Child=0
For Each TmpID in node
topic=topic+CLng(tmpid.selectSingleNode("@topic").text)
Child=Child+CLng(tmpid.selectSingleNode("@child").text)
Next
If topic+Child >0 Then
alltopic=alltopic+topic
allpost=allpost+topic+Child
UpDate_BoardInfoAndCache BoardID.text,topic,Child
End If
End If
Next
If allpost >0 Or alltopic >0 Then
Dvbbs.Execute("update dv_setup Set forum_postNum=forum_postNum+"& allpost &",forum_TopicNum=forum_topicNum +"& alltopic )
Dvbbs.loadSetup
End If
Tolog("还原主题:"&alltopic&"个,贴子"& allpost &"条")
End Sub
Sub Main()
bid=Request("bid")
If Not IsNumeric(BID) Then bid="0"
If bid="" Then bid="0"
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"))
posttable="dv_topic"
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
End If
If posttable="dv_topic" Then tableid="0"
Page=Request("Page")
If Not IsNumeric(Page) Then Page="1"
If Page="" Then Page="1"
Page=CLng(Page)
'传送参数到xml
Pagesize=30'手工设置每页最大显示30条
Set Node = XMLDom.documentElement.appendChild(XMLDom.createNode(1,"param",""))
Node.attributes.setNamedItem(XMLDom.createNode(2,"bid","")).text=bid
Node.attributes.setNamedItem(XMLDom.createNode(2,"tableid","")).text=tableid
Node.attributes.setNamedItem(XMLDom.createNode(2,"keyword","")).text=keyword
Node.attributes.setNamedItem(XMLDom.createNode(2,"pagesize","")).text=Pagesize
Node.attributes.setNamedItem(XMLDom.createNode(2,"posttable","")).text=posttable
Node.attributes.setNamedItem(XMLDom.createNode(2,"action","")).text=Request("action")
If session("flag")<>"" Then
Node.attributes.setNamedItem(XMLDom.createNode(2,"admin","")).text=1
End If
'根据页面参数产生查询代码
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=444 "
SQL1= SQL1 &" Where Boardid=444 "
If Bid <> "0" Then
SQL= SQL &"and LockTopic="&bid&" "
SQL1= SQL1 &"and LockTopic="&bid&" "
End If
If keyword<>"" Then
SQL= SQL & tmpsql
SQL1= SQL1 & tmpsql
End If
If tableid="0" Then
SQL= SQL &" order by topicid desc"
Else
SQL= SQL &" order by AnnounceID desc"
End If
Set Rs=Dvbbs.Execute(SQL1)
Node.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
Node.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
XMLDom.documentElement.appendChild(Application(Dvbbs.CacheName&"_sboardlist").documentElement.cloneNode(True))
End Sub
Sub View()
Dim Node,id,replyid,Rs,posttable,SQL
Set Node = XMLDom.documentElement.appendChild(XMLDom.createNode(1,"param",""))
Node.attributes.setNamedItem(XMLDom.createNode(2,"action","")).text=Request("action")
If Dvbbs.Master Then
Node.attributes.setNamedItem(XMLDom.createNode(2,"master","")).text=1
End If
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=请指定所需参数。&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=记录不存在!&action=OtherErr"
Else
posttable=Rs(0)
Node.attributes.setNamedItem(XMLDom.createNode(2,"boardid","")).text=Rs(1)
If replyid=0 Then
SQL="Select * From "&posttable & " where rootid="&ID&" and ParentID=0 and Boardid=444"
Else
SQL="Select * From "&posttable & " where rootid="&ID&" and AnnounceID="&replyid&"and Boardid=444"
End If
Set Rs=Dvbbs.Execute(SQL)
If Rs.EOF Then
Response.redirect "showerr.asp?ErrCodes=找不到匹配记录!&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(1)
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 UpDate_BoardInfoAndCache(BoardID,topic,Child)
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
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,0,'回收站','" & Dvbbs.MemberName & "','" & Dvbbs.CheckStr(Info) & "','" & Dvbbs.userTrueIP & "',0)")
End Sub
%>