messanger.asp

品泡女人香XI8.NET文章管理系统的源码

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

'发送信息,回复，转发,编辑
Sub sendmsg()
	Dim content,i,textarea,touser,incept
	Dim chatloglist
	textarea=""
	If Clng(Dvbbs.GroupSetting(53))>0 And DateDiff("s",Session(Dvbbs.CacheName & "UserID")(14),Now)<Clng(Dvbbs.GroupSetting(53))*60 Then
		ErrCodes=ErrCodes+"<li>"+Replace(template.Strings(39),"{$Lim_Time}",Dvbbs.GroupSetting(53))
		Exit sub
	End If
	If Dvbbs.GroupSetting(63)<>"0" Then
		If Clng(Dvbbs.GroupSetting(63))<=Clng(Dvbbs.UserToday(1)) Then
			ErrCodes=ErrCodes+"<li>"+Replace(template.Strings(65),"{$smslimited}",Dvbbs.GroupSetting(63))
			Exit sub
		End If
	End If
	touser=Dvbbs.Checkstr(Request("touser"))
	If id<>"" And isNumeric(id) And SqlStr<>"" Then
		Set Rs=Dvbbs.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(Dvbbs.CacheName & "UserID")(37)<>"" Then
				textarea=server.htmlencode(Session(Dvbbs.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(Dvbbs.CacheName & "UserID")(37))
	End If
	If Request("reaction")="chatlog" Then
	Dim temp_chat1,temp_chat2
			Touser=Dvbbs.checkStr(Request("touser"))
		Sql="SELECT sender,incept,title,content,sendtime FROM Dv_Message WHERE ((sender='"&Dvbbs.MemberName&"' And incept='"&Touser&"') or (sender='"&Touser&"' And incept='"&Dvbbs.MemberName&"')) And DelS=0 ORDER BY sendtime DESC"
		Set Rs=Dvbbs.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))=Dvbbs.MemberName Then
						temp_chat1=Replace(temp_chat1,"{$sendtime}",SQL(4,i))
						temp_chat1=Replace(temp_chat1,"{$incept}",Dvbbs.HtmlEncode(SQL(1,i)))
						chatloglist=chatloglist & temp_chat1
					Else
						temp_chat2=Replace(temp_chat2,"{$sendtime}",SQL(4,i))
						temp_chat2=Replace(temp_chat2,"{$senduser}",Dvbbs.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)&Dvbbs.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),Dvbbs.UserGroupID,2,1)
					chatloglist=chatloglist & "</td></tr>"
				Next
			End If
		End If
		If Dvbbs.FoundIsChallenge and Dvbbs.Forum_ChanSetting(0)=1 and Dvbbs.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 Dvbbs.Forum_ChanSetting(0)=1 and Dvbbs.Forum_ChanSetting(6)=1 Then
		if Dvbbs.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}",Dvbbs.GroupSetting(33))
	send_TempLateStr=Replace(send_TempLateStr,"{$Sms_maxbody}",(Dvbbs.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}",Dvbbs.membername)
	send_TempLateStr=Replace(send_TempLateStr,"{$textarea}",textarea)
	If Dvbbs.GroupSetting(63)<>"0" Then
		send_TempLateStr=Replace(send_TempLateStr,"{$smslimited}",Clng(Dvbbs.GroupSetting(63))-Clng(Dvbbs.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
		Dvbbs.execute(sql)
		UPDATE_User_Msg(Dvbbs.MemberName)
	End If

	Sql="SELECT id,sender FROM Dv_Message WHERE incept='"&Dvbbs.MemberName&"' And flag=0 And issend=1 And id>"&id&" ORDER BY sendtime "
	Set Rs=Dvbbs.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='"&Dvbbs.MemberName&"' or sender='"&Dvbbs.MemberName&"') And id="&id
	Set Rs=Dvbbs.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=Dvbbs.htmlencode(Rs("title"))
	sendtime=Rs("sendtime")
	Ubblists=Ubblist(Rs("content"))&"39,"
	content=dv_ubb.Dv_UbbCode(Rs("content"),Dvbbs.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(Dvbbs.CacheName & "UserID")
	mysessiondata(37)=Request.form("message")
	Session(Dvbbs.CacheName & "UserID")=mysessiondata

	BoxName=split(template.Strings(63),",")
	If Clng(Dvbbs.GroupSetting(53))>0 And DateDiff("s",Session(Dvbbs.CacheName & "UserID")(14),Now)<Clng(Dvbbs.GroupSetting(53))*60 Then
		ErrCodes=ErrCodes+"<li>"+Replace(template.Strings(39),"{$Lim_Time}",Dvbbs.GroupSetting(53))
		Exit Sub
	End If
	If Dvbbs.GroupSetting(63)<>"0" Then
		If Clng(Dvbbs.GroupSetting(63))<=Clng(Dvbbs.UserToday(1)) Then
			ErrCodes=ErrCodes+"<li>"+Replace(template.Strings(65),"{$smslimited}",Dvbbs.GroupSetting(63))
			Exit sub
		End If
	End If
	If Dvbbs.forum_setting(80)="1" Then
		If Not Dvbbs.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("Dvbbs"))=CStr(Dvbbs.Boardid) Then
		Dvbbs.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 Dvbbs.StrLength(Request.form("title")) > 50 Then
		ErrCodes=ErrCodes+"<li>"+template.Strings(53)
		Exit Sub
	Else
		title=Dvbbs.checkStr(Request.form("title"))
	End If
	If Request.form("message")="" or Dvbbs.StrLength(Request.form("message")) > CLng(Dvbbs.GroupSetting(34)) Then
		ErrCodes=ErrCodes+"<li>"+Replace(template.Strings(54),"{$MaxLen}",Dvbbs.GroupSetting(34))
		Exit Sub
	Else
		message=Html2Ubb(Request.form("message"))
		message=Dvbbs.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=Dvbbs.Execute(Sql)