savepost.asp

来自「现在好了」· ASP 代码 · 共 356 行 · 第 1/2 页

<!--#include file="conn.asp"-->
<!--#include file="inc/const.asp"-->
<!--#include file="inc/dv_clsother.asp"-->
<!--#include file="inc/md5.asp"-->
<!--#include file="inc/ubblist.asp"-->
<!--#include file="inc/Email_Cls.asp"-->
<%
If Dvbbs.BoardID < 1 Then
	Response.Write "参数错误"
	Response.End
End If
Dim MyPost
Dim postbuyuser,bgcolor,abgcolor
Dvbbs.Loadtemplates("post")
Set MyPost = New Dvbbs_Post
Dvbbs.Stats = MyPost.ActionName
Dvbbs.Nav()
Dvbbs.Head_var 1,Dvbbs.BoardNode.attributes.getNamedItem("depth").text,"",""
MyPost.Save_CheckData
Set MyPost = Nothing
Dvbbs.ActiveOnline
Dvbbs.Footer

Class Dvbbs_Post
	Public Action,ActionName,Star,Page,IsAudit,TotalUseTable,ToAction,TopicMode,Reuser
	Private AnnounceID,ReplyID,ParentID,RootID,Topic,Content,char_changed,signflag,mailflag,iLayer,iOrders
	Private TopTopic,IsTop,LastPost,LastPost_1,UpLoadPic_n,ihaveupfile,smsuserlist,upfileinfo
	Private UserName,UserPassWord,UserPost,GroupID,UserClass,DateAndTime,DateTimeStr,Expression,MyLastPostTime,LastPostTimes
	Private LockTopic,MyLockTopic,MyIsTop,MyIsTopAll,MyTopicMode,Child
	Private CanLockTopic,CanTopTopic,CanTopTopic_a,CanEditPost,Rs,SQL,i,IsAuditcheck
	Private vote,votetype,votenum,votetimeout,voteid,isvote,ErrCodes
	Private GetPostType,ToMoney,UseTools,ToolsBuyUser,GetMoneyType,Tools_UseTools,Tools_LastPostTime,ToolsInfo,ToolsSetting
	Private tMagicFace,iMagicFace,tMagicMoney,tMagicTicket,FoundUseMagic
	Private Sub Class_Initialize()
		ErrCodes = ""
		'管理员及该版版主允许在锁定论坛发帖
		If Dvbbs.Board_Setting(0)="1" And Not (Dvbbs.Master or Dvbbs.Boardmaster) Then
			Response.redirect "showerr.asp?action=lock&boardid="&dvbbs.boardID&"" 
		End If
		If Dvbbs.IsReadonly()  And Not Dvbbs.Master Then Response.redirect "showerr.asp?action=readonly&boardid="&dvbbs.boardID&"" 
		Action = Request("Action")
		TotalUseTable = Dvbbs.NowUseBBS
		Select Case Action
		Case "snew"
			Action = 5
			ActionName = template.Strings(1)
			If Dvbbs.GroupSetting(3)="0" Then Dvbbs.AddErrCode(70)
		Case "sre"
			Action = 6
			ActionName = template.Strings(3)
			If Dvbbs.GroupSetting(5)="0" then Dvbbs.AddErrCode(71)
		Case "svote"
			Action = 7
			ActionName = template.Strings(5)
			If Dvbbs.GroupSetting(8)="0" then Dvbbs.AddErrCode(56)
		Case "sedit"
			Action = 8
			ActionName = template.Strings(7)
		Case Else
			Action = 1
			ActionName = template.Strings(0)
		End Select
		Star = Request("star")
		If Star = "" Or Not IsNumeric(Star) Then Star = 1
		Star = Clng(Star)
		Page = Request("page")
		If Page = "" Or Not IsNumeric(Page) Then Page = 1
		Page = Clng(Page)
		IsAudit = Cint(Dvbbs.Board_Setting(3))
		Reuser = False'此变量标识是否更名发贴
		FoundUseMagic = False
	End Sub

	'通用判断
	Public Function Chk_Post()
		If Dvbbs.Board_Setting(43)="1" Then Dvbbs.AddErrCode(72)
		If Dvbbs.Board_Setting(1)="1" and Dvbbs.GroupSetting(37)="0" Then Dvbbs.AddErrCode(26)
		If Dvbbs.UserID>0 Then
			If Clng(Dvbbs.GroupSetting(52))>0 And DateDiff("s",Dvbbs.MyUserInfo(14),Now)<Clng(Dvbbs.GroupSetting(52))*60 Then Response.redirect "showerr.asp?ErrCodes=<li>"&Replace(template.Strings(21),"{$timelimited}",Dvbbs.GroupSetting(52))&"&action=OtherErr"
			If Dvbbs.GroupSetting(62)<>"0" And Not Action = 8 Then
				If Clng(Dvbbs.GroupSetting(62))<=Clng(Dvbbs.UserToday(0)) Then Response.redirect "showerr.asp?ErrCodes=<li>"&Replace(template.Strings(27),"{$topiclimited}",Dvbbs.GroupSetting(62))&"&action=OtherErr"
			End If
		End If
		If Dvbbs.GroupSetting(3)="0" And (Action = 5 Or Action = 7) Then Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(28)&"&action=OtherErr"
		If Dvbbs.GroupSetting(5)="0" And (Action = 6) Then Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(29)&"&action=OtherErr"
	End Function

	'返回判断和参数
	Public Function Get_M_Request()
		AnnounceID = Request("ID")
		If AnnounceID = "" Or Not IsNumeric(AnnounceID) Then Dvbbs.AddErrCode(30)
		Dvbbs.ShowErr()
		AnnounceID = cCur(AnnounceID)
	End Function
	

	'判断发表类型及权限 GetPostType 0=赠送金币贴(求回复答案),1=获赠金币贴,2=金币购买贴
	Private Sub Chk_PostType()
		Dim ToolsID
		ToolsID = Trim(Request.Form("ToolsID"))
		GetPostType = Trim(Request.Form("GetPostType"))
		ToMoney = Trim(Request.Form("ToMoney"))
		If ToMoney="" or Not Isnumeric(ToMoney) Then ToMoney = 0
		If ToolsID="" or Not Isnumeric(ToolsID) Then
			ToolsID = ""
		Else
			ToolsID = Cint(ToolsID)
		End If
		Dvbbs.MyUserInfo(37) = cCur(Dvbbs.MyUserInfo(37))	'用户金币数量
		ToMoney = cCur(ToMoney)
		UseTools = ""
		ToolsBuyUser = ""
		GetMoneyType = 0
		If Dvbbs.GroupSetting(59)<>1 Then Exit Sub
		If GetPostType<>"" and (Action = 5 or Action = 7) Then
			Select Case GetPostType
			Case "0"
				If ToMoney = 0 or ToMoney > Dvbbs.MyUserInfo(37) Or ToMoney < 0 Then Response.redirect "showerr.asp?ErrCodes=<li>您设置的金币值为空或者多于您拥有的金币数量。&action=OtherErr"
				Dvbbs.MyUserInfo(37) = Dvbbs.MyUserInfo(37)-ToMoney
				'UseTools = "-1111"
				ToolsBuyUser = "0|||$SendMoney"
				GetMoneyType = 1
			Case "1"
				ToolsBuyUser = "0|||$GetMoney"
				GetMoneyType = 2
				'UseTools = ToolsInfo(4)
			Case "2"
				If ToMoney = 0 Or ToMoney < 0 Then Response.redirect "showerr.asp?ErrCodes=<li>请正确填写购买帖的金币数量。&action=OtherErr"
				Dim Buy_Orders,Buy_VIPType,Buy_UserList
				Buy_Orders = Request.FORM("Buy_Orders")
				Buy_VIPType = Request.FORM("Buy_VIPType")
				Buy_UserList = Request.FORM("Buy_UserList")
				If Buy_Orders<>"" and IsNumeric(Buy_Orders) Then
					Buy_Orders = cCur(Buy_Orders)
				Else
					Buy_Orders = -1
				End If
				If Not IsNumeric(Buy_VIPType) Then Buy_VIPType = 0
				If Buy_UserList<>"" Then Buy_UserList = Replace(Replace(Replace(Buy_UserList,"|||",""),"@@@",""),"$PayMoney","")
				ToolsBuyUser = "0@@@"&Buy_Orders&"@@@"&Buy_VIPType&"@@@"&Buy_UserList&"|||$PayMoney|||"
				GetMoneyType = 3
				'UseTools = ToolsInfo(4)
			End Select
		End If
		'回复获赠金币帖判断
		If Action = 6 and GetPostType = "1" Then
			If ToMoney = 0 or ToMoney > Dvbbs.MyUserInfo(37) Or ToMoney < 0 Then Response.redirect "showerr.asp?ErrCodes=<li>您设置的金币值为空或者多于您拥有的金币数量。&action=OtherErr"
		End If
	End Sub

	'更新用户及系统道具数量(用户ID，道具ID，减少数量)
	Private Sub UpdateUserTools(U_UserID,U_ToolsID,n)
		Dim Sql,Rs
		If Clng(n)<0 Then
			n = "+" & n
		Else
			n = "-" & n
		End If
		Set Rs = Dvbbs.Plus_Execute("Select ID From [Dv_Plus_Tools_Buss] Where UserID="& U_UserID &" and ToolsID="& U_ToolsID)
		If Rs.Eof And Rs.Bof Then
			Dim Trs
			Set Trs = Dvbbs.Plus_Execute("Select ToolsName From Dv_Plus_Tools_Info Where ID=" & U_ToolsID)
			If Not (Trs.Eof And Trs.Bof) Then
				Sql = "Insert Into [Dv_Plus_Tools_Buss] (UserID,UserName,ToolsID,ToolsName,ToolsCount) Values ("&U_UserID&",'"&Dv_Tools.ToUserInfo(1)&"',"&U_ToolsID&",'"&Trs(0)&"',"&Clng(Replace(Replace(n,"+",""),"-",""))&")"
				Dvbbs.Plus_Execute(Sql)
			End If
			Trs.Close
			Set Trs=Nothing
		Else
			Sql = "Update [Dv_Plus_Tools_Buss] Set ToolsCount = ToolsCount"&n&" Where UserID="& U_UserID &" and ToolsID="& U_ToolsID
			Dvbbs.Plus_Execute(Sql)
		End If
		Rs.Close
		Set Rs=Nothing
		Sql = "Update [Dv_Plus_Tools_Info] Set UserStock =  UserStock"&n&" Where ID="& U_ToolsID
		Dvbbs.Plus_Execute(Sql)
	End Sub
	'回复获赠金币帖时更新