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

📄 plus_tools_postings.asp

📁 公司企业网站管理系统全站源码,用于企业内部对网站的管理
💻 ASP
📖 第 1 页 / 共 3 页
字号:
🔍
123 
	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_12()
	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 )
	If Dvbbs.UserID = Clng(Dv_Tools.ToUserInfo(0)) Then
		Dv_Tools.ShowErr(14)
		Exit Sub
	End If
	'更新用户信息
	Sql = "Select FollowMsgID 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(0)="" Or IsNull(Rs(0)) Then
		Rs(0) = Dvbbs.Membername
	Else
		Rs(0) = Rs(0) & "," & Dvbbs.Membername
	End If
	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

'---------------------------------------------------
'道具:救生圈，可将帖子固顶6小时
'---------------------------------------------------
Sub Tools_13()
	Dim Rs,Sql
	Dim T_Title,T_UseTools,T_PostTable,LastPostTime
	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
	LastPostTime = DateAdd("h",6,now)
	Sql = "Update [Dv_Topic] Set LastPostTime='"&LastPostTime&"',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)&"已成功固顶6小时！"
	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
'---------------------------------------------------
'道具:大救生圈，可将帖子固顶12小时
'---------------------------------------------------
Sub Tools_14()
	Dim Rs,Sql
	Dim T_Title,T_UseTools,T_PostTable,LastPostTime
	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
	LastPostTime = DateAdd("h",12,now)
	Sql = "Update [Dv_Topic] Set LastPostTime='"&LastPostTime&"',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)&"已成功固顶12小时！"
	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_15()

End Sub

'---------------------------------------------------
'道具:照妖镜 可查看匿名发帖用户名。
'---------------------------------------------------
Sub Tools_16()
	Dim Rs,Sql
	Dim T_Title,T_UseTools,T_PostTable,ToUserToolsName
	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,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)
		ToUserToolsName = Rs(3)
	End If
	'判断目标用户使用权限并取出目标用户信息
	Dv_Tools.ChkToUseTools(Rs(3))
	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)&"的发贴人是："&Dv_Tools.ToUserInfo(1)&"！"
	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_17()
	Dim Rs,Sql
	Dim T_Title,T_UseTools,T_PostTable,ToUserToolsName
	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,postuserid,ParentID 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)
		ToUserToolsName = Rs(3)
	End If
	'判断目标用户使用权限并取出目标用户信息
	Dv_Tools.ChkToUseTools(Rs(3))
	If Rs(4)=0 Then Dvbbs.Execute("Update Dv_Topic Set HideName=0 Where TopicID="&TopicID)
	Rs.Close
	Sql = "Update "&T_PostTable&" Set UseTools='"& T_UseTools &"',signflag=0 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


'---------------------------------------------------
'道具:精灵弓，可破坏小救生圈效果，对大救生圈效果破坏1/6
'---------------------------------------------------
Sub Tools_18()
	Dim Rs,Sql,CanUserTools,UseTools
	Dim T_Title,T_UseTools,T_PostTable
	CanUserTools = False
	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)
		UseTools = Rs(1)
		If UseTools="" Or IsNull(UseTools) Then
			Response.redirect "showerr.asp?ErrCodes=<li>该主题没有被使用相关道具！&action=NoHeadErr"
			Exit Sub
		End If
		If InStr("," & UseTools & ",",",13,") Then CanUserTools = True
		If InStr("," & UseTools & ",",",14,") Then CanUserTools = True
		If Not CanUserTools Then
			Response.redirect "showerr.asp?ErrCodes=<li>该主题没有被使用相关道具！&action=NoHeadErr"
			Exit Sub
		End If
		T_UseTools = LoadUserTools(UseTools,Dv_Tools.ToolsID)
		T_PostTable = Rs(2)
	End If
	Rs.Close
	Sql = ""
	If IsSqlDataBase=1 Then
		If InStr("," & UseTools & ",",",13,")>0 Then
			Sql = "Update [Dv_Topic] Set LastPostTime=DateAdd(hour,-6,"&SqlNowString&"),UseTools='"& T_UseTools &"' Where TopicID="&TopicID
		ElseIf InStr("," & UseTools & ",",",14,")>0 Then
			Sql = "Update [Dv_Topic] Set LastPostTime=DateAdd(hour,-2,"&SqlNowString&"),UseTools='"& T_UseTools &"' Where TopicID="&TopicID
		End If
	Else
		If InStr("," & UseTools & ",",",13,")>0 Then
			Sql = "Update [Dv_Topic] Set LastPostTime=DateAdd('h',-6,"&SqlNowString&"),UseTools='"& T_UseTools &"' Where TopicID="&TopicID
		ElseIf InStr("," & UseTools & ",",",14,")>0 Then
			Sql = "Update [Dv_Topic] Set LastPostTime=DateAdd('h',-2,"&SqlNowString&"),UseTools='"& T_UseTools &"' Where TopicID="&TopicID
		End If
	End If
	If Sql<>"" Then 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
'---------------------------------------------------
'道具:水之母，可延长大小救生圈固顶效果时限的1/6
'---------------------------------------------------
Sub Tools_19()
	Dim Rs,Sql
	Dim T_Title,T_UseTools,T_PostTable,CanUserTools,UseTools
	CanUserTools = False
	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)
		UseTools = Rs(1)
		If UseTools="" Or IsNull(UseTools) Then
			Response.redirect "showerr.asp?ErrCodes=<li>该主题没有被使用相关道具！&action=NoHeadErr"
			Exit Sub
		End If
		If InStr("," & UseTools & ",",",13,") Then CanUserTools = True
		If InStr("," & UseTools & ",",",14,") Then CanUserTools = True
		If Not CanUserTools Then
			Response.redirect "showerr.asp?ErrCodes=<li>该主题没有被使用相关道具！&action=NoHeadErr"
			Exit Sub
		End If
		T_UseTools = LoadUserTools(UseTools,Dv_Tools.ToolsID)
		T_PostTable = Rs(2)
	End If
	Rs.Close
	Sql = ""
	If IsSqlDataBase=1 Then
		If InStr("," & UseTools & ",",",13,")>0 Then
			Sql = "Update [Dv_Topic] Set LastPostTime=DateAdd(hour,1,"&SqlNowString&"),UseTools='"& T_UseTools &"' Where TopicID="&TopicID
		ElseIf InStr("," & UseTools & ",",",14,")>0 Then
			Sql = "Update [Dv_Topic] Set LastPostTime=DateAdd(hour,2,"&SqlNowString&"),UseTools='"& T_UseTools &"' Where TopicID="&TopicID
		End If
	Else
		If InStr("," & UseTools & ",",",13,")>0 Then
			Sql = "Update [Dv_Topic] Set LastPostTime=DateAdd('h',1,"&SqlNowString&"),UseTools='"& T_UseTools &"' Where TopicID="&TopicID
		ElseIf InStr("," & UseTools & ",",",14,")>0 Then
			Sql = "Update [Dv_Topic] Set LastPostTime=DateAdd('h',2,"&SqlNowString&"),UseTools='"& T_UseTools &"' Where TopicID="&TopicID
		End If
	End If
	If Sql<>"" Then 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_20()
	ChkAction = True
	Dim NewUserName,TempLateStr,i,Rs,Sql
	If Request("ToolsAction")="ChangID" Then
		NewUserName = Dvbbs.Checkstr(Trim(Request.Form("name")))
		If Dvbbs.chkpost = False Then Dvbbs.AddErrCode(16):Exit Sub
		'验证用户名字符长度是否符合论坛标准
		If NewUserName = "" or Dvbbs.strLength(NewUserName)>Cint(Dvbbs.Forum_Setting(41)) or Dvbbs.strLength(NewUserName)<Cint(Dvbbs.Forum_Setting(40)) Then
			Dvbbs.AddErrCode(17)
			ChkAction = False
		End If
		'验证用户名是否含有禁止字符；
		If Instr(NewUserName,"=")>0 or Instr(NewUserName,"%")>0 or Instr(NewUserName,chr(32))>0 or Instr(NewUserName,"?")>0 or Instr(NewUserName,"&")>0 or Instr(NewUserName,";")>0 or Instr(NewUserName,",")>0 or Instr(NewUserName,"'")>0 or Instr(NewUserName,chr(34))>0 or Instr(NewUserName,chr(9))>0 or Instr(NewUserName,"
123

⌨️ 快捷键说明

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