📄 settopic.asp
字号:
Set Rs=BBS94KK.execute("Select IsDel,Name From[KK_Topic] where TopicID="&ID&" And BoardID="&BBS94KK.BoardID&"")
IF Rs.eof Then
BBS94KK.GoToErr(11)
Else
IF Not Rs(0) Then
GoToUrl=False
'得出要删除的帖数
Temp=BBS94KK.Execute("Select Count(BbsID) From[KK_bbs"&BBS94KK.TB&"] where (TopicID="&ID&" Or ReplyTopicID="&ID&") And BoardID="&BBS94KK.BoardID)(0)
BBS94KK.execute("update [KK_Topic] set IsDel=True,ReplyNum=0 where TopicID="&ID&" And BoardID="&BBS94KK.BoardID)
BBS94KK.execute("update [KK_Bbs"&BBS94KK.TB&"] set IsDel=True where (TopicID="&ID&" Or ReplyTopicID="&ID&") And BoardID="&BBS94KK.BoardID)
BBS94KK.execute("update [KK_Config] set AllEssayNum=AllEssayNum-"&Temp&",TopicNum=TopicNum-1")
BBS94KK.execute("update [KK_Board] set EssayNum=EssayNum-"&Temp&",TopicNum=TopicNum-1 where BoardID="&BBS94KK.BoardID&"")
If BBS94KK.BoardDepth>1 Then
BBS94KK.Execute("Update [KK_Board] set TopicNum=TopicNum-1,EssayNum=EssayNum-"&Temp&" where BoardID In ("&BBS94KK.BoardParentStr&") And Depth>0")
End If
BoardLastRaply()
Temp=""
BBS94KK.Execute("update [KK_user] set coin=Coin+"&Coin&",Mark=Mark+"&Mark&",GameCoin=GameCoin+"&GameCoin&" where name='"&Rs(1)&"'")
If Coin<>0 or Mark<>0 or GameCoin<>0 Then
Temp="并且进行了"
If Mark<>0 Then Temp=Temp&"积分"&Mark&","
If Coin<>0 Then Temp=Temp&"金钱"&Coin&","
If GameCoin<>0 Then Temp=Temp&"游戏币"&GameCoin
Temp=Temp&"的操作。"
End If
If IsSms="yes" Then
Smss="你发表的主题被删除："&Cause&vbcrlf&Temp
If Sms<>"" Then Smss=Smss&vbcrlf&vbcrlf&"以下是操作人 "&BBS94KK.MyName&" 给你的附加留言信息："&vbcrlf&Sms
BBS94KK.Execute("insert into [KK_Sms](name,MyName,Content) values('自动送信系统','"&Rs(1)&"','"&Smss&"')")
BBS94KK.Execute("update [KK_User] set NewSmsNum=NewSmsNum+1,SmsSize=SmsSize+"&Len(Smss)&" Where Name='"&Rs(1)&"'")
End If
If Temp<>"" Then Temp="<li>"&Temp
Content="<li>删除主题帖子---成功！"&Temp
Else
Caption="错误信息"
Content="<li>帖子已经删除了！"
End IF
Rs.Close
End If
End If
Else
Caption="删除主题"
Content="<table align='center'><form method=POST action='?action=删除主题&Cmd=del&TB="&BBS94KK.TB&"&ID="&ID&"&BoardID="&BBS94KK.BoardID&"'><tr><td>操作理由：<select name='select' onChange='cause.value=this.options[this.selectedIndex].value'><option selected>帖子删除理由：</option><option value='本版严禁广告'>本版严禁广告</option><option value='帖子内容违规'>帖子内容违规</option><option value='无聊的乱灌水'>无聊的乱灌水</option><option value='重复发此类帖'>重复发此类帖</option></select> <input name='cause' type='text' value='' size='20' maxlength='10'> * 最多10个字符</td></tr>"&_
"<tr><td>对作者惩罚操作：积分<select name='mark'>"&Options(-5,0,1)&"</select> 金钱<select name='coin'>"&Options(-500,0,20)&"</select> 游戏币<select name='gamecoin'>"&Options(-200,0,10)&"</select></td></tr><tr><td>留言通知作者：<input name='issms' onclick='if(sms.disabled==true){sms.disabled=false;sms.focus()}else{sms.disabled=true;}' type='checkbox' value='yes'> 留言附加信息：<input name='sms' size='30' type='text' value='' disabled='true'></td></tr><tr><td align='center'><input type='submit' name='Submit' value='确定删除操作'></td></tr></form></table>"
End If
End Sub
Sub DelReply
Dim BbsID,Temp,Cmd,Cause,IsSms,Sms,Smss,Mark,coin,GameCoin
GotoUrl=False
BbsID=BBS94KK.CheckNum(request.querystring("BbsID"))
Cmd=Request("Cmd")
If Cmd="del" then
Mark=BBS94KK.Fun.GetStr("mark")
Coin=BBS94KK.Fun.GetStr("coin")
GameCoin=BBS94KK.Fun.GetStr("gamecoin")
Cause=BBS94KK.Fun.GetStr("cause")
IsSms=BBS94KK.Fun.GetStr("isSms")
Sms=BBS94KK.Fun.GetStr("sms")
If Cause="" Then
Content="<li>请填写删除理由！<a href=javascript:history.go(-1)>[返回]</a>"
ElseIf Len(Cause)>10 Then
Content="<li>删除理由描述不能超过10个字符！<a href=javascript:history.go(-1)>[返回]</a>"
Else
Set Rs=BBS94KK.execute("Select IsDel,Name From [KK_bbs"&BBS94KK.TB&"] where ReplyTopicID="&ID&" And BbsID="&BbsID&" And BoardID="&BBS94KK.BoardID&"")
IF Rs.eof Then
BBS94KK.GoToErr(11)
ElseIF Not Rs(0) Then
BBS94KK.execute("update [KK_bbs"&BBS94KK.TB&"] set IsDel=True where ReplyTopicID="&ID&" And BbsID="&BbsID&" And BoardID="&BBS94KK.BoardID&"")
BBS94KK.execute("update [KK_Config] Set AllEssayNum=AllEssayNum-1")
BBS94KK.execute("update [KK_Board] Set EssayNum=EssayNum-1 where BoardID="&BBS94KK.BoardID&"")
BBS94KK.execute("update [KK_Topic] set ReplyNum=ReplyNum-1 where TopicID="&ID&" And BoardID="&BBS94KK.BoardID&"")
If BBS94KK.BoardDepth>1 Then
BBS94KK.Execute("Update [KK_Board] set TopicNum=TopicNum-1,EssayNum=EssayNum-1 where BoardID In ("&BBS94KK.BoardParentStr&") And Depth>0")
End If
Dim ReRs,TopicLastReply
Set ReRs=BBS94KK.execute("select top 1 Name,Content from [KK_bbs"&BBS94KK.TB&"] where BoardID="&BBS94KK.BoardID&" And ReplyTopicID="&ID&" And IsDel=False order by BbsID desc")
If Not ReRs.Eof Then
TopicLastReply=""&ReRs(0)&"|"&BBS94KK.Fun.StrLeft(ReRs(1),40)
Else
TopicLastReply="——|暂无回复"
End If
ReRs.CLose:Set ReRs=Nothing
BBS94KK.execute("Update [KK_Topic] set LastReply='"&TopicLastReply&"' where TopicId="&ID&"")
BoardLastRaply()
BBS94KK.Execute("update [KK_user] set coin=Coin+"&Coin&",Mark=Mark+"&Mark&",GameCoin=GameCoin+"&GameCoin&" where name='"&Rs(1)&"'")
If Coin<>0 or Mark<>0 or GameCoin<>0 Then
Temp="并且进行了"
If Mark<>0 Then Temp=Temp&"积分"&Mark&","
If Coin<>0 Then Temp=Temp&"金钱"&Coin&","
If GameCoin<>0 Then Temp=Temp&"游戏币"&GameCoin
Temp=Temp&"的操作。"
End If
If IsSms="yes" Then
Smss="你回复的帖子被删除："&Cause&vbcrlf&Temp
If Sms<>"" Then Smss=Smss&vbcrlf&vbcrlf&"以下是操作人 "&BBS94KK.MyName&" 给你的附加留言信息："&vbcrlf&Sms
BBS94KK.Execute("insert into [KK_Sms](name,MyName,Content) values('自动送信系统','"&Rs(1)&"','"&Smss&"')")
BBS94KK.Execute("update [KK_User] set NewSmsNum=NewSmsNum+1,SmsSize=SmsSize+"&Len(Smss)&" Where Name='"&Rs(1)&"'")
End If
If Temp<>"" Then Temp="<li>"&Temp
Content="<li>删除回复帖子---成功！"&Temp&"<li><a href="&Url&">回到主题帖子</a><meta http-equiv=refresh content='2;url="&Url&"'>"
Else
Caption="错误信息"
Content="<li>帖子已经删除了！"
End IF
End if
Else
Caption="删除回复"
Content="<table align='center'><form method=POST action='?action=删除回复&Cmd=del&TB="&BBS94KK.TB&"&ID="&ID&"&BoardID="&BBS94KK.BoardID&"&BbsID="&BbsID&"'><tr><td>操作理由：<select name='select' onChange='cause.value=this.options[this.selectedIndex].value'><option selected>帖子删除理由：</option><option value='本版严禁广告'>本版严禁广告</option><option value='帖子内容违规'>帖子内容违规</option><option value='无聊的乱灌水'>无聊的乱灌水</option><option value='重复发此类帖'>重复发此类帖</option></select> <input name='cause' type='text' value='' size='20' maxlength='10'> * 最多10个字符</td></tr>"&_
"<tr><td>对作者惩罚操作：积分<select name='mark'>"&Options(-5,0,1)&"</select> 金钱<select name='coin'>"&Options(-500,0,20)&"</select> 游戏币<select name='gamecoin'>"&Options(-200,0,10)&"</select></td></tr><tr><td>留言通知作者：<input name='issms' onclick='if(sms.disabled==true){sms.disabled=false;sms.focus()}else{sms.disabled=true;}' type='checkbox' value='yes'> 留言附加信息：<input name='sms' size='30' type='text' value='' disabled='true'></td></tr><tr><td align='center'><input type='submit' name='Submit' value='确定删除操作'></td></tr></form></table>"
End If
End Sub
Sub SetMove
IF BBS94KK.MyAdmin<>1 and BBS94KK.MyAdmin<>2 Then BBS94KK.GoToErr(24)
GoToUrl=False
Caption="移动帖子"
Content="<form method=POST name='move' action='?action=move&TB="&BBS94KK.TB&"&ID="&ID&"&BoardID="&BBS94KK.BoardID&"'><p style='margin: 15'>请选择帖子要移动到的论坛："&GetBoardList()&" <input type=submit value=' 移 动 '> <br><br>是否用留言通知帖子的作者：<input name='issms' onclick='if(sms.disabled==true){sms.disabled=false;sms.value=""通知：您的帖子被管理员("&BBS94KK.MyName&")移动到这里：""}else{sms.disabled=true;sms.value="""";}' type='checkbox' value='yes'> <input name='sms' size='50' type='text' value='' disabled='true'></p></form>"
End Sub
Sub SaveMove
Dim IsSms,Sms,TmpBoardID
IF BBS94KK.MyAdmin<>1 and BBS94KK.MyAdmin<>2 Then BBS94KK.GoToErr(24)
GoToUrl=False
IsSms=BBS94KK.Fun.GetStr("issms")
Sms=BBS94KK.Fun.GetStr("sms")
TmpBoardID=BBS94KK.Checknum(request.form("BoardID"))
BBS94KK.execute("update [KK_Topic] Set BoardID="&TmpBoardID&" where TopicID="&ID&"")
BBS94KK.execute("update [KK_bbs"&BBS94KK.TB&"] Set BoardID="&TmpBoardID&" where TopicId="&ID&" or ReplyTopicid="&ID&"")
If IsSms="yes" Then
Sms=Sms&vbcrlf&"[url=Show.asp?BoardID="&TmpBoardID&"&ID="&ID&"&TB="&BBS94KK.TB&"]请点击这里您的帖子[/url]"
BBS94KK.Execute("insert into [KK_Sms](name,MyName,Content) values('自动送信系统','"&SetUserName&"','"&Sms&"')")
BBS94KK.Execute("update [KK_User] set NewSmsNum=NewSmsNum+1,SmsSize=SmsSize+"&Len(Sms)&" Where Name='"&SetUserName&"'")
End If
Content="<li>移动帖子---成功！！"
End Sub
Function GetBoardList()
Dim Temp,i
Temp="<select Style='font-size: 9pt' name='BoardID' >"
If IsArray(BBS94KK.Board_Rs) Then
For i=0 To Ubound(BBS94KK.Board_Rs,2)
IF BBS94KK.Board_Rs(0,I)=1 Then
Temp=Temp&"<option value="&BBS94KK.Board_Rs(1,I)&">├"&BBS94KK.Board_Rs(3,I)&"</option>"
ElseIf BBS94KK.Board_Rs(0,I)=2 Then
Temp=Temp&"<option value="&BBS94KK.Board_Rs(1,I)&">∣├"&BBS94KK.Board_Rs(3,I)&"</option>"
End If
Next
End If
GetBoardList=Temp&"</select>"
End Function
Sub BoardLastRaply()
Dim Temp,Rs,TempID,TempContent
Set Rs=BBS94KK.execute("select top 1 ReplyTopicID,Name,Caption,Content,TopicID,LastTime,Face,BoardID from [KK_bbs"&BBS94KK.TB&"] where BoardID="&BBS94KK.BoardID&" And IsDel=False order by BbsID desc")
if Rs.eof then
Temp=""
Else
If Rs("ReplyTopicID")=0 then
TempContent=BBS94KK.Fun.StrLeft(BBS94KK.Fun.FixReply(Rs("Caption")),20)
TempID=Rs("Topicid")
Else
TempContent=BBS94KK.Fun.StrLeft(BBS94KK.Fun.FixReply(Rs("Content")),20)
TempID=Rs("ReplyTopicID")
'更新主题
End if
Temp=""&Rs("name")&"|"&TempContent&"|"&Rs("LastTime")&"|"&Rs("Face")&"|"&TempID&"|"&Rs("BoardID")&"|"&BBS94KK.TB&""
end if
Rs.Close
IF Temp<>"" Then
BBS94KK.execute("update [KK_Board] set LastReply='"&Temp&"' where BoardID="&BBS94KK.BoardID&" and ParentID<>0")
If BBS94KK.BoardDepth>1 Then
BBS94KK.Execute("Update [KK_Board] set LastReply='"&Temp&"' where BoardID In ("&BBS94KK.BoardParentStr&") And ParentID<>0")
End If
End IF
'更新系统
Cache.name="Config"
Cache.clean()
'更新版块
Cache.Name="BoardInfo"
Cache.clean()
End Sub
Sub TopHeight
BBS94KK.Execute("update [KK_Topic] set LastTime='"&BBS94KK.NowBbsTime&"' where TopicID="&ID&" And BoardID="&BBS94KK.BoardID&"")
BBS94KK.Execute("update [KK_bbs"&BBS94KK.TB&"] set LastTime='"&BBS94KK.NowBbsTime&"' where TopicID="&ID&" And BoardID="&BBS94KK.BoardID&"")
Content="<Li>贴子主题提升---成功！！"
End Sub
Sub Setsubside
BBS94KK.Execute("update [KK_Topic] set LastTime=LastTime-30 where TopicID="&ID&" And BoardID="&BBS94KK.BoardID&"")
Content="<Li>已经成功的使贴子主题沉底到一个月前新帖后面！"
End Sub
Function Options(A,B,Steps)
dim I
For I=A to B Step Steps
Options=Options&"<option value="&I
If I=0 Then Options=Options&" selected"
Options=Options&">"&I&"</option>"
Next
End Function
Sub SetAppraise
GoToUrl=False
Dim BbsID
BbsID=BBS94KK.CheckNum(request.querystring("BbsID"))
Set Rs=BBS94KK.execute("Select BbsID From [KK_bbs"&BBS94KK.TB&"] where BbsID="&BbsID&" And BoardID="&BBS94KK.BoardID&"")
IF Rs.eof Then
BBS94KK.GoToErr(11)
Else
Caption="帖子评价"
Content="<table align='center'><form method=POST action='?action=appraise&TB="&BBS94KK.TB&"&BbsID="&BbsID&"&ID="&ID&"&BoardID="&BBS94KK.BoardID&"&Page="&Page&"'><tr><td>操作理由：<select name='select' onChange='cause.value=this.options[this.selectedIndex].value'><option selected>帖子评价自定义</option><option value='奖！此帖子不错哦'>奖！此帖子不错哦</option><option value='奖！感谢无私贡献'>奖！感谢无私贡献</option><option value='奖！好文章给奖励'>奖！好文章给奖励</option><option value='罚！本版严禁广告'>罚！本版严禁广告</option><option value='罚！帖子内容违规'>罚！帖子内容违规</option><option value='罚！无聊的乱灌水'>罚！无聊的乱灌水</option><option value='罚！重复发此类帖'>罚！重复发此类帖</option></select> <input name='cause' type='text' value='' size='20' maxlength='10'>最多10个字符</td></tr>"&_
"<tr><td>奖罚操作：积分<select name='mark'>"&Options(-5,5,1)&"</select> 金钱<select name='coin'>"&Options(-200,200,10)&"</select> 游戏币<select name='gamecoin'>"&Options(-50,50,1)&"</select></td></tr><tr><td>留言通知：<input name='issms' onclick='if(sms.disabled==true){sms.disabled=false;sms.focus()}else{sms.disabled=true;}' type='checkbox' value='yes'> 留言附加信息：<input name='sms' size='30' type='text' value='' disabled='true'></td></tr><tr><td align='center'><input type='submit' name='Submit' value='确定操作'></td></tr></form></table>"
End If
End Sub
Sub SaveAppraise
Dim BbsID,Cause,Mark,Coin,GameCoin,IsSms,Sms,Smss,temp
BbsID=BBS94KK.CheckNum(request.querystring("BbsID"))
Cause=BBS94KK.Fun.GetStr("cause")
Mark=BBS94KK.Fun.GetStr("mark")
Coin=BBS94KK.Fun.GetStr("coin")
GameCoin=BBS94KK.Fun.GetStr("gamecoin")
IsSms=BBS94KK.Fun.GetStr("issms")
Sms=BBS94KK.Fun.GetStr("sms")
Caption="评帖错误"
Set Rs=BBS94KK.execute("Select Name From [KK_bbs"&BBS94KK.TB&"] where BbsID="&BbsID&" And BoardID="&BBS94KK.BoardID&"")
IF Rs.eof Then
BBS94KK.GoToErr(11)
ElseIf Lcase(Rs(0))=Lcase(BBS94KK.MyName) Then
Content="<li>管理员和版主不能对自己进行评帖！"
ElseIf Cause="" And (Mark=0 and Coin=0 and GameCoin=0) Then
Content="<li>请填写完整再提交！"
ElseIf Len(Cause)>10 Then
Content="<li>评帖理由描述不能超过10个字符！"
Else
Cause=BBS94KK.Fun.HtmlCode(Cause)
BBS94KK.execute("insert into [KK_Appraise](BbsID,TopicID,Cause,Mark,Coin,GameCoin,AdminName,AddTime)VALUES("&BbsID&","&ID&",'"&Cause&"',"&Mark&","&Coin&","&GameCoin&",'"&BBS94KK.MyName&"','"&BBS94KK.NowBbsTime&"')")
If Coin<>0 or Mark<>0 or GameCoin<>0 Then
Temp=Temp&"并且进行了"
If Mark<>0 Then Temp=Temp&"积分"&Mark&","
If Coin<>0 Then Temp=Temp&"金钱"&Coin&","
If GameCoin<>0 Then Temp=Temp&"游戏币"&GameCoin
Temp=Temp&"的操作。"
End If
BBS94KK.Execute("Update [KK_user] set Mark=Mark+"&Mark&",Coin=Coin+"&Coin&",GameCoin=GameCoin+"&GameCoin&" where Name='"&Rs(0)&"'")
If IsSms="yes" Then
Smss="你[url="&Url&"]发表的帖子[/url]被评价："&Cause&vbcrlf&Temp
If Sms<>"" Then Smss=Smss&vbcrlf&vbcrlf&"以下是操作人给你的附加留言信息："&vbcrlf&Sms
BBS94KK.Execute("insert into [KK_Sms](name,MyName,Content) values('自动送信系统','"&Rs(0)&"','"&Smss&"')")
BBS94KK.Execute("update [KK_User] set NewSmsNum=NewSmsNum+1,SmsSize=SmsSize+"&Len(Smss)&" Where Name='"&Rs(0)&"'")
End If
Rs.Close
BBS94KK.Execute("Update [KK_bbs"&BBS94KK.TB&"] Set IsAppraise=True where BbsID="&BbsID&" And BoardID="&BBS94KK.BoardID&"")
Caption="帖子评定"
If Temp<>"" Then Temp="<li>"&Temp
Content="<li>帖子评定成功"&Temp
End If
End Sub
Sub delappraise
Dim BbsID
IF BBS94KK.MyAdmin<>1 Then BBS94KK.GoToErr(24)
BbsID=BBS94KK.CheckNum(request.querystring("BbsID"))
BBS94KK.Execute("delete from [KK_appraise] where BbsID="&BbsID&" and TopicID="&ID)
BBS94KK.Execute("update [KK_bbs"&BBS94KK.TB&"] set IsAppraise=False where BbsID="&BbsID&" And BoardID="&BBS94KK.BoardID&"")
Content="<li>删除评帖记录---成功！"
End Sub
Sub IsOk
BBS94KK.execute("update [KK_Topic] set Caption='【已解决】'&Caption where TopicID="&ID&" and BoardID="&BBS94KK.BoardID&"")
Content="<li>设定帖子为已解决帖子---成功！！"
End Sub
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -