<% Dim AdminLockTopic,XMLDom,TableList,paramnode,AccessSetting Rem 审核权限设置,如果不希望版主可以审核全部贴,请屏蔽下面第一行 If Dvbbs.UserGroupID=3 Then Dvbbs.Boardmaster=True Rem ======================================================= AdminLockTopic=False If (Dvbbs.master or Dvbbs.superboardmaster or Dvbbs.boardmaster) And Cint(Dvbbs.GroupSetting(36))=1 Then AdminLockTopic=True Else AdminLockTopic=False End If If Cint(Dvbbs.GroupSetting(36))=1 And Dvbbs.UserGroupID>3 Then AdminLockTopic=True End If If Dvbbs.FoundUserPer And Cint(Dvbbs.GroupSetting(36))=1 Then AdminLockTopic=true ElseIf Dvbbs.FoundUserPer And Cint(Dvbbs.GroupSetting(36))=0 Then AdminLockTopic=False End If If Not AdminLockTopic Then Response.redirect "showerr.asp?ErrCodes=
  • 您没有在本版面审核帖子的权限。&action=OtherErr" If Not Dvbbs.Master and (Request("action")="modify" Or Request("action")="save") Then Response.redirect "showerr.asp?ErrCodes=
  • 您没有修改审核设置的权限。&action=OtherErr" LoadTableList() Set paramnode=XMLDom.documentElement.appendChild(XMLDom.createNode(1,"param","")) paramnode.attributes.setNamedItem(XMLDom.createNode(2,"boardid","")).text=Dvbbs.Boardid paramnode.attributes.setNamedItem(XMLDom.createNode(2,"action","")).text=Request("action") If Dvbbs.Master Then paramnode.attributes.setNamedItem(XMLDom.createNode(2,"master","")).text=1 Dvbbs.LoadTemplates("query") Response.Write Dvbbs.mainhtml(18) If Not Dvbbs.ChkPost() Then Response.Redirect "index.asp" Select Case Request("action") Case "manage"'批量审核 Dvbbs.stats="批量审核" Dvbbs.Nav manage() If Dvbbs.BoardID=0 Then Dvbbs.Head_var 2,0,"","" Else Dvbbs.Head_var 1,Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"&Dvbbs.BoardID&"']/@depth").text,"","" End If Case "view"'查看单个审核贴 Dvbbs.stats="审核贴子" View() Dvbbs.Head() Case "modify"'审核设置管理 Dvbbs.stats="帖子审核设置管理" Dvbbs.Nav If Dvbbs.BoardID=0 Then Dvbbs.Head_var 2,0,"","" Else Dvbbs.Head_var 1,Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"&Dvbbs.BoardID&"']/@depth").text,"","" End If LoadAccessSetting Case "info"'查看当前审核规则 Dvbbs.stats="审核设置信息" Dvbbs.Nav If Dvbbs.BoardID=0 Then Dvbbs.Head_var 2,0,"","" Else Dvbbs.Head_var 1,Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"&Dvbbs.BoardID&"']/@depth").text,"","" End If LoadAccessSetting Case "save" Dvbbs.stats="保存审核设置" Dvbbs.Nav Dvbbs.Head_var 2,0,"","" SaveAccessSetting() Case "addnocheck" Dvbbs.stats="豁免审核用户" Dvbbs.Nav() Dvbbs.Head_var 2,0,"","" addnocheck Case "unlock" Dvbbs.stats="解除固封" Dvbbs.Nav() Dvbbs.Head_var 1,Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"&Dvbbs.BoardID&"']/@depth").text,"","" unlockPost() Case Else Dvbbs.stats="帖子审核" Dvbbs.Nav If Dvbbs.BoardID=0 Then Dvbbs.Head_var 2,0,"","" Else Dvbbs.Head_var 1,Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"&Dvbbs.BoardID&"']/@depth").text,"","" End If LoadAccessCount() accesslist() End Select XMLDom.documentElement.appendChild(Application(Dvbbs.CacheName&"_sboardlist").documentElement.cloneNode(True)) ShowHTML() If Request("action")="view" Then Response.Write "" Else Dvbbs.activeonline() Dvbbs.footer() End If Sub unlockPost() Dim id,replyid,rs,posttable id=Request("id") replyid=Request("replyid") If Not IsNumeric(id) Or id="" Then Response.redirect "showerr.asp?ErrCodes=
  • 请指定所需参数。&action=OtherErr" End If Id =CLng(id) If Not IsNumeric(replyid) Or replyid="" Then Response.redirect "showerr.asp?ErrCodes=
  • 请指定所需参数。&action=OtherErr" End If Set Rs=Dvbbs.Execute("select posttable From Dv_topic Where topicid="&id) If Rs.EOF Then Response.redirect "showerr.asp?ErrCodes=
  • 记录不存在。&action=OtherErr" End If posttable=Rs(0) Dvbbs.Execute("update " & Dvbbs.Checkstr(posttable) &" Set locktopic=0 where announceid="& replyid &" and rootid="&id&" and locktopic=3") 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 & "','主题编号:"& ID & ", 贴子编号:"& replyid &" ','" & Dvbbs.userTrueIP & "',3)") End Sub Function Getusergroupid(username) If Username<>"" Then Dim Rs,SQL SQL="select usergroupid From Dv_user Where username='"& Dvbbs.Checkstr(username) &"'" Set Rs=Dvbbs.Execute(SQL) If Rs.EOF Then Getusergroupid=0 Else Getusergroupid=Rs(0) End If Else Getusergroupid=0 End If End Function Sub addnocheck() Dim usergroupid,Dom,node Set Dom=Application(Dvbbs.CacheName & "_accesstopic").cloneNode(True) usergroupid=Getusergroupid(Request("username")) If usergroupid<>0 Then Set Node=Dom.documentElement.selectSingleNode("setting/checkuser[@usergroupid="&usergroupid&"]") If Not Node is Nothing Then Set Node=Dom.documentElement.selectSingleNode("setting/nocheck[username='"&Dvbbs.Checkstr(Request("username"))&"']") If Node is Nothing Then For Each node in Dom.documentElement.selectNodes("setting") Node.selectSingleNode("nocheck").appendChild(Dom.createNode(1,"username","")).text=Request("username") Next End If End If End If '删除已经不在审核组的用户的免审核数据 For Each Node in Dom.documentElement.selectNodes("setting/nocheck/username") usergroupid=Getusergroupid(node.text) If usergroupid=0 Then node.parentNode.removeChild(node) Else If Dom.documentElement.selectSingleNode("setting/checkuser[@usergroupid="&usergroupid&"]") is Nothing Then node.parentNode.removeChild(node) End If End If Next Dvbbs.Execute("update Dv_setup Set Forum_BoardXML='"&Dvbbs.Checkstr(Dom.xml)&"'") Set Application(Dvbbs.CacheName & "_accesstopic")=Dom.cloneNode(True) 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(Request("username")) & "','" & Dvbbs.userTrueIP & "',3)") End Sub Sub SaveAccessSetting() If Request.form("action")="" Then Exit Sub Dim id,node,Dom,node1,queststr,checkuser,node2 Set Dom=Server.CreateObject("Msxml2.FreeThreadedDOMDocument" & MsxmlVersion) Dom.appendChild(Dom.createElement("accesspost")) For Each id in Request("id") Set Node=Dom.documentElement.appendChild(Dom.createNode(1,"setting","")) Node.attributes.setNamedItem(Dom.createNode(2,"type","")).text=Request("setting_"&id&"_type") queststr=Request("setting_"&id&"_use") If queststr="" Then queststr="0" Node.attributes.setNamedItem(Dom.createNode(2,"use","")).text=queststr Set Node1=Node.appendChild(Dom.createNode(1,"check","")) queststr=Request("setting_"&id&"_check_new") If queststr="" Then queststr="0" Node1.attributes.setNamedItem(Dom.createNode(2,"new","")).text=queststr queststr=Request("setting_"&id&"_check_re") If queststr="" Then queststr="0" Node1.attributes.setNamedItem(Dom.createNode(2,"re","")).text=queststr queststr=Request("setting_"&id&"_check_edit") If queststr="" Then queststr="0" Node1.attributes.setNamedItem(Dom.createNode(2,"edit","")).text=queststr For Each checkuser in Request("setting_"&id&"_checkuser") Set Node1=Node.appendChild(Dom.createNode(1,"checkuser","")) Node1.attributes.setNamedItem(Dom.createNode(2,"usergroupid","")).text=Request("setting_"&id&"_checkuser_"&checkuser&"_usergroupid") queststr=Request("setting_"&id&"_checkuser_"&checkuser&"_use") If queststr="" Then queststr="0" Node1.attributes.setNamedItem(Dom.createNode(2,"use","")).text=queststr Set node2=Node1.appendChild(Dom.createNode(1,"usertopic","")) Node2.attributes.setNamedItem(Dom.createNode(2,"value","")).text=Request("setting_"&id&"_checkuser_"&checkuser&"_usertopic") queststr=Request("setting_"&id&"_checkuser_"&checkuser&"_usertopic_use") If queststr="" Then queststr="0" Node2.attributes.setNamedItem(Dom.createNode(2,"use","")).text=queststr Set node2=Node1.appendChild(Dom.createNode(1,"userpost","")) Node2.attributes.setNamedItem(Dom.createNode(2,"value","")).text=Request("setting_"&id&"_checkuser_"&checkuser&"_userpost") queststr=Request("setting_"&id&"_checkuser_"&checkuser&"_userpost_use") If queststr="" Then queststr="0" Node2.attributes.setNamedItem(Dom.createNode(2,"use","")).text=queststr Set node2=Node1.appendChild(Dom.createNode(1,"regdate","")) Node2.attributes.setNamedItem(Dom.createNode(2,"value","")).text=Request("setting_"&id&"_checkuser_"&checkuser&"_regdate") queststr=Request("setting_"&id&"_checkuser_"&checkuser&"_regdate_use") If queststr="" Then queststr="0" Node2.attributes.setNamedItem(Dom.createNode(2,"use","")).text=queststr Set node2=Node1.appendChild(Dom.createNode(1,"userdel","")) Node2.attributes.setNamedItem(Dom.createNode(2,"value","")).text=Request("setting_"&id&"_checkuser_"&checkuser&"_userdel") queststr=Request("setting_"&id&"_checkuser_"&checkuser&"_userdel_use") If queststr="" Then queststr="0" Node2.attributes.setNamedItem(Dom.createNode(2,"use","")).text=queststr Set node2=Node1.appendChild(Dom.createNode(1,"lockuser","")) queststr=Request("setting_"&id&"_checkuser_"&checkuser&"_lockuser_use") If queststr="" Then queststr="0" Node2.attributes.setNamedItem(Dom.createNode(2,"use","")).text=queststr Set node2=Node1.appendChild(Dom.createNode(1,"checkcontent","")) queststr=Request("setting_"&id&"_checkuser_"&checkuser&"_checkcontent_use") If queststr="" Then queststr="0" Node2.attributes.setNamedItem(Dom.createNode(2,"use","")).text=queststr Next Set Node1=Node.appendChild(Dom.createNode(1,"checkcontent","")) Set node2=Node1.appendChild(Dom.createNode(1,"checkpic","")) queststr=Request("setting_"&id&"_checkcontent_checkpic_use") If queststr="" Then queststr="0" Node2.attributes.setNamedItem(Dom.createNode(2,"use","")).text=queststr Set node2=Node1.appendChild(Dom.createNode(1,"checklink","")) queststr=Request("setting_"&id&"_checkcontent_checklink_use") If queststr="" Then queststr="0" Node2.attributes.setNamedItem(Dom.createNode(2,"use","")).text=queststr Set node2=Node1.appendChild(Dom.createNode(1,"checkflash","")) queststr=Request("setting_"&id&"_checkcontent_checkflash_use") If queststr="" Then queststr="0" Node2.attributes.setNamedItem(Dom.createNode(2,"use","")).text=queststr Set node2=Node1.appendChild(Dom.createNode(1,"checkmp","")) queststr=Request("setting_"&id&"_checkcontent_checkmp_use") If queststr="" Then queststr="0" Node2.attributes.setNamedItem(Dom.createNode(2,"use","")).text=queststr Set node2=Node1.appendChild(Dom.createNode(1,"checkrm","")) queststr=Request("setting_"&id&"_checkcontent_checkrm_use") If queststr="" Then queststr="0" Node2.attributes.setNamedItem(Dom.createNode(2,"use","")).text=queststr queststr=Request("setting_"&id&"_checkcontent_checkword") If queststr <>"" Then queststr=split(queststr,vbnewline) For Each Node2 in queststr If node2<>"" Then Node1.appendChild(Dom.createNode(1,"checkword","")).attributes.setNamedItem(Dom.createNode(2,"content","")).text=Node2 End If Next End If Set Node1=Node.appendChild(Dom.createNode(1,"nocheck","")) queststr=Request("setting_"&id&"_nocheck") If queststr <>"" Then queststr=split(queststr,vbnewline) For Each Node2 in queststr If node2<>"" Then Node1.appendChild(Dom.createNode(1,"username","")).text=Node2 End If Next End If Next Dvbbs.Execute("update Dv_setup Set Forum_BoardXML='"&Dvbbs.Checkstr(Dom.xml)&"'") Dvbbs.LoadSetup() 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.userTrueIP & "',3)") End Sub Sub LoadAccessSetting() Dim dom,Node,i,position,position1,node1 Set Dom=Application(Dvbbs.CacheName & "_accesstopic").cloneNode(True) If Request("addnew")="1" and Request("action")="modify" Then Set Node=Dom.documentElement.appendChild(Dom.createNode(1,"setting","")) Node.attributes.setNamedItem(Dom.createNode(2,"type","")).text="新建设置" Node.appendChild(Dom.createNode(1,"checkuser","")) ElseIf Request("delsetting")="1" Then Set Node=Dom.documentElement.selectNodes("setting") position=CLng(Request("position")) If position < Node.length +1 Then Dom.documentElement.removeChild(Node(position-1)) End If ElseIf Request("delusergroup")="1" Then Set Node=Dom.documentElement.selectNodes("setting") position=CLng(Request("position")) position1=CLng(Request("position1")) If position < Node.length +1 Then Set Node1=Node(position-1).selectNodes("checkuser") If position1 < Node1.length +1 Then Node(position-1).removeChild(Node1(position1-1)) End If End If ElseIf Request("addusergroup")="1" Then Set Node=Dom.documentElement.selectNodes("setting") position=CLng(Request("position")) If position < Node.length +1 Then Node(position-1).appendChild(Dom.createNode(1,"checkuser","")) End If End If XMLDom.documentElement.appendChild(dom.documentElement) XMLDom.documentElement.appendChild(Application(Dvbbs.CacheName &"_grouppic").documentElement.cloneNode(True)) End Sub Sub manage() Dim id,passed,replyid,i,node,posttable,LockTopic,boardid,rs,today,isvote,PollID i=1 For Each id in Request.form("id") Set Node = XMLDom.documentElement.appendChild(XMLDom.createNode(1,"result","")) If IsNumeric(id) and id<>"" Then replyid=Request("replyid")(i) passed = Request("pass_"&id&"_"& replyid) If replyid="" Then replyid=id replyid=Dvbbs.CheckNumeric(replyid) Node.attributes.setNamedItem(XMLDom.createNode(2,"rootid","")).text=id Node.attributes.setNamedItem(XMLDom.createNode(2,"announceid","")).text=replyid Rem 检查主题表是否有记录,并且取得其主贴状态 Set Rs=Dvbbs.Execute("select Boardid,LockTopic,PostTable,isvote,PollID From Dv_topic Where topicid="& id &"") If Not Rs.EOF Then posttable=Rs("posttable") LockTopic=Rs("boardid") 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),"系统[审核]","您发表的贴子已经通过审核,请点此查看" 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),"系统[审核]","您发表的贴子已经通过审核,请点此查看" 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),"系统[审核]","您发表的贴子已经通过审核,请点此查看" 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&"_sboardlist").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=
  • 请指定所需参数。&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) 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=
  • 找不到匹配记录!&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=Dvbbs.CreateXmlDoc("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 %>