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

    <!--#include file="Conn.asp"-->
<!-- #include file="inc/const.asp" -->
<!--#include file="inc/md5.asp"-->
<%
Dim ErrCodes
Mybbs.LoadTemplates("")
Mybbs.Stats="站内手机留言"
Mybbs.Head()
Response.Write "<div topmargin=0 leftmargin=0 onkeydown=""if(event.keyCode==13 && event.ctrlKey)messager.submit()"">"

If Mybbs.UserID=0 then ErrCodes=ErrCodes+"<li>您还没有登录，请登录后进行操作。"

If Not(Mybbs.Forum_ChanSetting(0)=1 And Mybbs.Forum_ChanSetting(6)=1) Then ErrCodes=ErrCodes+"<li>本论坛没有开启论坛手机短信互发功能。"

If ErrCodes<>"" Then Showerr

Select case request("action")
	case "submobile"
		Mybbs.Stats="提交资料"
		call sendmsg_2()
	case "submessage"
		Mybbs.Stats="提交资料"
		call sendmsg_3()
	case "redir"
		Mybbs.Stats="提交资料"
		call redir()
	case else
		Mybbs.Stats="输入资料"
		call sendmsg_1()
End Select 
If ErrCodes<>"" Then Showerr
Response.Write "</div>"
Mybbs.Footer()

Sub sendmsg_1()
	dim Rs
	set Rs=Mybbs.execute("select username from [dv_user] where userid="&Mybbs.userid&" and IsChallenge=1")
	If Rs.EOF And Rs.BOF Then
		ErrCodes=ErrCodes+"<li>您还不是本站的阳光会员，不能使用此功能，请<a href=challenge_up.asp>升级为阳光会员</a>。"
		Exit Sub
	Else
%>
<table cellpadding=3 cellspacing=1 align=center class=tableborder1>
<tr><th align=center colspan=2><form action="challenge_msg.asp?action=submobile" method=post>站内手机留言</td></tr>
<tr><td class=tablebody1 align=right width="40%"><B>请输入对方用户名</B>：<BR>对方必须是本站高级用户方可接收手机留言</td>
	<td class=tablebody1 width="60%">
<input type=text size=30 name="username" value="<%=rs("username")%>">
	</td></tr>
<tr><td align=center class=tablebody2 colspan=2><input type=submit value="下一步"></td></form></tr>
</table>
<%
	End If
	Set Rs=nothing
end sub

Sub sendmsg_2()
	Dim susername
	Dim Rs
	If request("username")="" Then
		If request("touser")="" Then
			ErrCodes=ErrCodes+"<li>请输入要发送站内手机留言的用户名。"
			Exit Sub
		Else
			susername=Mybbs.CheckStr(trim(request("touser")))
		End if
	Else
		susername=Mybbs.CheckStr(trim(request("username")))
	End If
	Set Rs=Mybbs.execute("select UserMobile from [dv_user] where username='"&susername&"' and IsChallenge=1")
	If rs.eof and rs.bof then
		ErrCodes=ErrCodes+"<li>您要发送的对象不是本站的阳光会员。"
		Mybbs.execute("insert into dv_message (incept,sender,title,content,sendtime,flag,issend) values ('"&susername&"','"&Mybbs.membername&"','站内手机短信发送失败通知','由于您不是本站的阳光会员，用户"&Mybbs.membername&"给您发送站内手机短信失败，您可以升级成为本站的手机阳光会员，以便您不在线的时候网友能够直接和您联系。',"&SqlNowString&",0,1)")
		UPDATE_User_Msg(susername)
		Exit Sub
	Else
%>
<table cellpadding=3 cellspacing=1 align=center class=tableborder1>
<tr><th align=center colspan=2><form action="challenge_msg.asp?action=submessage" method=post>站内手机留言</td></tr>
<tr><td class=tablebody1 align=right width="40%"><B>对方用户名</B>：<BR>对方必须是本站高级用户方可接收手机留言</td>
	<td class=tablebody1 width="60%">
<%=susername%>
<input type=hidden name="username" value="<%=susername%>">
	</td></tr>
	<tr><td class=tablebody1 align=right width="40%"><B>请输入手机留言内容</B>：最多只能输入114个字符，多出来的系统将自动截断并分条发送<BR></td>
	<td class=tablebody1 width="60%">
<textarea cols=70 rows=6 name="message"><%=request("message")%></textarea>
	</td></tr>
<tr><td align=center class=tablebody2 colspan=2><input type=submit value="提 交"></td></form></tr>
</table>
<%
	End If
	set rs=nothing
End Sub

Sub sendmsg_3()
	Dim susername,message
	Dim mymobile,tomobile
	Dim imymobile,itomobile
	Dim rs
	If request("username")="" then
		If request("touser")="" Then
			ErrCodes=ErrCodes+"<li>请输入要发送站内手机留言的用户名。"
			Exit Sub
		Else
			susername=Mybbs.CheckStr(trim(request("touser")))
		End If
	Else
		susername=Mybbs.CheckStr(trim(request("username")))
	End If
	
	If request("message")="" Then
		ErrCodes=ErrCodes+"<li>请输入要发送站内手机留言的信息。"
		Exit Sub
	Else
		message=Mybbs.CheckStr(trim(request("message")))
	End If

	Set Rs=Mybbs.execute("select UserMobile from [dv_user] where userid="&Mybbs.userid&" and IsChallenge=1")
	If Rs.EOF And Rs.BOF Then
		ErrCodes=ErrCodes+"<li>您还不是本站的阳光会员，不能使用此功能，<a href=challenge_up.asp>请升级为阳光会员</a>。"
		Exit Sub
	End If
	mymobile=rs(0)
	imymobile=mid(mymobile,3,1)
	If imymobile="0" or imymobile="1" or imymobile="2" or imymobile="3" or imymobile="4" Then
		imymobile=0
	Else 
		imymobile=1
	End If

	set rs=Mybbs.execute("select UserMobile from [dv_user] where username='"&susername&"' and IsChallenge=1")
	if rs.eof and rs.bof Then
		ErrCodes=ErrCodes+"<li>您要发送的对象不是本站的阳光会员。<br><li>您发送的手机短信已经自动转为站内短信发送给对方。"
		Mybbs.execute("insert into dv_message (incept,sender,title,content,sendtime,flag,issend) values ('"&susername&"','"&Mybbs.membername&"','站内手机短信发送失败通知','由于您不是本站的阳光会员，用户"&Mybbs.membername&"给您发送站内手机短信失败，您可以升级成为本站的手机阳光会员，以便您不在线的时候网友能够直接和您联系。"&chr(10)&"以下是用户"&Mybbs.membername&"给您发送的短信："&chr(10)&""&message&"',"&SqlNowString&",0,1)")
		UPDATE_User_Msg(susername)
		Exit Sub
	End If
	tomobile=rs(0)
	itomobile=mid(tomobile,3,1)
	If itomobile="0" or itomobile="1" or itomobile="2" or itomobile="3" or itomobile="4" Then
		itomobile=0
	Else 
		itomobile=1
	End If

	If imymobile<>itomobile Then
		ErrCodes=ErrCodes+"<li>对不起，根据相关政策，移动、联通手机不能互发短信。"
		Exit Sub
	End If

	Set Rs=Mybbs.execute("select top 1 * from Dv_ChallengeInfo")
	Dim MyForumID,MouseID
	MyForumID=rs("D_ForumID")
	MouseID=rs("D_username")
%>
正在提交数据，请稍后……
<form name="redir" action="http://bbs.ray5198.com/send_message.jsp" method="post">
<INPUT type=hidden name="from" value="<%=mymobile%>">
<INPUT type=hidden name="to" value="<%=tomobile%>">
<INPUT type=hidden name="message" value="<%=message%>">
<INPUT type=hidden name="forumId" value="<%=MyForumID%>">
<INPUT type=hidden name="mouseId" value="<%=mouseid%>">
<input type=hidden name="forumUrl" value="<%=Mybbs.Get_ScriptNameUrl%>">
<INPUT type=hidden name="sender" value="<%=Mybbs.membername%>">
<input type=hidden value="challenge_msg.asp?action=redir" name="dirPage">
</form>
<script LANGUAGE=javascript>
<!--
redir.submit();
//-->
</script>
<%
Set rs=nothing
End Sub

Sub redir()
	Dim ErrorCode,ErrorMsg

	ErrorCode=trim(request("ErrorCode"))
	ErrorMsg=trim(request("ErrorMsg"))

	Select Case ErrorCode
		Case 100
		Case 101
			ErrCodes=ErrCodes+"<li>您在论坛发送站内短信失败。"
			Exit Sub
		Case Else
			ErrCodes=ErrCodes+"<li>非法的提交过程。"
		Exit Sub
	End Select
%>
<table cellpadding=3 cellspacing=1 align=center class=tableborder1>
<tr>
<th height=24>成功：您成功的发送了站内短信</th>
</tr>
<tr><td class=tablebody1><br>
<ul><li><a href="challenge_msg.asp">返回发送页面</a></li></ul>
</td></tr>
</table>
<%
End Sub

'更新用户短信通知信息（新短信条数||新短讯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)
	Dim rs
	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
'-------------------------------------------------------------------------------------------------------------
'显示错误信息
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
%>