www.gusucode.com > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告) > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告)\13学生论坛ASPAC\BBS\messanger.asp

    <!--#include file="Conn.asp"-->
<!-- #include file="inc/const.asp" -->
<!--#include file="inc/DV_ubbcode.asp"-->
<!--#include file="inc/ubblist.asp"-->
<%
Mybbs.LoadTemplates("usermanager")
Mybbs.Stats=Mybbs.MemberName&template.Strings(4)
Mybbs.Head()
Dim Rs,Sql,SqlStr,ErrCodes,TempLateStr,id,sendtime,sender,temptxt
Dim top_TempLateStr,send_TempLateStr,Read_TempLateStr
DIM title,ActInfo
Dim EmotPath
Dim replyid,Announceid
EmotPath=Split(Mybbs.Forum_emot,"|||")(0)		'em心情路径
If Mybbs.userid=0 Then Mybbs.AddErrCode(6):Mybbs.Showerr()								'判断用户是否在线。
If Cint(Mybbs.GroupSetting(32))=0 Then ErrCodes=ErrCodes+"<li>"+template.Strings(33)	'判断用户是否有权限。
id=Request("id")
TempLateStr=split(template.html(11),"||")
If Mybbs.forum_setting(80)="0" Then
	TempLateStr(1)=Replace(TempLateStr(1),"{$getcode}","")
Else
	TempLateStr(4)=Replace(TempLateStr(4),"{$codestr}",Mybbs.GetCode)
	TempLateStr(1)=Replace(TempLateStr(1),"{$getcode}",TempLateStr(4))
End If
top_TempLateStr=TempLateStr(0)
top_TempLateStr=Replace(top_TempLateStr,"{$sms__write}",template.pic(5))
top_TempLateStr=Replace(top_TempLateStr,"{$sms__reply}",template.pic(6))
top_TempLateStr=Replace(top_TempLateStr,"{$sms__fw}",template.pic(7))
top_TempLateStr=Replace(top_TempLateStr,"{$sms_delete}",template.pic(8))
Send_TempLateStr=top_TempLateStr&TempLateStr(1)
Read_TempLateStr=top_TempLateStr&TempLateStr(2)
ActInfo=split(template.Strings(62),",")
If ErrCodes="" Then
Dim dv_ubb,abgcolor
Set dv_ubb=new Dvbbs_UbbCode
SELECT Case Request("action")
	Case "new"
		Response.Cookies("Mybbs")=""
		IF id<>"" Then
			title="RW: "
			SqlStr="SELECT id,title,content,incept,sender,sendtime FROM Dv_Message WHERE incept='"&Mybbs.MemberName&"' And id="&Mybbs.checkStr(id)
			temptxt=template.Strings(56)
		End If
		Mybbs.Stats=ActInfo(0)		'"发送短信"
		If Mybbs.IsReadonly()  And Not Mybbs.Master Then Response.redirect "showerr.asp?action=readonly&boardid="&Mybbs.boardID&"" 
		call sendmsg()
	Case "read"
		Mybbs.Stats=ActInfo(1)		'"阅读短信"
		call read()
		Mybbs.NewPassword()
	Case "outread"
		Mybbs.Stats=ActInfo(1)		'"阅读短信"
		call read()
		Mybbs.NewPassword()
	Case  "newmsg"
		Mybbs.Stats=ActInfo(0)		'"发送短信"
		If Mybbs.IsReadonly()  And Not Mybbs.Master Then Response.redirect "showerr.asp?action=readonly&boardid="&Mybbs.boardID&"" 
		Call newmsg()
	Case "send"
		Mybbs.Stats=ActInfo(2)		'"保存发送短信"
		If Mybbs.IsReadonly()  And Not Mybbs.Master Then Response.redirect "showerr.asp?action=readonly&boardid="&Mybbs.boardID&"" 
		call savemsg()
	Case "fw"
		Response.Cookies("Mybbs")=""
		title="FW: "
		Mybbs.Stats=ActInfo(3)		'"转发短信"
		If Mybbs.IsReadonly()  And Not Mybbs.Master Then Response.redirect "showerr.asp?action=readonly&boardid="&Mybbs.boardID&"" 
		SqlStr="SELECT id,title,content,incept,sender,sendtime FROM Dv_Message WHERE (incept='"&Mybbs.MemberName&"' or sender='"&Mybbs.MemberName&"') And id="&Mybbs.checkStr(id)
		temptxt=template.Strings(57)
		call sendmsg()
	Case "edit"
		Response.Cookies("Mybbs")=""
		Mybbs.Stats=ActInfo(4)		'"修改短信"
		If Mybbs.IsReadonly()  And Not Mybbs.Master Then Response.redirect "showerr.asp?action=readonly&boardid="&Mybbs.boardID&"" 
		SqlStr="SELECT id,title,content,incept,sender,sendtime FROM Dv_Message WHERE sender='"&Mybbs.MemberName&"' And issend=0 And id="&Mybbs.checkStr(id)
		call sendmsg()
	Case "savedit"
		Call savedit()
	Case "delet"
		If Mybbs.IsReadonly()  And Not Mybbs.Master Then Response.redirect "showerr.asp?action=readonly&boardid="&Mybbs.boardID&"" 
		call Delete()
	Case ActInfo(5)					'"删除收件箱"
		If Mybbs.IsReadonly()  And Not Mybbs.Master Then Response.redirect "showerr.asp?action=readonly&boardid="&Mybbs.boardID&"" 
		Mybbs.Stats=ActInfo(5)
		call Delinbox()
	Case ActInfo(6)					'"清空收件箱"
		Mybbs.Stats=ActInfo(6)
		If Mybbs.IsReadonly()  And Not Mybbs.Master Then Response.redirect "showerr.asp?action=readonly&boardid="&Mybbs.boardID&"" 
		call AllDelinbox()
	Case ActInfo(7)					'"删除草稿箱"
		Mybbs.Stats=ActInfo(7)
		If Mybbs.IsReadonly()  And Not Mybbs.Master Then Response.redirect "showerr.asp?action=readonly&boardid="&Mybbs.boardID&"" 
		call Deloutbox()
	Case ActInfo(8)					'"清空草稿箱"
		Mybbs.Stats=ActInfo(8)
		If Mybbs.IsReadonly()  And Not Mybbs.Master Then Response.redirect "showerr.asp?action=readonly&boardid="&Mybbs.boardID&"" 	
		call AllDeloutbox()
	Case ActInfo(9)					'"删除已发送的消息"
		Mybbs.Stats=ActInfo(9)
		If Mybbs.IsReadonly()  And Not Mybbs.Master Then Response.redirect "showerr.asp?action=readonly&boardid="&Mybbs.boardID&"" 
		call Delissend()
	Case ActInfo(10)				'"清空已发送的消息"
		Mybbs.Stats=ActInfo(10)
		If Mybbs.IsReadonly()  And Not Mybbs.Master Then Response.redirect "showerr.asp?action=readonly&boardid="&Mybbs.boardID&"" 
		call AllDelissend()
	case ActInfo(11)				'"删除垃圾箱"
		Mybbs.Stats=ActInfo(11)
		If Mybbs.IsReadonly()  And Not Mybbs.Master Then Response.redirect "showerr.asp?action=readonly&boardid="&Mybbs.boardID&"" 
		call Delrecycle()
	Case ActInfo(12)				'"清空垃圾箱"
		Mybbs.Stats=ActInfo(12)
		If Mybbs.IsReadonly()  And Not Mybbs.Master Then Response.redirect "showerr.asp?action=readonly&boardid="&Mybbs.boardID&"" 
		Call AllDelrecycle()
	Case Else
  		ErrCodes=ErrCodes+"<li>"+template.Strings(51)
End SELECT
End If
If ErrCodes<>"" Then Showerr
Mybbs.ActiveOnline()
Response.Write TempLateStr(3)
Response.Write "</div>"
Mybbs.Footer()

'发送信息,回复，转发,编辑
Sub sendmsg()
	Dim content,i,textarea,touser,incept
	Dim chatloglist
	textarea=""
	If Clng(Mybbs.GroupSetting(53))>0 And DateDiff("s",Session(Mybbs.CacheName & "UserID")(14),Now)<Clng(Mybbs.GroupSetting(53))*60 Then
		ErrCodes=ErrCodes+"<li>"+Replace(template.Strings(39),"{$Lim_Time}",Mybbs.GroupSetting(53))
		Exit sub
	End If
	If Mybbs.GroupSetting(63)<>"0" Then
		If Clng(Mybbs.GroupSetting(63))<=Clng(Mybbs.UserToday(1)) Then
			ErrCodes=ErrCodes+"<li>"+Replace(template.Strings(65),"{$smslimited}",Mybbs.GroupSetting(63))
			Exit sub
		End If
	End If
	touser=Mybbs.Checkstr(Request("touser"))
	If id<>"" And isNumeric(id) And SqlStr<>"" Then
		Set Rs=Mybbs.execute(SqlStr)
		If not(Rs.eof And Rs.bof) Then
			If Request("action")="new" or Request("action")="edit" Then touser=Rs("sender")
				incept=Rs("incept")
				sender=Rs("sender")
				sendtime=Rs("sendtime")
				title=title & Rs("title")
				content=Rs("content")
				temptxt=Replace(temptxt,"{$sendtime}",sendtime)
				temptxt=Replace(temptxt,"{$sender}",sender)
				'temptxt=Replace(temptxt,"{$br}",Chr(10))
				temptxt=Replace(temptxt,"{$br}","<br>")
			If Request("action")="new" or Request("action")="fw" Then 
				textarea=temptxt+content+"<br>======================================<br>"
			Else
				textarea=content
			End If
			If Session(Mybbs.CacheName & "UserID")(37)<>"" Then
				textarea=server.htmlencode(Session(Mybbs.CacheName & "UserID")(37))
			Else
				textarea=server.htmlencode(textarea)
			End If 
		Else
			ErrCodes=ErrCodes+"<li>"+template.Strings(35):Exit Sub
		End If
		Set Rs=Nothing
	Else
		textarea=server.htmlencode(Session(Mybbs.CacheName & "UserID")(37))
	End If
	If Request("reaction")="chatlog" Then
	Dim temp_chat1,temp_chat2
			Touser=Mybbs.checkStr(Request("touser"))
		Sql="SELECT sender,incept,title,content,sendtime FROM Dv_Message WHERE ((sender='"&Mybbs.MemberName&"' And incept='"&Touser&"') or (sender='"&Touser&"' And incept='"&Mybbs.MemberName&"')) And DelS=0 ORDER BY sendtime DESC"
		Set Rs=Mybbs.Execute(Sql)
			If Rs.eof And Rs.bof Then
			Chatloglist="<tr><td class=tablebody1 colspan=3>"&template.Strings(58)&"</td></tr>"
			Else
				SQL=Rs.GetRows(-1)
				Rs.close:Set Rs=nothing

				For i=0 to Ubound(SQL,2)
					temp_chat1=template.Strings(59)
					temp_chat2=template.Strings(60)
					chatloglist=chatloglist & "<tr><td class=tablebody2 height=25 colspan=3>"
					If Trim(SQL(0,i))=Mybbs.MemberName Then
						temp_chat1=Replace(temp_chat1,"{$sendtime}",SQL(4,i))
						temp_chat1=Replace(temp_chat1,"{$incept}",Mybbs.HtmlEncode(SQL(1,i)))
						chatloglist=chatloglist & temp_chat1
					Else
						temp_chat2=Replace(temp_chat2,"{$sendtime}",SQL(4,i))
						temp_chat2=Replace(temp_chat2,"{$senduser}",Mybbs.HtmlEncode(SQL(0,i)))
						chatloglist=chatloglist & temp_chat2
					End If
					chatloglist=chatloglist & "</td></tr><tr><td class=tablebody1 valign=top align=left colspan=3><b>"
					chatloglist=chatloglist & template.Strings(61)&Mybbs.HtmlEncode(SQL(2,i))
					chatloglist=chatloglist & "</b><hr size=1>"
					Ubblists=Ubblist(SQL(3,i))&"39,"
					chatloglist=chatloglist & dv_ubb.Dv_UbbCode(SQL(3,i),Mybbs.UserGroupID,2,1)
					chatloglist=chatloglist & "</td></tr>"
				Next
			End If
		End If
		If Mybbs.FoundIsChallenge and Mybbs.Forum_ChanSetting(0)=1 and Mybbs.Forum_ChanSetting(6)=1 Then
		'title="手机短信标题无效，一次一位会员"" disabled id=""touser"
		send_TempLateStr=Replace(send_TempLateStr,"{$Sms_SendAct}","messanger.asp?action=send")
	'	send_TempLateStr=Replace(send_TempLateStr,"{$Sms_SendAct}","challenge_msg.asp?action=submessage")
	ElseIf Request("action")="edit" Then 
		send_TempLateStr=Replace(send_TempLateStr,"{$Sms_SendAct}","messanger.asp?action=savedit&id="&id)
	Else
		send_TempLateStr=Replace(send_TempLateStr,"{$Sms_SendAct}","messanger.asp?action=send")
	End If
	If Mybbs.Forum_ChanSetting(0)=1 and Mybbs.Forum_ChanSetting(6)=1 Then
		if Mybbs.FoundIsChallenge then
		'template.html(18)=Replace(template.html(18),"{$ischecked}","checked")
		Else
		template.html(18)=Replace(template.html(18),"{$ischecked}","")
		End if
		send_TempLateStr=Replace(send_TempLateStr,"{$mo_send}",template.html(18))
	Else 
		send_TempLateStr=Replace(send_TempLateStr,"{$mo_send}","")
	End If

	send_TempLateStr=Replace(send_TempLateStr,"{$sender}",sender)
	send_TempLateStr=Replace(send_TempLateStr,"{$touser}",touser)
	send_TempLateStr=Replace(send_TempLateStr,"{$Friend_option}",OPTION_Friend)
	send_TempLateStr=Replace(send_TempLateStr,"{$title}","value="""&title&"""")
	send_TempLateStr=Replace(send_TempLateStr,"{$sms_id}",id)
	send_TempLateStr=Replace(send_TempLateStr,"{$sendtime}",sendtime)
	send_TempLateStr=Replace(send_TempLateStr,"{$content}",content)
	send_TempLateStr=Replace(send_TempLateStr,"{$Sms_senduser}",Mybbs.GroupSetting(33))
	send_TempLateStr=Replace(send_TempLateStr,"{$Sms_maxbody}",(Mybbs.GroupSetting(34)))
	send_TempLateStr=Replace(send_TempLateStr,"{$reaction}",Request("reaction"))
	send_TempLateStr=Replace(send_TempLateStr,"{$action}",Request("action"))
	send_TempLateStr=Replace(send_TempLateStr,"{$chatloglist}",EncodeJS(chatloglist))
	send_TempLateStr=Replace(send_TempLateStr,"{$myname}",Mybbs.membername)
	send_TempLateStr=Replace(send_TempLateStr,"{$textarea}",textarea)
	If Mybbs.GroupSetting(63)<>"0" Then
		send_TempLateStr=Replace(send_TempLateStr,"{$smslimited}",Clng(Mybbs.GroupSetting(63))-Clng(Mybbs.UserToday(1)))
	Else
		send_TempLateStr=Replace(send_TempLateStr,"{$smslimited}",9999)
	End If
	Response.Write send_TempLateStr
End Sub

'读取信息
sub read()
If id<>"" and isNumeric(id) Then
	id=Clng(id)
Else
	ErrCodes=ErrCodes+"<li>"+template.Strings(51)
	Exit Sub
End If
Dim incept,content
Dim nextid,nextsender
	If Request("action")="read" Then
   		Sql="UPDATE [Dv_message] Set flag=1 WHERE ID="&id
		Mybbs.execute(sql)
		UPDATE_User_Msg(Mybbs.MemberName)
	End If

	Sql="SELECT id,sender FROM Dv_Message WHERE incept='"&Mybbs.MemberName&"' And flag=0 And issend=1 And id>"&id&" ORDER BY sendtime "
	Set Rs=Mybbs.execute(sql)
	If not (Rs.eof And Rs.bof) Then
		nextid=Rs(0)
		nextsender=Rs(1)
	End If
	Rs.close

	Sql="SELECT * FROM Dv_Message WHERE (incept='"&Mybbs.MemberName&"' or sender='"&Mybbs.MemberName&"') And id="&id
	Set Rs=Mybbs.Execute(Sql)
	If Rs.eof And Rs.bof Then
		ErrCodes=ErrCodes+"<li>"+template.Strings(34)
		exit sub
	Else
	incept=Rs("incept")
	sender=Rs("sender")
	title=Mybbs.htmlencode(Rs("title"))
	sendtime=Rs("sendtime")
	Ubblists=Ubblist(Rs("content"))&"39,"
	content=dv_ubb.Dv_UbbCode(Rs("content"),Mybbs.UserGroupID,2,1)
	End If
	Rs.close:Set Rs=nothing
	Read_TempLateStr=Replace(Read_TempLateStr,"{$incept}",incept)
	Read_TempLateStr=Replace(Read_TempLateStr,"{$sender}",sender)
	Read_TempLateStr=Replace(Read_TempLateStr,"{$read_title}",title)
	Read_TempLateStr=Replace(Read_TempLateStr,"{$sms_id}",id)
	Read_TempLateStr=Replace(Read_TempLateStr,"{$sendtime}",sendtime)
	Read_TempLateStr=Replace(Read_TempLateStr,"{$textarea}",content)
	Read_TempLateStr=Replace(Read_TempLateStr,"{$nextid}",nextid)
	Read_TempLateStr=Replace(Read_TempLateStr,"{$nextsender}",nextsender)
	Response.Write Read_TempLateStr
End Sub


'保存
Sub savemsg()
	Dim i,BoxName
	Dim incept,title,message,subtype
	Dim mysessiondata
	'把提交的数据保存到session
	mysessiondata=Session(Mybbs.CacheName & "UserID")
	mysessiondata(37)=Request.form("message")
	Session(Mybbs.CacheName & "UserID")=mysessiondata

	BoxName=split(template.Strings(63),",")
	If Clng(Mybbs.GroupSetting(53))>0 And DateDiff("s",Session(Mybbs.CacheName & "UserID")(14),Now)<Clng(Mybbs.GroupSetting(53))*60 Then
		ErrCodes=ErrCodes+"<li>"+Replace(template.Strings(39),"{$Lim_Time}",Mybbs.GroupSetting(53))
		Exit Sub
	End If
	If Mybbs.GroupSetting(63)<>"0" Then
		If Clng(Mybbs.GroupSetting(63))<=Clng(Mybbs.UserToday(1)) Then
			ErrCodes=ErrCodes+"<li>"+Replace(template.Strings(65),"{$smslimited}",Mybbs.GroupSetting(63))
			Exit sub
		End If
	End If
	If Mybbs.forum_setting(80)="1" Then
		If Not Mybbs.CodeIsTrue() Then
			ErrCodes=ErrCodes+"<meta http-equiv=refresh content=""2;URL="&Request.ServerVariables("HTTP_REFERER")&"""><li>验证码校验失败，请返回刷新页面再试。两秒后自动返回"
			Exit Sub
		End If
	End If 
	If CStr(Request.Cookies("Mybbs"))=CStr(Mybbs.Boardid) Then
		Mybbs.Dvbbs_Suc("<li>"+template.Strings(26))	'您的修改信息已成功提交！
		Exit Sub
	End If

	If Request.form("touser")="" Then
		ErrCodes=ErrCodes+"<li>"+template.Strings(35)
		Exit Sub
	Else
		incept=replace(Request.form("touser"),"'","")
		incept=split(incept,",")
	End If

	If Request.form("title")="" or Mybbs.StrLength(Request.form("title")) > 50 Then
		ErrCodes=ErrCodes+"<li>"+template.Strings(53)
		Exit Sub
	Else
		title=Mybbs.checkStr(Request.form("title"))
	End If
	If Request.form("message")="" or Mybbs.StrLength(Request.form("message")) > CLng(Mybbs.GroupSetting(34)) Then
		ErrCodes=ErrCodes+"<li>"+Replace(template.Strings(54),"{$MaxLen}",Mybbs.GroupSetting(34))
		Exit Sub
	Else
		message=Html2Ubb(Request.form("message"))
		message=Mybbs.checkStr(message)
	End If

	Dim InceptName,SendNum
	SendNum = 0
	FOR i=0 TO ubound(incept)
		Sql="SELECT UserName FROM [Dv_User] WHERE UserName = '"& Trim(incept(i)) &"' "
		Set Rs=Mybbs.Execute(Sql)
		If Rs.eof And Rs.bof Then
			ErrCodes=ErrCodes+"<li>"+template.Strings(35):Exit Sub
		ELSE
			InceptName=RS(0)
		End If
		Rs.close
		If CHKHateName(InceptName) Then
			ErrCodes=ErrCodes+"<li>"+Replace(template.Strings(64),"{$incept}",InceptName)
			Exit Sub
		Else
			If Request.Form("sms_act")="Sms_Issend" Then
				Sql="insert into Dv_Message (incept,sender,title,content,sendtime,flag,issend) values ('"&InceptName&"','"&Mybbs.MemberName&"','"&title&"','"&message&"',"&SqlNowString&",0,1)"
				subtype=BoxName(2)		'已发送的消息
				SendNum = SendNum + 1
			ElseIf Request.Form("sms_act")="Sms_Issave" Then
				Sql="insert into Dv_Message (incept,sender,title,content,sendtime,flag,issend) values ('"&InceptName&"','"&Mybbs.MemberName&"','"&title&"','"&message&"',"&SqlNowString&",0,0)"
				subtype=BoxName(4)		'发件箱
			Else
				Sql="insert into Dv_Message (incept,sender,title,content,sendtime,flag,issend) values ('"&InceptName&"','"&Mybbs.MemberName&"','"&title&"','"&message&"',"&SqlNowString&",0,1)"
				subtype=BoxName(2)		'已发送的消息
				SendNum = SendNum + 1
			End If
			Mybbs.execute(sql)
			UPDATE_User_Msg(InceptName)
		End IF
		If i>Cint(Mybbs.GroupSetting(33))-1 Then
			ErrCodes=ErrCodes+"<li>"+Replace(template.Strings(55),"{$Sms_MaxSend}",Mybbs.GroupSetting(33))
			EXIT Sub
		EXIT For
		End If
	NEXT
	'更新用户当日发短信数据以及缓存
	If SendNum > 0 Then
		Dim iUserInfo
		iUserInfo = Session(Mybbs.CacheName & "UserID")
		iUserInfo(36) = Mybbs.UserToday(0) & "|" & Mybbs.UserToday(1) + SendNum & "|" & Mybbs.UserToday(2)
		iUserInfo(37) = ""
		Session(Mybbs.CacheName & "UserID") = iUserInfo
		Mybbs.Execute( "Update [Dv_User] Set UserToday='" & iUserInfo(36) & "' Where UserID = " & Mybbs.UserID)
	End If
	Response.Cookies("Mybbs")=Mybbs.Boardid
	Mybbs.Dvbbs_Suc("<li>"+Replace(template.Strings(38),"{$SmsBOX}",subtype))
End Sub

'保存修改
Sub savedit()
Dim incept,title,message,subtype
If Clng(Mybbs.GroupSetting(53))>0 And DateDiff("s",Session(Mybbs.CacheName & "UserID")(14),Now)<Clng(Mybbs.GroupSetting(53))*60 Then
	ErrCodes=ErrCodes+"<li>"+Replace(template.Strings(39),"{$Lim_Time}",Mybbs.GroupSetting(53))
	Exit Sub
End If
If CheckID(id) = False Then
	ErrCodes=ErrCodes+"<li>"+template.Strings(51)
	Exit Sub
End If
If Request("touser")="" Then
	ErrCodes=ErrCodes+"<li>"+template.Strings(35)
	Exit Sub
Else
	incept=Mybbs.checkStr(Request.Form("touser"))
End If
If Request("title")="" or Mybbs.StrLength(Request("title")) > 50 Then
	ErrCodes=ErrCodes+"<li>"+template.Strings(53)
	Exit Sub
Else
	title=Mybbs.checkStr(Request.Form("title"))
End If
If Request("message")="" or Mybbs.StrLength(Request("message")) > CLng(Mybbs.GroupSetting(34)) Then
	ErrCodes=ErrCodes+"<li>"+Replace(template.Strings(54),"{$MaxLen}",Mybbs.GroupSetting(34))
	Exit Sub
Else
	message=Html2Ubb(Request.form("message"))
	message=Mybbs.checkStr(message)
End If

Dim SendNum
SendNum = 0
Sql="SELECT UserName FROM [Dv_User] WHERE UserName='"&incept&"'"
Set Rs=Mybbs.execute(sql)
If Rs.eof And Rs.bof Then
	ErrCodes=ErrCodes+"<li>"+template.Strings(35)
	Exit Sub
End If
Rs.close:Set Rs=Nothing
If Request("Submit")="Sms_Issend" Then
	Sql="UPDATE Dv_Message Set incept='"&incept&"',title='"&title&"',content='"&message&"',sendtime="&SqlNowString&",flag=0,issend=1 WHERE id="&Mybbs.checkStr(id)
	subtype="发送箱"
	SendNum = 1
Else
	Sql="UPDATE Dv_Message Set incept='"&incept&"',title='"&title&"',content='"&message&"',sendtime="&SqlNowString&",flag=0,issend=0 WHERE id="&Mybbs.checkStr(id)
	subtype="发件箱"
End If
Mybbs.execute(sql)

'更新用户当日发短信数据以及缓存
If SendNum > 0 Then
	Dim iUserInfo
	iUserInfo = Session(Mybbs.CacheName & "UserID")
	iUserInfo(36) = Mybbs.UserToday(0) & "|" & Mybbs.UserToday(1) + SendNum & "|" & Mybbs.UserToday(2)
	Session(Mybbs.CacheName & "UserID") = iUserInfo
	Mybbs.Execute("Update [Dv_User] Set UserToday='" & iUserInfo(36) & "' Where UserID = " & Mybbs.UserID)
End If
UPDATE_User_Msg(incept)
UPDATE_User_Msg(Mybbs.membername)
Mybbs.Dvbbs_Suc("<li>"+Replace(template.Strings(38),"{$SmsBOX}",subtype))
End Sub

'-------------------------------------------------------------逻辑删除-----------------------------------------
'收件逻辑删除，置于回收站，入口字段DelR，可用于批量及单个删除
Sub Delinbox()
If CheckID(id) = False Then
	ErrCodes=ErrCodes+"<li>"+template.Strings(51)
else
	Mybbs.execute("UPDATE Dv_Message Set DelR=1 WHERE incept='"&Mybbs.MemberName&"' And id in ("&Mybbs.checkStr(id)&")")
	Mybbs.Dvbbs_Suc("<li>"+template.Strings(36))
	UPDATE_User_Msg(Mybbs.membername)
End If 
End Sub

Sub AllDelinbox()
	Mybbs.execute("UPDATE Dv_Message Set DelR=1 WHERE incept='"&Mybbs.MemberName&"' And DelR=0")
	Mybbs.Dvbbs_Suc("<li>"+template.Strings(36))
	UPDATE_User_Msg(Mybbs.membername)
End Sub

'发件逻辑删除，置于回收站，入口字段DelS，可用于批量及单个删除
Sub Deloutbox()
If CheckID(id) = False Then
	ErrCodes=ErrCodes+"<meta http-equiv=refresh content=""2;URL="&Request.ServerVariables("HTTP_REFERER")&"""><li>"+template.Strings(51)&"2秒后自动返回上一页"
Else
	Mybbs.execute("UPDATE Dv_Message Set DelS=1 WHERE sender='"&Mybbs.MemberName&"' And issend=0 And id in ("&Mybbs.checkStr(id)&")")
	Mybbs.Dvbbs_Suc("<li>"+template.Strings(36))
	UPDATE_User_Msg(Mybbs.membername)
End If
End Sub

Sub AllDeloutbox()
	Mybbs.execute("UPDATE Dv_Message Set DelS=1 WHERE sender='"&Mybbs.MemberName&"' And DelS=0 And issend=0")
	Mybbs.Dvbbs_Suc("<li>"+template.Strings(36))
	UPDATE_User_Msg(Mybbs.membername)
End Sub

'已发送逻辑删除，置于回收站，入口字段DelS，可用于批量及单个删除
'DelS：0未操作，1发送者删除，2发送者从回收站删除
Sub DelISsend()
If CheckID(id) = False Then
	ErrCodes=ErrCodes+"<meta http-equiv=refresh content=""2;URL="&Request.ServerVariables("HTTP_REFERER")&"""><li>"+template.Strings(51)&"两秒后自动返回"
Else 
	Mybbs.execute("UPDATE Dv_Message Set DelS=1 WHERE sender='"&Mybbs.MemberName&"' And issend=1 And id in ("&Mybbs.checkStr(id)&")")
	Mybbs.Dvbbs_Suc("<li>"+template.Strings(36))
	UPDATE_User_Msg(Mybbs.membername)
End If
End Sub

'将已发送的短信移到回收站。
Sub AllDelIssend()
	Mybbs.execute("UPDATE Dv_Message Set DelS=1 WHERE sender='"&Mybbs.MemberName&"' And DelS=0 And issend=1")
	Mybbs.Dvbbs_Suc("<li>"+template.Strings(36))
	UPDATE_User_Msg(Mybbs.membername)
End Sub

'用户能完全删除收到信息和逻辑删除所发送信息，逻辑删除所发送信息设置入口字段DelS参数为2
sub Delrecycle()
If CheckID(id) = False Then
	ErrCodes=ErrCodes+"<meta http-equiv=refresh content=""2;URL="&Request.ServerVariables("HTTP_REFERER")&"""><li>"+template.Strings(51)
	Exit Sub
Else
	Mybbs.execute("DelETE FROM Dv_Message WHERE incept='"&Mybbs.MemberName&"' And DelR=1 And id in ("&Mybbs.checkStr(id)&")")
	Mybbs.execute("UPDATE Dv_Message Set DelS=2 WHERE sender='"&Mybbs.MemberName&"' And DelS=1 And id in ("&Mybbs.checkStr(id)&")")
	Mybbs.Dvbbs_Suc("<li>"+template.Strings(37))
	UPDATE_User_Msg(Mybbs.membername)
End If
End Sub

'收信人回收站： incept=收信人 DelR=1
'发信人回收站： sender=收信人 DelS=2
'清空及删除回收站记录，将不在回收站的记录放到回收站内
sub AllDelrecycle()
	Mybbs.execute("DelETE FROM Dv_Message WHERE incept='"&Mybbs.MemberName&"' And DelR=1")	
	Mybbs.execute("UPDATE Dv_Message Set DelS=2 WHERE sender='"&Mybbs.MemberName&"' And DelS=1")
	'sucmsg=sucmsg+"<br>"+"<li>删除短信息成功。删除的消息将不可恢复。"
	Mybbs.Dvbbs_Suc("<li>"+template.Strings(37))
	UPDATE_User_Msg(Mybbs.Membername)
End Sub

'删除的消息将置于您的回收站
Sub Delete()
If CheckID(id) = False Then
	ErrCodes=ErrCodes+"<meta http-equiv=refresh content=""2;URL="&Request.ServerVariables("HTTP_REFERER")&"""><li>"+template.Strings(51)
Else
	Mybbs.execute("UPDATE Dv_Message Set DelR=1 WHERE incept='"&Mybbs.MemberName&"' And id="&Mybbs.checkStr(id))
	Mybbs.execute("UPDATE Dv_Message Set DelS=1 WHERE sender='"&Mybbs.MemberName&"' And id="&Mybbs.checkStr(id))
	UPDATE_User_Msg(Mybbs.membername)
	Mybbs.Dvbbs_Suc("<li>"+template.Strings(36))
End If
End Sub

'-------------------------------------------------------------------------------------------------------------
'显示错误信息
Sub Showerr()
Dim Show_Errmsg
	If ErrCodes<>"" Then 
		Show_Errmsg=Mybbs.mainhtml(14)
		ErrCodes=Replace(ErrCodes,"{$color}",Mybbs.mainSetting(1))
		Show_Errmsg=Replace(Show_Errmsg,"{$color}",Mybbs.mainSetting(1))
		Show_Errmsg=Replace(Show_Errmsg,"{$errtitle}",Mybbs.Forum_Info(0)&"-"&Mybbs.Stats)
		Show_Errmsg=Replace(Show_Errmsg,"{$action}",Mybbs.Stats)
		Show_Errmsg=Replace(Show_Errmsg,"{$ErrString}",ErrCodes)
	End If
	Response.write Show_Errmsg
End Sub

'用户好友下拉名单
Function OPTION_Friend()
DIM i
Sql="SELECT F_friend FROM Dv_Friend WHERE F_userid="&Mybbs.userid&" ORDER BY F_addtime DESC"
Set Rs=Mybbs.Execute(Sql)
If not Rs.eof Then
	SQL=Rs.GetRows(-1)
	Rs.Close:Set Rs=Nothing
End if
If IsArray(SQL) Then
	For i=0 To Ubound(SQL,2)
	OPTION_Friend=OPTION_Friend & "<OPTION value="""&SQL(0,i)&""">"&SQL(0,i)&"</OPTION> "
	Next
Else
	OPTION_Friend=""
End If
End Function

'黑名单验证
Function CHKHateName(name)
DIM Sql,Rs
CHKHateName=False
Sql="Select F_friend From Dv_Friend Where (F_userid="&Mybbs.userid&" or F_username='"&name&"') And F_Mod=2"
Set Rs=Mybbs.Execute(Sql)
If not Rs.eof Then
	Sql=Rs.GetString(,, ",", "", "")
	Rs.Close:Set Rs=Nothing
	If instr(Sql,name) or instr(Sql,Mybbs.Membername) Then CHKHateName=True
End If
End Function

'更新用户短信通知信息（新短信条数||新短讯ID||发信人名）
Sub UPDATE_User_Msg(username)
	Dim msginfo,i,UP_UserInfo,newmsg
	newmsg=newincept(username)
	If newmsg>0 Then
		msginfo=newincept(username) & "||" & inceptid(1,username) & "||" & inceptid(2,username)
	Else
		msginfo="0||0||null"
	End If
	Mybbs.execute("UPDATE [Dv_User] Set UserMsg='"&Mybbs.CheckStr(msginfo)&"' WHERE username='"&Mybbs.CheckStr(username)&"'")
	If username=Mybbs.MemberName Then
		UP_UserInfo=Session(Mybbs.CacheName & "UserID")
		UP_UserInfo(30)=msginfo
		Session(Mybbs.CacheName & "UserID")=UP_UserInfo
	Else
		Call Mybbs.NeedUpdateList(username,1)
	End If
End Sub

'统计留言
Function newincept(iusername)
Dim Rs
Rs=Mybbs.execute("SELECT Count(id) FROM Dv_Message WHERE flag=0 And issend=1 And DelR=0 And incept='"& iusername &"'")
    newincept=Rs(0)
	Set Rs=nothing
	If isnull(newincept) Then newincept=0
End Function

Function inceptid(stype,iusername)
	Set Rs=Mybbs.execute("SELECT top 1 id,sender FROM Dv_Message WHERE flag=0 And issend=1 And DelR=0 And incept='"& iusername &"'")
	If not rs.eof Then
		If stype=1 Then
			inceptid=Rs(0)
		Else
			inceptid=Rs(1)
		End If
	Else
		If stype=1 Then
			inceptid=0
		Else
			inceptid="null"
		End If
	End If
	Set Rs=nothing
End Function

Function Get_ForumCSS()
	Dim Sid
	sid = Request.Cookies("skin")("skinid_0")
	If Not IsNumeric(sid) Or sid = "" Then Sid=Application(Forum_CacheName & "_Dv_Setup")(17,0)
	Get_ForumCSS=Application(Forum_CacheName &"_Forum_CSS"&Sid)
End Function  

Function CheckID(CHECK_ID)
	Dim Delid,Fixid
	CheckID=True
	Delid=replace(CHECK_ID,"'","")
	Delid=replace(Delid,";","")
	Delid=replace(Delid,"--","")
	Delid=replace(Delid,")","")
	Fixid=replace(Delid,",","")
	Fixid=Trim(replace(fixid," ",""))
	If Delid="" or isnull(Delid) Then  CheckID=False
	If Not IsNumeric(fixid) Then CheckID=False
End Function

Function EncodeJS(str)
EncodeJS = Replace(Replace(Replace(Replace(Replace(str,chr(10),""),"\","\\"),"'","\'"),VbCrLf,"\n"),chr(13),"")
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 Mybbs.Board_Setting(5)="0" Then 
		'	re.Pattern="<(.[^>]*)>"
		'	Str=re.Replace(Str,"")	
		'End If
		Str = Replace(Str, "[br]", "<br>")
		re.Pattern = "(&nbsp;)"
		Str = re.Replace(Str,Chr(9))
		re.Pattern="(>)("&vbNewLine&")(<)"
		Str=re.Replace(Str,"$1$3") 
		re.Pattern="(>)("&vbNewLine&vbNewLine&")(<)"
		Str=re.Replace(Str,"$1$3") 
		re.Pattern = "(<p>)"
		Str = re.Replace(Str,"")
		re.Pattern = "(<\/p>)"
		Str = re.Replace(Str,CHR(13) & CHR(10))
		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
%>