savepost.asp

一个很不错的论坛系统

				MyLastPostTime=DateADD("d",300,Replace(Replace(CSTR(NOW()+Dvbbs.Forum_Setting(0)/24),"上午",""),"下午",""))
			ElseIf Myistop=1 Then
				MyLastPostTime=DateADD("d",100,Replace(Replace(CSTR(NOW()+Dvbbs.Forum_Setting(0)/24),"上午",""),"下午",""))
			Else
				MyLastPostTime=Replace(Replace(CSTR(NOW()+Dvbbs.Forum_Setting(0)/24),"上午",""),"下午","")
			End If
			DateTimeStr=Replace(Replace(CSTR(NOW()+Dvbbs.Forum_Setting(0)/24),"上午",""),"下午","")
			If Action = 7 Then Insert_To_Vote()
			Insert_To_Topic()
			'更新总固顶和固顶的数据以及缓存数据
			If MyIsTop=3 Then
				'将总固顶ID插入总设置表
				Dim iForum_AllTopNum
				Set Rs=Dvbbs.Execute("Select Forum_AllTopNum From Dv_Setup")
				If Trim(Rs(0))="" Or IsNull(Rs(0)) Then
					iForum_AllTopNum = RootID
				Else
					iForum_AllTopNum = Rs(0) & "," & RootID
				End If
				Dvbbs.Execute("Update Dv_Setup Set Forum_AllTopNum='"&iForum_AllTopNum&"'")
				Dvbbs.ReloadSetupCache iForum_AllTopNum,28
				Set Rs=Nothing
			ElseIf MyIsTop=1 Then
				Dim BoardTopStr
				Set Rs=Dvbbs.Execute("Select BoardID,BoardTopStr From Dv_Board Where BoardID="&Clng(Dvbbs.BoardID))
				If Not (Rs.Eof And Rs.Bof) Then
					If Rs(1)="" Or IsNull(Rs(1)) Then
						BoardTopStr = RootID
					Else
						If InStr(","&Rs(1)&",","," & RootID & ",")>0 Then
							BoardTopStr = Rs(1)
						Else
							BoardTopStr = Rs(1) & "," & RootID
						End If
					End If
					Dvbbs.Execute("Update Dv_Board Set BoardTopStr='"&BoardTopStr&"' Where BoardID="&Rs(0))
					Dvbbs.ReloadBoardInfo(Rs(0))
				End If
				Set Rs=Nothing
			End If
		ElseIf Action = 6 Then
			Get_SaveRe_TopicInfo()

			Get_ForumTreeCode()

			DateTimeStr=Replace(Replace(CSTR(NOW()+Dvbbs.Forum_Setting(0)/24),"上午",""),"下午","")
		End If
		Insert_To_Announce()
		If Action = 6 Then
			topic=Replace(Replace(cutStr(topic,14),chr(10),""),"'","")
			If topic="" Then
				topic=Content
				topic=Replace(cutStr(topic,14),chr(10),"")
			Else
				topic=Replace(cutStr(topic,14),chr(10),"")
			End If
			If ihaveupfile=1 Then Dvbbs.Execute("update dv_upfile set F_AnnounceID='"&RootID&"|"&AnnounceID&"',F_Readme='"&Replace(toptopic,"'","")&"',F_flag=0 where F_ID in ("&upfileinfo&")")
		Else
			If ihaveupfile=1 Then Dvbbs.Execute("update dv_upfile set F_AnnounceID='"&RootID&"|"&AnnounceID&"',F_Readme='"&Topic&"',F_flag=0  where F_ID in ("&upfileinfo&")")
		End If		
		LastPost=Replace(username,"$","") & "$" & AnnounceID & "$" & DateTimeStr & "$" & Replace(cutStr(topic,20),"$","") & "$" & uploadpic_n & "$" & Dvbbs.UserID & "$" & RootID & "$" & Dvbbs.BoardID
		LastPost=reubbcode(Replace(LastPost,"'",""))

		If Action = 6 Then 
			If istop=3 Then
				If IsSqlDataBase=1 Then
					SQL="update Dv_topic set child=child+1,LastPostTime=dateadd(day,300,"&SqlNowString&"),LastPost='"&LastPost&"' where TopicID="&RootID
				Else
					SQL="update Dv_topic set child=child+1,LastPostTime=dateadd('d',300,"&SqlNowString&"),LastPost='"&LastPost&"' where TopicID="&RootID
				End If
			ElseIf istop=1 Then
				If IsSqlDataBase=1 Then
					SQL="update Dv_topic set child=child+1,LastPostTime=dateadd(day,100,"&SqlNowString&"),LastPost='"&LastPost&"' where TopicID="&RootID
				Else
					SQL="update Dv_topic set child=child+1,LastPostTime=dateadd('d',100,"&SqlNowString&"),LastPost='"&LastPost&"' where TopicID="&RootID
				End If		
			Else
				SQL="update Dv_topic set child=child+1,LastPostTime="&SqlNowString&",LastPost='"&LastPost&"' where TopicID="&RootID
			End If
			Dvbbs.Execute(SQL)
			Child=Child+2
			If Child mod Dvbbs.Board_Setting(27)=0 Then 
				star=Child\Dvbbs.Board_Setting(27)
			Else
				star=(Child\Dvbbs.Board_Setting(27))+1
			End If
			Get_Chan_TopicOrder()
		Else
			Dvbbs.Execute("update Dv_topic set LastPost='"&LastPost&"' where topicid="&RootID)
		End If	
		If Action = 5 Or Action = 7 Then
			toptopic=topic
		Else
			toptopic=Replace(cutStr(toptopic,20),"$","")
		End If
		'toptopic =主标题,Content=内容
		'判断是否是加密的论坛，如果是，则不显示最后发贴内容。
		If Dvbbs.Board_Setting(2)="1" Then
			LastPost_1="保密$" & AnnounceID & "$" & DateTimeStr & "$请认证用户进入查看$" & uploadpic_n & "$" & Dvbbs.UserID & "$" & RootID & "$" & Dvbbs.BoardID
		Else
			LastPost_1=Replace(username,"$","") & "$" & AnnounceID & "$" & DateTimeStr & "$" & toptopic & "$" & uploadpic_n & "$" & Dvbbs.UserID & "$" & RootID & "$" & Dvbbs.BoardID
		End If
		LastPost_1=reubbcode(Replace(LastPost_1,"'",""))
		If IsAudit=0 Then
			UpDate_BoardInfoAndCache()
			UpDate_ForumInfoAndCache()
		End If
		Response.Cookies("Dvbbs")=Dvbbs.BoardID
	End Sub
	Public Sub Get_SaveRe_TopicInfo()
		SQL="select locktopic,LastPost,title,smsuserlist,IsSmsTopic,istop,Child from Dv_topic where BoardID="&Dvbbs.BoardID&" And topicid="&cstr(RootID)
		Set Rs=dvbbs.Execute(sql)
		If Not Rs.EOF And Not Rs.BOF Then
			toptopic=rs(2)
			istop=rs(5)
			Child=Rs("Child")
			If rs("IsSmsTopic")=1 Then smsuserlist=rs("smsuserlist")
			If Rs("LockTopic")=1 And Not (Dvbbs.Master Or Dvbbs.BoardMaster Or Dvbbs.SuperBoardMaster) Then Dvbbs.AddErrCode(78)
			If Not IsNull(rs(1)) Then
				LastPost=split(rs(1),"$")
				If ubound(LastPost)=7 Then
					UpLoadPic_n=LastPost(4)
				Else
					UpLoadPic_n=""
				End If
			End If
		End If
		Dvbbs.showErr()
		Set Rs = Nothing
	End Sub
	Public Sub Insert_To_Vote()
		'插入投票记录 GroupSetting(68)投票项目中是否可以使用HTML
		If Dvbbs.GroupSetting(68)<>"1" Then vote=server.htmlencode(vote)
		dvbbs.execute("insert into dv_vote (vote,votenum,votetype,timeout) values ('"&vote&"','"&votenum&"',"&votetype&",'"&votetimeout&"')")
		set rs=dvbbs.execute("select Max(voteid) from dv_vote")
		voteid=Rs(0)
		isvote=1
		Set Rs=Nothing
	End Sub
	Public Sub Insert_To_Topic()
		'插入主题表
		SQL="insert into Dv_topic (Title,Boardid,PostUsername,PostUserid,DateAndTime,Expression,LastPost,LastPostTime,PostTable,locktopic,istop,TopicMode,isvote,PollID,Mode) values ('"&topic&"',"&Dvbbs.boardid&",'"&username&"',"&Dvbbs.userid&",'"&DateTimeStr&"','"&Expression&"','$$"&DateTimeStr&"$$$$','"&MyLastPostTime&"','"&TotalUseTable&"',"&locktopic&","&Myistop&","&MyTopicMode&","&isvote&","&voteid&","&TopicMode&")" 
		Dvbbs.Execute(sql)
		Set Rs=Dvbbs.Execute("select Max(topicid) from Dv_topic Where PostUserid="&Dvbbs.UserID)
		RootID=rs(0)
	End Sub
	Public Sub Insert_To_Announce()
		'插入回复表
		DIM UbblistBody
		UbblistBody = Content
		Content = Html2Ubb(Content)
		UbblistBody = Ubblist(Content)
		SQL="insert into "&TotalUseTable&"(Boardid,ParentID,username,topic,body,DateAndTime,length,RootID,layer,orders,ip,Expression,locktopic,signflag,emailflag,isbest,PostUserID,isupload,IsAudit,Ubblist) values ("&Dvbbs.boardid&","&ParentID&",'"&username&"','"&topic&"','"&Content&"','"&DateTimeStr&"','"&Dvbbs.strlength(Content)&"',"&RootID&","&ilayer&","&iorders&",'"&Dvbbs.UserTrueIP&"','"&Expression&"',"&locktopic&","&signflag&","&mailflag&",0,"&Dvbbs.userid&","&ihaveupfile&","&IsAudit&",'"&UbblistBody&"')"
		Dvbbs.Execute(sql)
		Set rs=Dvbbs.Execute("select Max(AnnounceID) from "&TotalUseTable&" Where PostUserID="&Dvbbs.UserID)
		AnnounceID=rs(0)
	End Sub
	'检查贴中是否含过滤字
	Public Function NeedIsAudit()
		NeedIsAudit=0
		Dim i,ChecKData
		If Dvbbs.Board_Setting(58)<>"0" Then
			ChecKData=split(Dvbbs.Board_Setting(58),"|")
			For i=0 to UBound(ChecKData)
				If Trim(ChecKData(i))<>"" Then
					If InStr(Content,ChecKData(i))>0 Or InStr(Topic,ChecKData(i))>0 Then
						NeedIsAudit=1
						Exit Function
					End If
				End If
			Next
		End If		
	End Function
	Public Sub Get_Chan_TopicOrder()
		If Dvbbs.Forum_ChanSetting(0)="1" And Not isnull(smsuserlist) and smsuserlist<>"" Then
		'随机数
		Dim MaxUserID,MaxLength
		MaxLength=12
		set rs=Dvbbs.execute("select Max(userid) from [dv_user]")
		MaxUserID=rs(0)
		Dim num1,rndnum
		Randomize
		Do While Len(rndnum)<4
			num1=CStr(Chr((57-48)*rnd+48))
			rndnum=rndnum&num1
		loop
		MaxUserID=rndnum & MaxUserID
		MaxLength=MaxLength-len(MaxUserID)
		Select Case MaxLength
		Case 7
			MaxUserID="0000000" & MaxUserID
		Case 6
			MaxUserID="000000" & MaxUserID
		Case 5
			MaxUserID="00000" & MaxUserID
		Case 4
			MaxUserID="0000" & MaxUserID
		Case 3
			MaxUserID="000" & MaxUserID
		Case 2
			MaxUserID="00" & MaxUserID
		Case 1
			MaxUserID="0" & MaxUserID
		Case 0
			MaxUserID=MaxUserID
		End Select
		Session("challengeWord")=MaxUserID
		Response.Write "<iframe name=getchallengeword frameborder=0 width=100% height=0 scrolling=no src=""pay_topic_postforumid.asp?chanWord="&Session("challengeWord")&"""></iframe>"
		End If
	End Sub
	Public Sub Get_ForumTreeCode()
		Dim mailbody
		Set Rs=Dvbbs.Execute("select b.layer,b.orders,b.EmailFlag,b.username,u.userEmail from "&TotalUseTable&" b inner join [Dv_user] u on b.postuserid=u.userid where b.AnnounceID="&ParentID)
		If Not(rs.EOF And rs.BOF) Then
			If IsNull(Rs(0)) Then
				iLayer=1
			Else
				iLayer=Rs(0)
			End If
			If IsNull(Rs(1)) Then
				iOrders=0
			Else
				iOrders=Rs(1)
			End If
			If Rs(3)=Dvbbs.membername Then
				If Cint(Dvbbs.GroupSetting(4))=0 Then Dvbbs.AddErrCode(73)
			End If
			If rs(3) <> Dvbbs.membername Then 
				Dim sUrl,Email,TempArray,etopic
				TempArray = Split(template.html(10),"||")
				sUrl=Dvbbs.Get_ScriptNameUrl
				If Rs(2)=1 Or Rs(2)=3 Then
					etopic=Replace(template.Strings(25),"{$forumname}",Dvbbs.Forum_info(0))
					email=Rs(4)
					mailbody = TempArray(0)
					mailbody = Replace(mailbody,"{$boardid}",Dvbbs.BoardID)
					mailbody = Replace(mailbody,"{$forumname}",Dvbbs.Forum_info(0))
					mailbody = Replace(mailbody,"{$topicid}",RootID)
					mailbody = Replace(mailbody,"{$star}",Star)
					mailbody = Replace(mailbody,"{$surl}",sUrl)
					mailbody = Replace(mailbody,"{$parentid}",ParentID)
					Select Case Dvbbs.Forum_Setting(2)
					Case "1"
						jmail email,etopic,mailbody
					Case "2"
						Cdonts email,etopic,mailbody
					Case "3"
						aspemail email,etopic,mailbody
					End Select
				End If
				If Rs(2)=2 Or Rs(2)=3 Then
					mailbody = TempArray(1)
					mailbody = Replace(mailbody,"{$boardid}",Dvbbs.BoardID)
					mailbody = Replace(mailbody,"{$topicid}",RootID)
					mailbody = Replace(mailbody,"{$star}",Star)
					mailbody = Replace(mailbody,"{$surl}",sUrl)
					mailbody = Replace(mailbody,"{$parentid}",ParentID)
					Dvbbs.Execute("insert into dv_message(incept,sender,title,content,sendtime,flag,issend) values('"&Rs(3)&"','"&Dvbbs.Forum_info(0)&"','"&template.Strings(26)&"','"&mailbody&"',"&SqlNowString&",0,1)")
					update_user_msg(Rs(3))
				End If
			End If
		Else
			iLayer=1
			iOrders=0
		End If
		Set Rs=Nothing
		If RootID<>0 Then 
			iLayer=ilayer+1
			Dvbbs.Execute "update "&TotalUseTable&" set orders=orders+1 where RootID="&cstr(RootID)&" and orders>"&cstr(iOrders)
			iOrders=iOrders+1
		End If
	End Sub
	Public Sub Update_Edit_Announce()
		Dim re,LastBoard,LastTopic
		Set re=new RegExp
		re.IgnoreCase =True
		re.Global=True
		re.Pattern="<br>"
		Content = re.Replace(Content,"[br]")
		re.Pattern="\[align=right\]\[color=#000066\](.*)\[\/color\]\[\/align\]"
		Content = re.Replace(Content,"")
		re.Pattern="<div align=right><font color=#000066>(.*)<\/font><\/div>"
		Content = re.Replace(Content,"")
		re.Pattern="\[br\]>"
		Content = re.Replace(Content,"<br>")		
		Set re=Nothing
		If Dvbbs.membername<>UserName Then 
			If Dvbbs.forum_setting(49)="1" Then char_changed = "[align=right][color=#000066][此贴子已经被"&Dvbbs.membername&"于"&Now()&"编辑过][/color][/align]"
		Else
			If Dvbbs.forum_setting(48)="1" Then char_changed = "[align=right][color=#000066][此贴子已经被作者于"&Now()&"编辑过][/color][/align]"
		End If
		Get_Edit_PermissionInfo
		Dim Contentdata
		Contentdata=Content
		Dvbbs.ShowErr
		'取出当前版面最后回复id,如果本帖为最后回复则更新相应数据
		Set Rs = Dvbbs.Execute("select LastPost from dv_board where boardid="&Dvbbs.BoardID)
		If not (Rs.EOF And Rs.BOF) Then
			If Not IsNull(rs(0)) And rs(0)<>"" then
				LastBoard=split(rs(0),"$")
				If ubound(LastBoard)=7 Then
					If Clng(LastBoard(6))=Clng(AnnounceID) Then
						LastPost=LastBoard(0) & "$" & LastBoard(1) & "$" & Now() & "$" & Replace(cutStr(reubbcode(topic),20),"$","") & "$" & LastBoard(4) & "$" & LastBoard(5) & "$" & LastBoard(6) & "$" & Dvbbs.BoardID
						dvbbs.execute("update dv_board set LastPost='"&SimEncodeJS(Replace(LastPost,"'",""))&"' where boardid="&Dvbbs.BoardID)
					End If
				End If
			End If
		End If

		'取得当前主题最后回复id,如果本帖为最后回复则更新相应数据
		Set Rs=Dvbbs.Execute("select LastPost,istop from dv_topic where topicid="&rootid)
		If Not (Rs.Eof And Rs.Bof) Then
			istop=rs(1)
			If Not Isnull(Rs(0)) And Rs(0)<>"" Then
				LastTopic=split(rs(0),"$")
				If Ubound(LastTopic)=7 Then
					If Clng(LastTopic(1))=Clng(Announceid) Then
						LastPost=LastTopic(0) & "$" & LastTopic(1) & "$" & Now() & "$" & Replace(cutStr(reubbcode(Contentdata),20),"$","") & "$" & LastTopic(4) & "$" & LastTopic(5) & "$" & LastTopic(6) & "$" & Dvbbs.BoardID
						dvbbs.execute("update dv_topic set LastPost='"&Replace(LastPost,"'","")&"' where topicid="&rootid)
					End If
				End If
			End If
		End If

		Set Rs = Server.CreateObject("ADODB.Recordset")
		SQL="SELECT * FROM "&TotalUseTable&" where AnnounceID="&Announceid&" And username='"&trim(username)&"'"
		rs.Open SQL,conn,1,3
		If Rs.EOF And Rs.BOF Then
			If Not CanEditPost Then Dvbbs.AddErrCode(77)
		ElseIf Not Dvbbs.master And rs("locktopic")=1 then
			Dvbbs.AddErrCode(78)
		Else
			If Rs("parentid")=0 then
				If istop=1 Then
					If IsSqlDataBase=1 Then
						dvbbs.execute("update dv_topic set title='"&topic&"',LastPostTime=dateadd(day,100,"&SqlNowString&"),TopicMode="&MyTopicMode&" where topicid="&rootid)
					Else
						dvbbs.execute("update dv_topic set title='"&topic&"',LastPostTime=dateadd('d',100,"&SqlNowString&"),TopicMode="&MyTopicMode&" where topicid="&rootid)
					End If
				ElseIf istop=3 Then
					If IsSqlDataBase=1 Then
						dvbbs.execute("update dv_topic set title='"&topic&"',LastPostTime=dateadd(day,300,"&SqlNowString&"),TopicMode="&MyTopicMode&" where topicid="&rootid)
					Else
						dvbbs.execute("update dv_topic set title='"&topic&"',LastPostTime=dateadd('d',300,"&SqlNowString&"),TopicMode="&MyTopicMode&" where topicid="&rootid)
					End If
				Else
					dvbbs.execute("update dv_topic set title='"&topic&"',TopicMode="&MyTopicMode&" where topicid="&rootid)
				End If
			End If
			Content = Html2Ubb(Content)
			Rs("Topic") =Replace(Topic,"''","'")
			rs("Body") =Replace(Content,"''","'")
			rs("length")=Dvbbs.strlength(Content)
			rs("ip")=Dvbbs.UserTrueIP
			rs("Expression")=Expression
			rs("signflag")=signflag
			rs("emailflag")=mailflag
			If Rs("isupload")=0 And ihaveupfile=1 Then Rs("isupload")=1
			Dim UbblistBody
			UbblistBody = Ubblist(Content)
			Rs("Ubblist")=UbblistBody
			rs.Update
			If ihaveupfile=1 Then dvbbs.execute("update dv_upfile set F_AnnounceID='"&rootid&"|"&AnnounceID&"',F_Readme='"&Replace(Rs("Topic"),"'","''")&"',F_flag=0 where F_ID in ("&upfileinfo&")")
		End If	
		Rs.Close
		Set Rs=Nothing
		Dvbbs.ShowErr()
	End Sub
	'更新版面数据和缓存
	Public Sub UpDate_BoardInfoAndCache()