📄 wap_post.asp

📁 公司企业网站管理系统全站源码,用于企业内部对网站的管理
💻 ASP
📖 第 1 页 / 共 2 页
字号:
上一页 12
			FoundErr = True
			Exit Sub
		End If
		Set Rs = Nothing
End Sub

Public Sub Get_ForumTreeCode()
	Dim Rs,Sql
	Sql = "Select AnnounceID,PostUserID From "&TotalUseTable&" where ParentID=0 and RootID="&RootID
	Set Rs = Dvbbs.Execute(Sql)
	If Rs.Eof Then
		DvbbsWap.ShowErr 0,"该帖子不存在！"
		FoundErr = True
		Exit Sub
	Else
		ParentID = Rs(0)
		If Rs(1)=Dvbbs.UserID Then
			If Cint(Dvbbs.GroupSetting(4))=0 Then
				DvbbsWap.AddErrCode(73)
				FoundErr = True
				Exit Sub
			End If
		End If
	End If
	Rs.Close
	Sql = "Select Max(layer),Max(orders) From "&TotalUseTable&" where RootID="&RootID
	Set Rs=Dvbbs.Execute(sql)
	If Not(rs.EOF And rs.BOF) Then
			If IsNull(Rs(0)) Then
				Layer=1
			Else
				Layer=Rs(0)+1
			End If
			If IsNull(Rs(1)) Then
				Orders=0
			Else
				Orders=Rs(1)+1
			End If
	Else
			Layer=1
			Orders=0
	End If
	Rs.Close
	Set Rs=Nothing
End Sub


'插入主题
Sub Insert_To_Topic()
	Dim Sql
	SQL="insert into Dv_topic (Title,Boardid,PostUsername,PostUserid,DateAndTime,Expression,LastPost,LastPostTime,PostTable,locktopic,istop,TopicMode,isvote,PollID,Mode,GetMoney,GetMoneyType,IsSmsTopic) values ('"&Topic&"',"&Dvbbs.Boardid&",'"&Dvbbs.MemberName&"',"&Dvbbs.Userid&",'"&DateTimeStr&"','"&Expression&"','$$"&DateTimeStr&"$$$$','"&MyLastPostTime&"','"&TotalUseTable&"',0,0,0,0,0,0,0,0,1)"
	Dvbbs.Execute(sql)
	RootID=Dvbbs.Execute("select Max(topicid) From Dv_topic Where PostUserid="&Dvbbs.UserID)(0)
End Sub

'插入回复
Sub Insert_To_Announce()
	Dim Sql
	Body = Html2Ubb(Body)
	UbblistBody = Ubblist(Body)
	SQL="insert into "&TotalUseTable&"(Boardid,ParentID,username,topic,body,DateAndTime,length,RootID,layer,orders,ip,Expression,locktopic,signflag,emailflag,isbest,PostUserID,isupload,IsAudit,Ubblist,GetMoney,GetMoneyType) values ("&Dvbbs.boardid&","&ParentID&",'"&Dvbbs.MemberName&"','"&Topic&"','"&Body&"','"&DateTimeStr&"','"&Dvbbs.strlength(Body)&"',"&RootID&","&layer&","&orders&",'"&Dvbbs.UserTrueIP&"','"&Expression&"',0,0,0,0,"&Dvbbs.userid&",2,0,'"&UbblistBody&"',0,0)"
	Dvbbs.Execute(sql)
	AnnounceID=Dvbbs.Execute("select Max(AnnounceID) From "&TotalUseTable&" Where PostUserID="&Dvbbs.UserID)(0)
End Sub


'编辑
Sub SaveData_Edit()
	If FoundErr Then Exit Sub
	Dim Rs,Sql
	Dim PostUserID,CanEditPost,UserGroupID,IsTopic,LockTopic,istop,dateandtime
	CanEditPost = False
	IsTopic = False
	Sql = "Select Title,LockTopic,PostTable,PostUserID,istop From [Dv_Topic] where BoardID="&Dvbbs.BoardID&" and TopicID="&RootID
	Set Rs = Dvbbs.Execute(sql)
	If Rs.Eof Then
		DvbbsWap.ShowErr 0,"该帖子不存在！"
		FoundErr = True
		Exit Sub
	Else
		TotalUseTable = Rs(2)
		istop = Rs(4)
	End If
	Rs.Close

	Sql = "Select B.AnnounceID,B.Topic,B.Body,B.PostUserID,B.UbbList,B.ParentID,B.locktopic,B.DateAndTime,U.UserGroupID From "&TotalUseTable&" B, [Dv_user] U where B.PostUserID=U.UserID and BoardID="&Dvbbs.BoardID&" and AnnounceID="&ID
	Set Rs = Dvbbs.Execute(sql)

	If Rs.Eof Then
		DvbbsWap.ShowErr 0,"该帖子不存在！"
		FoundErr = True
		Exit Sub
	Else
		AnnounceID = Rs(0)
		PostUserID = Rs(3)
		If Rs(5)=0 Then
			IsTopic = True
		Else
			Topic = Rs(1)
		End If
		LockTopic = Rs(6)
		DateAndTime = Rs(8)
		UserGroupID = Rs(8)
	End If
	Rs.Close

	If IsTopic and Topic="" Then
		DvbbsWap.ShowErr 0,"主题不能为空！"
		FoundErr = True
		Exit Sub
	End If
	If PostUserID=Dvbbs.UserID Then
		If Dvbbs.GroupSetting(10)="0" then
			DvbbsWap.AddErrCode(74)
			CanEditPost=False
			FoundErr = True
			Exit Sub
		Else 
			CanEditPost=True
		End If
	Else
		If (Dvbbs.Master or Dvbbs.Superboardmaster or Dvbbs.Boardmaster) and Dvbbs.GroupSetting(23)="1" then
			CanEditPost=True
		Else 
			CanEditPost=False
		End If 
		If Cint(Dvbbs.UserGroupID) > 3 And Dvbbs.GroupSetting(23)="1" Then CanEditPost=True
		If Dvbbs.GroupSetting(23)="1" and Dvbbs.founduserPer Then 
				CanEditPost=True
		ElseIf Dvbbs.GroupSetting(23)="0" And Dvbbs.founduserPer Then 
				CanEditPost=False
		End If
		If Not CanEditPost Then
			DvbbsWap.AddErrCode(74)
			FoundErr = True
			Exit Sub
		End If
		If Cint(Dvbbs.UserGroupID) < 4 And Cint(Dvbbs.UserGroupID) = UserGroupID Then 
				DvbbsWap.AddErrCode(75)
				FoundErr = True
		ElseIf Cint(Dvbbs.UserGroupID) < 4 and Cint(Dvbbs.UserGroupID) > UserGroupID Then
				DvbbsWap.AddErrCode(76)
				FoundErr = True
		End If
	End If
	If FoundErr Then
		Exit Sub
	End If
	If Not Dvbbs.master And LockTopic=1 then
		DvbbsWap.AddErrCode(78)
		FoundErr = True
		Exit Sub
	End If

	Dim char_changed
	Dim re,LastBoard,LastTopic,LastPost
	Set re=new RegExp
	re.IgnoreCase =True
	re.Global=True
	re.Pattern="\[align=right\]\[color=#000066\](.|\n)*\[\/color\]\[\/align\]"
	Body = re.Replace(Body,"")
	re.Pattern="<div align=right><font color=#000066>(.|\n)*<\/font><\/div>"
	Body = re.Replace(Body,"")
	Set re=Nothing

	If PostUserID<>Dvbbs.UserID 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

	If Clng(Dvbbs.forum_setting(50))>0 then
		If Datediff("s",DateAndTime,Now())>Clng(Dvbbs.forum_setting(50))*60 then
			Body = Body+chr(13)+chr(10)+char_changed+chr(13)
		End If
	Else
		Body = Body+chr(13)+chr(10)+char_changed+chr(13)
	End If
	If Clng(Dvbbs.forum_setting(51))>0 and not (Dvbbs.master or Dvbbs.boardmaster or Dvbbs.superboardmaster) Then 
		If DateDiff("s",DateAndTime,Now())>Clng(Dvbbs.forum_setting(51))*60 Then
			DvbbsWap.ShowErr 0,"论坛限制在："&Dvbbs.forum_setting(51)&"秒内不能编辑！"
			FoundErr = True
			Exit Sub
		End If
	End If 
		'取出当前版面最后回复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 cCur(LastBoard(6))=cCur(AnnounceID) Then
						LastPost=LastBoard(0) & "$" & LastBoard(1) & "$" & Now() & "$" & Replace(cutStr(reubbcode(topic),20),"$","&#36;") & "$" & 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 cCur(LastTopic(1))=cCur(Announceid) Then
						LastPost=LastTopic(0) & "$" & LastTopic(1) & "$" & Now() & "$" & Replace(cutStr(reubbcode(body),20),"$","&#36;") & "$" & 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
		rs.Open SQL,conn,1,3
		If not (Rs.EOF And Rs.BOF) Then
			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&") where topicid="&rootid)
					Else
						dvbbs.execute("update dv_topic set title='"&topic&"',LastPostTime=dateadd('d',100,"&SqlNowString&") 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&") where topicid="&rootid)
					Else
						dvbbs.execute("update dv_topic set title='"&topic&"',LastPostTime=dateadd('d',300,"&SqlNowString&") where topicid="&rootid)
					End If
				Else
					dvbbs.execute("update dv_topic set title='"&topic&"' where topicid="&rootid)
				End If
			End If
			Body = Html2Ubb(Body)
			Rs("Topic") = Topic
			Rs("Body") = Body
			Rs("length")= Dvbbs.strlength(Body)
			Rs("ip")= Dvbbs.UserTrueIP
			'If Rs("isupload")=0 And ihaveupfile=1 Then Rs("isupload")=1
			Rs("isupload")=2	'WAP标识
			UbblistBody = Ubblist(Body)
			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&")")
			DvbbsWap.ShowErr 1,"编辑成功！"
		End If	
		Rs.Close
		Set Rs=Nothing
End Sub

'截取指定字符
Function cutStr(str,strlen)
	'去掉所有HTML标记
	Dim re
	Set re=new RegExp
	re.IgnoreCase =True
	re.Global=True
	re.Pattern="<(.[^>]*)>"
	str=re.Replace(str,"")	
	set re=Nothing
	Dim l,t,c,i
	l=Len(str)
	t=0
	For i=1 to l
		c=Abs(Asc(Mid(str,i,1)))
		If c>255 Then
			t=t+2
		Else
			t=t+1
		End If
		If t>=strlen Then
			cutStr=left(str,i)&"..."
			Exit For
		Else
			cutStr=str
		End If
	Next
	cutStr=Replace(cutStr,chr(10),"")
	cutStr=Replace(cutStr,chr(13),"")
End Function
'过滤不必要UBB
Function reUBBCode(strContent)
	Dim re
	Set re=new RegExp
	re.IgnoreCase =True
	re.Global=True
	strContent=Replace(strContent,"&nbsp;"," ")
	re.Pattern="(\[QUOTE\])(.|\n)*(\[\/QUOTE\])"
	strContent=re.Replace(strContent,"")
	re.Pattern="(\[point=*([0-9]*)\])(.|\n)*(\[\/point\])"
	strContent=re.Replace(strContent,"&nbsp;")
	re.Pattern="(\[post=*([0-9]*)\])(.|\n)*(\[\/post\])"
	strContent=re.Replace(strContent,"&nbsp;")
	re.Pattern="(\[power=*([0-9]*)\])(.|\n)*(\[\/power\])"
	strContent=re.Replace(strContent,"&nbsp;")
	re.Pattern="(\[usercp=*([0-9]*)\])(.|\n)*(\[\/usercp\])"
	strContent=re.Replace(strContent,"&nbsp;")
	re.Pattern="(\[money=*([0-9]*)\])(.|\n)*(\[\/money\])"
	strContent=re.Replace(strContent,"&nbsp;")
	re.Pattern="(\[replyview\])(.|\n)*(\[\/replyview\])"
	strContent=re.Replace(strContent,"&nbsp;")
	re.Pattern="(\[usemoney=*([0-9]*)\])(.|\n)*(\[\/usemoney\])"
	strContent=re.Replace(strContent,"&nbsp;")
	strContent=Replace(strContent,"<I></I>","")
	set re=Nothing
	reUBBCode=strContent
End Function

Function SimEncodeJS(str)
	If Not IsNull(str) Then
		str = Replace(str, "\", "\\")
		str = Replace(str, chr(34), "\""")
		str = Replace(str, chr(39), "\'")
		str = Replace(str, chr(10), "\n")
		str = Replace(str, chr(13), "\r")
		SimEncodeJS=str
	End If
End Function

'发贴时用，为了减少入库量
Function Html2Ubb(str)
	If Str<>"" And Not IsNull(Str) Then
		Dim re,tmpstr
		Set re=new RegExp
		re.IgnoreCase =True
		re.Global=True
		re.Pattern = "(<br>)"
		Str = re.Replace(Str,"[br]")
		If Dvbbs.Board_Setting(5)="0" Then
			'先去掉标记中的换行
			re.Pattern="(<(i|b|p)>)"
			Str=re.Replace(Str,"[$2]")
			re.Pattern="(<(\/i|\/b|\/p)>)"
			Str=re.Replace(Str,"[$2]")
			re.Pattern="(>)("&vbNewLine&")(<)"
			Str=re.Replace(Str,"$1$3") 
			re.Pattern="(>)("&vbNewLine&vbNewLine&")(<)"
			Str=re.Replace(Str,"$1$3")
			re.Pattern="(<DIV class=quote>)((.|\n)*)(<\/div>)"
			Str=re.Replace(Str,"[quote]$2[/quote]")
			re.Pattern="<(.[^>]*)>"
			Str=re.Replace(Str,"")
			re.Pattern="(\[(i|b|p)\])"
			Str=re.Replace(Str,"<$2>")
			re.Pattern="(\[(\/i|\/b|\/p)\])"
			Str=re.Replace(Str,"<$2>")
		End If
		Str = Replace(Str, "[br]", CHR(13) & CHR(10))
		re.Pattern = "(&nbsp;)"
		Str = re.Replace(Str,Chr(9))
		re.Pattern = "(<STRONG>)"
		Str = re.Replace(Str,"<b>")
		re.Pattern = "(<\/STRONG>)"
		Str = re.Replace(Str,"</b>")
		re.Pattern ="(<TBODY>)"
		Str = re.Replace(Str,"")
		re.Pattern ="(<\/TBODY>)"
		Str = re.Replace(Str,"")
		Set Re=Nothing
		Html2Ubb = Str
	Else
		Html2Ubb = ""
	End If
End Function
'检查贴中是否含过滤字
Function NeedIsAudit(Content)
		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
%>
上一页 12
💿 文件大小 12830 K
👤 上传用户 caim3587
📂 所属分类企业管理
🏷️ 相关标签

#企业网站 #管理系统 #源码 #网站
⌨️ 快捷键说明

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