message.asp

一套开源WEB的网站管理系统

	End If
	If Trim(Request("sid")) <> "" Then
		sid = Newasp.ChkNumeric(Request("sid"))
	End If
	If Action = "fw" And IsNumeric(Request("sid"))  Then
		Set Rs = Newasp.Execute("SELECT * FROM NC_Message where (sender='"&MemberName&"' Or incept='"&MemberName&"') And id="& CLng(sid))
		If Rs.BOF And Rs.EOF Then
			ErrMsg = ErrMsg + "<li>错误的系统参数~！</li>"
			Founderr = True
			Set Rs = Nothing
			Exit Sub
		End If
		smsincept = ""
		smscontent = "=================== 下面是转发信息 =================== <br>" & Rs("content") & "<br>====================================================<br>"
		smstopic = "FW：" & Rs("title")
		sendername = Rs("sender")
		Set Rs = Nothing
	End If
	If Trim(Request("touser")) <> "" And Request("sid") <> "" Then
		Set Rs = Newasp.Execute("select * from NC_Message where id="& CLng(sid) &" And incept='"&MemberName&"'")
		If Rs.BOF And Rs.EOF Then
			ErrMsg = ErrMsg + "<li>错误的系统参数~！</li>"
			Founderr = True
			Set Rs = Nothing
			Exit Sub
		End If
		smsincept = Rs("incept")
		smscontent = "============在 " & Rs("SendTime") & " 您来信中写道：============<br>" & Rs("content") & "<br>======================================================<br>"
		smstopic = "RW：" & Rs("title")
		sendername = Rs("sender")
		Set Rs = Nothing
	End If
	Dim Touser,temp_chat1,temp_chat2
	If Request("reaction")="chatlog" Then
		Touser=Newasp.CheckStr(Request("touser"))
		SQL="SELECT top 30 sender,incept,title,content,sendtime FROM NC_Message WHERE ((sender='"&MemberName&"' And incept='"&Touser&"') or (sender='"&Touser&"' And incept='"&MemberName&"')) And delSend=0 ORDER BY sendtime DESC"
		Set Rs=Newasp.Execute(SQL)
		If Rs.EOF And Rs.BOF Then
			Chatloglist="<tr><td class=Usertablerow1 colspan=2>还没有任何聊天记录！</td></tr>"
		Else
			SQL=Rs.GetRows(-1)
			Rs.close:Set Rs=nothing

			For i=0 to Ubound(SQL,2)
				chatloglist=chatloglist & "<tr><td class=Usertablerow2 height=25 colspan=2>"
				If Trim(SQL(0,i))=MemberName Then
					temp_chat1 = "在" & SQL(4,i)
					temp_chat1 = temp_chat1 & "，您发送此消息给" & Newasp.HtmlEncode(SQL(1,i))
					chatloglist=chatloglist & temp_chat1
				Else
					temp_chat2 = "在" & SQL(4,i) & "，"
					temp_chat2 = temp_chat2 & Newasp.HtmlEncode(SQL(0,i)) & "给您发送的消息！"
					chatloglist=chatloglist & temp_chat2
				End If
				chatloglist=chatloglist & "</td></tr><tr><td class=Usertablerow1 valign=top align=left colspan=2><b>消息标题："
				chatloglist=chatloglist & Newasp.HtmlEncode(SQL(2,i))
				chatloglist=chatloglist & "</b><hr size=1>"
				chatloglist=chatloglist & UbbCode(SQL(3,i))
				chatloglist=chatloglist & "</td></tr>"
			Next
		End If
	End If
End Sub
Sub DelMessage()
	If Founderr = True Then Exit Sub
	If sid = 0 Then
		ErrMsg = ErrMsg + "<li>对不起！错误的系统参数。</li>"
		Founderr = True
		Exit Sub
	End If
	SQL="SELECT incept FROM NC_Message WHERE (sender='"&MemberName&"' Or incept='"&MemberName&"') And id="& CLng(sid)
	Set Rs=Newasp.Execute(SQL)
	If Rs.EOF And Rs.BOF Then
		ErrMsg = ErrMsg + "<li>请选择正确的系统参数！</li>"
		Founderr = True
		Exit Sub
		Set Rs = Nothing
	Else
		If Rs(0) = MemberName Then
			Newasp.Execute("DELETE FROM NC_Message WHERE flag=0 And incept='"&MemberName&"' And id="& CLng(sid))
		Else
			Newasp.Execute("UPDATE NC_Message SET delsend=1 WHERE sender='"&MemberName&"' And id="& CLng(sid))
		End If
	End If
	Rs.Close:Set Rs = Nothing
	Call Returnsuc("<li>删除短消息完成！</li>")
End Sub
Sub DelAllMessage()
	If Founderr = True Then Exit Sub
	Newasp.Execute("DELETE FROM NC_Message WHERE flag=0 And incept='"&MemberName&"'")
	Newasp.Execute("UPDATE NC_Message Set delsend=1 WHERE sender='"&MemberName&"'")
	Call Returnsuc("<li>您的短消息已经全部清除！</li>")
End Sub
'================================================
' 函数名：Option_Friend
' 作  用：用户好友下拉名单
'================================================
Function Option_Friend()
	DIM i
	SQL = "SELECT friend FROM NC_Friend WHERE grouping<>2 And userid="& memberid &" order by addtime desc"
	Set Rs = Newasp.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
'================================================
' 函数名：newincept
' 作  用：统计短信
'================================================
Function newincept(iusername)
	Dim Rs
	Rs = Newasp.Execute("SELECT Count(id) FROM NC_Message WHERE isRead=0 And flag=0 And incept='"& iusername &"'")
	newincept = Rs(0)
	Set Rs=Nothing
	If IsNull(newincept) Then newincept = 0
End Function
'================================================
' 函数名：ChkHateName
' 作  用：黑名单验证
'================================================
Function ChkHateName(sName)
	DIM SQL,Rs
	ChkHateName = False
	SQL="SELECT friend FROM NC_Friend WHERE (userid="& memberid &" Or username='"& sName &"') And grouping=2"
	Set Rs = Newasp.Execute(SQL)
	If Not Rs.EOF Then
		SQL=Rs.GetString(,, ",", "", "")
		Rs.Close:Set Rs=Nothing
		If Instr(SQL,sName) Or Instr(SQL,MemberName) Then ChkHateName = True
	End If
End Function
'================================================
' 函数名：CheckID
' 作  用：验证短信ID
'================================================
Function CheckID(CHECK_ID)
	Dim Delid,Fixid
	CheckID=True
	Delid=replace(CHECK_ID,"'","")
	Delid=replace(Delid,";","")
	Delid=replace(Delid,"--","")
	Delid=replace(Delid,")","")
	Delid=replace(Delid,"@","")
	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
'================================================
' 过程名：SaveMessage
' 作  用：保存短消息
'================================================
Sub SaveMessage()
	Dim strIncept,strContent,strTitle,InceptName,n
	If CLng(UserToday(4)) => CLng(GroupSetting(29)) Then
		FoundErr = True
		ErrMsg = ErrMsg + "<li>您每天最多只能发布<font color=red><b>" & GroupSetting(29) & "</b></font>篇文章，如果还要继续发布请明天再来吧！</li>"
	End If
	If Trim(Request.Form("incept")) = "" Then
		ErrMsg = ErrMsg + "<li>请填写收件人姓名！</li>"
		Founderr = True
	Else
		strIncept = Newasp.CheckBadstr(Request.Form("incept"))
		strIncept = split(strIncept,",")
	End If
	If Trim(Request.Form("topic")) = "" Then
		ErrMsg = ErrMsg + "<li>请填写短信标题！</li>"
		Founderr = True
	Else
		strTitle = Left(Newasp.ChkFormStr(Request.Form("topic")),50)
	End If
	If Trim(Request.Form("content1")) = "" Then
		ErrMsg = ErrMsg + "<li>请填写短信内容！</li>"
		Founderr = True
	Else
		strContent = Html2Ubb(Request.Form("content1"))
	End If
	If Len(Request.Form("content1")) > CLng(GroupSetting(23)) Then
		ErrMsg = ErrMsg + "<li>短信内容不能大于" & GroupSetting(23) & "字符！</li>"
		Founderr = True
	End If
	If CInt(GroupSetting(2)) = 1 Then
		If Not Newasp.CodeIsTrue() Then
			ErrMsg = ErrMsg + "<meta http-equiv=refresh content=""2;URL="&Request.ServerVariables("HTTP_REFERER")&"""><li>验证码校验失败，请返回刷新页面再试。两秒后自动返回</li>"
			Founderr = True
		End If
		Session("GetCode") = ""
	End If
	If Founderr = True Then Exit Sub
	On Error Resume Next
	Call PreventRefresh  '防刷新
	n=0
	For i = 0 To Ubound(strIncept)
		If i >= 5 Then Exit For
		n = n + 1
		InceptName = Trim(strIncept(i))
		SQL = "SELECT username FROM [NC_User] WHERE username='"&InceptName&"'"
		Set Rs = Newasp.Execute(SQL)
		If Rs.EOF And Rs.BOF Then
			ErrMsg = ErrMsg + "<li>没有找到<font color=red>" & InceptName & "</font>这个用户，短信发送不成功~！</li>"
			Founderr = True
			Rs.Close:Set Rs = Nothing
			Exit Sub
		Else
			InceptName = Rs(0)
		End If
		Rs.Close:Set Rs = Nothing
		If ChkHateName(InceptName) Then
			ErrMsg = ErrMsg + "由于对方<font color=red>" & InceptName & "</font>已将你列入黑名单，或<font color=red>" & InceptName & "</font>存在你的黑名单中，因此短信发送被终止！"
			Founderr = True
			Exit Sub
		Else
			SQL = "Insert into NC_Message (sender,incept,title,content,flag,SendTime,isRead,delSend) values ('"& MemberName &"','"& InceptName &"','"& strTitle &"','"& strContent &"',0,"& NowString &",0,0) "
			Newasp.Execute(SQL)
			SQL = "Update NC_User Set usermsg=usermsg+1 where username='"&InceptName&"'"
			Newasp.Execute(SQL)
		End If
		
	Next
	Dim strUserToday
	strUserToday = UserToday(0) &","& UserToday(1) &","& UserToday(2) &","& UserToday(3) &","& UserToday(4)+n &","& UserToday(5)
	UpdateUserToday(strUserToday)
	Call Returnsuc("<li>恭喜您！发送短信成功。</li>")
End Sub
'删除收件箱
Sub Delinbox()
	If Not CheckID(Request("id")) Then
		ErrMsg = ErrMsg + "<li>错误的系统参数！</li>"
		Founderr = True
	End If
	If Founderr = True Then Exit Sub
	Newasp.Execute("DELETE FROM NC_Message WHERE flag=0 And incept='"&MemberName&"' And id in (" & Newasp.CheckBadstr(Request("id")) & ")")
	Call Returnsuc("<li>删除收件箱中的短信成功！</li>")
End Sub
'清空收件箱
Sub DelAllinbox()
	If Founderr = True Then Exit Sub
	Newasp.Execute("DELETE FROM NC_Message WHERE flag=0 And incept='"&MemberName&"'")
	Call Returnsuc("<li>您的收件箱已成功清空！</li>")
End Sub
'删除发件箱
Sub DelSendbox()
	If Not CheckID(Request("id")) Then
		ErrMsg = ErrMsg + "<li>错误的系统参数！</li>"
		Founderr = True
	End If
	If Founderr = True Then Exit Sub
	Newasp.Execute("UPDATE NC_Message SET delsend=1 WHERE sender='"&MemberName&"' And id in (" & Newasp.CheckBadstr(Request("id")) & ")")
	Call Returnsuc("<li>删除发件箱中的短信成功！</li>")
End Sub
'清空发件箱
Sub DelAllSendbox()
	If Founderr = True Then Exit Sub
	Newasp.Execute("UPDATE NC_Message SET delsend=1 WHERE sender='"&MemberName&"'")
	Call Returnsuc("<li>您的发件箱已成功清空！</li>")
End Sub
%>
<!--#include file="foot.inc"-->