<%
Dim FA
Dvbbs.LoadTemplates("fmanage")
Dvbbs.Stats=template.Strings(0)
Dvbbs.Nav()
Dvbbs.Showerr()
If Dvbbs.BoardID=0 Then
Dvbbs.AddErrCode(29)
Dvbbs.showerr()
End If
'修改权限判断已经在主类核心自动完成。
Dvbbs.Head_var 1,Dvbbs.BoardNode.attributes.getNamedItem("depth").text,"",""
Set FA=New Dv_Forum_Admin
FA.main
Dvbbs.ActiveOnline()
Set Fa=Nothing
Dvbbs.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 = Dvbbs.UserTrueIP
LocalCanLockTopic = False
LocalCanDelTopic = False
LocalCanMoveTopic = False
LocalCanTopTopic = False
LocalCanBestTopic = False
LocalCanAwardTopic = False
LocalCanTopTopic_a = False
LocalCanTopTopic_m = False
LocalCanTopicMode = False
'本论坛和上级论坛ID
'UpdateBoardID = Dvbbs.Board_Data(3,0) & "," & Dvbbs.BoardID
UpdateBoardID = Dvbbs.BoardNode.attributes.getNamedItem("parentstr").text & "," & Dvbbs.BoardID
doWealth = 0
douserEP = 0
douserCP = 0
doWealthMsg = ""
allmsg = "没有对用户进行分值操作"
If Dvbbs.UserID=0 Then Dvbbs.AddErrCode(6)
ID=Request("ID")
If ID="" or IsNumeric(ID)=0 Then
Dvbbs.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 Dvbbs.ErrCodes<>"" Then Dvbbs.ShowErr
Set Rs=Dvbbs.Execute("Select Title,Postusername,PostuserID,PostTable From Dv_Topic Where boardid="&dvbbs.boardid&" and TopicID="&ID)
If Rs.Eof And Rs.Bof Then
Dvbbs.AddErrCode(32)
Else
Topic=rs(0)
Topicusername=rs(1)
TopicuserID=Clng(rs(2))
TotalUseTable=rs(3)
End If
Set Rs=Nothing
If Dvbbs.ErrCodes<>"" Then Dvbbs.ShowErr
End Sub
'判断用户是否有专题管理操作权限
Public Property Get CanTopicMod()
If (dvbbs.master or dvbbs.superboardmaster or dvbbs.boardmaster) and Cint(Dvbbs.GroupSetting(65))=1 Then
CanTopicMode=True
End If
If Cint(Dvbbs.GroupSetting(19))=1 and Dvbbs.UserGroupID>3 Then
LocalCanTopicMod=True
End If
If Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(65))=1 and TopicUserID=Dvbbs.Userid Then
LocalCanTopicMod=True
Else
LocalCanTopicMod=False
End If
CanTopicMod=LocalCanTopicMod
End Property
'判断用户是否有锁定/解除锁定权限
Public Property Get CanLockTopic()
If (dvbbs.master or dvbbs.superboardmaster or dvbbs.boardmaster) and Cint(Dvbbs.GroupSetting(20))=1 Then LocalCanLockTopic=True
If Cint(Dvbbs.GroupSetting(20))=1 and Dvbbs.UserGroupID>3 Then LocalCanLockTopic=True
If (Cint(Dvbbs.GroupSetting(13))=1 and TopicUsername=Dvbbs.MemberName) Then LocalCanLockTopic=True
If Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(13))=1 and TopicUsername=Dvbbs.MemberName Then
LocalCanLockTopic=True
ElseIf Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(13))=0 and TopicUsername=Dvbbs.MemberName Then
LocalCanLockTopic=False
End If
If Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(20))=1 and TopicUsername<>Dvbbs.MemberName Then
LocalCanLockTopic=True
ElseIf Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(20))=0 and TopicUsername<>Dvbbs.MemberName Then
LocalCanLockTopic=False
End If
CanLockTopic=LocalCanLockTopic
End Property
'判断用户是否有移动帖子权限
Public Property Get CanMoveTopic()
If (dvbbs.master or dvbbs.superboardmaster or dvbbs.boardmaster) and Cint(Dvbbs.GroupSetting(19))=1 Then LocalCanMoveTopic=True
If Cint(Dvbbs.GroupSetting(19))=1 and Dvbbs.UserGroupID>3 Then LocalCanMoveTopic=True
If (Cint(Dvbbs.GroupSetting(12))=1 and TopicUsername=Dvbbs.MemberName) Then LocalCanMoveTopic=True
If Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(12))=1 and TopicUsername=Dvbbs.MemberName Then
LocalCanMoveTopic=True
ElseIf Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(12))=0 and TopicUsername=Dvbbs.MemberName Then
LocalCanMoveTopic=False
End If
If Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(19))=1 and TopicUsername<>Dvbbs.MemberName Then
LocalCanMoveTopic=True
ElseIf Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(19))=0 and TopicUsername<>Dvbbs.MemberName Then
LocalCanMoveTopic=False
End If
CanMoveTopic=LocalCanMoveTopic
End Property
'判断用户是否有删除帖子权限
Public Property Get CanDelTopic()
If (dvbbs.master or dvbbs.superboardmaster or dvbbs.boardmaster) and Cint(Dvbbs.GroupSetting(18))=1 Then LocalCanDelTopic=True
If Cint(Dvbbs.GroupSetting(18))=1 and Dvbbs.UserGroupID>3 Then LocalCanDelTopic=True
If (Cint(Dvbbs.GroupSetting(11))=1 and TopicUsername=Dvbbs.MemberName) Then LocalCanDelTopic=True
If Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(11))=1 and TopicUsername=Dvbbs.MemberName Then
LocalCanDelTopic=True
ElseIf Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(11))=0 and TopicUsername=Dvbbs.MemberName Then
LocalCanDelTopic=False
End If
If Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(18))=1 and TopicUsername<>Dvbbs.MemberName Then
LocalCanDelTopic=True
ElseIf Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(18))=0 and TopicUsername<>Dvbbs.MemberName Then
LocalCanDelTopic=False
End If
CanDelTopic=LocalCanDelTopic
End Property
'判断用户是否有固顶/解除固顶帖子权限
Public Property Get CanTopTopic()
If (dvbbs.master or dvbbs.superboardmaster or dvbbs.boardmaster) and Cint(Dvbbs.GroupSetting(21))=1 Then LocalCanTopTopic=True
If Cint(Dvbbs.GroupSetting(21))=1 and Dvbbs.UserGroupID>3 Then LocalCanTopTopic=True
If Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(21))=1 Then
LocalCanTopTopic=True
ElseIf Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(21))=0 Then
LocalCanTopTopic=False
End If
CanTopTopic=LocalCanTopTopic
End Property
'判断用户是否有总固顶帖子权限
Public Property Get CanTopTopic_a()
If (dvbbs.master or dvbbs.superboardmaster or dvbbs.boardmaster) and Cint(Dvbbs.GroupSetting(38))=1 Then LocalCanTopTopic_a=True
If Cint(Dvbbs.GroupSetting(38))=1 and Dvbbs.UserGroupID>3 Then LocalCanTopTopic_a=True
If Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(38))=1 Then
LocalCanTopTopic_a=True
ElseIf Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(38))=0 Then
LocalCanTopTopic_a=False
End If
CanTopTopic_a=LocalCanTopTopic_a
End Property
'判断用户是否有区域固顶帖子权限
Public Property Get CanTopTopic_m()
If (dvbbs.master or dvbbs.superboardmaster or dvbbs.boardmaster) and Cint(Dvbbs.GroupSetting(54))=1 Then LocalCanTopTopic_m=True
If Cint(Dvbbs.GroupSetting(54))=1 and Dvbbs.UserGroupID>3 Then LocalCanTopTopic_m=True
If Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(54))=1 Then
LocalCanTopTopic_m=True
ElseIf Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(54))=0 Then
LocalCanTopTopic_m=False
End If
CanTopTopic_m=LocalCanTopTopic_m
End Property
'判断用户是否有加入/解除精华帖子权限
Public Property Get CanBestTopic()
If (dvbbs.master or dvbbs.superboardmaster or dvbbs.boardmaster) and Cint(Dvbbs.GroupSetting(24))=1 Then LocalCanBestTopic=True
If Cint(Dvbbs.GroupSetting(24))=1 and Dvbbs.UserGroupID>3 Then LocalCanBestTopic=True
If Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(24))=1 Then
LocalCanBestTopic=True
ElseIf Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(24))=0 Then
LocalCanBestTopic=False
End If
CanBestTopic=LocalCanBestTopic
End Property
'判断用户是否有奖励/惩罚帖子权限
Public Property Get CanAwardTopic()
If (dvbbs.master or dvbbs.superboardmaster or dvbbs.boardmaster) and Cint(Dvbbs.GroupSetting(22))=1 Then LocalCanAwardTopic=True
If Cint(Dvbbs.GroupSetting(22))=1 and Dvbbs.UserGroupID>3 Then LocalCanAwardTopic=True
If Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(22))=1 Then
LocalCanAwardTopic=True
ElseIf Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(22))=0 Then
LocalCanAwardTopic=False
End If
CanAwardTopic=LocalCanAwardTopic
End Property
Public Function Main()
If Not Dvbbs.ChkPost() Then Dvbbs.AddErrCode(42):Dvbbs.Showerr()
Select Case Request("action")
Case "修复"
If Dvbbs.userid=0 Then
Dvbbs.AddErrCode(6)
Else
ActionInfo="修复帖子"
fixtopic()
End If
Case "lock"
If not CanLockTopic Then
Dvbbs.AddErrCode(28)
Else
ActionInfo="锁定帖子"
lock()
End If
Case "unlock"
If not CanLockTopic Then
Dvbbs.AddErrCode(28)
Else
ActionInfo="解除锁定"
unlock()
End If
Case "uptopic"
If Not CanLockTopic Then
Dvbbs.AddErrCode(28)
Else
ActionInfo="提升帖子"
uptopic()
End If
Case "downtopic"
If Not CanLockTopic Then
Dvbbs.AddErrCode(28)
Else
ActionInfo="沉底帖子"
downtopic()
End If
Case "move"
If not CanMoveTopic Then
Dvbbs.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
Dvbbs.AddErrCode(28)
End If
Case "delet"
If not CanDelTopic Then
Dvbbs.AddErrCode(28)
Else
ActionInfo="删除帖子"
delete()
End If
Case "dele"
ActionInfo="删除帖子"
dele(1)
Case "islockpage"
If not CanBestTopic Then
Dvbbs.AddErrCode(28)
Else
ActionInfo="单帖屏蔽"
islockpage()
End If
Case "nolockpage"
If not CanBestTopic Then
Dvbbs.AddErrCode(28)
Else
ActionInfo="解除屏蔽"
nolockpage()
End If
Case "isbest"
If not CanBestTopic Then
Dvbbs.AddErrCode(28)
Else
ActionInfo="精华帖子"
isbest()
End If
Case "nobest"
If not CanBestTopic Then
Dvbbs.AddErrCode(28)
Else
ActionInfo="解除精华"
nobest()
End If
Case "TopicMode"
ActionInfo="专题管理"
If not CanMoveTopic Then Dvbbs.AddErrCode(28)
TopicMode()
Case "delre"
ActionInfo="批量删除跟贴"
Call delre()
Case "SaveRewardMoney" '奖励金币操作
ActionInfo="帖子评价"
Call RewardMoney
Case Else
main_a()
End Select
If Dvbbs.ErrCodes<>"" Then Dvbbs.ShowErr()
End Function
'批量删除跟贴
Private Sub delre()
Check_topicInfo()
If Dvbbs.ErrCodes<>"" Then Exit Sub
'判断用户是否有删除帖子权限
If Not CanDelTopic Then Dvbbs.AddErrCode(28)
Dim DelID,j,i
j=0
DelID=Request("DelID")
If delid="" Then
Dvbbs.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
Dvbbs.Dvbbs_Suc(SucMsgInfo("批量删除"&j&"个跟贴,您的操作已经记录"))
Else
Dvbbs.AddErrCode(35)
End If
End Sub
Public Sub main_a()
Dim seldisable,reaction,Action
Dim postusername,DelUpFile
DelUpFile=0
Action=Request("action")
Select Case Action
Case "锁定"
If Not CanAwardTopic Then seldisable="disabled"
reaction="lock"
If not CanLockTopic Then Dvbbs.AddErrCode(28)
Case "解锁"
If Not CanAwardTopic Then seldisable="disabled"
reaction="unlock"
If not CanLockTopic Then Dvbbs.AddErrCode(28)
Case "提升"
If Not CanAwardTopic Then seldisable="disabled"
reaction="uptopic"
If not CanLockTopic Then Dvbbs.AddErrCode(28)
Case "沉底"
If Not CanAwardTopic Then seldisable="disabled"
reaction="downtopic"
If not CanLockTopic Then Dvbbs.AddErrCode(28)
Case "删除主题"
doWealth=-Dvbbs.Forum_user(3)
douserEP=-Dvbbs.Forum_user(8)
douserCP=-Dvbbs.Forum_user(13)
If Not CanAwardTopic Then seldisable="disabled"
reaction="delet"
If not CanDelTopic Then Dvbbs.AddErrCode(28)
If SysObjFso=True Then DelUpFile=1
Case "dele_a"
doWealth=-Dvbbs.Forum_user(3)
douserEP=-Dvbbs.Forum_user(8)
douserCP=-Dvbbs.Forum_user(13)
If Not CanAwardTopic Then seldisable="disabled"
reaction="dele"
Action="删除单贴"
Check_AnnounceInfo()
If Dvbbs.ErrCodes<>"" Then Exit Sub
'判断用户是否有删除帖子权限
If Not CanDelTopic Then Dvbbs.AddErrCode(28)
If SysObjFso=True Then DelUpFile=1
Case "islockpage_a"
doWealth=-Dvbbs.Forum_user(15)
douserEP=-Dvbbs.Forum_user(17)
douserCP=-Dvbbs.Forum_user(16)
If Not CanAwardTopic Then seldisable="disabled"
reaction="islockpage"
Action="单贴屏蔽"
Check_AnnounceInfo()
If Dvbbs.ErrCodes<>"" Then Exit Sub
If Not CanBestTopic Then Dvbbs.AddErrCode(28)
Case "nolockpage_a"
doWealth=Dvbbs.Forum_user(15)
douserEP=Dvbbs.Forum_user(17)
douserCP=Dvbbs.Forum_user(16)
If Not CanAwardTopic Then seldisable="disabled"
reaction="nolockpage"
Action="解除屏蔽"
Check_AnnounceInfo()
If Dvbbs.ErrCodes<>"" Then Exit Sub
If Not CanBestTopic Then Dvbbs.AddErrCode(28)
Case "isbest_a"
doWealth=Dvbbs.Forum_user(15)
douserEP=Dvbbs.Forum_user(17)
douserCP=Dvbbs.Forum_user(16)
If Not CanAwardTopic Then seldisable="disabled"
reaction="isbest"
Action="加为精华"
Check_AnnounceInfo()
If Dvbbs.ErrCodes<>"" Then Exit Sub
If Not CanBestTopic Then Dvbbs.AddErrCode(28)
Case "nobest_a"
doWealth=-Dvbbs.Forum_user(15)
douserEP=-Dvbbs.Forum_user(17)
douserCP=-Dvbbs.Forum_user(16)
If Not CanAwardTopic Then seldisable="disabled"
reaction="nobest"
Action="解除精华"
Check_AnnounceInfo()
If Dvbbs.ErrCodes<>"" Then Exit Sub
If not CanBestTopic Then Dvbbs.AddErrCode(28)
Case "copy_a"
seldisable="disabled"
reaction="copy"
Action="复制贴子"
Check_AnnounceInfo()
If Dvbbs.ErrCodes<>"" Then Exit Sub
'判断用户是否有移动帖子权限
If Not CanMoveTopic Then Dvbbs.AddErrCode(28)
Case "设置固顶"
If Not CanAwardTopic Then seldisable="disabled"
reaction="istop"
If CanTopTopic Or CanTopTopic_a Or CanTopTopic_m Then
Else
Dvbbs.AddErrCode(28)
End If
Case "编辑固顶"
If Not CanAwardTopic Then seldisable="disabled"
reaction="istop"
If CanTopTopic Or CanTopTopic_a Or CanTopTopic_m Then
Else
Dvbbs.AddErrCode(28)
End If
Case "移动"
seldisable="disabled"
reaction="move"
If Not CanMoveTopic Then Dvbbs.AddErrCode(28)
Case "专题管理"
If Not CanMoveTopic Then Dvbbs.AddErrCode(28)
reaction="TopicMode"
Case "跟贴管理"
doWealth=-Dvbbs.Forum_user(3)
douserEP=-Dvbbs.Forum_user(8)
douserCP=-Dvbbs.Forum_user(13)
Check_topicInfo()
If Dvbbs.ErrCodes<>"" Then Exit Sub
'判断用户是否有删除帖子权限
If Not CanDelTopic Then Dvbbs.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="&Dvbbs.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(Dvbbs.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(Dvbbs.ChkBadWords(rs("body"))),chr(10),""),35))
Else
treedata=Replace(treedata,"{$topic}",cutStr(Dvbbs.ChkBadWords(rs("Topic")),35))
End If
If j=0 Then
If star=1 Then
treedata=Replace(treedata,"{$del}","")
treedata=Replace(treedata,"{$alertcolor}",Dvbbs.mainsetting(1))
Else
treedata=Replace(treedata,"{$del}"," ")
treedata=Replace(treedata,"{$alertcolor}","")
End If
Else
treedata=Replace(treedata,"{$del}"," ")
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(Dvbbs.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}",Dvbbs.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 "
分页： "
Dim Endpage
If Star > 4 Then
Response.Write "[1] ..."
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 " ["&i&"]"
Else
Response.Write " ["&i&"]"
End If
End If
Next
If star+3 < Rs.PageCount Then
response.write "... ["&Rs.PageCount&"]"
End If
Response.Write "
"
Set Rs=Nothing
Response.Write ""
Response.Write Chr(10)
Exit Sub
Case "RewardMoney"
If Not ChkRewardMoney Then Dvbbs.AddErrCode(28) : Exit Sub
reaction = "SaveRewardMoney"
Action = "帖子评价"
Dim TempStr0
If Not Dvbbs.Master Then
template.Strings(3) = Replace(template.Strings(3),"{$PayMoney}",(Clng(Dvbbs.Forum_Setting(97))-Clng(Dvbbs.UserToday(4))))
TempStr0 = Replace(template.html(8),"{$UserTodyInfo}",template.Strings(3))
Else
TempStr0 = Replace(template.html(8),"{$UserTodyInfo}","")
End If
Case Else
Dvbbs.AddErrCode(35)
Exit Sub
End Select
Dim TempStr
TempStr = template.html(0)
If reaction = "SaveRewardMoney" Then
TempStr = Replace(TempStr,"{$ManageInfo}",TempStr0)
Else
TempStr = Replace(TempStr,"{$ManageInfo}",template.html(7))
End If
TempStr = Replace(TempStr,"{$reaction}",reaction)
TempStr = Replace(TempStr,"{$action}",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}",Dvbbs.BoardID)
TempStr = Replace(TempStr,"{$id}",id)
TempStr = Replace(TempStr,"{$replyid}",replyid)
TempStr = Replace(TempStr,"{$fileconfirm}",DelUpFile)
Dim TopicQuestion,iTopicQuestion
TopicQuestion = Split(Dvbbs.Board_Setting(65),"|")
For i = 0 To Ubound(TopicQuestion)
iTopicQuestion = iTopicQuestion & ""
Next
TempStr = Replace(TempStr,"{$topicquestion}",iTopicQuestion)
Response.Write TempStr
End Sub
Public Function Check_AnnounceInfo()
Set Rs=Dvbbs.Execute("Select topic,username,postuserID From "&TotalUseTable&" Where boardid="&Dvbbs.boardid&" and AnnounceID="&ReplyID)
If Rs.Eof And Rs.Bof Then
Dvbbs.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=Dvbbs.Execute("Select topic,username,postuserID From "&TotalUseTable&" Where ParentID=0 and boardid="&dvbbs.boardid&" and RootID="&ID)
If Rs.Eof And Rs.Bof Then
Dvbbs.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()
Dvbbs.Execute("Insert Into Dv_Log (l_AnnounceID,l_BoardID,l_touser,l_username,l_content,l_ip,l_type) values (" & ID & "," & Dvbbs.BoardID & ",'" & Dvbbs.CheckStr(TopicUsername) & "','" & Dvbbs.MemberName & "','" & Dvbbs.CheckStr(sucmsg) & "','" & IP & "',"&LogType&")")
End Function
Public Function Update_User_Point(SQLSTR)
If allmsg<>"" Then
Dvbbs.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="&Dvbbs.BoardID&"&ID="&ID&"]"&Topic&"[/url]》因"&replace(Content,"原因：","")&"而被"&ActionInfo&"，且进行了"&replace(Allmsg,"用户操作：","")&"的操作"
If Request("msg")<>"" Then msgContent=msgContent & chr(10) & "以下为操作者给您的附言：" & Request("msg")
Dvbbs.Execute("Insert Into Dv_Message(incept,sender,title,content,sendtime,flag,issend) values('"&Dvbbs.CheckStr(TopicUsername)&"','"&Dvbbs.MemberName&"','系统消息','"&Dvbbs.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
Dvbbs.Execute("Update [Dv_User] Set UserMsg='"&dvbbs.CheckStr(msginfo)&"' Where username='"&dvbbs.CheckStr(username)&"'")
End Function
'统计留言
Public Function newincept(iusername)
Dim rs
Rs=Dvbbs.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=Dvbbs.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=Dvbbs.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=Dvbbs.Execute("select top 1 topic,body,AnnounceID,dateandtime,username,PostUserID,rootID,boardID from "&TotalUseTable&" where BoardID="&Dvbbs.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)
Dvbbs.BoardID=rs(7)
Else
LastTopic="无"
LastRootID=0
LastPostTime=now()
LastPostUser="无"
LastPostUserID=0
LastID=0
Dvbbs.BoardID=0
End If
set rs=nothing
LastPost=LastPostUser & "$" & LastRootID & "$" & LastPostTime & "$" & replace(left(LastTopic,20),"$","") & "$" & uploadpic_n & "$" & LastPostUserID & "$" & LastID & "$" & Dvbbs.BoardID
Dvbbs.Execute("update Dv_topic set LastPost='"&LastPost&"' where topicID="&ID)
End If
End Function
'更新帖子最后回复信息 2005-1-12 Dv.Yz
Public Function FixLastPost()
Dim LastTopic,body,LastRootID,LastPostTime,LastPostUser
Dim LastPost,uploadpic_n,LastPostUserID,LastID
Set Rs = Dvbbs.Execute("SELECT TOP 1 Topic, Body, AnnounceID, Dateandtime, Username, PostUserID, RootID, BoardID FROM " & TotalUseTable & " WHERE BoardID = " & Dvbbs.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)
Dvbbs.BoardID = Rs(7)
Else
LastTopic = "无"
LastRootID = 0
LastPostTime = Now()
LastPostUser = "无"
LastPostUserID = 0
LastID = 0
Dvbbs.BoardID = 0
End If
Set Rs = Nothing
LastPost = LastPostUser & "$" & LastRootID & "$" & LastPostTime & "$" & Replace(left(LastTopic,20),"$","") & "$" & Uploadpic_n & "$" & LastPostUserID & "$" & LastID & "$" & Dvbbs.BoardID
Dvbbs.Execute("UPDATE Dv_Topic SET LastPost = '" & LastPost & "' WHERE TopicID = " & ID)
End Function
'更新指定论坛信息
Public Function LastCount(boardID)
Dim LastTopic,body,LastRootID,LastPostTime,LastPostUser
Dim LastPost,uploadpic_n,LastpostuserID,LastID
set rs=Dvbbs.Execute("select top 1 T.title,b.AnnounceID,b.dateandtime,b.username,b.postuserID,b.rootID from "&dvbbs.NowUseBBS&" b inner join dv_Topic T on b.rootID=T.TopicID where b.boardID="&boardID&" order by b.announceID desc")
If not(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=Dvbbs.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
Dvbbs.Execute("update dv_board set LastPost='"&LastPost&"' where boardID="&SplitUpBoardID(i))
End If
End If
End If
Next
Set Rs=Nothing
'Dvbbs.ReloadBoardInfo(UpdateBoardID)
End Function
'版面发帖数增加
Public Sub BoardNumAdd(boardID,topicNum,postNum,todayNum)
Dvbbs.Execute("update dv_board set postnum=postnum+"&postNum&",topicNum=topicNum+"&topicNum&",todayNum=todayNum+"&todayNum&" where boardID in ("&UpdateBoardID&")")
'Dvbbs.ReloadBoardInfo(UpdateBoardID)
End Sub
'版面发帖数减少
Public Sub BoardNumSub(boardID,topicNum,postNum,todayNum)
Dvbbs.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=Dvbbs.Execute("select top 1 T.title,b.Announceid,b.dateandtime,b.username,b.postuserid,b.rootid from "&Dvbbs.NowUseBBS&" b inner join dv_Topic T on b.rootid=T.TopicID where b.boardid="&boardid&" order by b.Announceid desc")
If not(trs.eof and trs.bof) Then
Lasttopic=replace(left(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
'Dvbbs.ReloadBoardInfo(UpdateBoardID)
End Sub
'所有论坛发帖数增加
Public Function AllboardNumAdd(todayNum,postNum,topicNum)
Dvbbs.Execute("Update dv_Setup Set Forum_TodayNum=Forum_todayNum+"&todaynum&",Forum_PostNum=Forum_PostNum+"&postNum&",Forum_TopicNum=Forum_topicNum+"&TopicNum)
Dvbbs.ReloadSetupCache CLng(Dvbbs.CacheData(7,0))+TopicNum,7
Dvbbs.ReloadSetupCache CLng(Dvbbs.CacheData(8,0))+postNum,8
Dvbbs.ReloadSetupCache CLng(Dvbbs.CacheData(9,0))+todaynum,9
End Function
'所有论坛发帖数减少
Public Function AllboardNumSub(todayNum,postNum,topicNum)
Dvbbs.Execute("Update dv_Setup Set Forum_TodayNum=Forum_TodayNum-"&todaynum&",Forum_PostNum=Forum_PostNum-"&postNum&",Forum_TopicNum=Forum_TopicNum-"&TopicNum)
Dvbbs.ReloadSetupCache CLng(Dvbbs.CacheData(7,0))-TopicNum,7
Dvbbs.ReloadSetupCache CLng(Dvbbs.CacheData(8,0))-postNum,8
Dvbbs.ReloadSetupCache CLng(Dvbbs.CacheData(9,0))-todaynum,9
End Function
Public Sub Get_RequestInfo()
sucmsg=""
title=Dvbbs.htmlencode(Request.form("title"))
content=Dvbbs.htmlencode(Request.form("content"))
content="原因：" & title & content
If Request.form("title")="" and Request.form("content")="" Then
Dvbbs.AddErrCode(39)
Dvbbs.ShowErr()
End If
sucmsg=ActionInfo&"《"&server.htmlencode(topic)&"》，"&server.htmlencode(content)& "，"&allmsg&""
End Sub
Private Function SucMsgInfo(GetMsg)
SucMsgInfo="
"+"返回主题：《"&server.htmlencode(Topic)&"》"
End Function
'专题管理操作
Public Sub TopicMode()
Dim ModeID
ModeID=Request.Form("mode")
If Request.form("title")="" and Request.form("content")="" Then
Dvbbs.AddErrCode(39)
Exit Sub
End If
If ModeID<>"" And IsNumeric(ModeID) Then
LogType=5
Get_RequestInfo
ModeID=Cint(ModeID)
DVbbs.Execute("Update Dv_Topic Set Mode="&ModeID&" Where BoardID="&Dvbbs.BoardID&" And TopicID=" & ID)
Insert_Forum_Log()
Update_User_Point("")
Topic_Manage_Sms()
Dvbbs.Dvbbs_Suc(SucMsgInfo(sucmsg))
Else
title=Dvbbs.htmlencode(Request.form("title"))
content=Dvbbs.htmlencode(Request.form("content"))
content=title & content
Dim BoardTopic,SelectBoardTopic,TempStr
BoardTopic=Split(Dvbbs.Board_Setting(48),"$$")
If Ubound(BoardTopic)>0 Then
For i=0 to Ubound(BoardTopic)-1
SelectBoardTopic=SelectBoardTopic+""
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 lock()
LogType=5
Get_RequestInfo
Dvbbs.Execute("Update Dv_topic Set locktopic=1 where boardID="&Dvbbs.boardID&" and topicID="&ID)
Insert_Forum_Log()
Update_User_Point("")
Topic_Manage_Sms()
Dvbbs.Dvbbs_Suc(SucMsgInfo(sucmsg))
End Sub
'解除锁定帖子
Public Sub unlock()
LogType=3
Get_RequestInfo
Dvbbs.Execute("Update Dv_topic Set locktopic=0 where boardID="&Dvbbs.boardID&" and topicID="&ID)
Insert_Forum_Log()
Update_User_Point("")
Topic_Manage_Sms()
Dvbbs.Dvbbs_Suc(SucMsgInfo(sucmsg))
End Sub
'提升帖子
Public Sub uptopic()
LogType=3
Get_RequestInfo
Dvbbs.Execute("Update dv_topic set LastPostTime="&SqlNowString&" where boardID="&Dvbbs.BoardID&" and IsTop=0 and topicID="&ID)
Insert_Forum_Log()
Update_User_Point("")
Topic_Manage_Sms()
Dvbbs.Dvbbs_Suc(SucMsgInfo(sucmsg))
End Sub
'沉底帖子
Public Sub downtopic()
LogType=3
Get_RequestInfo
If IsSqlDataBase=1 Then
Dvbbs.Execute("Update dv_topic set LastPostTime=dateadd(day,-100,LastPostTime) where boardID="&Dvbbs.BoardID&" and IsTop=0 and topicID="&ID)
Else
Dvbbs.Execute("Update dv_topic set LastPostTime=dateadd('d',-100,LastPostTime) where boardID="&Dvbbs.BoardID&" and IsTop=0 and topicID="&ID)
End If
Insert_Forum_Log()
Update_User_Point("")
Topic_Manage_Sms()
Dvbbs.Dvbbs_Suc(SucMsgInfo(sucmsg))
End Sub
'固顶帖子，包括总固顶、区固顶和固顶
Public Sub Getistop()
Dim IsTop
Dim iForum_AllTopNum,mForum_AllTopNum
Dim getBoard,BoardTopStr,iBoardTopStr,UpBoardID
Dim Bn
LogType=4
Get_RequestInfo
If Request("istopaction")="1" Then
'------------------------------------------------------------------------------------
'如果等级是斑主，需要判断是否有该版的管理权限 Fssunwin
If Dvbbs.UserGroupID = 3 and Trim(Request("getboard"))<>"" Then
Dim CanMsterBoardID
CanMsterBoardID = GetBoardMsterID(Dvbbs.MemberName)
If CanMsterBoardID="" Then
Dvbbs.AddErrCode(28)
Exit Sub
End If
GetBoard = Split(Replace(Request("getboard")," ",""),",")
For i=0 To Ubound(GetBoard)
If InStr("," & CanMsterBoardID & ",", "," & GetBoard(i) & ",")=0 Then
Dvbbs.AddErrCode(28)
Exit Sub
End If
Next
End If
'------------------------------------------------------------------------------------
'如果原来是固顶、区域固顶或总固顶，判断其是否有需要清理数据
Set Rs=Dvbbs.Execute("Select IsTop From Dv_Topic Where TopicID="& ID)
IsTop = Rs(0)
'如果有总固顶需要清理
If IsTop = 3 And Request("alltop")="" And CanTopTopic_a Then
ActionInfo = "清除总固顶"
If IsSqlDataBase=1 Then
Dvbbs.Execute("update dv_topic set istop=0,LastPostTime=dateadd(day,-300,LastPostTime) where boardID="&Dvbbs.BoardID&" and topicID="&ID)
Else
Dvbbs.Execute("update dv_topic set istop=0,LastPostTime=dateadd('d',-300,LastPostTime) where boardID="&Dvbbs.BoardID&" and topicID="&ID)
End If
IsTop = 0
'将总固顶ID从总设置表去除
Set Rs=Dvbbs.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
Dvbbs.Execute("Update Dv_Setup Set Forum_AllTopNum='"&mForum_AllTopNum&"'")
Dvbbs.ReloadSetupCache mForum_AllTopNum,28
End If
Set Rs=Nothing
End If
'如果有固顶需要清理
If IsTop = 1 And CanTopTopic And Trim(Request("getboard"))="" Then
ActionInfo = "解除固顶"
If IsSqlDataBase=1 Then
Dvbbs.Execute("update dv_topic set istop=0,LastPostTime=dateadd(day,-100,LastPostTime) where boardID="&Dvbbs.BoardID&" and topicID="&ID)
Else
Dvbbs.Execute("update dv_topic set istop=0,LastPostTime=dateadd('d',-100,LastPostTime) where boardID="&Dvbbs.BoardID&" and topicID="&ID)
End If
IsTop = 0
'清理对应版面中的帖子ID
Set Rs=Dvbbs.Execute("Select BoardID,BoardTopStr From Dv_Board Where BoardID="&Dvbbs.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
Dvbbs.Execute("Update Dv_Board Set BoardTopStr='"&iBoardTopStr&"' Where BoardID="&Rs(0))
'Dvbbs.ReloadBoardInfo(Rs(0))
Dvbbs.ReloadBoardCache Dvbbs.BoardID,iBoardTopStr,"boardtopstr"
BoardTopStr = ""
End If
End If
'如果有区域固顶需要清理
UpBoardID = ""
If IsTop = 2 And CanTopTopic_m Then
'如果返回的getboard为空，则已经解除该贴的区域固顶，应清理所有含有该ID的版面
If Trim(Request("getboard"))="" Then
ActionInfo = "解除区域固顶"
If IsSqlDataBase=1 Then
Dvbbs.Execute("update dv_topic set istop=0,LastPostTime=dateadd(day,-200,LastPostTime) where boardID="&Dvbbs.BoardID&" and topicID="&ID)
Else
Dvbbs.Execute("update dv_topic set istop=0,LastPostTime=dateadd('d',-200,LastPostTime) where boardID="&Dvbbs.BoardID&" and topicID="&ID)
End If
IsTop = 0
'查询得出原来该贴所固顶的版面
Set Rs=Dvbbs.Execute("Select BoardID,BoardTopStr From Dv_Board Where BoardTopStr Like '%"&ID&"%'")
Rem 以数组代替循环查询。 2004-5-7 Dvbbs.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)
UpBoardID = UpBoardID & Sql(0,Bn) &","
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
Dvbbs.Execute("Update Dv_Board Set BoardTopStr='" & iBoardTopStr & "' Where BoardID = " & Sql(0,Bn))
BoardTopStr = ""
iBoardTopStr = ""
Next
Dvbbs.ReloadBoardInfo(UpBoardID & Dvbbs.BoardID)
End If
'如果返回的getboard不为空，则应清理原来含有该ID且不属于返回的getboard的版面的该帖子ID
'需同时判断，如果用户将原区域固顶设置升级为总固顶，且忘记取消列表中的版面，则应清理该ID对应的版面
Else
Dim ii
ii = 0
If Request("alltop")="1" Then
If IsSqlDataBase=1 Then
Dvbbs.Execute("update dv_topic set istop=0,LastPostTime=dateadd(day,-200,LastPostTime) where boardID="&Dvbbs.BoardID&" and topicID="&ID)
Else
Dvbbs.Execute("update dv_topic set istop=0,LastPostTime=dateadd('d',-200,LastPostTime) where boardID="&Dvbbs.BoardID&" and topicID="&ID)
End If
IsTop = 0
'查询得出原来该贴所固顶的版面
UpBoardID = ""
Set Rs = Dvbbs.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)
UpBoardID = UpBoardID & Sql(0,Bn) &","
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
Dvbbs.Execute("UPDATE Dv_Board SET BoardTopStr = '" & iBoardTopStr & "' WHERE BoardID = " & Sql(0,Bn))
BoardTopStr = ""
iBoardTopStr = ""
Next
Dvbbs.ReloadBoardInfo(UpBoardID & Dvbbs.BoardID)
End If
IsTop = 0
Else
UpBoardID = ""
Set Rs = Dvbbs.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)
UpBoardID = UpBoardID & Sql(0,Bn) &","
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
Dvbbs.Execute("UPDATE Dv_Board SET BoardTopStr = '" & iBoardTopStr & "' WHERE BoardID = " & Sql(0,Bn))
BoardTopStr = ""
iBoardTopStr = ""
Next
Dvbbs.ReloadBoardInfo(UpBoardID & Dvbbs.BoardID)
End If
GetBoard = Split(Request("getboard"),",")
'如果单选当前版面，则取消区域固顶，还原为版面固顶，如多选则不做处理
If Ubound(getBoard)=0 And Clng(getBoard(0))=Dvbbs.BoardID And CanTopTopic Then
Select Case IsTop
Case 0 : TimeAdd = 100
Case 1 : TimeAdd = 0
Case 2 : TimeAdd = -100
Case 3 : TimeAdd = -200
Case Else : TimeAdd = 0
End Select
If IsSqlDataBase=1 Then
Dvbbs.Execute("UPDATE Dv_Topic SET Istop = 1, LastPostTime = DATEADD(Day, " & TimeAdd & ", LastPostTime) WHERE BoardID = " & Dvbbs.BoardID & " AND TopicID = " & ID)
Else
Dvbbs.Execute("UPDATE Dv_Topic SET Istop = 1, LastPostTime = DATEADD('d', " & TimeAdd & ", LastPostTime) WHERE BoardID = " & Dvbbs.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
Dvbbs.Execute("update dv_topic set istop=3,LastPostTime=dateadd(day,"&TimeAdd&",LastPostTime) where boardID="&Dvbbs.BoardID&" and topicID="&ID)
Else
Dvbbs.Execute("update dv_topic set istop=3,LastPostTime=dateadd('d',"&TimeAdd&",LastPostTime) where boardID="&Dvbbs.BoardID&" and topicID="&ID)
End If
'将总固顶ID插入总设置表
Set Rs=Dvbbs.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
Dvbbs.Execute("Update Dv_Setup Set Forum_AllTopNum='"&iForum_AllTopNum&"'")
Dvbbs.ReloadSetupCache iForum_AllTopNum,28
End If
Set Rs=Nothing
Else
If Request("getboard")<>"" Then
getBoard = Split(Request("getBoard"),",")
'单选且当前版面固顶
i = 0
If Ubound(getBoard)=0 And Clng(getBoard(0))=Dvbbs.BoardID And CanTopTopic Then
Set Rs=Dvbbs.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
Dvbbs.Execute("Update Dv_Board Set BoardTopStr='"&BoardTopStr&"' Where BoardID="&Rs(0))
Dvbbs.ReloadBoardCache Rs(0),BoardTopStr,"boardtopstr"
'Dvbbs.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
Dvbbs.Execute("update dv_topic set istop=1,LastPostTime=dateadd(day,"&TimeAdd&",LastPostTime) where boardID="&Dvbbs.BoardID&" and topicID="&ID)
Else
Dvbbs.Execute("update dv_topic set istop=1,LastPostTime=dateadd('d',"&TimeAdd&",LastPostTime) where boardID="&Dvbbs.BoardID&" and topicID="&ID)
End If
End If
'多选区域固顶，包含在当前版面固顶操作中单选其它版面
'在这里不需判断当前用户在其它版面的权限
'因为只要在用户组或版面权限或用户权限中对当前版面有区域固顶权限，则默认为可添加固顶到其它版面
Else
Set Rs=Dvbbs.Execute("Select BoardID,BoardTopStr From Dv_Board Where BoardID In ("&Dvbbs.Checkstr(Request("getBoard"))&")")
REM 数组替换循环查询。 2004-5-7 Dvbbs.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) = Dvbbs.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
Dvbbs.Execute("UPDATE Dv_Board SET BoardTopStr = '" & BoardTopStr & "' WHERE BoardID = " & Sql(0,Bn))
'Dvbbs.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
Dvbbs.Execute("UPDATE Dv_Board SET BoardTopStr = '" & BoardTopStr & "' WHERE BoardID = " & Sql(0,Bn))
End If
BoardTopStr = ""
Next
Dvbbs.ReloadBoardInfo(Dvbbs.Checkstr(Request("getBoard")))
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
Dvbbs.Execute("update dv_topic set istop=2,LastPostTime=dateadd(day,"&TimeAdd&",LastPostTime) where boardID="&Dvbbs.BoardID&" and topicID="&ID)
Else
Dvbbs.Execute("update dv_topic set istop=2,LastPostTime=dateadd('d',"&TimeAdd&",LastPostTime) where boardID="&Dvbbs.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
Dvbbs.Execute("update dv_topic set istop=1,LastPostTime=dateadd(day,"&TimeAdd&",LastPostTime) where boardID="&Dvbbs.BoardID&" and topicID="&ID)
Else
Dvbbs.Execute("update dv_topic set istop=1,LastPostTime=dateadd('d',"&TimeAdd&",LastPostTime) where boardID="&Dvbbs.BoardID&" and topicID="&ID)
End If
End If
End If
Set Rs=Nothing
End If
End If
sucmsg=ActionInfo&"《"&Server.htmlencode(topic)&"》，"&Server.htmlencode(content)& "，"&allmsg&""
Insert_Forum_Log()
Update_User_Point("")
Topic_Manage_Sms()
Dvbbs.Dvbbs_Suc(SucMsgInfo(sucmsg))
Else
Dim Body,TempStr,BoardJump
TempStr = template.html(3)
Set Rs=Dvbbs.Execute("Select title,Istop From Dv_Topic Where Boardid="&Dvbbs.boardid&" and TopicID="&ID)
IsTop = Rs(1)
Set Rs=Dvbbs.Execute("Select Body From "&TotalUseTable&" Where Boardid="&Dvbbs.boardid&" and RootID="&ID&" And ParentID=0")
Body = Left(Dvbbs.HtmlEncode(Rs(0)),"250") & "..."
Set Rs=Nothing
TempStr = Replace(TempStr,"{$boardid}",Dvbbs.BoardID)
TempStr = Replace(TempStr,"{$id}",ID)
TempStr = Replace(TempStr,"{$topic}",Dvbbs.HtmlEncode(Topic))
TempStr = Replace(TempStr,"{$content}",Body)
TempStr = Replace(TempStr,"{$reaction}",request("action"))
'有总固顶和区域固顶权限则显示所有版面列表
If CanTopTopic_a Or CanTopTopic_m Then
Set Rs=Dvbbs.Execute("select boardid,boardtype,depth,BoardTopStr from dv_board order by rootid,orders")
Else
Set Rs=Dvbbs.Execute("select boardid,boardtype,depth,BoardTopStr from dv_board Where BoardID="&Dvbbs.BoardID)
End If
Do While Not Rs.Eof
BoardJump = BoardJump & ""
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}",Dvbbs.htmlencode(Request.form("title")))
TempStr = Replace(TempStr,"{$msgcontent}",Dvbbs.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 Dvbbs.GroupSetting(21)="1" Then TempStr = Replace(TempStr,"{$boardtop}","√")
TempStr = Replace(TempStr,"{$boardtop}","×")
If Dvbbs.GroupSetting(54)="1" Then TempStr = Replace(TempStr,"{$areatop}","√")
TempStr = Replace(TempStr,"{$areatop}","×")
If Dvbbs.GroupSetting(38)="1" Then TempStr = Replace(TempStr,"{$alltop}","√")
TempStr = Replace(TempStr,"{$alltop}","×")
Response.Write TempStr
End If
End Sub
'单帖屏蔽帖子
Public Sub islockpage()
LogType=5
Get_RequestInfo
Dvbbs.Execute("Update "&TotalUseTable&" Set LockTopic=2 where boardID="&Dvbbs.BoardID&" and announceID="&replyID)
GetUserID
Insert_Forum_Log()
Update_User_Point("")
Topic_Manage_Sms()
Dvbbs.Dvbbs_Suc(SucMsgInfo(sucmsg))
End Sub
Sub GetUserID()
Dim Rs
Set Rs=Dvbbs.Execute("Select PostUserid,UserName From "&TotalUseTable&" Where Boardid="&Dvbbs.boardid&" and 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
Dvbbs.Execute("Update "&TotalUseTable&" set LockTopic=0 Where boardID="&Dvbbs.BoardID&" and announceID="&replyID)
GetUserID
Insert_Forum_Log()
Update_User_Point("")
Topic_Manage_Sms()
Dvbbs.Dvbbs_Suc(SucMsgInfo(sucmsg))
End Sub
Public Sub fixtopic()
Dim myistop
LogType=3
'Get_RequestInfo
sucmsg="修复帖子"
Set Rs=Dvbbs.Execute("select istop from dv_topic where boardID="&Dvbbs.BoardID&" and topicID="&ID)
If Rs.Eof And Rs.Bof Then
Dvbbs.AddErrCode(32)
Exit Sub
End If
myistop=rs(0)
Set Rs = Dvbbs.Execute("SELECT COUNT(*), MAX(DateAndTime) FROM " & TotalUseTable & " WHERE BoardID = " & Dvbbs.BoardID & " AND RootID = " & ID)
If Not IsNull(rs(0)) And Not IsNull(rs(1)) Then
If myistop=0 Then
Dvbbs.Execute("update dv_topic set child="&Rs(0)-1&",LastPostTime='"&rs(1)&"' where topicID="&ID)
ElseIf myistop=1 Then
If IsSqlDataBase=1 Then
Dvbbs.Execute("update dv_topic set child="&Rs(0)-1&",LastPostTime=DateAdd(d,100,'"&rs(1)&"') where topicID="&ID)
Else
Dvbbs.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
Dvbbs.Execute("update dv_topic set child="&Rs(0)-1&",LastPostTime=DateAdd(d,200,'"&rs(1)&"') where topicID="&ID)
Else
Dvbbs.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
Dvbbs.Execute("update dv_topic set child="&Rs(0)-1&",LastPostTime=DateAdd(d,300,'"&rs(1)&"') where topicID="&ID)
Else
Dvbbs.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
FixLastPost
Insert_Forum_Log()
Update_User_Point("")
Topic_Manage_Sms()
Dvbbs.Dvbbs_Suc(SucMsgInfo(sucmsg))
End Sub
'精华帖子
Public Sub isbest()
LogType=3
Dim datetimestr
Get_RequestInfo
Set rs=Dvbbs.Execute("Select * From "&TotalUseTable&" Where boardid="&dvbbs.boardid&" and AnnounceID="&replyID)
If rs.eof and rs.bof Then
Dvbbs.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"),"上午",""),"下午","")
Dvbbs.Execute("Update "&TotalUseTable&" Set isbest=1 where boardID="&Dvbbs.BoardID&" and announceID="&replyID)
Dvbbs.Execute("Update Dv_topic Set isbest=1 where boardID="&Dvbbs.BoardID&" and topicID="&ID)
Dvbbs.Execute("Insert Into Dv_bestTopic (title,boardID,AnnounceID,rootID,postusername,postuserID,dateandtime,expression) values ('"&Dvbbs.CheckStr(topic)&"',"&rs("boardID")&","&rs("AnnounceID")&","&rs("rootID")&",'"&Dvbbs.CheckStr(topicusername)&"',"&rs("postuserID")&",'"&datetimestr&"','"&rs("expression")&"')")
Set Rs=Nothing
Insert_Forum_Log()
Update_User_Point(",userIsBest=userisBest+1")
Topic_Manage_Sms()
Dvbbs.Dvbbs_Suc(SucMsgInfo(sucmsg))
End Sub
'解除精华帖子
Public Sub nobest()
LogType=3
Dim datetimestr
Get_RequestInfo
Set rs=Dvbbs.Execute("Select * From "&TotalUseTable&" Where boardid="&dvbbs.boardid&" and AnnounceID="&replyID)
If rs.eof and rs.bof Then
Dvbbs.AddErrCode(32)
Exit Sub
End If
topic=rs("topic")
topicusername=rs("username")
topicuserID=rs("postuserID")
If topic="" Then topic="本帖子为回复帖子"
Set Rs=Nothing
Dvbbs.Execute("Update "&TotalUseTable&" set isbest=0 Where boardID="&Dvbbs.BoardID&" and announceID="&replyID)
Dvbbs.Execute("Update Dv_topic set isbest=0 Where boardID="&Dvbbs.BoardID&" and topicID="&ID)
Dvbbs.Execute("Delete from Dv_besttopic Where AnnounceID="&replyID)
Insert_Forum_Log()
Update_User_Point(",userIsBest=userisBest-1")
Topic_Manage_Sms()
Dvbbs.Dvbbs_Suc(SucMsgInfo(sucmsg))
End Sub
'删除跟贴
Public Sub dele(md)
Dim todaynum
Dim isbest,IsUpload
todaynum=0
Set rs=Dvbbs.Execute("select topic,username,postuserID,DateAndTime,isbest,IsUpload from "&TotalUseTable&" where boardid="&dvbbs.boardid&" and AnnounceID="&replyID)
If Not rs.eof Then
Topic=Dvbbs.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
Dvbbs.AddErrCode(32)
Exit Sub
End If
End If
Set Rs=Nothing
'判断用户是否有删除帖子权限
If Not CanDelTopic Then
Dvbbs.AddErrCode(28)
Exit Sub
End If
LogType=3
Get_RequestInfo
Dim LastPostime,istop
'删除时自动删除精华回复帖
If IsBest=1 Then
Dvbbs.Execute("update dv_topic set isbest=0 where boardid="&Dvbbs.BoardID&" and topicid="&ID)
Dvbbs.Execute("delete from dv_besttopic where Announceid="&replyID)
End If
Set Rs=Dvbbs.Execute("select istop from dv_topic where boardID="&Dvbbs.BoardID&" and topicID="&ID)
istop=Rs(0)
Rs.close
Dvbbs.Execute("Update "&TotalUseTable&" Set BoardID=444,locktopic="&Dvbbs.BoardID&" Where BoardID="&Dvbbs.BoardID&" And AnnounceID="&replyID)
Set Rs=Dvbbs.Execute("select Max(dateandtime) from "&TotalUseTable&" where boardID="&Dvbbs.BoardID&" and rootID="&ID)
LastPostime=rs(0)
Set Rs=Nothing
isLastPost
call LastCount(dvbbs.boardID)
call BoardNumSub(dvbbs.boardID,0,1,todaynum)
call AllboardNumSub(todaynum,1,0)
Dvbbs.ReloadBoardInfo(UpdateBoardID)
If IsUpload=1 Then
If Request.form("delupfile")<>"" and Request.form("delupfile")=1 Then
Call Delupfiles(Dvbbs.BoardID,ID&"|"&replyID)
Else
'更新上传附件数据
Dvbbs.Execute("update Dv_Upfile Set F_flag=4 Where F_BoardID="&Dvbbs.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="&Dvbbs.BoardID&" and topicID="&ID
Else
sql="update dv_topic set child=child-1,LastPostTime='"&LastPostime&"' where boardID="&Dvbbs.BoardID&" and topicID="&ID
End If
'Response.Write sql
Dvbbs.Execute(sql)
Insert_Forum_Log()
Update_User_Point(",UserPost=UserPost-1,userDel=userDel-1")
Topic_Manage_Sms()
If md=1 Then
Dvbbs.Dvbbs_Suc(SucMsgInfo(sucmsg))
End If
End Sub
'删除主贴
Public Sub delete()
Dim voteID,isvote,isbest,istop
Dim UpBoardID
set rs=Dvbbs.Execute("select title,postusername,postuserID,PollID,isvote,isbest,istop from dv_topic where boardid="&Dvbbs.boardid&" and topicID="&ID)
If rs.eof and rs.bof Then
Dvbbs.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=Dvbbs.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=Dvbbs.Execute(sql)
todayNum=rs(0)
'放入回收站，回收站boardid为444，locktopic为原版面ID
Dvbbs.Execute("update "&TotalUseTable&" set BoardID=444,locktopic="&Dvbbs.BoardID&" where rootID="&ID)
If isvote=1 Then
Dvbbs.Execute("update dv_topic set BoardID=444,locktopic="&Dvbbs.BoardID&",isvote=0,VoteTotal=0 where topicID="&ID)
Dvbbs.Execute("delete from dv_vote where voteID="&voteID)
Dvbbs.Execute("delete from dv_voteuser where voteID="&voteID)
'删帖时自动解除精华帖子
ElseIf isbest=1 Then
Dvbbs.Execute("update dv_topic set BoardID=444,locktopic="&Dvbbs.BoardID&",isbest=0 where topicid="&id)
Dvbbs.Execute("delete from dv_besttopic where rootid="&id)
Else
Dvbbs.Execute("update dv_topic set BoardID=444,locktopic="&Dvbbs.BoardID&" where topicID="&ID)
End If
If istop>0 Then
Dvbbs.Execute("update dv_topic set istop=0,LastPostTime="&SqlNowString&" where topicid="&ID)
If istop=3 Then
'将总固顶ID从总设置表去除
Set Rs=Dvbbs.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
Dvbbs.Execute("Update Dv_Setup Set Forum_AllTopNum='"&mForum_AllTopNum&"'")
Dvbbs.ReloadSetupCache mForum_AllTopNum,28
End If
Set Rs=Nothing
Else
'将固顶贴ID从版面表中去除
'查询得出原来该贴所固顶的版面
Dim BoardTopStr,iBoardTopStr
Set Rs=Dvbbs.Execute("Select BoardID,BoardTopStr From Dv_Board Where BoardTopStr Like '%"&ID&"%'")
Do While Not Rs.Eof
UpBoardID = UpBoardID & Rs(0) &","
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
Dvbbs.Execute("Update Dv_Board Set BoardTopStr='"&iBoardTopStr&"' Where BoardID="&Rs(0))
BoardTopStr = ""
iBoardTopStr = ""
Rs.Movenext
Loop
Set Rs=Nothing
Dvbbs.ReloadBoardInfo(UpBoardID&Dvbbs.Boardid)
End If
End If
If Request.form("delupfile")="1" Then
Call Delupfiles(Dvbbs.BoardID,ID&"|")
Else
'上传文件数据更新
Dvbbs.Execute("update Dv_Upfile Set F_flag=4 Where F_BoardID="&Dvbbs.BoardID&" And F_AnnounceID LIKE '"&ID&"|"&"%' ")
End IF
call LastCount(dvbbs.boardID)
call BoardNumSub(dvbbs.boardID,1,postNum,todayNum)
call AllboardNumSub(todayNum,postNum,1)
Dvbbs.ReloadBoardInfo(UpdateBoardID)
Insert_Forum_Log()
Topic_Manage_Sms()
Dvbbs.Dvbbs_Suc(SucMsgInfo(sucmsg))
If AllMsg<>"" Then
Set Rs=Dvbbs.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
Dvbbs.AddErrCode(40)
Exit Sub
ElseIf not IsNumeric(Request("newboardID")) Or Request("newboardID") = "" Then
Dvbbs.AddErrCode(29)
Exit Sub
Else
newboardID=Request("newboardID")
End If
'目标论坛和其上级论坛ID
set rs=Dvbbs.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
Dvbbs.AddErrCode(41)
Exit Sub
End If
sql="select * from dv_topic where boardID="&Dvbbs.BoardID&" and topicID="&ID
set rs=Dvbbs.Execute(sql)
If rs.eof and rs.bof Then
Dvbbs.AddErrCode(32)
Exit Sub
Else
If Request.form("isdispmove")="yes" Then
newtopic=Dvbbs.CheckStr(Request.form("topic")) & "-->" & Dvbbs.MemberName & "转移"
Else
newtopic=Dvbbs.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,GetMoney,UseTools,GetMoneyType) values ('"&newtopic&"',"&newboardID&",'"&rs("postusername")&"',"&rs("postuserID")&",'"&rs("dateandtime")&"','"&rs("Expression")&"','"&rs("LastPost")&"','"&rs("LastPosttime")&"',"&rs("child")&","&rs("hits")&","&rs("isvote")&",0,"&rs("votetotal")&",'"&Dvbbs.NowUseBBS&"',"&Rs("GetMoney")&",'"&Rs("UseTools")&"',"&Rs("GetMoneyType")&")"
Dvbbs.Execute(sql)
End If
End If
'移动后，取消专题所属
Dvbbs.Execute("update dv_topic set mode=0 where topicID="&ID)
If Request("leavemessage")="yes" Then
Dvbbs.Execute("update dv_topic set locktopic=1 where topicID="&ID)
set rs=Dvbbs.Execute("select Max(topicID) from dv_topic where boardid="&newboardID)
newparentID=rs(0)
sql="select * from "&TotalUseTable&" where rootID="&ID&" and boardid<>444 and boardID <>777 order by AnnounceID"
set rs=Dvbbs.Execute(sql)
do while not rs.eof
Sql="insert into "&Dvbbs.NowUseBBS&"(BoardID,ParentID,username,topic,body,DateAndTime,length,rootID,layer,orders,ip,Expression,locktopic,signflag,emailflag,isbest,postuserID,UbbList,GetMoney,UseTools,GetMoneyType,PostBuyUser) values "&_
"("&_
newboardID&","&rs("parentID")&",'"&_
rs("username")&"','"&_
Dvbbs.CheckStr(rs("topic"))&"','"&_
Dvbbs.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")&"',"&Rs("GetMoney")&",'"&Rs("UseTools")&"',"&Rs("GetMoneyType")&",'"&Dvbbs.CheckStr(Rs("PostBuyUser"))&"')"
'response.write sql
Dvbbs.Execute(sql)
rs.movenext
loop
ElseIf Request("leavemessage")="no" Then
If Request.form("isdispmove")="yes" Then
newtopic=Dvbbs.CheckStr(Request.form("topic")) & "-->" & Dvbbs.MemberName & "转移"
Else
newtopic=Dvbbs.CheckStr(Request.form("topic"))
End If
'移动且不保留时自动解除精华帖子
if rs("isbest")=1 then
Dvbbs.Execute("update dv_topic set title='"&newtopic&"',boardid="&newboardid&",isbest=0 where topicid="&id)
Dvbbs.Execute("update "&TotalUseTable&" set topic='"&newtopic&"',isbest=0 where announceid="&replyid)
Dvbbs.Execute("update "&TotalUseTable&" set boardid="&newboardid&",isbest=0 where rootid="&id&" And boardid<>444 and boardID <>777")
Dvbbs.Execute("delete from dv_besttopic where rootid="&id)
'更新回收站或审核帖中的跟贴的原版面编号
Dvbbs.Execute("update "&TotalUseTable&" set locktopic="&newboardid&" where rootid="&id &" and (boardid=444 OR boardID=777)")
else
Dvbbs.Execute("update dv_topic set title='"&newtopic&"',boardid="&newboardid&" where topicid="&id)
Dvbbs.Execute("update "&TotalUseTable&" set topic='"&newtopic&"' where announceid="&replyid)
Dvbbs.Execute("update "&TotalUseTable&" set boardid="&newboardid&" where rootid="&id &" and boardid<>444 and boardID <>777")
'更新回收站中的跟贴的原版面编号
Dvbbs.Execute("update "&TotalUseTable&" set locktopic="&newboardid&" where rootid="&id &" and (boardid=444 OR boardID =777)")
end if
'移动时判断是否固顶并作相关处理 2004-4-25 Dvbbs.YangZheng
If Rs("istop") > 0 Then
Dim Yrs, TopstrinfoN, TopstrinfoO
'读取新旧版面的固顶信息
Set Yrs = Dvbbs.Execute("SELECT BoardTopStr From Dv_Board Where Boardid = " & Dvbbs.Boardid)
TopstrinfoO = Yrs(0)
Set Yrs = Dvbbs.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 = " & Dvbbs.Boardid
Dvbbs.Execute(Sql)
'更新新版面固顶信息及缓存
Sql = "UPDATE Dv_Board SET BoardTopStr = '" & TopstrinfoN & "' WHERE Boardid = " & Newboardid
Dvbbs.Execute(Sql)
Dvbbs.ReloadBoardCache Dvbbs.Boardid,TopstrinfoO,"boardtopstr"
Dvbbs.ReloadBoardCache Newboardid,TopstrinfoN,"boardtopstr"
'Dvbbs.ReloadBoardInfo(Newboardid)
End If
'批量移动上传文件数据
dim F_announceID
F_announceID=id & "|"
Dvbbs.Execute("update DV_Upfile set F_readme='"&newtopic&"',F_boardid="&newboardid&" where F_announceID like '"& F_announceID&"%'")
Else
Dvbbs.AddErrmsg "请选择相应操作。"
exit sub
End If
Dim postNum,todayNum
'计算该帖子的回复数量，用来统计对应版面帖子数
'老迷修正，查询跟贴数字排除被删除和待审核的(2004.8.6)
set rs=Dvbbs.Execute("select count(*) from "&TotalUseTable&" where rootID="&ID&" And BoardID <> 444 And BoardID <> 777")
'set rs=Dvbbs.Execute("select count(*) from "&TotalUseTable&" where rootID="&ID)
postNum=rs(0)
'计算该帖子中今日回复的数量,8.6加入非删除条件（boardid<>444 and boardID <>777）
If IsSqlDataBase=1 Then
sql="select count(*) from "&TotalUseTable&" where rootID="&ID&" and dateandtime>='"&date()&"' and boardid<>444 and boardID <>777"
else
sql="select count(*) from "&TotalUseTable&" where rootID="&ID&" and dateandtime>=#"&date()&"# and boardid<>444 and boardID <>777"
end if
Set Rs=Dvbbs.Execute(sql)
todayNum=rs(0)
set rs=nothing
'更新论坛贴子数据
call LastCount(dvbbs.boardID)
call BoardNumSub(dvbbs.boardID,1,postNum,todayNum)
Dvbbs.ReloadBoardInfo(UpdateBoardID)
UpdateBoardID=UpdateBoardID_1
call LastCount(newboardID)
call BoardNumAdd(newboardID,1,postNum,todayNum)
Dvbbs.ReloadBoardInfo(UpdateBoardID)
'更新论坛数据结束
Insert_Forum_Log()
Update_User_Point("")
Topic_Manage_Sms()
Dvbbs.Boardid = Newboardid
Dvbbs.Dvbbs_Suc(SucMsgInfo(sucmsg))
Else
Dim TempStr
TempStr = Replace(template.html(1),"{$boardid}",Request("boardID"))
TempStr = Replace(TempStr,"{$replyID}",Request("replyID"))
TempStr = Replace(TempStr,"{$ID}",Request("ID"))
TempStr = Replace(TempStr,"{$title}",Dvbbs.htmlencode(Request.form("title")))
TempStr = Replace(TempStr,"{$content}",Dvbbs.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))
Response.Write TempStr
End If
End Sub
'复制帖子
Public Sub copy()
Dim reBoard_Setting
set rs=Dvbbs.Execute("select topic,username,postuserID from "&TotalUseTable&" where boardid="&dvbbs.boardid&" and AnnounceID="&replyID)
If rs.eof and rs.bof Then
Dvbbs.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
Dvbbs.AddErrCode(28)
exit sub
End If
LogType=3
Get_RequestInfo
If Request("checked")="yes" Then
Dim newboardID
Dim todaynum,postnum
set rs=Dvbbs.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=Dvbbs.Execute(sql)
todayNum=rs(0)
If Request("boardID")=Request("newboardID") Then
Dvbbs.AddErrCode(40)
exit sub
ElseIf not IsNumeric(Request("newboardID")) Then
Dvbbs.AddErrCode(29)
exit sub
Else
newboardID=Request("newboardID")
End If
'目标论坛和其上级论坛ID
set rs=Dvbbs.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
Dvbbs.AddErrCode(41)
exit sub
End If
set rs=Dvbbs.Execute("select boardID from "&TotalUseTable&" where announceID="&replyID&" and boardID="&Dvbbs.BoardID)
If rs.eof and rs.bof Then
Dvbbs.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=Dvbbs.CheckStr(Request.form("topic")) & "-->" & Dvbbs.MemberName & "添加"
Else
newtopic=Dvbbs.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,'"&Dvbbs.NowUseBBS&"')"
Dvbbs.Execute(sql)
set trs=Dvbbs.Execute("select Max(topicID) from dv_topic where boardid="&newboardID&" and postuserID="&rs("postuserID"))
Sql="insert into "&Dvbbs.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")&"')"
Dvbbs.Execute(sql)
rs.close
set rs=nothing
'移动上传文件数据
Dim F_announceID
F_announceID=ID & "|" &replyID
Dvbbs.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)
Dvbbs.ReloadBoardInfo(UpdateBoardID)
Insert_Forum_Log()
Update_User_Point("")
Topic_Manage_Sms()
Dvbbs.Dvbbs_Suc(SucMsgInfo(sucmsg))
Else
Dim TempStr
TempStr = Replace(template.html(2),"{$boardid}",Request("boardID"))
TempStr = Replace(TempStr,"{$replyID}",Request("replyID"))
TempStr = Replace(TempStr,"{$ID}",Request("ID"))
TempStr = Replace(TempStr,"{$title}",Dvbbs.htmlencode(Request.form("title")))
TempStr = Replace(TempStr,"{$content}",Dvbbs.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))
TempStr = Replace(TempStr,"{$BoardJumpList}","")
Response.Write TempStr
Response.Write ""
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 Dvbbs.Forum_Setting(76)="" Or Dvbbs.Forum_Setting(76)="0" Then Dvbbs.Forum_Setting(76)="UploadFile/"
If right(Dvbbs.Forum_Setting(76),1)<>"/" Then Dvbbs.Forum_Setting(76)=Dvbbs.Forum_Setting(76)&"/"
path=Dvbbs.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=Dvbbs.Execute(DelSql)
Do While Not DelRs.Eof
Filepath = path&DelRs(0)
ViewFilepath = DelRs(1)
If Err <> 0 Then
Dvbbs.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
Dvbbs.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
'---------------------------------------------------
'斑主奖惩帖子
'---------------------------------------------------
Private Function ChkRewardMoney()
Dim CanRewardMoney
CanRewardMoney = False
If (Dvbbs.Master or Dvbbs.superboardmaster or Dvbbs.boardmaster) and Cint(Dvbbs.GroupSetting(22))=1 Then CanRewardMoney=True
If Cint(Dvbbs.GroupSetting(22))=1 and Dvbbs.UserGroupID>3 Then CanRewardMoney=True
If Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(22))=1 Then
CanRewardMoney=True
ElseIf Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(22))=0 Then
CanRewardMoney=False
End If
If Not Dvbbs.Master Then
If Clng(Dvbbs.UserToday(4))>Clng(Dvbbs.Forum_Setting(97)) Then CanRewardMoney = False
End If
ChkRewardMoney = CanRewardMoney
If Not CanRewardMoney Then Dvbbs.AddErrCode(28) : Dvbbs.ShowErr()
End Function
Private Sub RewardMoney
Dim CanRewardMoney,GiveMoney
Dim ReAct,UpIsagree,UpGetMoney,TempString
GiveMoney = Request.FORM("GiveMoney")
LogType = 5
Get_RequestInfo
If Not ChkRewardMoney Then Dvbbs.AddErrCode(28) : Exit Sub
If Not IsNumeric(GiveMoney) Then
GiveMoney = 0
Else
GiveMoney = Clng(GiveMoney)
End If
If GiveMoney = 0 Then Dvbbs.AddErrCode(35) : Exit Sub
If GiveMoney<0 Then
ReAct=1
GiveMoney = -GiveMoney
Else
ReAct=0
End If
If not Dvbbs.Master and Clng(Dvbbs.UserToday(4))>Clng(Dvbbs.Forum_Setting(97)) Then Dvbbs.AddErrCode(28) : Exit Sub
Set Rs = Dvbbs.Execute("Select topic,username,postuserID,Isagree,GetMoney From "&TotalUseTable&" Where boardid="&Dvbbs.boardid&" and AnnounceID="&ReplyID)
If Rs.Eof And Rs.Bof Then
Dvbbs.AddErrCode(32)
Exit Sub
End If
Topic = Rs(0)
TopicUsername = Rs(1)
TopicUserID = Clng(Rs(2))
TempString = Rs(3)
UpGetMoney = Clng(Rs(4))
Rs.close
If TopicUserID=Dvbbs.UserID Then Dvbbs.AddErrCode(38) : Exit Sub
'更新斑主每日奖励金币数
If not Dvbbs.Master and ReAct = 0 Then
Dvbbs.UserToday(4) = Clng(Dvbbs.UserToday(4)) + GiveMoney
Dvbbs.MyUserInfo(36) = Clng(Dvbbs.UserToday(0)) &"|"& Clng(Dvbbs.UserToday(1)) &"|"& Clng(Dvbbs.UserToday(2)) &"|"& Clng(Dvbbs.UserToday(3)) &"|"& Clng(Dvbbs.UserToday(4))
Session(Dvbbs.CacheName & "UserID") = Dvbbs.MyUserInfo
Sql = "Update Dv_user Set UserToday='"&Dvbbs.CheckStr(Dvbbs.MyUserInfo(36))&"' where UserID="&Dvbbs.UserID
Dvbbs.Execute Sql
End If
'Isagree字段，定义为：扣金币数|加金币数 ,GetMoney中为得到的总数
If TempString="" or Instr(TempString&"","|")=0 Then
If ReAct = 1 Then
UpIsagree = GiveMoney&"|0"
Else
UpIsagree = "0|"&GiveMoney
End If
Else
TempString = Split(TempString,"|")
If ReAct = 1 Then
TempString(0) = TempString(0) + GiveMoney
Else
TempString(1) = TempString(1) + GiveMoney
End If
UpIsagree = TempString(0) &"|"& TempString(1)
End If
If ReAct = 1 Then
UpGetMoney = UpGetMoney - GiveMoney
Sql = "Update Dv_user Set UserMoney=UserMoney-"&GiveMoney&" where UserID="&TopicUserID
sucmsg = sucmsg&",对用户："&TopicUsername&"扣除"&GiveMoney&"个金币!"
Else
UpGetMoney = UpGetMoney + GiveMoney
Sql = "Update Dv_user Set UserMoney=UserMoney+"&GiveMoney&" where UserID="&TopicUserID
sucmsg = sucmsg&",对用户："&TopicUsername&"奖励"&GiveMoney&"个金币!"
End If
Dvbbs.Execute Sql
Sql = "Update "&TotalUseTable&" Set Isagree='"&UpIsagree&"' Where boardid="&Dvbbs.boardid&" and AnnounceID="&ReplyID
Dvbbs.Execute Sql
Update_User_Point("")
Topic_Manage_Sms()
Insert_Forum_Log()
Dvbbs.Dvbbs_Suc(SucMsgInfo(sucmsg))
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,"","")
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, "&#", "&#")
fString = Replace(fString, CHR(32), " ")
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), "
")
fString = Replace(fString, CHR(10), " ")
fString=Dvbbs.ChkBadWords(fString)
dvHTMLEncode = fString
End If
End Function
'返回该用户名的可管理的版块ID 以“,”分隔。
Private Function GetBoardMsterID(username)
Dim Srs,Board_Data,i,TempData
TempData = ""
Set Srs=Dvbbs.Execute("Select Boardid,Boardmaster,Child From Dv_Board Where Boardmaster<>'' Order By Rootid,Orders")
If not Srs.Eof Then
Board_Data=Srs.GetRows(-1)
End if
Srs.Close:Set Srs=Nothing
If IsArray(Board_Data) Then
For i=0 to Ubound(Board_Data,2)
If Instr(","&TempData&",",","&Board_Data(0,i)&",")=0 Then
If instr("|" & Trim(Board_Data(1,i)) & "|","|" & username & "|")>0 Then
TempData = TempData & Board_Data(0,i) &","
If Cint(Board_Data(2,i))>0 Then
TempData = TempData & GetBoardID(Board_Data(0,i))
End If
End If
End If
Next
If Right(TempData,1)="," Then
TempData = Left(TempData,Len(TempData)-1)
End If
End If
GetBoardMsterID=TempData
End Function
'获取下属版块ID
Private Function GetBoardID(BoardIDVal)
Dim TempData,Nodelist,Node
Set Nodelist = Dvbbs.BoardXML.documentElement.getElementsByTagName("board")
For Each Node in Nodelist
If Instr(","&Node.attributes.getNamedItem("parentstr").text&",",","&BoardIDVal&",")>0 Then
TempData = TempData & Node.attributes.getNamedItem("boardid").text &","
End If
Next
GetBoardID = TempData
End Function
End Class
%>