savepost.asp

公司企业网站管理系统全站源码,用于企业内部对网站的管理

				Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text  = CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text) -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?ShowErrType="&Dvbbs.ErrType&"&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 > CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text)  Or ToMoney < 0 Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您设置的金币值为空或者多于您拥有的金币数量。&action=OtherErr"
		End If
	End Sub


	Rem ------------------------
	Rem 保存部分函数开始
	Rem ------------------------
	'检查数据,提取数据，获得贴子数据表名等。

	Public Sub Save_CheckData()
		Chk_Post()
		CheckfromScript()
		'把提交的数据保存到session
		Content = CheckAlipay()
		isAlipayTopic = 2
		If Content = "" Then
			Content = Dvbbs.Checkstr(Request.Form("body"))
			isAlipayTopic = 0
		End If
		Dvbbs.UserSession.documentElement.selectSingleNode("userinfo").attributes.setNamedItem(Dvbbs.UserSession.createNode(2,"postdata","")).text= Request.Form("body")
		
		'验证码校验
		If Dvbbs.Board_Setting(4) = "1" Then
			If Not Dvbbs.CodeIsTrue() Then
				
				 Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>验证码校验失败，2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
			End If
		End If
		
		If InStr(Content,"[/payto]") > 0 And InStr(Content,"[payto]") > 0 And InStr(Content,"(/seller)") > 0 And InStr(Content,"(seller)") > 0 Then isAlipayTopic = 2
		Chk_PostType()

		'魔法表情检查部分
		tMagicFace = Request("tMagicFace")
		If tMagicFace = "" Or Not IsNumeric(tMagicFace) Then tMagicFace = 0
		tMagicFace = Cint(tMagicFace)
		iMagicFace = Request("iMagicFace")
		If iMagicFace = "" Or Not IsNumeric(iMagicFace) Then iMagicFace = 0
		iMagicFace = Clng(iMagicFace)
		Expression = Dvbbs.Checkstr(Request.Form("Expression"))
		If Expression = "" Then
			Expression = "face1.gif"
		Else
			Expression = Replace(Expression,"|","")
		End If
		If tMagicFace = 1 And iMagicFace > 0 And Dvbbs.Forum_Setting(98)="1" Then
			Set Rs = Dvbbs.Plus_Execute("Select tMoney,tTicket,MagicSetting From Dv_Plus_Tools_MagicFace Where MagicFace_s = " & iMagicFace)
			If Rs.Eof And Rs.Bof Then
				Expression = "0|" & Expression
				tMagicMoney = 0
				tMagicTicket = 0
			Else
				If cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text) < Rs(1) And cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text ) < Rs(0) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您没有足够的金币或点券使用魔法表情，2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
				Dim iMagicSetting
				iMagicSetting = Split(Rs(2),"|")
				If cCur(iMagicSetting(0)) > cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpost").text ) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您的帖子数没有达到使用魔法表情的标准，2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
				If cCur(iMagicSetting(1)) > cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userwealth").text) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您的金钱数没有达到使用魔法表情的标准，2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
				If cCur(iMagicSetting(2)) > cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userep").text) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您的经验数没有达到使用魔法表情的标准，2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
				If cCur(iMagicSetting(3)) > cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usercp").text ) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您的魅力数没有达到使用魔法表情的标准，2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
				If cCur(iMagicSetting(4)) > cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpower").text) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您的威望数没有达到使用魔法表情的标准，2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
				Expression = iMagicFace & "|" & Expression
				tMagicMoney = Rs(0)
				tMagicTicket = Rs(1)
				FoundUseMagic = True
			End If
			Rs.Close
			Set Rs=Nothing
		Else
			Expression = "0|" & Expression
		End If
		Expression = Split(Expression,"|")
		Topic = Dvbbs.Checkstr(Trim(Request.Form("topic")))
		signflag = Dvbbs.Checkstr(Trim(Request.Form("signflag")))
		mailflag = Dvbbs.Checkstr(Trim(Request.Form("emailflag")))
		MyTopicMode = Dvbbs.Checkstr(Trim(Request.Form("topicximoo")))
		MyLockTopic = Dvbbs.Checkstr(Trim(Request.Form("locktopic")))
		Myistop = Dvbbs.Checkstr(Trim(Request.Form("istop")))
		Myistopall = Dvbbs.Checkstr(Trim(Request.Form("istopall")))
		TopicMode = Request.Form("topicmode")
		If Dvbbs.strLength(topic)> CLng(Dvbbs.Board_Setting(45)) Then 
			parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>"&Replace(template.Strings(23),"{$topiclimited}",Dvbbs.Board_Setting(45))&"<BR>2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
			
			Response.redirect parameter
		End If
		Rem 限制提交数据不能大于64K
		If Len(Content) > 64*1024*1024 Then
			parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您提交的数据过大，提交数据不能大于64K&action=OtherErr&autoreload=1"
			
			Response.redirect parameter
		End If
		Dim TMPData
		'TMPData=inpostlist
		If TMPData<>"" Then
			If Action <> 8 Then
				parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes="&TMPData&"&action=OtherErr&autoreload=1"
				
				Response.redirect parameter
			End If
		End If
		Rem 老迷增加xhtml格式限制
		Dim XMLPOST,XHTML
		XHTML=True
		If XHTML Then
			Set XMLPOST=Server.CreateObject("msxml2.DOMDocument"& MsxmlVersion)
			If XMLPOST.loadxml("<xhtml>" & replace(Content,"&","&amp;") &"</xhtml>") Then
				Content=replace(Mid(XMLPOST.documentElement.xml,8,Len(XMLPOST.documentElement.xml)-15),"&amp;","&")
			Else
				parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您提交的数据不合法(必须提交XHTML格式)&action=OtherErr&autoreload=1"
				
				Response.redirect parameter
			End If
			Set XMLPOST=Nothing
		End If
		If Dvbbs.strLength(Content) > CLng(Dvbbs.Board_Setting(16)) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>"&Replace(template.Strings(24),"{$bodylimited}",Dvbbs.Board_Setting(16))&"<BR>2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
			REM 2004-4-23添加限制帖子内容最小字节数,下次在模板中添加。Dvbbs.YangZheng
			If Dvbbs.strLength(Content) < CLng(Dvbbs.Board_Setting(52)) And Not CLng(Dvbbs.Board_Setting(52)) = 0 Then
				parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>"&Replace(template.Strings(24),"大于{$bodylimited}","小于"&Dvbbs.Board_Setting(52))&"<BR>2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
				
			Response.redirect parameter
		End If
		Dim testContent
		testContent=Content
		testContent=Replace(testContent,vbNewLine,"")
		testContent=Replace(testContent," ","")
		testContent=Replace(testContent,"&nbsp;","")		
		testContent=Trim(Dvbbs.Replacehtml(testContent))
		If testContent="" and InStr(Content,"<img")=0 and InStr(Content,"<input")=0 and InStr(Content,"<object")=0  and InStr(Content,"<embed")=0 Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您没有填写内容.2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
		If Dvbbs.UserID=0 Then
			mailflag=0:signflag=0
		Else
			If Not IsNumeric(mailflag) Or mailflag="" Then mailflag=0
			mailflag=CInt(mailflag)
			If Not IsNumeric(signflag) Or signflag="" Then signflag=1
			signflag=CInt(signflag)
		End If
		If TopicMode<>"" and IsNumeric(TopicMode) Then TopicMode=Cint(TopicMode) Else TopicMode=0
		If Request.form("upfilerename")<>"" Then
			ihaveupfile=1
			upfileinfo=Replace(Request.form("upfilerename"),"'","")
			upfileinfo=Replace(upfileinfo,";","")
			upfileinfo=Replace(upfileinfo,"--","")
			upfileinfo=Replace(upfileinfo,")","")
			Dim fixid,upfilelen
			fixid=Replace(upfileinfo," ","")
			fixid=Replace(fixid,",","")
			If Not IsNumeric(fixid) Then ihaveupfile=0
			upfilelen=len(upfileinfo)
			upfileinfo=left(upfileinfo,upfilelen-1)
		Else
			ihaveupfile=0
		End If
		voteid=0
		isvote=0
		Dim VoteTemp,VoteTemp1,VoteTemp2
		If Action = 7 Then
			votetype=Dvbbs.Checkstr(request.Form("votetype"))
			If IsNumeric(votetype)=0 or votetype="" Then votetype=0
			vote=Dvbbs.Checkstr(trim(Replace(request.Form("vote"),"|","")))
			Dim j,k,vote_1,votelen,votenumlen
			If vote="" Then
				Dvbbs.AddErrCode(81)
			Else
				vote=split(vote,chr(13)&chr(10))
				j=0
				For i = 0 To ubound(vote)
					VoteTemp1 = ""
					VoteTemp2 = ""
					If Not (vote(i)="" Or vote(i)=" ") Then
						VoteTemp = Split(vote(i),"@@")
						If Ubound(VoteTemp) = 3 Then '判断是否调查
							If VoteTemp(1)="0" or VoteTemp(1)="1" Then
								VoteTemp1 = Split(VoteTemp(2),"$$")
								For k=0 to Ubound(VoteTemp1)-1
									VoteTemp2 = VoteTemp2 & "0$$"
								Next
							Else
								VoteTemp2 = 0
							End If
							votenum= votenum & VoteTemp2&"|"
						Else
							votenum=votenum&"0|"
						End If
						vote_1=""&vote_1&""&vote(i)&"|"
						j=j+1
					End If
					If i>cint(Dvbbs.Board_Setting(32))-2 Then Exit For
				Next
				'For k = 1 to j
				'	votenum=""&votenum&"0|"
				'Next

				votelen=len(vote_1)
				votenumlen=len(votenum)
				votenum=left(votenum,votenumlen-1)
				vote=left(vote_1,votelen-1)
				'Response.Write votenum
				'Response.End
			End If
			If Not IsNumeric(request("votetimeout")) Then
				Dvbbs.AddErrCode(82)
			Else
				If request("votetimeout")="0" Then
					votetimeout=dateadd("d",9999,Now())
				Else
					votetimeout=dateadd("d",CCur(request("votetimeout")),Now())
				End If
				votetimeout=Replace(Replace(CSTR(votetimeout+Dvbbs.Forum_Setting(0)/24),"上午",""),"下午","")
			End If
		End If
		If Action = 5 Or Action = 7 Then
			CanLockTopic=False
			CanTopTopic=False
			CanTopTopic_a=False
			If Topic="" OR Replace(Topic&"","