⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 plus_tools_postings.asp

📁 公司企业网站管理系统全站源码,用于企业内部对网站的管理
💻 ASP
📖 第 1 页 / 共 3 页
字号:
🔍
123 
	Dv_Tools.ChkToUseTools(Rs(3))
	Rs.Close
	Sql = "Update "&T_PostTable&" Set LockTopic=0,UseTools='"& T_UseTools &"' Where AnnounceID=" & ReplyID
	Dvbbs.Execute(Sql)
	Call UpdateUserTools(Dvbbs.UserID,Dv_Tools.ToolsID,1)
	LogMsg = "使用：<B>"& Dv_Tools.ToolsInfo(1) &"</B>成功，"&LoadTitle(T_Title)&"已成功解除单贴屏蔽状态！"
	Call Dvbbs.ToolsLog(Dv_Tools.ToolsID,1,0,0,1,LogMsg,Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text&"|"&Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text)
	Dvbbs.Dvbbs_Suc(LogMsg)
End Sub
'---------------------------------------------------
'道具:二级特赦令，可解除主题锁定
'---------------------------------------------------
Sub Tools_4()
	Dim Rs,Sql
	Dim T_Title,T_UseTools,T_PostTable
	If ChkAction = False Then Dvbbs.AddErrCode(42) : Exit Sub
	Sql = "Select Title,UseTools,PostTable From [Dv_Topic] Where TopicID="&TopicID&" And LockTopic=1"
	Set Rs = Dvbbs.Execute(Sql)
	If Rs.Eof Then 
		Response.redirect "showerr.asp?ErrCodes=<li>该主题不存在或不是锁定状态！&action=NoHeadErr"
		Exit Sub
	Else
		T_Title = Rs(0)
		T_UseTools = LoadUserTools(Rs(1),Dv_Tools.ToolsID)
		T_PostTable = Rs(2)
	End If
	Rs.Close
	Sql = "Update [Dv_Topic] Set LockTopic=0,UseTools='"& T_UseTools &"' Where TopicID="&TopicID
	Dvbbs.Execute(Sql)
	Call UpdateUserTools(Dvbbs.UserID,Dv_Tools.ToolsID,1)
	LogMsg = "使用：<B>"& Dv_Tools.ToolsInfo(1) &"</B>成功，"&LoadTitle(T_Title)&"已成功解除锁定！"
	Call Dvbbs.ToolsLog(Dv_Tools.ToolsID,1,0,0,1,LogMsg,Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text&"|"&Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text)
	Dvbbs.Dvbbs_Suc(LogMsg)
End Sub

'---------------------------------------------------
'道具:三级特赦令，解除自己或他人的屏蔽或锁定状态
'---------------------------------------------------
Sub Tools_5()
	Dim Rs,Sql
	Dim T_Title,T_UseTools,T_PostTable
	ChkAction = True
	If ToUserID = 0 Then ChkAction = False
	If ChkAction = False Then Dvbbs.AddErrCode(42) : Exit Sub
	'判断目标用户使用权限并取出目标用户信息
	Dv_Tools.ChkToUseTools(ToUserID)
	Sql = "Select UserID From Dv_User Where UserID="&ToUserID&" And LockUser>0"
	Set Rs = Dvbbs.Execute(Sql)
	If Rs.Eof Then 
		Response.redirect "showerr.asp?ErrCodes=<li>该用户不存在或不是屏蔽或锁定状态！&action=NoHeadErr"
		Exit Sub
	Else
		Dvbbs.Execute("Update Dv_User Set LockUser=0 Where UserID="& Rs(0))
	End If
	Rs.Close
	Call UpdateUserTools(Dvbbs.UserID,Dv_Tools.ToolsID,1)
	LogMsg = "使用：<B>"& Dv_Tools.ToolsInfo(1) &"</B>成功，用户<B>"&Dv_Tools.ToUserInfo(1)&"</B>已成功解除锁定或屏蔽状态！"
	Call Dvbbs.ToolsLog(Dv_Tools.ToolsID,1,0,0,1,LogMsg,Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text&"|"&Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text)
	Dvbbs.Dvbbs_Suc(LogMsg)
End Sub
'---------------------------------------------------
'道具:吖噗鸡，可使帖子提升到第一页
'---------------------------------------------------
Sub Tools_6()
	Dim Rs,Sql
	Dim T_Title,T_UseTools,T_PostTable
	If ChkAction = False Then Dvbbs.AddErrCode(42) : Exit Sub
	Sql = "Select Title,UseTools,PostTable From [Dv_Topic] Where TopicID="&TopicID&" And LockTopic=1"
	Set Rs = Dvbbs.Execute(Sql)
	If Rs.Eof Then 
		Response.redirect "showerr.asp?ErrCodes=<li>该主题不存在或不是锁定状态！&action=NoHeadErr"
		Exit Sub
	Else
		T_Title = Rs(0)
		T_UseTools = LoadUserTools(Rs(1),Dv_Tools.ToolsID)
		T_PostTable = Rs(2)
	End If
	Rs.Close
	Sql = "Update [Dv_Topic] Set LastPostTime="&SqlNowString&",UseTools='"& T_UseTools &"' Where TopicID="&TopicID
	Dvbbs.Execute(Sql)
	Call UpdateUserTools(Dvbbs.UserID,Dv_Tools.ToolsID,1)
	LogMsg = "使用：<B>"& Dv_Tools.ToolsInfo(1) &"</B>成功，"&LoadTitle(T_Title)&"已成功提升到第一页！"
	Call Dvbbs.ToolsLog(Dv_Tools.ToolsID,1,0,0,1,LogMsg,Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text&"|"&Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text)
	Dvbbs.Dvbbs_Suc(LogMsg)
End Sub
'---------------------------------------------------
'道具:醒目灯，可将主题变色
'---------------------------------------------------
Sub Tools_7()
	Dim Rs,Sql,i
	Dim T_Title,T_UseTools,T_PostTable,ToolsColorList
	If ChkAction = False Then Dvbbs.AddErrCode(42) : Exit Sub
	Sql = "Select Title,UseTools,PostTable From [Dv_Topic] Where TopicID="&TopicID
	Set Rs = Dvbbs.Execute(Sql)
	If Rs.Eof Then 
		Response.redirect "showerr.asp?ErrCodes=<li>该主题不存在或不是锁定状态！&action=NoHeadErr"
		Exit Sub
	Else
		T_Title = Rs(0)
		T_UseTools = LoadUserTools(Rs(1),Dv_Tools.ToolsID)
		T_PostTable = Rs(2)
	End If
	Rs.Close
	ToolsColorList = "#000000,#F0F8FF,#FAEBD7,#00FFFF,#7FFFD4,#F0FFFF,#F5F5DC,#FFE4C4,#000000,#FFEBCD,#0000FF,#8A2BE2,#A52A2A,#DEB887,#5F9EA0,#7FFF00,#D2691E,#FF7F50,#6495ED,#FFF8DC,#DC143C,#00FFFF,#00008B,#008B8B,#B8860B,#A9A9A9,#006400,#BDB76B,#8B008B,#556B2F,#FF8C00,#9932CC,#8B0000,#E9967A,#8FBC8F,#483D8B,#2F4F4F,#00CED1,#9400D3,#FF1493,#00BFFF,#696969,#1E90FF,#B22222,#FFFAF0,#228B22,#FF00FF,#DCDCDC,#F8F8FF,#FFD700,#DAA520,#808080,#008000,#ADFF2F,#F0FFF0,#FF69B4,#CD5C5C,#4B0082,#FFFFF0,#F0E68C,#E6E6FA,#FFF0F5,#7CFC00,#FFFACD,#ADD8E6,#F08080,#E0FFFF,#FAFAD2,#90EE90,#D3D3D3,#FFB6C1,#FFA07A,#20B2AA,#87CEFA,#778899,#B0C4DE,#FFFFE0,#00FF00,#32CD32,#FAF0E6,#FF00FF,#800000,#66CDAA,#0000CD,#BA55D3,#9370DB,#3CB371,#7B68EE,#00FA9A,#48D1CC,#C71585,#191970,#F5FFFA,#FFE4E1,#FFE4B5,#FFDEAD,#000080,#FDF5E6,#808000,#6B8E23,#FFA500,#FF4500,#DA70D6,#EEE8AA,#98FB98,#AFEEEE,#DB7093,#FFEFD5,#FFDAB9,#CD853F,#FFC0CB,#DDA0DD,#B0E0E6,#800080,#FF0000,#BC8F8F,#4169E1,#8B4513,#FA8072,#F4A460,#2E8B57,#FFF5EE,#A0522D,#C0C0C0,#87CEEB,#6A5ACD,#708090,#FFFAFA,#00FF7F,#4682B4,#D2B48C,#008080,#D8BFD8,#FF6347,#40E0D0,#EE82EE,#F5DEB3,#FFFFFF,#F5F5F5,#FFFF00,#9ACD32"
	If Request("ToolsAction")="SendColor" Then
		If Instr("," & ToolsColorList & ",","," & Request("color") & ",")=0 Then
			Response.redirect "showerr.asp?ErrCodes=<li>错误的颜色参数！&action=NoHeadErr"
			Exit Sub
		End If
		T_Title = "<font color="&Request("color")&">"&T_Title&"</font>"
		Dvbbs.Execute("Update Dv_Topic Set Title='"&Replace(T_Title,"'","''")&"',TopicMode=1,UseTools='"& T_UseTools &"' Where TopicID=" & TopicID)
		Dvbbs.Execute("Update "&T_PostTable&" Set Topic='"&Replace(T_Title,"'","''")&"',UseTools='"& T_UseTools &"' Where RootID="&TopicID&" And ParentID=0")
		Call UpdateUserTools(Dvbbs.UserID,Dv_Tools.ToolsID,1)
		LogMsg = "使用：<B>"& Dv_Tools.ToolsInfo(1) &"</B>成功，"&Replace(Replace(LoadTitle(T_Title),"&lt;","<"),"&gt;",">")&"已成功操作！"
		Call Dvbbs.ToolsLog(Dv_Tools.ToolsID,1,0,0,1,LogMsg,Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text&"|"&Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text)
		Dvbbs.Dvbbs_Suc(LogMsg)
	Else
	ToolsColorList = Split(ToolsColorList,",")
%>
<table border="0" cellpadding=3 cellspacing=1 align=center class=Tableborder1 Style="Width:99%">
	<tr>
	<th height=23 colspan=2>使用道具 <%=Dv_Tools.ToolsInfo(1)%></th></tr>
	<tr><td height=23 class=Tablebody1 colspan=2>
	<B>说明</B>：本道具可使目标帖子标题变成您所选择的颜色，请在下面选择您所需要的颜色</td></tr>
	<FORM METHOD=POST ACTION="?ToolsAction=SendColor" name="theForm">
<!--	<input type=hidden value="<%=ToUserID%>" name="ToUserID">  -->
	<input type=hidden value="<%=Dvbbs.BoardID%>" name="BoardID">
	<input type=hidden value="<%=TopicID%>" name="TopicID">
	<input type=hidden value="<%=ReplyID%>" name="ReplyID">
	<input type=hidden value="<%=Dv_Tools.ToolsID%>" name="ToolsID">
	<tr>
	<td height=23 class=Tablebody1 width="30%" align=right>颜色列表：</td>
	<td height=23 class=Tablebody1 width="70%">
	<SELECT onChange="document.getElementById('TopicColor').color=options[selectedIndex].value;" name="color"> 
	<%
	For i=0 To Ubound(ToolsColorList)
		Response.Write "<option style=""background-color:"&ToolsColorList(i)&";color: "&ToolsColorList(i)&""" value="""&ToolsColorList(i)&""">"&ToolsColorList(i)&"</option>"
	Next
	%>
	</SELECT>
	</td>
	</tr>
	<tr>
	<td height=23 class=Tablebody1 width="30%" align=right>使用效果：</td>
	<td height=23 class=Tablebody1 width="70%"><font id=TopicColor><%=Server.HtmlEncode(T_Title)%></font></td>
	</tr>
	<tr><td height=23 class=Tablebody2 colspan=2 align=center>
	<input type=submit value="确认使用" name=submit>
	</td></tr>
	</FORM>
</table>
<%
	End If
End Sub

'---------------------------------------------------
'道具:水晶球，可查看发贴用户IP
'---------------------------------------------------
Sub Tools_8()
	Dim Rs,Sql
	Dim T_Title,T_UseTools,T_PostTable,ToUserToolsIP
'	If ToUserID = 0 Then ChkAction = False
'	If ChkAction = False Then Dvbbs.AddErrCode(42) : Exit Sub
	'判断目标用户使用权限并取出目标用户信息
'	Dv_Tools.ChkToUseTools()
	Sql = "Select Title,UseTools,PostTable From [Dv_Topic] Where TopicID="&TopicID
	Set Rs = Dvbbs.Execute(Sql)
	If Rs.Eof Then 
		Response.redirect "showerr.asp?ErrCodes=<li>该主题不存在！&action=NoHeadErr"
		Response.write "1"
		Exit Sub
	Else
		T_PostTable = Rs(2)
	End If
	Rs.Close
	Set Rs=Dvbbs.Execute("Select Topic,UseTools,Body,IP,postuserid From "&T_PostTable&" Where AnnounceID="&ReplyID)
	If Rs.Eof Then
		Response.redirect "showerr.asp?ErrCodes=<li>该帖子不存在！&action=NoHeadErr"
		Exit Sub
	Else
		If Rs(0)="" Or IsNull(Rs(0)) Then
			T_Title = Left(Rs(2),25)
		Else
			T_Title = Rs(0)
		End If
		T_UseTools = LoadUserTools(Rs(1),Dv_Tools.ToolsID)
		ToUserToolsIP = Rs(3)
	End If
	'判断目标用户使用权限并取出目标用户信息
	Dv_Tools.ChkToUseTools(Rs(4))
	Rs.Close
	Sql = "Update "&T_PostTable&" Set UseTools='"& T_UseTools &"' Where AnnounceID=" & ReplyID
	Dvbbs.Execute(Sql)
	Call UpdateUserTools(Dvbbs.UserID,Dv_Tools.ToolsID,1)
	LogMsg = "使用：<B>"& Dv_Tools.ToolsInfo(1) &"</B>成功，"&LoadTitle(T_Title)&"中帖子编号为"&ReplyID&"的发贴IP是："&ToUserToolsIP&"！"
	Call Dvbbs.ToolsLog(Dv_Tools.ToolsID,1,0,0,1,LogMsg,Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text&"|"&Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text)
	Dvbbs.Dvbbs_Suc(LogMsg)
End Sub
'---------------------------------------------------
'道具:追踪器，可查看发贴用户的IP和来源
'---------------------------------------------------
Sub Tools_9()
	Dim Rs,Sql
	Dim T_Title,T_UseTools,T_PostTable,ToUserToolsIP,ToUserToolsIP_1,ToUserToolsAddress
'	If ToUserID = 0 Then ChkAction = False
'	If ChkAction = False Then Dvbbs.AddErrCode(42) : Exit Sub
	'判断目标用户使用权限并取出目标用户信息
'	Dv_Tools.ChkToUseTools()
	Sql = "Select Title,UseTools,PostTable From [Dv_Topic] Where TopicID="&TopicID
	Set Rs = Dvbbs.Execute(Sql)
	If Rs.Eof Then 
		Response.redirect "showerr.asp?ErrCodes=<li>该主题不存在！&action=NoHeadErr"
		Exit Sub
	Else
		T_PostTable = Rs(2)
	End If
	Rs.Close
	Set Rs=Dvbbs.Execute("Select Topic,UseTools,Body,IP,postuserid From "&T_PostTable&" Where AnnounceID="&ReplyID)
	If Rs.Eof Then
		Response.redirect "showerr.asp?ErrCodes=<li>该帖子不存在！&action=NoHeadErr"
		Exit Sub
	Else
		If Rs(0)="" Or IsNull(Rs(0)) Then
			T_Title = Left(Rs(2),25)
		Else
			T_Title = Rs(0)
		End If
		T_UseTools = LoadUserTools(Rs(1),Dv_Tools.ToolsID)
		ToUserToolsIP = Rs(3)
	End If
	'判断目标用户使用权限并取出目标用户信息
	Dv_Tools.ChkToUseTools(Rs(4))
	Rs.Close
	Sql = "Update "&T_PostTable&" Set UseTools='"& T_UseTools &"' Where AnnounceID=" & ReplyID
	Dvbbs.Execute(Sql)
	ToUserToolsIP_1 = ToUserToolsIP
	ToUserToolsAddress = lookaddress(ToUserToolsIP_1)
	Call UpdateUserTools(Dvbbs.UserID,Dv_Tools.ToolsID,1)
	LogMsg = "使用：<B>"& Dv_Tools.ToolsInfo(1) &"</B>成功，"&LoadTitle(T_Title)&"中帖子编号为"&ReplyID&"的发贴IP是："&ToUserToolsIP&"，来源是："&ToUserToolsAddress&"！"
	Call Dvbbs.ToolsLog(Dv_Tools.ToolsID,1,0,0,1,LogMsg,Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text&"|"&Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text)
	Dvbbs.Dvbbs_Suc(LogMsg)

End Sub
'---------------------------------------------------
'道具:一星龙珠，可将用户所有负分转为0
'---------------------------------------------------
Sub Tools_10()
	Dim Rs,Sql
	Dim T_Title,T_UseTools,T_PostTable
	ChkAction = True
	If ToUserID = 0 Then ChkAction = False
	If ChkAction = False Then Dvbbs.AddErrCode(42) : Exit Sub
	'判断目标用户使用权限并取出目标用户信息
	Dv_Tools.ChkToUseTools(ToUserID)
	'更新用户分值信息
	Sql = "Select UserWealth,UserEP,UserCP,UserPower,UserDel From Dv_User Where UserID= " & Dv_Tools.ToUserInfo(0)
	Set Rs = server.CreateObject ("adodb.recordset")
	If Not IsObject(Conn) Then ConnectionDatabase
	Rs.Open Sql,Conn,1,3
	If Rs("UserWealth") < 0 Then Rs("UserWealth") = 0
	If Rs("UserEP") < 0 Then Rs("UserEP") = 0
	If Rs("UserCP") < 0 Then Rs("UserCP") = 0
	If Rs("UserPower") < 0 Then Rs("UserPower") = 0
	If Rs("UserDel") < 0 Then Rs("UserDel") = 0
	Rs.Update
	Rs.Close
	Set Rs=Nothing
	'更新用户和系统使用数量
	Call UpdateUserTools(Dvbbs.UserID,Dv_Tools.ToolsID,1)
	LogMsg = "使用：<B>"& Dv_Tools.ToolsInfo(1) &"</B>成功，成功将用户<b>"&Dv_Tools.ToUserInfo(1)&"</b>的所有负分转正！"
	Call Dvbbs.ToolsLog(Dv_Tools.ToolsID,1,0,0,1,LogMsg,Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text&"|"&Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text)
	Dvbbs.Dvbbs_Suc(LogMsg)

End Sub
'---------------------------------------------------
'道具:二星龙珠，可将用户经验负分转为0
'---------------------------------------------------
Sub Tools_11()
	Dim Rs,Sql
	Dim T_Title,T_UseTools,T_PostTable
	ChkAction = True
	If ToUserID = 0 Then ChkAction = False
	If ChkAction = False Then Dvbbs.AddErrCode(42) : Exit Sub
	'判断目标用户使用权限并取出目标用户信息
	Dv_Tools.ChkToUseTools(ToUserID )
	'更新用户分值信息
	Sql = "Select UserEP From Dv_User Where UserID= " & Dv_Tools.ToUserInfo(0)
	Set Rs = server.CreateObject ("adodb.recordset")
	If Not IsObject(Conn) Then ConnectionDatabase
	Rs.Open Sql,Conn,1,3
	If Rs("UserEP") < 0 Then Rs("UserEP") = 0
	Rs.Update
	Rs.Close
	Set Rs=Nothing
	'更新用户和系统使用数量
	Call UpdateUserTools(Dvbbs.UserID,Dv_Tools.ToolsID,1)
	LogMsg = "使用：<B>"& Dv_Tools.ToolsInfo(1) &"</B>成功，成功将用户<b>"&Dv_Tools.ToUserInfo(1)&"</b>的经验负分转正！"
123

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -