gusucode.com > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告) > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告)\13学生论坛ASPAC\BBS\admin_postings.asp
<!--#include file="Conn.asp"--> <!-- #include file="inc/const.asp" --> <!-- #include file="inc/dv_clsother.asp" --> <% Dim FA Mybbs.LoadTemplates("fmanage") Mybbs.Stats=template.Strings(0) Mybbs.Nav() Mybbs.Showerr() If Mybbs.BoardID=0 Then Mybbs.AddErrCode(29) Mybbs.showerr() End If '修改权限判断已经在主类核心自动完成。 Mybbs.Head_var 1,Mybbs.Board_Data(4,0),"","" Set FA=New Dv_Forum_Admin FA.main Mybbs.ActiveOnline() Set Fa=Nothing Mybbs.Footer() Class Dv_Forum_Admin Public IP,ID,replyID,ActionInfo,Topic,Content,AllMsg,TopicUserID,TopicUsername,TotalUseTable Public doWealth,douserCP,douserEP,UpdateBoardID,UpdateBoardID_1 Public Rs,SQL,i Private LocalCanLockTopic,LocalCanDelTopic,LocalCanMoveTopic,LocalCanTopTopic,LocalCanBestTopic,LocalCanAwardTopic,LocalCanTopTopic_a,LocalCanTopTopic_m,LocalCanTopicMode Public title,sucmsg,LogType Public Lasttopic,Lastpost Public lastrootID,lastpostuser Private Sub Class_Initialize() Dim doWealthMsg,douserEPMsg,douserCPMsg IP = Mybbs.UserTrueIP LocalCanLockTopic = False LocalCanDelTopic = False LocalCanMoveTopic = False LocalCanTopTopic = False LocalCanBestTopic = False LocalCanAwardTopic = False LocalCanTopTopic_a = False LocalCanTopTopic_m = False LocalCanTopicMode = False '本论坛和上级论坛ID UpdateBoardID = Mybbs.Board_Data(3,0) & "," & Mybbs.BoardID doWealth = 0 douserEP = 0 douserCP = 0 doWealthMsg = "" allmsg = "没有对用户进行分值操作" If Mybbs.UserID=0 Then Mybbs.AddErrCode(34) ID=Request("ID") If ID="" or IsNumeric(ID)=0 Then Mybbs.AddErrCode(30) Else ID=Clng(ID) End If If IsNumeric(Request("replyID")) and Request("replyID")<>"" Then replyID=Request("replyID") If IsNumeric(Request("doWealth")) And Not (Request("doWealth")="0" or Request("doWealth")="") Then doWealth=Request("doWealth") doWealthMsg="金钱" & Request("doWealth") & "," End If If IsNumeric(Request("douserEP")) And Not (Request("douserEP")="0" or Request("douserEP")="") Then douserEP=Request("douserEP") douserEPMsg="经验" & Request("douserEP") & "," End If If IsNumeric(Request("douserCP")) And Not (Request("douserCP")="0" or Request("douserCP")="") Then douserCP=Request("douserCP") douserCPMsg="魅力" & Request("douserCP") End If If Not (doWealthMsg="" And douserEPMsg="" And douserCPMsg="") Then allmsg="用户操作:" & doWealthMsg & douserEPMsg & douserCPMsg If Mybbs.ErrCodes<>"" Then Mybbs.ShowErr Set Rs=Mybbs.Execute("Select Title,Postusername,PostuserID,PostTable From Dv_Topic Where boardid="&Mybbs.boardid&" and TopicID="&ID) If Rs.Eof And Rs.Bof Then Mybbs.AddErrCode(32) Else Topic=rs(0) Topicusername=rs(1) TopicuserID=Clng(rs(2)) TotalUseTable=rs(3) End If Set Rs=Nothing If Mybbs.ErrCodes<>"" Then Mybbs.ShowErr End Sub '判断用户是否有专题管理操作权限 Public Property Get CanTopicMod() If (Mybbs.master or Mybbs.superboardmaster or Mybbs.boardmaster) and Cint(Mybbs.GroupSetting(65))=1 Then CanTopicMode=True End If If Cint(Mybbs.GroupSetting(19))=1 and Mybbs.UserGroupID>3 Then LocalCanTopicMod=True End If If Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(65))=1 and TopicUserID=Mybbs.Userid Then LocalCanTopicMod=True Else LocalCanTopicMod=False End If CanTopicMod=LocalCanTopicMod End Property '判断用户是否有锁定/解除锁定权限 Public Property Get CanLockTopic() If (Mybbs.master or Mybbs.superboardmaster or Mybbs.boardmaster) and Cint(Mybbs.GroupSetting(20))=1 Then LocalCanLockTopic=True If Cint(Mybbs.GroupSetting(20))=1 and Mybbs.UserGroupID>3 Then LocalCanLockTopic=True If (Cint(Mybbs.GroupSetting(13))=1 and TopicUsername=Mybbs.MemberName) Then LocalCanLockTopic=True If Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(13))=1 and TopicUsername=Mybbs.MemberName Then LocalCanLockTopic=True ElseIf Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(13))=0 and TopicUsername=Mybbs.MemberName Then LocalCanLockTopic=False End If If Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(20))=1 and TopicUsername<>Mybbs.MemberName Then LocalCanLockTopic=True ElseIf Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(20))=0 and TopicUsername<>Mybbs.MemberName Then LocalCanLockTopic=False End If CanLockTopic=LocalCanLockTopic End Property '判断用户是否有移动帖子权限 Public Property Get CanMoveTopic() If (Mybbs.master or Mybbs.superboardmaster or Mybbs.boardmaster) and Cint(Mybbs.GroupSetting(19))=1 Then LocalCanMoveTopic=True If Cint(Mybbs.GroupSetting(19))=1 and Mybbs.UserGroupID>3 Then LocalCanMoveTopic=True If (Cint(Mybbs.GroupSetting(12))=1 and TopicUsername=Mybbs.MemberName) Then LocalCanMoveTopic=True If Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(12))=1 and TopicUsername=Mybbs.MemberName Then LocalCanMoveTopic=True ElseIf Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(12))=0 and TopicUsername=Mybbs.MemberName Then LocalCanMoveTopic=False End If If Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(19))=1 and TopicUsername<>Mybbs.MemberName Then LocalCanMoveTopic=True ElseIf Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(19))=0 and TopicUsername<>Mybbs.MemberName Then LocalCanMoveTopic=False End If CanMoveTopic=LocalCanMoveTopic End Property '判断用户是否有删除帖子权限 Public Property Get CanDelTopic() If (Mybbs.master or Mybbs.superboardmaster or Mybbs.boardmaster) and Cint(Mybbs.GroupSetting(18))=1 Then LocalCanDelTopic=True If Cint(Mybbs.GroupSetting(18))=1 and Mybbs.UserGroupID>3 Then LocalCanDelTopic=True If (Cint(Mybbs.GroupSetting(11))=1 and TopicUsername=Mybbs.MemberName) Then LocalCanDelTopic=True If Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(11))=1 and TopicUsername=Mybbs.MemberName Then LocalCanDelTopic=True ElseIf Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(11))=0 and TopicUsername=Mybbs.MemberName Then LocalCanDelTopic=False End If If Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(18))=1 and TopicUsername<>Mybbs.MemberName Then LocalCanDelTopic=True ElseIf Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(18))=0 and TopicUsername<>Mybbs.MemberName Then LocalCanDelTopic=False End If CanDelTopic=LocalCanDelTopic End Property '判断用户是否有固顶/解除固顶帖子权限 Public Property Get CanTopTopic() If (Mybbs.master or Mybbs.superboardmaster or Mybbs.boardmaster) and Cint(Mybbs.GroupSetting(21))=1 Then LocalCanTopTopic=True If Cint(Mybbs.GroupSetting(21))=1 and Mybbs.UserGroupID>3 Then LocalCanTopTopic=True If Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(21))=1 Then LocalCanTopTopic=True ElseIf Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(21))=0 Then LocalCanTopTopic=False End If CanTopTopic=LocalCanTopTopic End Property '判断用户是否有总固顶帖子权限 Public Property Get CanTopTopic_a() If (Mybbs.master or Mybbs.superboardmaster or Mybbs.boardmaster) and Cint(Mybbs.GroupSetting(38))=1 Then LocalCanTopTopic_a=True If Cint(Mybbs.GroupSetting(38))=1 and Mybbs.UserGroupID>3 Then LocalCanTopTopic_a=True If Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(38))=1 Then LocalCanTopTopic_a=True ElseIf Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(38))=0 Then LocalCanTopTopic_a=False End If CanTopTopic_a=LocalCanTopTopic_a End Property '判断用户是否有区域固顶帖子权限 Public Property Get CanTopTopic_m() If (Mybbs.master or Mybbs.superboardmaster or Mybbs.boardmaster) and Cint(Mybbs.GroupSetting(54))=1 Then LocalCanTopTopic_m=True If Cint(Mybbs.GroupSetting(54))=1 and Mybbs.UserGroupID>3 Then LocalCanTopTopic_m=True If Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(54))=1 Then LocalCanTopTopic_m=True ElseIf Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(54))=0 Then LocalCanTopTopic_m=False End If CanTopTopic_m=LocalCanTopTopic_m End Property '判断用户是否有加入/解除精华帖子权限 Public Property Get CanBestTopic() If (Mybbs.master or Mybbs.superboardmaster or Mybbs.boardmaster) and Cint(Mybbs.GroupSetting(24))=1 Then LocalCanBestTopic=True If Cint(Mybbs.GroupSetting(24))=1 and Mybbs.UserGroupID>3 Then LocalCanBestTopic=True If Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(24))=1 Then LocalCanBestTopic=True ElseIf Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(24))=0 Then LocalCanBestTopic=False End If CanBestTopic=LocalCanBestTopic End Property '判断用户是否有奖励/惩罚帖子权限 Public Property Get CanAwardTopic() If (Mybbs.master or Mybbs.superboardmaster or Mybbs.boardmaster) and Cint(Mybbs.GroupSetting(22))=1 Then LocalCanAwardTopic=True If Cint(Mybbs.GroupSetting(22))=1 and Mybbs.UserGroupID>3 Then LocalCanAwardTopic=True If Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(22))=1 Then LocalCanAwardTopic=True ElseIf Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(22))=0 Then LocalCanAwardTopic=False End If CanAwardTopic=LocalCanAwardTopic End Property Public Function Main() If Not Mybbs.ChkPost() Then Mybbs.AddErrCode(42):Mybbs.Showerr() Select Case Request("action") Case "修复" If Mybbs.userid=0 Then Mybbs.AddErrCode(28) Else ActionInfo="修复帖子" fixtopic() End If Case "lock" If not CanLockTopic Then Mybbs.AddErrCode(28) Else ActionInfo="锁定帖子" lock() End If Case "unlock" If not CanLockTopic Then Mybbs.AddErrCode(28) Else ActionInfo="解除锁定" unlock() End If Case "uptopic" If Not CanLockTopic Then Mybbs.AddErrCode(28) Else ActionInfo="提升帖子" uptopic() End If Case "move" If not CanMoveTopic Then Mybbs.AddErrCode(28) Else ActionInfo="移动帖子" Tmove() End If Case "copy" ActionInfo="复制帖子" copy() Case "istop" If CanTopTopic Or CanTopTopic_a Or CanTopTopic_m Then ActionInfo="固顶帖子" Getistop() Else Mybbs.AddErrCode(28) End If Case "delet" If not CanDelTopic Then Mybbs.AddErrCode(28) Else ActionInfo="删除帖子" delete() End If Case "dele" ActionInfo="删除帖子" dele(1) Case "islockpage" If not CanBestTopic Then Mybbs.AddErrCode(28) Else ActionInfo="单帖屏蔽" islockpage() End If Case "nolockpage" If not CanBestTopic Then Mybbs.AddErrCode(28) Else ActionInfo="解除屏蔽" nolockpage() End If Case "isbest" If not CanBestTopic Then Mybbs.AddErrCode(28) Else ActionInfo="精华帖子" isbest() End If Case "nobest" If not CanBestTopic Then Mybbs.AddErrCode(28) Else ActionInfo="解除精华" nobest() End If Case "award" If not CanAwardTopic Then Mybbs.AddErrCode(28) Else ActionInfo="奖励用户" award() End If Case "punish" If not CanAwardTopic Then Mybbs.AddErrCode(28) Else ActionInfo="惩罚用户" punish() End If Case "TopicMode" ActionInfo="专题管理" If not CanMoveTopic Then Mybbs.AddErrCode(28) TopicMode() Case "delre" ActionInfo="批量删除跟贴" Call delre() Case Else main_a() End Select If Mybbs.ErrCodes<>"" Then Mybbs.ShowErr() End Function '批量删除跟贴 Private Sub delre() Check_topicInfo() If Mybbs.ErrCodes<>"" Then Exit Sub '判断用户是否有删除帖子权限 If Not CanDelTopic Then Mybbs.AddErrCode(28) Dim DelID,j,i j=0 DelID=Request("DelID") If delid="" Then Mybbs.AddErrCode(35) Exit Sub End If delid=Split(delid,",") For i = 0 to UBound(delid) If Trim(delid(i))<>"" and IsNumeric(Trim(delid(i))) Then j=j+1 replyID=Ccur(Trim(delid(i))) dele(0) End If Next If j>0 Then Mybbs.Dvbbs_Suc(SucMsgInfo("批量删除"&j&"个跟贴,您的操作已经记录")) Else Mybbs.AddErrCode(35) End If End Sub Public Sub main_a() Dim seldisable,reaction Dim postusername,DelUpFile DelUpFile=0 Select Case Request("action") Case "锁定" If Not CanAwardTopic Then seldisable="disabled" reaction="lock" If not CanLockTopic Then Mybbs.AddErrCode(28) Case "解锁" If Not CanAwardTopic Then seldisable="disabled" reaction="unlock" If not CanLockTopic Then Mybbs.AddErrCode(28) Case "提升" If Not CanAwardTopic Then seldisable="disabled" reaction="uptopic" If not CanLockTopic Then Mybbs.AddErrCode(28) Case "删除主题" doWealth=-Mybbs.Forum_user(3) douserEP=-Mybbs.Forum_user(8) douserCP=-Mybbs.Forum_user(13) If Not CanAwardTopic Then seldisable="disabled" reaction="delet" If not CanDelTopic Then Mybbs.AddErrCode(28) If SysObjFso=True Then DelUpFile=1 Case "删除跟帖" doWealth=-Mybbs.Forum_user(3) douserEP=-Mybbs.Forum_user(8) douserCP=-Mybbs.Forum_user(13) If Not CanAwardTopic Then seldisable="disabled" reaction="dele" Check_AnnounceInfo() If Mybbs.ErrCodes<>"" Then Exit Sub '判断用户是否有删除帖子权限 If Not CanDelTopic Then Mybbs.AddErrCode(28) If SysObjFso=True Then DelUpFile=1 Case "单帖屏蔽" doWealth=-Mybbs.Forum_user(15) douserEP=-Mybbs.Forum_user(17) douserCP=-Mybbs.Forum_user(16) If Not CanAwardTopic Then seldisable="disabled" reaction="islockpage" Check_AnnounceInfo() If Mybbs.ErrCodes<>"" Then Exit Sub If Not CanBestTopic Then Mybbs.AddErrCode(28) Case "解除屏蔽" doWealth=Mybbs.Forum_user(15) douserEP=Mybbs.Forum_user(17) douserCP=Mybbs.Forum_user(16) If Not CanAwardTopic Then seldisable="disabled" reaction="nolockpage" Check_AnnounceInfo() If Mybbs.ErrCodes<>"" Then Exit Sub If Not CanBestTopic Then Mybbs.AddErrCode(28) Case "精华" doWealth=Mybbs.Forum_user(15) douserEP=Mybbs.Forum_user(17) douserCP=Mybbs.Forum_user(16) If Not CanAwardTopic Then seldisable="disabled" reaction="isbest" Check_AnnounceInfo() If Mybbs.ErrCodes<>"" Then Exit Sub If Not CanBestTopic Then Mybbs.AddErrCode(28) Case "解除精华" doWealth=-Mybbs.Forum_user(15) douserEP=-Mybbs.Forum_user(17) douserCP=-Mybbs.Forum_user(16) If Not CanAwardTopic Then seldisable="disabled" reaction="nobest" Check_AnnounceInfo() If Mybbs.ErrCodes<>"" Then Exit Sub If not CanBestTopic Then Mybbs.AddErrCode(28) Case "复制" seldisable="disabled" reaction="copy" Check_AnnounceInfo() If Mybbs.ErrCodes<>"" Then Exit Sub '判断用户是否有移动帖子权限 If Not CanMoveTopic Then Mybbs.AddErrCode(28) Case "设置固顶" If Not CanAwardTopic Then seldisable="disabled" reaction="istop" If CanTopTopic Or CanTopTopic_a Or CanTopTopic_m Then Else Mybbs.AddErrCode(28) End If Case "编辑固顶" If Not CanAwardTopic Then seldisable="disabled" reaction="istop" If CanTopTopic Or CanTopTopic_a Or CanTopTopic_m Then Else Mybbs.AddErrCode(28) End If Case "移动" seldisable="disabled" reaction="move" If Not CanMoveTopic Then Mybbs.AddErrCode(28) Case "奖励" seldisable="" reaction="award" If Not CanAwardTopic Then Mybbs.AddErrCode(28) Case "惩罚" doWealth=-5 douserEP=-1 douserCP=-2 seldisable="" reaction="punish" If Not CanAwardTopic Then Mybbs.AddErrCode(28) Case "专题管理" If Not CanMoveTopic Then Mybbs.AddErrCode(28) reaction="TopicMode" Case "跟贴管理" doWealth=-Mybbs.Forum_user(3) douserEP=-Mybbs.Forum_user(8) douserCP=-Mybbs.Forum_user(13) Check_topicInfo() If Mybbs.ErrCodes<>"" Then Exit Sub '判断用户是否有删除帖子权限 If Not CanDelTopic Then Mybbs.AddErrCode(28) Dim Star,i,j,treedata,tmpstr,blank Star=Request("Star") If Star="" Then Star=1 If Not IsNumeric(Star) Then star=1 Set Rs=server.createobject("adodb.recordset") sql="select AnnounceID,parentID,BoardID,UserName,PostUserid,Topic,DateAndTime,length,RootID,layer,orders,Expression,body from "&TotalUseTable&" where BoardID="&Mybbs.BoardID&" and RootID="&ID&" and BoardID<>777 and BoardID<>444 order by RootID desc,orders" rs.open sql,conn,1,1 j=0 If Not(Rs.EOF And Rs.BOF) Then Rs.PageSize=Cint(Mybbs.Board_Setting(27)) Rs.AbsolutePage=Star Do while Not Rs.EOF treedata=template.html(6) For i=1 to Rs(9) blank=blank&" " Next If Rs("topic")="" or isnull(rs("topic")) Then treedata=Replace(treedata,"{$topic}",cutStr(replace(reubbcode(Mybbs.ChkBadWords(rs("body"))),chr(10),""),35)) Else treedata=Replace(treedata,"{$topic}",cutStr(Mybbs.ChkBadWords(rs("Topic")),35)) End If If j=0 Then If star=1 Then treedata=Replace(treedata,"{$del}","") treedata=Replace(treedata,"{$alertcolor}",Mybbs.mainsetting(1)) Else treedata=Replace(treedata,"{$del}"," <input type=""checkbox"" name=""DelID"" value="""&Rs(0)&""">") treedata=Replace(treedata,"{$alertcolor}","") End If Else treedata=Replace(treedata,"{$del}"," <input type=""checkbox"" name=""DelID"" value="""&Rs(0)&""">") treedata=Replace(treedata,"{$alertcolor}","") End If treedata=Replace(treedata,"{$announceid}",Rs(0)) treedata=Replace(treedata,"{$boardid}",Rs(2)) treedata=Replace(treedata,"{$username}",Rs(3)) treedata=Replace(treedata,"{$DateAndTime}",Rs(6)) If Rs(7)=0 Then treedata=Replace(treedata,"{$length}","无内容") Else treedata=Replace(treedata,"{$length}",Rs(7)&"字节") End If treedata=Replace(treedata,"{$rootid}",Rs(8)) treedata=Replace(treedata,"{$Expression}",Rs(11)) treedata=Replace(treedata,"{$blank}",blank) blank="" tmpstr=tmpstr&treedata Rs.MoveNext j=j+1 If j=Cint(Mybbs.Board_Setting(27)) Then Exit Do Loop End If template.html(5) = Replace(template.html(5),"{$id}",ID) template.html(5) = Replace(template.html(5),"{$boardid}",Mybbs.boardid) template.html(5) = Replace(template.html(5),"{$reaction}",reaction) template.html(5) = Replace(template.html(5),"{$seldisable}",seldisable) template.html(5) = Replace(template.html(5),"{$doWealth}",doWealth) template.html(5) = Replace(template.html(5),"{$dousercp}",dousercp) template.html(5) = Replace(template.html(5),"{$douserep}",douserep) template.html(5) = Replace(template.html(5),"{$fileconfirm}",DelUpFile) template.html(5) = Replace(template.html(5),"{$action}",request("action")) template.html(5) = Replace(template.html(5),"{$treeloop}",tmpstr) Response.Write template.html(5) Endpage=Rs.PageCount Response.Write "<table border=0 cellpadding=0 cellspacing=3 width="""&Mybbs.mainsetting(0)&""" align=center>" Response.Write "<tr><td valign=middle nowrap>" Response.Write "页次:<b>"&Star&"</b>/<b>"&Endpage&"</b>页" Response.Write "每页<b>"& Mybbs.Board_Setting(27) &"</b> 贴数<b>"& Rs.RecordCount &"</b></td>" Response.Write "<td valign=middle nowrap><div align=right><p>分页: <b>" Dim Endpage If Star > 4 Then Response.Write "<a href=""admin_postings.asp?action=跟贴管理&BoardID="&Mybbs.BoardID&"&ID="&ID&"&star=1"">[1]</a> ..." End If If Endpage >Star+3 Then Endpage=Star+3 End If For i=Star-3 to Endpage If Not i<1 Then If i = CLng(star) Then response.write " <font color="&Mybbs.mainsetting(1)&">["&i&"]</font>" Else Response.Write " <a href=""admin_postings.asp?action=跟贴管理&BoardID="&Mybbs.BoardID&"&ID="&ID&"&star="&i&""">["&i&"]</a>" End If End If Next If star+3 < Rs.PageCount Then response.write "... <a href=""admin_postings.asp?action=跟贴管理&BoardID="&Mybbs.BoardID&"&ID="&ID&"&star="&Rs.PageCount&""">["&Rs.PageCount&"]</a></b>" End If Response.Write "</p></div></td></tr></table>" Set Rs=Nothing Response.Write "<script language=""JavaScript"">" Response.Write Chr(10) Response.Write "<!--" Response.Write Chr(10) Response.Write "function CheckAll(form) {" Response.Write Chr(10) Response.Write "for (var i=0;i<form.elements.length;i++){" Response.Write Chr(10) Response.Write "var e = form.elements[i];" Response.Write Chr(10) Response.Write "if (e.name != 'chkall') e.checked = form.chkall.checked;" Response.Write Chr(10) Response.Write "}" Response.Write Chr(10) Response.Write "}" Response.Write Chr(10) Response.Write "//-->" Response.Write Chr(10) Response.Write "</script>" Response.Write Chr(10) Exit Sub Case Else Mybbs.AddErrCode(35) Exit Sub End Select Dim TempStr TempStr = template.html(0) TempStr = Replace(TempStr,"{$reaction}",reaction) TempStr = Replace(TempStr,"{$action}",request("action")) TempStr = Replace(TempStr,"{$seldisable}",seldisable) TempStr = Replace(TempStr,"{$doWealth}",doWealth) TempStr = Replace(TempStr,"{$dousercp}",dousercp) TempStr = Replace(TempStr,"{$douserep}",douserep) TempStr = Replace(TempStr,"{$boardid}",Mybbs.BoardID) TempStr = Replace(TempStr,"{$id}",id) TempStr = Replace(TempStr,"{$replyid}",replyid) TempStr = Replace(TempStr,"{$fileconfirm}",DelUpFile) Response.Write TempStr End Sub Public Function Check_AnnounceInfo() Set Rs=Mybbs.Execute("Select topic,username,postuserID From "&TotalUseTable&" Where boardid="&Mybbs.boardid&" and AnnounceID="&replyID) If Rs.Eof And Rs.Bof Then Mybbs.AddErrCode(32) Exit Function End If Topic=rs(0) TopicUsername=rs(1) TopicUserID=Clng(rs(2)) Rs.close End Function Public Function Check_topicInfo() Set Rs=Mybbs.Execute("Select topic,username,postuserID From "&TotalUseTable&" Where ParentID=0 and boardid="&Mybbs.boardid&" and RootID="&ID) If Rs.Eof And Rs.Bof Then Mybbs.AddErrCode(32) Exit Function End If Topic=rs(0) TopicUsername=rs(1) TopicUserID=Clng(rs(2)) Rs.close End Function Public Function Insert_Forum_Log() Mybbs.Execute("Insert Into Dv_Log (l_AnnounceID,l_BoardID,l_touser,l_username,l_content,l_ip,l_type) values (" & ID & "," & Mybbs.BoardID & ",'" & Mybbs.CheckStr(TopicUsername) & "','" & Mybbs.MemberName & "','" & Mybbs.CheckStr(sucmsg) & "','" & IP & "',"&LogType&")") End Function Public Function Update_User_Point(SQLSTR) If allmsg<>"" Then Mybbs.Execute("Update [Dv_user] Set userWealth=userWealth+"&doWealth&",userCP=userCP+"&douserCP&",userEP=userEP+"&douserEP&" "&SQLSTR&" Where UserID="&TopicUserID) End If End Function Public Function Topic_Manage_Sms() If Request("ismsg")="1" Then Dim msgcontent msgcontent="您发表的帖子《[url=dispbbs.asp?boardID="&Mybbs.BoardID&"&ID="&ID&"]"&Topic&"[/url]》因"&replace(Content,"原因:","")&"而被"&ActionInfo&",且进行了"&replace(Allmsg,"用户操作:","")&"的操作" If Request("msg")<>"" Then msgContent=msgContent & chr(10) & "以下为操作者给您的附言:" & Request("msg") Mybbs.Execute("Insert Into Dv_Message(incept,sender,title,content,sendtime,flag,issend) values('"&Mybbs.CheckStr(TopicUsername)&"','"&Mybbs.MemberName&"','系统消息','"&Mybbs.CheckStr(msgContent)&"',"&SqlNowString&",0,1)") Update_User_Msg(TopicUsername) End If End Function Public Function Update_User_Msg(username) Dim msginfo If newincept(username)>0 Then msginfo=newincept(username) & "||" & inceptid(1,username) & "||" & inceptid(2,username) Else msginfo="0||0||null" End If Mybbs.Execute("Update [Dv_User] Set UserMsg='"&Mybbs.CheckStr(msginfo)&"' Where username='"&Mybbs.CheckStr(username)&"'") End Function '统计留言 Public Function newincept(iusername) Dim rs Rs=Mybbs.Execute("Select Count(id) From Dv_Message Where flag=0 and issend=1 and delR=0 And incept='"& iusername &"'") newincept=Rs(0) Set Rs=Nothing If IsNull(newincept) Then newincept=0 End Function Public Function inceptid(stype,iusername) Dim ars set ars=Mybbs.Execute("Select top 1 id,sender From Dv_Message Where flag=0 and issend=1 and delR=0 And incept ='"& iusername &"'") if stype=1 then inceptid=ars(0) else inceptid=ars(1) end if set ars=nothing End Function '判断是否为帖子最后回复 Public Function isLastPost() Dim LastTopic,body,LastRootID,LastPostTime,LastPostUser Dim LastPost,uploadpic_n,LastPostUserID,LastID isLastPost=False '取得当前主题最后回复ID Set Rs=Mybbs.Execute("select LastPost from Dv_topic where topicID="&ID) If not (rs.eof and rs.bof) Then If not isnull(rs(0)) and rs(0)<>"" Then If Clng(split(rs(0),"$")(1))=Clng(replyID) Then isLastPost=True End If End If If isLastPost Then Set Rs=Mybbs.Execute("select top 1 topic,body,AnnounceID,dateandtime,username,PostUserID,rootID,boardID from "&TotalUseTable&" where BoardID="&Mybbs.BoardID&" And rootID="&ID&" order by AnnounceID desc") If not(rs.eof and rs.bof) Then body=rs(1) LastRootID=rs(2) LastPostTime=rs(3) LastPostUser=replace(rs(4),"$","") LastTopic=left(replace(body,"$",""),20) LastPostUserID=rs(5) LastID=rs(6) Mybbs.BoardID=rs(7) Else LastTopic="无" LastRootID=0 LastPostTime=now() LastPostUser="无" LastPostUserID=0 LastID=0 Mybbs.BoardID=0 End If set rs=nothing LastPost=LastPostUser & "$" & LastRootID & "$" & LastPostTime & "$" & replace(left(LastTopic,20),"$","") & "$" & uploadpic_n & "$" & LastPostUserID & "$" & LastID & "$" & Mybbs.BoardID Mybbs.Execute("update Dv_topic set LastPost='"&LastPost&"' where topicID="&ID) End If End Function '更新指定论坛信息 Public Function LastCount(boardID) Dim LastTopic,body,LastRootID,LastPostTime,LastPostUser Dim LastPost,uploadpic_n,LastpostuserID,LastID set rs=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="&boardID&" order by b.announceID desc") If not(rs.eof and rs.bof) Then Lasttopic=replace(left(rs(0),15),"$","") LastRootID=rs(1) LastPostTime=rs(2) LastPostUser=rs(3) LastPostUserID=rs(4) LastID=rs(5) Else LastTopic="无" LastRootID=0 LastPostTime=now() LastPostUser="无" LastPostUserID=0 LastID=0 End If set rs=nothing LastPost=LastPostUser & "$" & LastRootID & "$" & LastPostTime & "$" & LastTopic & "$" & uploadpic_n & "$" & LastPostUserID & "$" & LastID & "$" & BoardID Dim SplitUpBoardID,SplitLastPost SplitUpBoardID=split(UpdateBoardID,",") For i=0 to ubound(SplitUpBoardID) set rs=Mybbs.Execute("select LastPost from dv_board where boardID="&SplitUpBoardID(i)) If not (rs.eof and rs.bof) Then SplitLastPost=split(rs(0),"$") If IsNumeric(LastRootID) and IsNumeric(SplitLastPost(1)) Then If ubound(SplitLastPost)=7 and clng(LastRootID)<>clng(SplitLastPost(1)) Then Mybbs.Execute("update dv_board set LastPost='"&LastPost&"' where boardID="&SplitUpBoardID(i)) Mybbs.ReloadBoardCache SplitUpBoardID(i),LastPost,14,0 End If End If End If Next set rs=nothing End Function '版面发帖数增加 Public Sub BoardNumAdd(boardID,topicNum,postNum,todayNum) Dim iUpdateBoardID Mybbs.Execute("update dv_board set postnum=postnum+"&postNum&",topicNum=topicNum+"&topicNum&",todayNum=todayNum+"&todayNum&" where boardID in ("&UpdateBoardID&")") iUpdateBoardID = Split(UpdateBoardID,",") For i=0 To Ubound(iUpdateBoardID) Mybbs.ReloadBoardCache iUpdateBoardID(i),PostNum,9,1 Mybbs.ReloadBoardCache iUpdateBoardID(i),TopicNum,10,1 Mybbs.ReloadBoardCache iUpdateBoardID(i),TodayNum,12,1 Next End Sub '版面发帖数减少 Public Sub BoardNumSub(boardID,topicNum,postNum,todayNum) Dim iUpdateBoardID Mybbs.Execute("update dv_board set postnum=postnum-"&postNum&",topicNum=topicNum-"&topicNum&",todayNum=todayNum-"&todayNum&" where boardID in ("&UpdateBoardID&")") Dim trs,LastPostTime,LastpostuserID,Lastid,uploadpic_n 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="&boardid&" order by b.Announceid desc") If not(trs.eof and trs.bof) Then Lasttopic=replace(left(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 trs.close Set trs=nothing LastPost=LastPostUser & "$" & LastRootid & "$" & LastPostTime & "$" & LastTopic & "$" & uploadpic_n & "$" & LastPostUserID & "$" & LastID & "$" & BoardID iUpdateBoardID = Split(UpdateBoardID,",") For i=0 To Ubound(iUpdateBoardID) Mybbs.ReloadBoardCache iUpdateBoardID(i),0 - PostNum,9,1 Mybbs.ReloadBoardCache iUpdateBoardID(i),0 - TopicNum,10,1 Mybbs.ReloadBoardCache iUpdateBoardID(i),0 - TodayNum,12,1 Mybbs.ReloadBoardCache iUpdateBoardID(i),LastPost,14,0 Next End Sub '所有论坛发帖数增加 Public Function AllboardNumAdd(todayNum,postNum,topicNum) Mybbs.Execute("Update dv_Setup Set Forum_TodayNum=Forum_todayNum+"&todaynum&",Forum_PostNum=Forum_PostNum+"&postNum&",Forum_TopicNum=Forum_topicNum+"&TopicNum) Mybbs.ReloadSetupCache CLng(Mybbs.CacheData(7,0))+TopicNum,7 Mybbs.ReloadSetupCache CLng(Mybbs.CacheData(8,0))+postNum,8 Mybbs.ReloadSetupCache CLng(Mybbs.CacheData(9,0))+todaynum,9 End Function '所有论坛发帖数减少 Public Function AllboardNumSub(todayNum,postNum,topicNum) Mybbs.Execute("Update dv_Setup Set Forum_TodayNum=Forum_TodayNum-"&todaynum&",Forum_PostNum=Forum_PostNum-"&postNum&",Forum_TopicNum=Forum_TopicNum-"&TopicNum) Mybbs.ReloadSetupCache CLng(Mybbs.CacheData(7,0))-TopicNum,7 Mybbs.ReloadSetupCache CLng(Mybbs.CacheData(8,0))-postNum,8 Mybbs.ReloadSetupCache CLng(Mybbs.CacheData(9,0))-todaynum,9 End Function Public Sub Get_RequestInfo() sucmsg="" title=Mybbs.htmlencode(Request.form("title")) content=Mybbs.htmlencode(Request.form("content")) content="原因:" & title & content If Request.form("title")="" and Request.form("content")="" Then Mybbs.AddErrCode(39) Mybbs.ShowErr() End If sucmsg=ActionInfo&"《"&server.htmlencode(topic)&"》,"&server.htmlencode(content)& ","&allmsg&"" End Sub Private Function SucMsgInfo(GetMsg) SucMsgInfo="<li>"+GetMsg SucMsgInfo=SucMsgInfo+"<li>"+"<a href=list.asp?boardid="&Mybbs.boardid&">返回论坛列表</a>" SucMsgInfo=SucMsgInfo+"<li>"+"<a href=dispbbs.asp?boardid="&Mybbs.boardid&"&id="&ID&" >返回主题:《"&server.htmlencode(Topic)&"》</a>" End Function '专题管理操作 Public Sub TopicMode() Dim ModeID ModeID=Request.Form("mode") If Request.form("title")="" and Request.form("content")="" Then Mybbs.AddErrCode(39) Exit Sub End If If ModeID<>"" And IsNumeric(ModeID) Then LogType=5 Get_RequestInfo ModeID=Cint(ModeID) Mybbs.Execute("Update Dv_Topic Set Mode="&ModeID&" Where BoardID="&Mybbs.BoardID&" And TopicID=" & ID) Insert_Forum_Log() Update_User_Point("") Topic_Manage_Sms() Mybbs.Dvbbs_Suc(SucMsgInfo(sucmsg)) Else title=Mybbs.htmlencode(Request.form("title")) content=Mybbs.htmlencode(Request.form("content")) content=title & content Dim BoardTopic,SelectBoardTopic,TempStr BoardTopic=Split(Mybbs.Board_Setting(48),"$$") If Ubound(BoardTopic)>0 Then For i=0 to Ubound(BoardTopic)-1 SelectBoardTopic=SelectBoardTopic+"<option value="&(i+1) SelectBoardTopic=SelectBoardTopic+" >"&BoardTopic(i)&"</option>" Next End If TempStr = template.html(4) TempStr = Replace(TempStr,"{$reaction}",request("action")) TempStr = Replace(TempStr,"{$boardid}",Request("boardID")) TempStr = Replace(TempStr,"{$id}",Request("ID")) TempStr = Replace(TempStr,"{$title}",content) TempStr = Replace(TempStr,"{$doWealth}",doWealth) TempStr = Replace(TempStr,"{$dousercp}",dousercp) TempStr = Replace(TempStr,"{$douserep}",douserep) TempStr = Replace(TempStr,"{$msg}",Request.form("msg")) TempStr = Replace(TempStr,"{$ismsg}",Request.form("ismsg")) TempStr = Replace(TempStr,"{$TopicMode}",SelectBoardTopic) Response.Write TempStr End If End Sub '奖励用户 Public Sub award() LogType=5 Get_RequestInfo If TopicUserName=Mybbs.MemberName Then Mybbs.AddErrCode(38) Exit Sub End If Insert_Forum_Log() Update_User_Point("") Topic_Manage_Sms() Mybbs.Dvbbs_Suc(SucMsgInfo(sucmsg)) End Sub '惩罚用户 Public Sub punish() LogType=5 Get_RequestInfo Insert_Forum_Log() Update_User_Point("") Topic_Manage_Sms() Mybbs.Dvbbs_Suc(SucMsgInfo(sucmsg)) End Sub '锁定帖子 Public Sub lock() LogType=5 Get_RequestInfo Mybbs.Execute("Update Dv_topic Set locktopic=1 where boardID="&Mybbs.boardID&" and topicID="&ID) Insert_Forum_Log() Update_User_Point("") Topic_Manage_Sms() Mybbs.Dvbbs_Suc(SucMsgInfo(sucmsg)) End Sub '解除锁定帖子 Public Sub unlock() LogType=3 Get_RequestInfo Mybbs.Execute("Update Dv_topic Set locktopic=0 where boardID="&Mybbs.boardID&" and topicID="&ID) Insert_Forum_Log() Update_User_Point("") Topic_Manage_Sms() Mybbs.Dvbbs_Suc(SucMsgInfo(sucmsg)) End Sub '提升帖子 Public Sub uptopic() LogType=3 Get_RequestInfo Mybbs.Execute("Update dv_topic set LastPostTime="&SqlNowString&" where boardID="&Mybbs.BoardID&" and IsTop=0 and topicID="&ID) Insert_Forum_Log() Update_User_Point("") Topic_Manage_Sms() Mybbs.Dvbbs_Suc(SucMsgInfo(sucmsg)) End Sub '固顶帖子,包括总固顶、区固顶和固顶 Public Sub Getistop() Dim IsTop Dim iForum_AllTopNum,mForum_AllTopNum Dim getBoard,BoardTopStr,iBoardTopStr Dim Bn LogType=4 Get_RequestInfo If Request("istopaction")="1" Then '如果原来是固顶、区域固顶或总固顶,判断其是否有需要清理数据 Set Rs=Mybbs.Execute("Select IsTop From Dv_Topic Where TopicID="& ID) IsTop = Rs(0) '如果有总固顶需要清理 If IsTop = 3 And Request("alltop")="" And CanTopTopic_a Then If IsSqlDataBase=1 Then Mybbs.Execute("update dv_topic set istop=0,LastPostTime=dateadd(day,-300,LastPostTime) where boardID="&Mybbs.BoardID&" and topicID="&ID) Else Mybbs.Execute("update dv_topic set istop=0,LastPostTime=dateadd('d',-300,LastPostTime) where boardID="&Mybbs.BoardID&" and topicID="&ID) End If IsTop = 0 '将总固顶ID从总设置表去除 Set Rs=Mybbs.Execute("Select Forum_AllTopNum From Dv_Setup") iForum_AllTopNum = "," & Rs(0) & "," If Instr(iForum_AllTopNum,"," & ID & ",")>0 Then iForum_AllTopNum = Split(iForum_AllTopNum,",") For i=1 To Ubound(iForum_AllTopNum)-1 If Cstr(Trim(iForum_AllTopNum(i)))<>Cstr(ID) Then If mForum_AllTopNum="" Then mForum_AllTopNum = iForum_AllTopNum(i) Else mForum_AllTopNum = mForum_AllTopNum & "," & iForum_AllTopNum(i) End If End If Next Mybbs.Execute("Update Dv_Setup Set Forum_AllTopNum='"&mForum_AllTopNum&"'") Mybbs.Name="setup" Mybbs.ReloadSetup End If Set Rs=Nothing End If '如果有固顶需要清理 If IsTop = 1 And CanTopTopic And Trim(Request("getboard"))="" Then If IsSqlDataBase=1 Then Mybbs.Execute("update dv_topic set istop=0,LastPostTime=dateadd(day,-100,LastPostTime) where boardID="&Mybbs.BoardID&" and topicID="&ID) Else Mybbs.Execute("update dv_topic set istop=0,LastPostTime=dateadd('d',-100,LastPostTime) where boardID="&Mybbs.BoardID&" and topicID="&ID) End If IsTop = 0 '清理对应版面中的帖子ID Set Rs=Mybbs.Execute("Select BoardID,BoardTopStr From Dv_Board Where BoardID="&Mybbs.BoardID) If Not (Rs.Eof And Rs.Bof) Then If Rs(1)="" Or IsNull(Rs(1)) Then iBoardTopStr = "" Else If InStr(","&Rs(1)&",",","&ID&",")>0 Then BoardTopStr = "," & Rs(1) & "," BoardTopStr = Split(BoardTopStr,",") For i = 1 To Ubound(BoardTopStr)-1 If Cstr(Trim(BoardTopStr(i)))<>Cstr(ID) Then If iBoardTopStr="" Then iBoardTopStr = BoardTopStr(i) Else iBoardTopStr = iBoardTopStr & "," & BoardTopStr(i) End If End If Next Else iBoardTopStr = Rs(1) End If End If Mybbs.Execute("Update Dv_Board Set BoardTopStr='"&iBoardTopStr&"' Where BoardID="&Rs(0)) Mybbs.ReloadBoardInfo(Rs(0)) BoardTopStr = "" End If End If '如果有区域固顶需要清理 If IsTop = 2 And CanTopTopic_m Then '如果返回的getboard为空,则已经解除该贴的区域固顶,应清理所有含有该ID的版面 If Trim(Request("getboard"))="" Then If IsSqlDataBase=1 Then Mybbs.Execute("update dv_topic set istop=0,LastPostTime=dateadd(day,-200,LastPostTime) where boardID="&Mybbs.BoardID&" and topicID="&ID) Else Mybbs.Execute("update dv_topic set istop=0,LastPostTime=dateadd('d',-200,LastPostTime) where boardID="&Mybbs.BoardID&" and topicID="&ID) End If IsTop = 0 '查询得出原来该贴所固顶的版面 Set Rs=Mybbs.Execute("Select BoardID,BoardTopStr From Dv_Board Where BoardTopStr Like '%"&ID&"%'") Rem 以数组代替循环查询。 2004-5-7 Mybbs.YangZheng If Not (Rs.Eof And Rs.Bof) Then Sql = Rs.GetRows(-1) Rs.Close:Set Rs = Nothing For Bn = 0 To Ubound(Sql,2) If Sql(1,Bn) = "" Or IsNull(Sql(1,Bn)) Then iBoardTopStr = "" Else If InStr("," & Sql(1,Bn) & ",", "," & ID & ",") > 0 Then BoardTopStr = "," & Sql(1,Bn) & "," BoardTopStr = Split(BoardTopStr,",") For i = 1 To Ubound(BoardTopStr)-1 If Cstr(Trim(BoardTopStr(i))) <> Cstr(ID) Then If iBoardTopStr="" Then iBoardTopStr = BoardTopStr(i) Else iBoardTopStr = iBoardTopStr & "," & BoardTopStr(i) End If End If Next Else iBoardTopStr = Sql(1,Bn) End If End If Mybbs.Execute("Update Dv_Board Set BoardTopStr='" & iBoardTopStr & "' Where BoardID = " & Sql(0,Bn)) Mybbs.ReloadBoardInfo(Sql(0,Bn)) BoardTopStr = "" iBoardTopStr = "" Next End If '如果返回的getboard不为空,则应清理原来含有该ID且不属于返回的getboard的版面的该帖子ID '需同时判断,如果用户将原区域固顶设置升级为总固顶,且忘记取消列表中的版面,则应清理该ID对应的版面 Else Dim ii ii = 0 If Request("alltop")="1" Then If IsSqlDataBase=1 Then Mybbs.Execute("update dv_topic set istop=0,LastPostTime=dateadd(day,-200,LastPostTime) where boardID="&Mybbs.BoardID&" and topicID="&ID) Else Mybbs.Execute("update dv_topic set istop=0,LastPostTime=dateadd('d',-200,LastPostTime) where boardID="&Mybbs.BoardID&" and topicID="&ID) End If IsTop = 0 '查询得出原来该贴所固顶的版面 Set Rs = Mybbs.Execute("Select BoardID,BoardTopStr From Dv_Board Where BoardTopStr Like '%" & ID & "%'") If Not (Rs.Eof And Rs.Bof) Then Sql = Rs.GetRows(-1) Rs.Close:Set Rs = Nothing For Bn = 0 To Ubound(Sql,2) If Sql(1,Bn) = "" Or IsNull(Sql(1,Bn)) Then iBoardTopStr = "" Else If InStr("," & Sql(1,Bn) & ",", "," & ID & ",") > 0 Then BoardTopStr = "," & Sql(1,Bn) & "," BoardTopStr = Split(BoardTopStr,",") For i = 1 To Ubound(BoardTopStr)-1 If Cstr(Trim(BoardTopStr(i))) <> Cstr(ID) Then If iBoardTopStr="" Then iBoardTopStr = BoardTopStr(i) Else iBoardTopStr = iBoardTopStr & "," & BoardTopStr(i) End If End If Next Else iBoardTopStr = Sql(1,Bn) End If End If Mybbs.Execute("UPDATE Dv_Board SET BoardTopStr = '" & iBoardTopStr & "' WHERE BoardID = " & Sql(0,Bn)) Mybbs.ReloadBoardInfo(Sql(0,Bn)) BoardTopStr = "" iBoardTopStr = "" Next End If IsTop = 0 Else Set Rs = Mybbs.Execute("SELECT BoardID, BoardTopStr FROM Dv_Board WHERE (NOT BoardID IN (" & Request("getboard") & ")) AND BoardTopStr LIKE '%" & ID & "%'") If Not (Rs.Eof And Rs.Bof) Then Sql = Rs.GetRows(-1) Rs.Close:Set Rs = Nothing For Bn = 0 To Ubound(Sql,2) If Sql(1,Bn) = "" Or IsNull(Sql(1,Bn)) Then iBoardTopStr = "" Else If InStr("," & Sql(1,Bn) & ",", "," & ID & ",") > 0 Then BoardTopStr = "," & Sql(1,Bn) & "," BoardTopStr = Split(BoardTopStr,",") For i = 1 To Ubound(BoardTopStr)-1 If Cstr(Trim(BoardTopStr(i)))<>Cstr(ID) Then If iBoardTopStr="" Then iBoardTopStr = BoardTopStr(i) Else iBoardTopStr = iBoardTopStr & "," & BoardTopStr(i) End If End If Next ii = ii + 1 Else iBoardTopStr = Sql(1,Bn) End If End If Mybbs.Execute("UPDATE Dv_Board SET BoardTopStr = '" & iBoardTopStr & "' WHERE BoardID = " & Sql(0,Bn)) Mybbs.ReloadBoardInfo(Sql(0,Bn)) BoardTopStr = "" iBoardTopStr = "" Next End If GetBoard = Split(Request("getboard"),",") '如果单选当前版面,则取消区域固顶,还原为版面固顶,如多选则不做处理 If Ubound(getBoard)=0 And Clng(getBoard(0))=Mybbs.BoardID And CanTopTopic Then If IsTop = 0 Then TimeAdd = 100 If IsTop = 1 Then TimeAdd = 0 If IsTop = 2 Then TimeAdd = -100 If IsTop = 3 Then TimeAdd = -200 If IsSqlDataBase=1 Then Mybbs.Execute("UPDATE Dv_Topic SET Istop = 1, LastPostTime = DATEADD(Day, " & TimeAdd & ", LastPostTime) WHERE BoardID = " & Mybbs.BoardID & " AND TopicID = " & ID) Else Mybbs.Execute("UPDATE Dv_Topic SET Istop = 1, LastPostTime = DATEADD('d', " & TimeAdd & ", LastPostTime) WHERE BoardID = " & Mybbs.BoardID & " AND TopicID = " & ID) End If IsTop = 1 End If End If 'End By AllTop End If End If '总固顶操作 Dim TimeAdd TimeAdd = 0 If Request("alltop")="1" And CanTopTopic_a Then If IsTop = 0 Then TimeAdd = 300 If IsTop = 1 Then TimeAdd = 200 If IsTop = 2 Then TimeAdd = 100 If IsTop = 3 Then TimeAdd = 0 If IsSqlDataBase=1 Then Mybbs.Execute("update dv_topic set istop=3,LastPostTime=dateadd(day,"&TimeAdd&",LastPostTime) where boardID="&Mybbs.BoardID&" and topicID="&ID) Else Mybbs.Execute("update dv_topic set istop=3,LastPostTime=dateadd('d',"&TimeAdd&",LastPostTime) where boardID="&Mybbs.BoardID&" and topicID="&ID) End If '将总固顶ID插入总设置表 Set Rs=Mybbs.Execute("Select Forum_AllTopNum From Dv_Setup") iForum_AllTopNum = "," & Rs(0) & "," If Instr(iForum_AllTopNum,"," & ID & ",")=0 Then If Trim(Rs(0))="" Then iForum_AllTopNum = ID Else iForum_AllTopNum = Rs(0) & "," & ID End If Mybbs.Execute("Update Dv_Setup Set Forum_AllTopNum='"&iForum_AllTopNum&"'") Mybbs.Name="setup" Mybbs.ReloadSetup End If Set Rs=Nothing Else If Request("getboard")<>"" Then getBoard = Split(Request("getBoard"),",") '单选且当前版面固顶 i = 0 If Ubound(getBoard)=0 And Clng(getBoard(0))=Mybbs.BoardID And CanTopTopic Then Set Rs=Mybbs.Execute("Select BoardID,BoardTopStr From Dv_Board Where BoardID="&Clng(getBoard(0))) If Not (Rs.Eof And Rs.Bof) Then If Rs(1)="" Or IsNull(Rs(1)) Then BoardTopStr = ID i = i + 1 Else If InStr(","&Rs(1)&",",","&ID&",")>0 Then BoardTopStr = Rs(1) Else BoardTopStr = Rs(1) & "," & ID i = i + 1 End If End If Mybbs.Execute("Update Dv_Board Set BoardTopStr='"&BoardTopStr&"' Where BoardID="&Rs(0)) Mybbs.ReloadBoardInfo(Rs(0)) BoardTopStr = "" End If If i > 0 Then If IsTop = 0 Then TimeAdd = 100 If IsTop = 1 Then TimeAdd = 0 If IsTop = 2 Then TimeAdd = -100 If IsTop = 3 Then TimeAdd = -200 If IsSqlDataBase=1 Then Mybbs.Execute("update dv_topic set istop=1,LastPostTime=dateadd(day,"&TimeAdd&",LastPostTime) where boardID="&Mybbs.BoardID&" and topicID="&ID) Else Mybbs.Execute("update dv_topic set istop=1,LastPostTime=dateadd('d',"&TimeAdd&",LastPostTime) where boardID="&Mybbs.BoardID&" and topicID="&ID) End If End If '多选区域固顶,包含在当前版面固顶操作中单选其它版面 '在这里不需判断当前用户在其它版面的权限 '因为只要在用户组或版面权限或用户权限中对当前版面有区域固顶权限,则默认为可添加固顶到其它版面 Else Set Rs=Mybbs.Execute("Select BoardID,BoardTopStr From Dv_Board Where BoardID In ("&Request("getBoard")&")") REM 数组替换循环查询。 2004-5-7 Mybbs.YangZheng If Not (Rs.Eof And Rs.Bof) Then Sql = Rs.GetRows(-1) Rs.Close:Set Rs = Nothing For Bn = 0 To Ubound(Sql,2) If Sql(0,Bn) = Mybbs.BoardID And CanTopTopic Then If Sql(1,Bn) = "" Or IsNull(Sql(1,Bn)) Then BoardTopStr = ID i = i + 1 Else If InStr("," & Sql(1,Bn) & ",", "," & ID & ",") > 0 Then BoardTopStr = Sql(1,Bn) Else BoardTopStr = Sql(1,Bn) & "," & ID i = i + 1 End If End If Mybbs.Execute("UPDATE Dv_Board SET BoardTopStr = '" & BoardTopStr & "' WHERE BoardID = " & Sql(0,Bn)) Mybbs.ReloadBoardInfo(Sql(0,Bn)) ElseIf CanTopTopic_m Then If Sql(1,Bn) = "" Or IsNull(Sql(1,Bn)) Then BoardTopStr = ID i = i + 1 Else If InStr("," & Sql(1,Bn) & ",", "," & ID & ",") > 0 Then BoardTopStr = Sql(1,Bn) Else BoardTopStr = Sql(1,Bn) & "," & ID i = i + 1 End If End If Mybbs.Execute("UPDATE Dv_Board SET BoardTopStr = '" & BoardTopStr & "' WHERE BoardID = " & Sql(0,Bn)) Mybbs.ReloadBoardInfo(Sql(0,Bn)) End If BoardTopStr = "" Next End If If i > 0 And CanTopTopic_m Then If IsTop = 0 Then TimeAdd = 200 If IsTop = 1 Then TimeAdd = 100 If IsTop = 2 Then TimeAdd = 0 If IsTop = 3 Then TimeAdd = -100 If IsSqlDataBase=1 Then Mybbs.Execute("update dv_topic set istop=2,LastPostTime=dateadd(day,"&TimeAdd&",LastPostTime) where boardID="&Mybbs.BoardID&" and topicID="&ID) Else Mybbs.Execute("update dv_topic set istop=2,LastPostTime=dateadd('d',"&TimeAdd&",LastPostTime) where boardID="&Mybbs.BoardID&" and topicID="&ID) End If ElseIf i > 0 And CanTopTopic Then If IsTop = 0 Then TimeAdd = 100 If IsTop = 1 Then TimeAdd = 0 If IsTop = 2 Then TimeAdd = -100 If IsTop = 3 Then TimeAdd = -200 If IsSqlDataBase=1 Then Mybbs.Execute("update dv_topic set istop=1,LastPostTime=dateadd(day,"&TimeAdd&",LastPostTime) where boardID="&Mybbs.BoardID&" and topicID="&ID) Else Mybbs.Execute("update dv_topic set istop=1,LastPostTime=dateadd('d',"&TimeAdd&",LastPostTime) where boardID="&Mybbs.BoardID&" and topicID="&ID) End If End If End If Set Rs=Nothing End If End If Insert_Forum_Log() Update_User_Point("") Topic_Manage_Sms() Mybbs.Dvbbs_Suc(SucMsgInfo(sucmsg)) Else Dim Body,TempStr,BoardJump TempStr = template.html(3) Set Rs=Mybbs.Execute("Select title,Istop From Dv_Topic Where TopicID="&ID) IsTop = Rs(1) Set Rs=Mybbs.Execute("Select Body From "&TotalUseTable&" Where RootID="&ID&" And ParentID=0") Body = Left(Mybbs.HtmlEncode(Rs(0)),"250") & "..." Set Rs=Nothing TempStr = Replace(TempStr,"{$boardid}",Mybbs.BoardID) TempStr = Replace(TempStr,"{$id}",ID) TempStr = Replace(TempStr,"{$topic}",Mybbs.HtmlEncode(Topic)) TempStr = Replace(TempStr,"{$content}",Body) TempStr = Replace(TempStr,"{$reaction}",request("action")) '有总固顶和区域固顶权限则显示所有版面列表 If CanTopTopic_a Or CanTopTopic_m Then Set Rs=Mybbs.Execute("select boardid,boardtype,depth,BoardTopStr from dv_board order by rootid,orders") Else Set Rs=Mybbs.Execute("select boardid,boardtype,depth,BoardTopStr from dv_board Where BoardID="&Mybbs.BoardID) End If Do While Not Rs.Eof BoardJump = BoardJump & "<option " If rs(0)=Mybbs.boardid Then BoardJump = BoardJump & " selected" Else If Rs(3)<>"" And Not IsNull(Rs(3)) And IsTop>0 Then If Instr("," & Rs(3) & ",","," & ID & ",")>0 Then BoardJump = BoardJump & " selected" End If End If BoardJump = BoardJump & " value="&rs(0)&">" Select Case rs(2) Case 0 BoardJump = BoardJump & "╋" Case 1 BoardJump = BoardJump & " ├" End Select If rs(2)>1 Then For ii=2 To rs(2) BoardJump = BoardJump & " │" Next BoardJump = BoardJump & " ├" End If BoardJump = BoardJump & rs(1) BoardJump = BoardJump & "</option>" Rs.MoveNext Loop Set Rs=Nothing TempStr = Replace(TempStr,"{$boardselected}",BoardJump) If Not CanTopTopic_a Then TempStr = Replace(TempStr,"{$checkbox1}","disabled") If IsTop = 3 Then TempStr = Replace(TempStr,"{$checkbox1}","checked") TempStr = Replace(TempStr,"{$checkbox1}","") TempStr = Replace(TempStr,"{$title}",Mybbs.htmlencode(Request.form("title"))) TempStr = Replace(TempStr,"{$msgcontent}",Mybbs.htmlencode(Request.form("content"))) TempStr = Replace(TempStr,"{$doWealth}",doWealth) TempStr = Replace(TempStr,"{$dousercp}",dousercp) TempStr = Replace(TempStr,"{$douserep}",douserep) TempStr = Replace(TempStr,"{$msg}",Request.form("msg")) TempStr = Replace(TempStr,"{$ismsg}",Request.form("ismsg")) If Mybbs.GroupSetting(21)="1" Then TempStr = Replace(TempStr,"{$boardtop}","√") TempStr = Replace(TempStr,"{$boardtop}","<font color=red>×</font>") If Mybbs.GroupSetting(54)="1" Then TempStr = Replace(TempStr,"{$areatop}","√") TempStr = Replace(TempStr,"{$areatop}","<font color=red>×</font>") If Mybbs.GroupSetting(38)="1" Then TempStr = Replace(TempStr,"{$alltop}","√") TempStr = Replace(TempStr,"{$alltop}","<font color=red>×</font>") Response.Write TempStr End If End Sub '单帖屏蔽帖子 Public Sub islockpage() LogType=5 Get_RequestInfo Mybbs.Execute("Update "&TotalUseTable&" Set LockTopic=2 where boardID="&Mybbs.BoardID&" and announceID="&replyID) GetUserID Insert_Forum_Log() Update_User_Point("") Topic_Manage_Sms() Mybbs.Dvbbs_Suc(SucMsgInfo(sucmsg)) End Sub Sub GetUserID() Dim Rs Set Rs=Mybbs.Execute("Select PostUserid,UserName From "&TotalUseTable&" Where announceID="&replyID&"") If Not Rs.EOF Then TopicUserID=Rs(0) TopicUsername=Rs(1) End If Set Rs=Nothing End Sub '解除单帖屏蔽帖子 Public Sub nolockpage() LogType=3 Get_RequestInfo Mybbs.Execute("Update "&TotalUseTable&" set LockTopic=0 Where boardID="&Mybbs.BoardID&" and announceID="&replyID) GetUserID Insert_Forum_Log() Update_User_Point("") Topic_Manage_Sms() Mybbs.Dvbbs_Suc(SucMsgInfo(sucmsg)) End Sub Public Sub fixtopic() Dim myistop LogType=3 'Get_RequestInfo sucmsg="修复帖子" Set Rs=Mybbs.Execute("select istop from dv_topic where boardID="&Mybbs.BoardID&" and topicID="&ID) If Rs.Eof And Rs.Bof Then Mybbs.AddErrCode(32) Exit Sub End If myistop=rs(0) Set Rs=Mybbs.Execute("Select count(*),max(DateAndTime) from "&TotalUseTable&" where (Not BoardID In (444,777)) And RootID="&ID) If Not IsNull(rs(0)) And Not IsNull(rs(1)) Then If myistop=0 Then Mybbs.Execute("update dv_topic set child="&Rs(0)-1&",LastPostTime='"&rs(1)&"' where topicID="&ID) ElseIf myistop=1 Then If IsSqlDataBase=1 Then Mybbs.Execute("update dv_topic set child="&Rs(0)-1&",LastPostTime=DateAdd(d,100,'"&rs(1)&"') where topicID="&ID) Else Mybbs.Execute("update dv_topic set child="&Rs(0)-1&",LastPostTime=DateAdd('d',100,'"&rs(1)&"') where topicID="&ID) End If ElseIf myistop=2 Then If IsSqlDataBase=1 Then Mybbs.Execute("update dv_topic set child="&Rs(0)-1&",LastPostTime=DateAdd(d,200,'"&rs(1)&"') where topicID="&ID) Else Mybbs.Execute("update dv_topic set child="&Rs(0)-1&",LastPostTime=DateAdd('d',200,'"&rs(1)&"') where topicID="&ID) End If ElseIf myistop=3 Then If IsSqlDataBase=1 Then Mybbs.Execute("update dv_topic set child="&Rs(0)-1&",LastPostTime=DateAdd(d,300,'"&rs(1)&"') where topicID="&ID) Else Mybbs.Execute("update dv_topic set child="&Rs(0)-1&",LastPostTime=DateAdd('d',300,'"&rs(1)&"') where topicID="&ID) End If End If Set Rs=Nothing End If Insert_Forum_Log() Update_User_Point("") Topic_Manage_Sms() Mybbs.Dvbbs_Suc(SucMsgInfo(sucmsg)) End Sub '精华帖子 Public Sub isbest() LogType=3 Dim datetimestr Get_RequestInfo Set rs=Mybbs.Execute("Select * From "&TotalUseTable&" Where boardid="&Mybbs.boardid&" and AnnounceID="&replyID) If rs.eof and rs.bof Then Mybbs.AddErrCode(32) Exit Sub End If topic=rs("topic") topicusername=rs("username") topicuserID=rs("postuserID") If topic="" Then topic=left(replace(rs("body"),chr(10),","),26) datetimestr=replace(replace(rs("dateandtime"),"上午",""),"下午","") Mybbs.Execute("Update "&TotalUseTable&" Set isbest=1 where boardID="&Mybbs.BoardID&" and announceID="&replyID) Mybbs.Execute("Update Dv_topic Set isbest=1 where boardID="&Mybbs.BoardID&" and topicID="&ID) Mybbs.Execute("Insert Into Dv_bestTopic (title,boardID,AnnounceID,rootID,postusername,postuserID,dateandtime,expression) values ('"&Mybbs.CheckStr(topic)&"',"&rs("boardID")&","&rs("AnnounceID")&","&rs("rootID")&",'"&Mybbs.CheckStr(topicusername)&"',"&rs("postuserID")&",'"&datetimestr&"','"&rs("expression")&"')") Set Rs=Nothing Insert_Forum_Log() Update_User_Point(",userIsBest=userisBest+1") Topic_Manage_Sms() Mybbs.Dvbbs_Suc(SucMsgInfo(sucmsg)) End Sub '解除精华帖子 Public Sub nobest() LogType=3 Dim datetimestr Get_RequestInfo Set rs=Mybbs.Execute("Select * From "&TotalUseTable&" Where boardid="&Mybbs.boardid&" and AnnounceID="&replyID) If rs.eof and rs.bof Then Mybbs.AddErrCode(32) Exit Sub End If topic=rs("topic") topicusername=rs("username") topicuserID=rs("postuserID") If topic="" Then topic="本帖子为回复帖子" Set Rs=Nothing Mybbs.Execute("Update "&TotalUseTable&" set isbest=0 Where boardID="&Mybbs.BoardID&" and announceID="&replyID) Mybbs.Execute("Update Dv_topic set isbest=0 Where boardID="&Mybbs.BoardID&" and topicID="&ID) Mybbs.Execute("Delete from Dv_besttopic Where AnnounceID="&replyID) Insert_Forum_Log() Update_User_Point(",userIsBest=userisBest-1") Topic_Manage_Sms() Mybbs.Dvbbs_Suc(SucMsgInfo(sucmsg)) End Sub '删除跟贴 Public Sub dele(md) Dim todaynum Dim isbest,IsUpload todaynum=0 Set rs=Mybbs.Execute("select topic,username,postuserID,DateAndTime,isbest,IsUpload from "&TotalUseTable&" where boardid="&Mybbs.boardid&" and AnnounceID="&replyID) If Not rs.eof Then Topic=Mybbs.CheckStr(rs(0)) topicusername=rs(1) topicuserID=rs(2) isbest=rs(4) IsUpload=rs(5) If topic="" Then topic="本帖子为回复帖子" If datediff("d",rs(3),now())=0 Then todaynum=1 Else todaynum=0 End If Else If md=1 Then Mybbs.AddErrCode(32) Exit Sub End If End If Set Rs=Nothing '判断用户是否有删除帖子权限 If Not CanDelTopic Then Mybbs.AddErrCode(28) Exit Sub End If LogType=3 Get_RequestInfo Dim LastPostime,istop '删除时自动删除精华回复帖 If IsBest=1 Then Mybbs.Execute("update dv_topic set isbest=0 where boardid="&Mybbs.BoardID&" and topicid="&ID) Mybbs.Execute("delete from dv_besttopic where Announceid="&replyID) End If Set Rs=Mybbs.Execute("select istop from dv_topic where boardID="&Mybbs.BoardID&" and topicID="&ID) istop=Rs(0) Rs.close Mybbs.Execute("Update "&TotalUseTable&" Set BoardID=444,locktopic="&Mybbs.BoardID&" Where BoardID="&Mybbs.BoardID&" And AnnounceID="&replyID) Set Rs=Mybbs.Execute("select Max(dateandtime) from "&TotalUseTable&" where boardID="&Mybbs.BoardID&" and rootID="&ID) LastPostime=rs(0) Set Rs=Nothing isLastPost call LastCount(Mybbs.boardID) call BoardNumSub(Mybbs.boardID,0,1,todaynum) call AllboardNumSub(todaynum,1,0) If IsUpload=1 Then If Request.form("delupfile")<>"" and Request.form("delupfile")=1 Then Call Delupfiles(Mybbs.BoardID,ID&"|"&replyID) Else '更新上传附件数据 Mybbs.Execute("update Dv_Upfile Set F_flag=4 Where F_BoardID="&Mybbs.BoardID&" And F_AnnounceID LIKE '"&ID&"|"&replyID&"' ") End If End IF If istop>0 Then sql="update dv_topic set child=child-1 where boardID="&Mybbs.BoardID&" and topicID="&ID Else sql="update dv_topic set child=child-1,LastPostTime='"&LastPostime&"' where boardID="&Mybbs.BoardID&" and topicID="&ID End If 'Response.Write sql Mybbs.Execute(sql) Insert_Forum_Log() Update_User_Point(",UserPost=UserPost-1,userDel=userDel-1") Topic_Manage_Sms() If md=1 Then Mybbs.Dvbbs_Suc(SucMsgInfo(sucmsg)) End If End Sub '删除主贴 Public Sub delete() Dim voteID,isvote,isbest,istop set rs=Mybbs.Execute("select title,postusername,postuserID,PollID,isvote,isbest,istop from dv_topic where boardid="&Mybbs.boardid&" and topicID="&ID) If rs.eof and rs.bof Then Mybbs.AddErrCode(32) Exit Sub Else Topic=rs(0) topicusername=rs(1) topicuserID=rs(2) voteID=rs(3) isvote=rs(4) isbest=rs(5) istop=rs(6) If topic="" Then topic="本帖子为回复帖子" End If Set Rs=Nothing LogType=3 Get_RequestInfo Dim todaynum,postnum set rs=Mybbs.Execute("select count(*) from "&TotalUseTable&" where rootID="&ID) postNum=rs(0) If IsSqlDataBase=1 Then sql="select count(*) from "&TotalUseTable&" where rootID="&ID&" and dateandtime>'"&date()&"'" else sql="select count(*) from "&TotalUseTable&" where rootID="&ID&" and dateandtime>#"&date()&"#" end if Set Rs=Mybbs.Execute(sql) todayNum=rs(0) '放入回收站,回收站boardid为444,locktopic为原版面ID Mybbs.Execute("update "&TotalUseTable&" set BoardID=444,locktopic="&Mybbs.BoardID&" where rootID="&ID) If isvote=1 Then Mybbs.Execute("update dv_topic set BoardID=444,locktopic="&Mybbs.BoardID&",isvote=0,VoteTotal=0 where topicID="&ID) Mybbs.Execute("delete from dv_vote where voteID="&voteID) Mybbs.Execute("delete from dv_voteuser where voteID="&voteID) '删帖时自动解除精华帖子 ElseIf isbest=1 Then Mybbs.Execute("update dv_topic set BoardID=444,locktopic="&Mybbs.BoardID&",isbest=0 where topicid="&id) Mybbs.Execute("delete from dv_besttopic where rootid="&id) Else Mybbs.Execute("update dv_topic set BoardID=444,locktopic="&Mybbs.BoardID&" where topicID="&ID) End If If istop>0 Then Mybbs.Execute("update dv_topic set istop=0,LastPostTime="&SqlNowString&" where topicid="&ID) If istop=3 Then '将总固顶ID从总设置表去除 Set Rs=Mybbs.Execute("Select Forum_AllTopNum From Dv_Setup") Dim iForum_AllTopNum,mForum_AllTopNum iForum_AllTopNum = "," & Rs(0) & "," If Instr(iForum_AllTopNum,"," & ID & ",")>0 Then iForum_AllTopNum = Split(iForum_AllTopNum,",") For i=1 To Ubound(iForum_AllTopNum)-1 If Cstr(Trim(iForum_AllTopNum(i)))<>Cstr(ID) Then If mForum_AllTopNum="" Then mForum_AllTopNum = iForum_AllTopNum(i) Else mForum_AllTopNum = mForum_AllTopNum & "," & iForum_AllTopNum(i) End If End If Next Mybbs.Execute("Update Dv_Setup Set Forum_AllTopNum='"&mForum_AllTopNum&"'") 'Mybbs.Name="setup" 'Mybbs.ReloadSetup Mybbs.ReloadSetupCache mForum_AllTopNum,28 End If Set Rs=Nothing Else '将固顶贴ID从版面表中去除 '查询得出原来该贴所固顶的版面 Dim BoardTopStr,iBoardTopStr Set Rs=Mybbs.Execute("Select BoardID,BoardTopStr From Dv_Board Where BoardTopStr Like '%"&ID&"%'") Do While Not Rs.Eof If Rs(1)="" Or IsNull(Rs(1)) Then iBoardTopStr = "" Else If InStr(","&Rs(1)&",",","&ID&",")>0 Then BoardTopStr = "," & Rs(1) & "," BoardTopStr = Split(BoardTopStr,",") For i = 1 To Ubound(BoardTopStr)-1 If Cstr(Trim(BoardTopStr(i)))<>Cstr(ID) Then If iBoardTopStr="" Then iBoardTopStr = BoardTopStr(i) Else iBoardTopStr = iBoardTopStr & "," & BoardTopStr(i) End If End If Next Else iBoardTopStr = Rs(1) End If End If Mybbs.Execute("Update Dv_Board Set BoardTopStr='"&iBoardTopStr&"' Where BoardID="&Rs(0)) Mybbs.ReloadBoardInfo(Rs(0)) BoardTopStr = "" iBoardTopStr = "" Rs.Movenext Loop Set Rs=Nothing End If End If If Request.form("delupfile")="1" Then Call Delupfiles(Mybbs.BoardID,ID&"|") Else '上传文件数据更新 Mybbs.Execute("update Dv_Upfile Set F_flag=4 Where F_BoardID="&Mybbs.BoardID&" And F_AnnounceID LIKE '"&ID&"|"&"%' ") End IF call LastCount(Mybbs.boardID) call BoardNumSub(Mybbs.boardID,1,postNum,todayNum) call AllboardNumSub(todayNum,postNum,1) Insert_Forum_Log() Topic_Manage_Sms() Mybbs.Dvbbs_Suc(SucMsgInfo(sucmsg)) If AllMsg<>"" Then Set Rs=Mybbs.Execute("select postuserID from "&TotalUseTable&" where rootID="&ID) Do While Not Rs.Eof TopicUserID = Rs(0) Update_User_Point(",UserPost=UserPost-1,userDel=userDel-1") Rs.MoveNext Loop End If Set Rs=Nothing End Sub '移动帖子 Public Sub Tmove() LogType=3 Get_RequestInfo Dim reBoard_Setting,newboardID,newParentID,nrs,newtopic Set Rs=Server.CreateObject("ADODB.RecordSet") If Request("checked")="yes" Then If Request("boardID")=Request("newboardID") Then Mybbs.AddErrCode(40) Exit Sub ElseIf not IsNumeric(Request("newboardID")) Then Mybbs.AddErrCode(29) Exit Sub Else newboardID=Request("newboardID") End If '目标论坛和其上级论坛ID set rs=Mybbs.Execute("select ParentStr,Board_Setting from dv_board where boardID="&newboardID) UpdateBoardID_1=rs(0) & "," & newboardID reBoard_Setting=split(rs(1),",") If Cint(reBoard_Setting(43))=1 Then Mybbs.AddErrCode(41) Exit Sub End If sql="select * from dv_topic where boardID="&Mybbs.BoardID&" and topicID="&ID set rs=Mybbs.Execute(sql) If rs.eof and rs.bof Then Mybbs.AddErrCode(32) Exit Sub Else If Request.form("isdispmove")="yes" Then newtopic=Mybbs.CheckStr(Request.form("topic")) & "-->" & Mybbs.MemberName & "转移" Else newtopic=Mybbs.CheckStr(Request.form("topic")) End If If Request("leavemessage")="yes" Then sql="insert into dv_topic (Title,BoardID,PostUsername,PostUserID,DateAndTime,Expression,LastPost,LastPostTime,child,hits,isvote,isbest,votetotal,PostTable) values ('"&newtopic&"',"&newboardID&",'"&rs("postusername")&"',"&rs("postuserID")&",'"&rs("dateandtime")&"','"&rs("Expression")&"','"&rs("LastPost")&"','"&rs("LastPosttime")&"',"&rs("child")&","&rs("hits")&","&rs("isvote")&",0,"&rs("votetotal")&",'"&Mybbs.NowUseBBS&"')" Mybbs.Execute(sql) End If End If If Request("leavemessage")="yes" Then Mybbs.Execute("update dv_topic set locktopic=1 where topicID="&ID) set rs=Mybbs.Execute("select Max(topicID) from dv_topic where boardid="&newboardID) newparentID=rs(0) sql="select * from "&TotalUseTable&" where rootID="&ID&" order by AnnounceID" set rs=Mybbs.Execute(sql) do while not rs.eof Sql="insert into "&Mybbs.NowUseBBS&"(BoardID,ParentID,username,topic,body,DateAndTime,length,rootID,layer,orders,ip,Expression,locktopic,signflag,emailflag,isbest,postuserID,UbbList) values "&_ "("&_ newboardID&","&rs("parentID")&",'"&_ rs("username")&"','"&_ Mybbs.CheckStr(rs("topic"))&"','"&_ Mybbs.CheckStr(rs("body"))&"','"&_ rs("DateAndTime")&"','"&_ rs("length")&"',"&newParentID&","&rs("layer")&","&rs("orders")&",'"&rs("ip")&"','"&_ rs("Expression")&"',"&rs("locktopic")&","&rs("signflag")&","&rs("emailflag")&",0,"&rs("postuserID")&",'"&rs("UbbList")&"')" 'response.write sql Mybbs.Execute(sql) rs.movenext loop ElseIf Request("leavemessage")="no" Then If Request.form("isdispmove")="yes" Then newtopic=Mybbs.CheckStr(Request.form("topic")) & "-->" & Mybbs.MemberName & "转移" Else newtopic=Mybbs.CheckStr(Request.form("topic")) End If '移动且不保留时自动解除精华帖子 if rs("isbest")=1 then Mybbs.Execute("update dv_topic set title='"&newtopic&"',boardid="&newboardid&",isbest=0 where topicid="&id) Mybbs.Execute("update "&TotalUseTable&" set topic='"&newtopic&"',isbest=0 where announceid="&replyid) Mybbs.Execute("update "&TotalUseTable&" set boardid="&newboardid&",isbest=0 where rootid="&id) Mybbs.Execute("delete from dv_besttopic where rootid="&id) else Mybbs.Execute("update dv_topic set title='"&newtopic&"',boardid="&newboardid&" where topicid="&id) Mybbs.Execute("update "&TotalUseTable&" set topic='"&newtopic&"' where announceid="&replyid) Mybbs.Execute("update "&TotalUseTable&" set boardid="&newboardid&" where rootid="&id) end if '移动时判断是否固顶并作相关处理 2004-4-25 Mybbs.YangZheng If Rs("istop") > 0 Then Dim Yrs, TopstrinfoN, TopstrinfoO '读取新旧版面的固顶信息 Set Yrs = Mybbs.Execute("SELECT BoardTopStr From Dv_Board Where Boardid = " & Mybbs.Boardid) TopstrinfoO = Yrs(0) Set Yrs = Mybbs.Execute("SELECT BoardTopStr From Dv_Board Where Boardid = " & Newboardid) TopstrinfoN = Yrs(0) Yrs.Close:Set Yrs = Nothing '删除原固顶主题ID TopstrinfoO = Replace(TopstrinfoO, Cstr(Rs("TopicID"))&",", "") TopstrinfoO = Replace(TopstrinfoO, ","&Cstr(Rs("TopicID")), "") TopstrinfoO = Replace(TopstrinfoO, Cstr(Rs("TopicID")), "") If TopstrinfoN = "" Or Isnull(TopstrinfoN) Then TopstrinfoN = Cstr(Rs("TopicID")) ElseIf TopstrinfoN = Cstr(Rs("TopicID")) Then TopstrinfoN = TopstrinfoN ElseIf Instr(TopstrinfoN, ","&Cstr(Rs("TopicID"))) > 0 Then TopstrinfoN = TopstrinfoN Else TopstrinfoN = TopstrinfoN & "," & Cstr(Rs("TopicID")) End If '更新当前版面固顶信息及缓存 Sql = "UPDATE Dv_Board SET BoardTopStr = '" & TopstrinfoO & "' WHERE BoardID = " & Mybbs.Boardid Mybbs.Execute(Sql) Mybbs.ReloadBoardInfo(Mybbs.Boardid) '更新新版面固顶信息及缓存 Sql = "UPDATE Dv_Board SET BoardTopStr = '" & TopstrinfoN & "' WHERE Boardid = " & Newboardid Mybbs.Execute(Sql) Mybbs.ReloadBoardInfo(Newboardid) End If '批量移动上传文件数据 dim F_announceID F_announceID=id & "|" Mybbs.Execute("update DV_Upfile set F_readme='"&newtopic&"',F_boardid="&newboardid&" where F_announceID like '"& F_announceID&"%'") Else Mybbs.AddErrmsg "请选择相应操作。" exit sub End If Dim postNum,todayNum '计算该帖子的回复数量,用来统计对应版面帖子数 set rs=Mybbs.Execute("select count(*) from "&TotalUseTable&" where rootID="&ID) postNum=rs(0) '计算该帖子中今日回复的数量 If IsSqlDataBase=1 Then sql="select count(*) from "&TotalUseTable&" where rootID="&ID&" and dateandtime>='"&date()&"'" else sql="select count(*) from "&TotalUseTable&" where rootID="&ID&" and dateandtime>=#"&date()&"#" end if Set Rs=Mybbs.Execute(sql) todayNum=rs(0) set rs=nothing '更新论坛贴子数据 call LastCount(Mybbs.boardID) call BoardNumSub(Mybbs.boardID,1,postNum,todayNum) UpdateBoardID=UpdateBoardID_1 call LastCount(newboardID) call BoardNumAdd(newboardID,1,postNum,todayNum) '更新论坛数据结束 Insert_Forum_Log() Update_User_Point("") Topic_Manage_Sms() Mybbs.Dvbbs_Suc(SucMsgInfo(sucmsg)) Else Dim TempStr,BoardJumpList,ii TempStr = template.html(1) TempStr = Replace(TempStr,"{$boardid}",Request("boardID")) TempStr = Replace(TempStr,"{$replyID}",Request("replyID")) TempStr = Replace(TempStr,"{$ID}",Request("ID")) TempStr = Replace(TempStr,"{$title}",Mybbs.htmlencode(Request.form("title"))) TempStr = Replace(TempStr,"{$content}",Mybbs.htmlencode(Request.form("content"))) TempStr = Replace(TempStr,"{$doWealth}",doWealth) TempStr = Replace(TempStr,"{$dousercp}",dousercp) TempStr = Replace(TempStr,"{$douserep}",douserep) TempStr = Replace(TempStr,"{$msg}",Request.form("msg")) TempStr = Replace(TempStr,"{$ismsg}",Request.form("ismsg")) TempStr = Replace(TempStr,"{$topic}",Server.Htmlencode(Topic)) Set Rs=Mybbs.Execute("select boardID,boardtype,depth,Board_Setting from dv_board Where Not BoardID in (444,777) order by rootID,orders") Do While Not Rs.Eof reBoard_Setting=split(rs(3),",") BoardJumpList = BoardJumpList & "<option value="""&rs(0)&""" " BoardJumpList = BoardJumpList & ">" Select Case rs(2) Case 0 BoardJumpList = BoardJumpList & "╋" Case 1 BoardJumpList = BoardJumpList & " ├" End Select If rs(2)>1 Then For ii=2 To rs(2) BoardJumpList = BoardJumpList & " │" Next BoardJumpList = BoardJumpList & " ├" End If BoardJumpList = BoardJumpList & rs(1) If Cint(reBoard_Setting(43))=1 Then BoardJumpList = BoardJumpList & "(不许转移)" End If BoardJumpList = BoardJumpList & "</option>" Rs.MoveNext Loop Set Rs=Nothing TempStr = Replace(TempStr,"{$BoardJumpList}",BoardJumpList) Response.Write TempStr End If End Sub '复制帖子 Public Sub copy() Dim reBoard_Setting set rs=Mybbs.Execute("select topic,username,postuserID from "&TotalUseTable&" where boardid="&Mybbs.boardid&" and AnnounceID="&replyID) If rs.eof and rs.bof Then Mybbs.AddErrCode(32) exit sub Else Topic=rs(0) topicusername=rs(1) topicuserID=rs(2) If topic="" Then topic="本帖子为回复帖子" End If Set Rs=Nothing '判断用户是否有移动帖子权限 If Not CanMoveTopic Then Mybbs.AddErrCode(28) exit sub End If LogType=3 Get_RequestInfo If Request("checked")="yes" Then Dim newboardID Dim todaynum,postnum set rs=Mybbs.Execute("select count(*) from "&TotalUseTable&" where rootID="&ID) postNum=rs(0) If IsSqlDataBase=1 Then sql="select count(*) from "&TotalUseTable&" where rootID="&ID&" and dateandtime>'"&date()&"'" else sql="select count(*) from "&TotalUseTable&" where rootID="&ID&" and dateandtime>#"&date()&"#" end if set rs=Mybbs.Execute(sql) todayNum=rs(0) If Request("boardID")=Request("newboardID") Then Mybbs.AddErrCode(40) exit sub ElseIf not IsNumeric(Request("newboardID")) Then Mybbs.AddErrCode(29) exit sub Else newboardID=Request("newboardID") End If '目标论坛和其上级论坛ID set rs=Mybbs.Execute("select ParentStr,Board_Setting from dv_board where boardID="&newboardID) UpdateBoardID=rs(0) & "," & newboardID reBoard_Setting=split(rs(1),",") If Cint(reBoard_Setting(43))=1 Then Mybbs.AddErrCode(41) exit sub End If set rs=Mybbs.Execute("select boardID from "&TotalUseTable&" where announceID="&replyID&" and boardID="&Mybbs.BoardID) If rs.eof and rs.bof Then Mybbs.AddErrCode(32) exit sub End If Dim newtopic,trs set rs=server.createobject("adodb.recordset") sql="select * from "&TotalUseTable&" where announceID="&replyID rs.open sql,conn,1,1 If Request.form("isdispmove")="yes" Then newtopic=Mybbs.CheckStr(Request.form("topic")) & "-->" & Mybbs.MemberName & "添加" Else newtopic=Mybbs.CheckStr(Request.form("topic")) End If sql="insert into dv_topic (Title,BoardID,PostUsername,PostUserID,DateAndTime,Expression,LastPost,LastPostTime,child,hits,isvote,isbest,votetotal,PostTable) values ('"&newtopic&"',"&newboardID&",'"&rs("username")&"',"&rs("postuserID")&","&SqlNowString&",'"&rs("Expression")&"','"&rs("username")&"$#$"&Now()&"$$$$',"&SqlNowString&",0,0,0,0,0,'"&Mybbs.NowUseBBS&"')" Mybbs.Execute(sql) set trs=Mybbs.Execute("select Max(topicID) from dv_topic where boardid="&newboardID&" and postuserID="&rs("postuserID")) Sql="insert into "&Mybbs.NowUseBBS&"(BoardID,ParentID,username,topic,body,DateAndTime,length,rootID,layer,orders,ip,Expression,locktopic,signflag,emailflag,isbest,postuserID,UbbList) values "&_ "("&_ newboardID&",0,'"&_ rs("username")&"','"&_ newtopic&"','"&_ rs("body")&"','"&_ rs("DateAndTime")&"','"&_ rs("length")&"',"&trs(0)&",1,0,'"&rs("ip")&"','"&_ rs("Expression")&"',"&rs("locktopic")&","&rs("signflag")&","&rs("emailflag")&",0,"&rs("postuserID")&",'"&rs("UbbList")&"')" Mybbs.Execute(sql) rs.close set rs=nothing '移动上传文件数据 Dim F_announceID F_announceID=ID & "|" &replyID Mybbs.Execute("update DV_Upfile set F_readme='"&newtopic&"',F_boardid="&newboardid&" where F_announceID = '"& F_announceID&"'") '更新论坛贴子数据 call LastCount(NewboardID) call BoardNumAdd(newboardID,1,postNum,todayNum) call AllboardNumAdd(todayNum,postNum,1) Insert_Forum_Log() Update_User_Point("") Topic_Manage_Sms() Mybbs.Dvbbs_Suc(SucMsgInfo(sucmsg)) Else Dim TempStr,BoardJumpList TempStr = template.html(2) TempStr = Replace(TempStr,"{$boardid}",Request("boardID")) TempStr = Replace(TempStr,"{$replyID}",Request("replyID")) TempStr = Replace(TempStr,"{$ID}",Request("ID")) TempStr = Replace(TempStr,"{$title}",Mybbs.htmlencode(Request.form("title"))) TempStr = Replace(TempStr,"{$content}",Mybbs.htmlencode(Request.form("content"))) TempStr = Replace(TempStr,"{$doWealth}",doWealth) TempStr = Replace(TempStr,"{$dousercp}",dousercp) TempStr = Replace(TempStr,"{$douserep}",douserep) TempStr = Replace(TempStr,"{$msg}",Request.form("msg")) TempStr = Replace(TempStr,"{$ismsg}",Request.form("ismsg")) TempStr = Replace(TempStr,"{$topic}",Server.Htmlencode(Topic)) Dim ii Set Rs=Mybbs.Execute("select boardID,boardtype,depth,Board_Setting from dv_board Where Not BoardID in (444,777) order by rootID,orders") Do While Not Rs.Eof reBoard_Setting=split(rs(3),",") BoardJumpList = BoardJumpList & "<option value="""&rs(0)&""" " BoardJumpList = BoardJumpList & ">" Select Case rs(2) Case 0 BoardJumpList = BoardJumpList & "╋" Case 1 BoardJumpList = BoardJumpList & " ├" End Select If rs(2)>1 Then For ii=2 To rs(2) BoardJumpList = BoardJumpList & " │" Next BoardJumpList = BoardJumpList & " ├" End If BoardJumpList = BoardJumpList & rs(1) If Cint(reBoard_Setting(43))=1 Then BoardJumpList = BoardJumpList & "(不许转移)" End If BoardJumpList = BoardJumpList & "</option>" Rs.MoveNext Loop Set Rs=Nothing TempStr = Replace(TempStr,"{$BoardJumpList}",BoardJumpList) Response.Write TempStr End If End Sub Private Function SysObjFso() Dim xTestObj SysObjFso = False On Error Resume Next Set xTestObj = Server.CreateObject("Scripting.FileSystemObject") If Err = 0 Then SysObjFso = True Set xTestObj = Nothing Err = 0 End Function Private Sub Delupfiles(F_BoardID,F_announceID) Dim DelSql,DelRs,Filepath,ViewFilepath,objFSO,path If Mybbs.Forum_Setting(76)="" Or Mybbs.Forum_Setting(76)="0" Then Mybbs.Forum_Setting(76)="UploadFile/" If right(Mybbs.Forum_Setting(76),1)<>"/" Then Mybbs.Forum_Setting(76)=Mybbs.Forum_Setting(76)&"/" path=Mybbs.Forum_Setting(76) Err=0 On Error Resume Next Set objFSO = Server.CreateObject("Scripting.FileSystemObject") DelSql="Select F_Filename,F_Viewname,F_ID From Dv_Upfile Where F_BoardID="&F_BoardID&" And F_AnnounceID LIKE '"&F_announceID&"%' And F_Flag=0" Set DelRs=Mybbs.Execute(DelSql) Do While Not DelRs.Eof Filepath = path&DelRs(0) ViewFilepath = DelRs(1) If Err <> 0 Then Mybbs.Execute("update Dv_Upfile Set F_flag=4 Where F_BoardID="&F_BoardID&" And F_AnnounceID LIKE '"&F_announceID&"%'") Exit Sub Else If objFSO.FileExists(Server.MapPath(Filepath)) Then objFSO.DeleteFile(Server.MapPath(Filepath)) End If IF NOT IsNull(ViewFilepath) and ViewFilepath<>"" Then ViewFilepath=Replace(ViewFilepath,"..","") If objFSO.FileExists(Server.MapPath(ViewFilepath)) Then objFSO.DeleteFile(Server.MapPath(ViewFilepath)) End If End IF Mybbs.Execute("Delete from Dv_Upfile Where F_ID="&DelRs(2)) End If DelRs.MoveNext Loop DelRs.close:Set DelRs=Nothing Set objFSO=Nothing End Sub Function reUBBCode(strContent) Dim re Set re=new RegExp re.IgnoreCase =True re.Global=True strContent=replace(strContent," "," ") re.Pattern="(\[QUOTE\])(.*)(\[\/QUOTE\])" strContent=re.Replace(strContent,"$2") re.Pattern="(\[point=*([0-9]*)\])(.*)(\[\/point\])" strContent=re.Replace(strContent," ") re.Pattern="(\[post=*([0-9]*)\])(.*)(\[\/post\])" strContent=re.Replace(strContent," ") re.Pattern="(\[power=*([0-9]*)\])(.*)(\[\/power\])" strContent=re.Replace(strContent," ") re.Pattern="(\[usercp=*([0-9]*)\])(.*)(\[\/usercp\])" strContent=re.Replace(strContent," ") re.Pattern="(\[money=*([0-9]*)\])(.*)(\[\/money\])" strContent=re.Replace(strContent," ") re.Pattern="(\[replyview\])(.*)(\[\/replyview\])" strContent=re.Replace(strContent," ") re.Pattern="(\[usemoney=*([0-9]*)\])(.*)(\[\/usemoney\])" strContent=re.Replace(strContent," ") re.Pattern="\[username=(.[^\[]*)\](.[^\[]*)\[\/username\]" strContent=re.Replace(strContent," ") strContent=replace(strContent,"<I></I>","") set re=Nothing reUBBCode=strContent End Function '截取指定字符 Function cutStr(str,strlen) '去掉所有HTML标记 Dim re Set re=new RegExp re.IgnoreCase =True re.Global=True re.Pattern="<(.[^>]*)>" str=re.Replace(str,"") set re=Nothing Dim l,t,c,i l=Len(str) t=0 For i=1 to l c=Abs(Asc(Mid(str,i,1))) If c>255 Then t=t+2 Else t=t+1 End If If t>=strlen Then cutStr=left(str,i)&"..." Exit For Else cutStr=str End If Next str = dvHTMLEncode(str) cutStr=Replace(cutStr,chr(10),"") End Function Function dvHTMLEncode(fString) If Not IsNull(fString) Then fString = replace(fString, ">", ">") fString = replace(fString, "<", "<") fString = replace(fString, "&#", "<I>&#</I>") fString = Replace(fString, CHR(32), "<I></I> ") fString = Replace(fString, CHR(9), " ") fString = Replace(fString, CHR(34), """) fString = Replace(fString, CHR(39), "'") fString = Replace(fString, CHR(13), "") fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ") fString = Replace(fString, CHR(10), "<br> ") fString=Mybbs.ChkBadWords(fString) dvHTMLEncode = fString End If End Function End Class %>