user_message.asp

淘客网上商店网站程序 淘客网上商店网站程序 淘客网上商店网站程序

<!--#include file="../Conn.asp"-->
<!--#include file="../Inc/Cl_ClsSysTem.asp"-->
<!--#include file="../Inc/Cl_ClsUbb.asp"-->
<!--#include file="Inc/Function.asp"-->
<%
Const Max_sEnd=5	'群发限制人数
Const Max_sms=1000	'内容最多字符数
Const ChannelID=0
const PageSize=20
Cl.Page_Admin=True
Cl.Get_WebSetting()
If Not Cl.ChkUserLogin Then
	Cl.ShowErr("<li>以下操作需要登录后方或进行，您未登录。</li><li>请点击<a href='Login.asp' target='_Top'>这里登录</a>。")
	Response.End
End If

Dim ComeUrl,FoundErr,Errmsg
Dim SQL,Rs,i,Action
Dim TotalPut,CurrentPage,TotalPages
Action=Lcase(request("action"))
ComeUrl=Cstr(Request.ServerVariables("HTTP_REFERER"))
CurrentPage	= Cl.GetClng(request("page"))
If ComeUrl="" Then ComeUrl="User_Message.asp"
Header
User_MsgNav
Select Case Action
Case "new" : sEndmsg
Case "read" : read
Case "outread" : read
Case "delet" : delete
Case "newmsg" : newmsg
Case "send" : savemsg
Case "fw" : fw
Case "edit" : edit
Case "savedit" : savedit
Case "删除收件" : delinbox
Case "清空收件箱" : AllDelinbox
Case "删除草稿" : deloutbox
Case "清空草稿箱" : AllDeloutbox
Case "删除已发送的消息" : delissEnd
Case "清空已发送的消息" : AllDelissEnd
Case "删除垃圾" : delrecycle
Case "清空垃圾箱" : AllDelrecycle
Case Else : SmsMain
End Select
Footer
'发送信息
Sub sEndmsg()
	dim sEndtime,title,content
	If request("id")<>"" and isNumeric(request("id")) Then
		sql="Select sEndtime,title,content from " & Db.MessageTable & " where incept='"&Cl.MemberName&"' and id="&Clng(request("id"))
		Set rs=Cl.Execute_U(sql)
		If not(rs.eof and rs.bof) Then
			sEndtime=rs("sEndtime"):title="RE " & rs("title"):content=rs("content")
		End If
		rs.close:Set rs=Nothing
	End If
%>
<form action="User_Message.asp" method="post" name="messager" id="messager">
<table cellpadding="3" cellspacing="1" align="center" class="border">
	<tr> 
		<th class="title" colspan="3" align="center"><b>发送短消息（请输入完整信息）</b></th>
	</tr>
	<tr> 
		<td class="tdbg" valign="middle"><b>收件人：</b></td>
		<td class="tdbg" valign="middle">
		  <input type="hidden" name="action" value="sEnd" />
		  <input type="text" name="touser" value="<%=request("touser")%>" size="80" />
		  <select name="font" onchange="DoTitle(this.options[this.selectedIndex].value)">
		  <option selected="selected" value="">选择</option>
		<%
		sql="Select F_Friend from " & Db.FriendTable & " where F_username='"&Cl.MemberName&"' order by F_addtime desc"
		Set rs=Cl.Execute_U(sql)
		do while not rs.eof
		Response.write "<option value="""&rs(0)&""">"&rs(0)&"</option>"
		rs.movenext
		loop
		rs.close:Set rs=Nothing
		%>
		  </select>
		</td>
	</tr>
	<tr> 
		<td class="tdbg" valign="top" width="15%"><b>标题：</b></td>
		<td class="tdbg" valign="middle">
		  <input type="text" name="title" size="90" maxlength="90" value="<%=title%>" />
		</td>
	</tr>
	<tr> 
		<td class="tdbg" valign="top" width="15%"><b>内容：</b></td>
		<td  class="tdbg" valign="middle">
		  <textarea cols="76" rows="16" name="message" title="Ctrl+Enter发送"><%
			If request("id")<>"" Then
			Response.write("====== 在 "&sEndtime&" 您来信中写道： ======")
			Response.write(Vbcrlf & server.htmlencode(content))
			Response.write(Vbcrlf & "=====================================")
			End If
			%></textarea>
		</td>
	</tr>
	<tr> 
		<td class="tdbg" colspan="2">
<b>说明</b>：<br />
① 您可以使用<b>Ctrl+Enter</b>键快捷发送短信<br />
② 可以用英文状态下的逗号将用户名隔开实现群发，最多<b><%=max_sEnd%></b>个用户<br />
③ 标题最多<b>50</b>个字符，内容最多<b><%=max_sms%></b>个字符<br />
		</td>
	</tr>
	<tr> 
		<td class="tdbg" valign="middle" colspan="2" align="center"> 
		  <input type="submit" value="发送" name="Submit" />
		  &nbsp; 
		  <input type="submit" value="保存" name="Submit" />
		  &nbsp; 
		  <input type="reset" name="Clear" value="清除" />
		  &nbsp; 
		<%If request("reaction")="chatlog" Then%>
		  <input type="button" value="关闭聊天记录" name="chatlog" onclick="location.href='?action=new&amp;id=<%=request("id")%>&amp;touser=<%=request("touser")%>'" />
		<%Else%>
		  <input type="button" value="查看聊天记录" name="chatlog" onclick="location.href='?action=new&amp;id=<%=request("id")%>&amp;touser=<%=request("touser")%>&amp;reaction=chatlog'" />
		<%End If%>
		  &nbsp; 
		  <input type="button" name="close" value="关闭" onclick="window.close()" />
		</td>
	</tr>
<%
If request("reaction")="chatlog" Then
	Dim Touser
	Touser = Cl.ReplaceBadChar(Request("touser"))
	Response.write("<tr class=""title""><td colspan=""3"">我与"&request("touser")&"的聊天记录</td></tr>")
	If Cl.MemberName=Touser Then
	Response.write("<tr><td class=""tdbg"" colspan=""3"">自己跟自己的聊天记录没什么好看的：）</td></tr>")
	Else
		sql="Select * from " & Db.MessageTable & " where ((sEnder='"&Trim(Cl.MemberName)&"' and incept='"&Touser&"') or (sEnder='"&Touser&"' and incept='"&Cl.MemberName&"')) and delS=0 order by sEndtime desc"
		Set rs=Cl.Execute_U(sql)
		If rs.eof and rs.bof Then
		Response.write("<tr><td class=""tdbg"" colspan=""3"">还没有任何聊天记录！</td></tr>")
		Else
		do while not rs.eof
			Response.write("tr><td class=""tdbg"" height=""25"" colspan=""3"">")
			If rs("sEnder")=Cl.MemberName Then
				Response.write("在<b>"&rs("sEndtime")&"</b>，您发送此消息给<b>"&Cl.HTMLEncode(rs("incept"))&"</b>！")
			Else
				Response.write("在<b>"&rs("sEndtime")&"</b>，<b>"&Cl.HTMLEncode(rs("sEnder"))&"</b>给您发送的消息！")
			End If
			Response.write("</td></tr>")
			Response.write("<tr><td  class=""tdbg"" valign=""top"" align=""left"" colspan=""3"">")
			Response.write("<b>消息标题："&Cl.HTMLEncode(rs("title"))&"</b>")
			Response.write("<hr size=""1"" />")
			Response.write(Cl.Ubbcode(Cl.HTMLEncode(rs("content"))))
			Response.write("</td></tr>")
			rs.movenext
		loop
		End If
		rs.close : Set rs=Nothing
	End If
End If%>
  </table>
</form>
<%
	DoTitleJs
End Sub
'读取信息
Sub read()
	If request("id")="" or not isNumeric(request("id")) Then
		Call Cl.OutMsg(0,"请指定正确的参数。","javascript:history.go(-1)")
	End If
	If request("action")="read" Then
		Cl.Execute_U("update " & Db.MessageTable & " Set flag=1 where ID="&Cl.GetClng(request("id")))
	End If
	sql="Select * from " & Db.MessageTable & " where (incept='"&Cl.MemberName&"' or sEnder='"&Cl.MemberName&"') and id="&Cl.GetClng(request("id"))
	Set rs=Cl.Execute_U(sql)
	If rs.eof and rs.bof Then
		rs.close:Set rs=Nothing
		Call Cl.OutMsg(0,"你是不是跑到别人的信箱啦、或者该信息已经收件人删除。","javascript:history.go(-1)")
	Else
%>
<table cellpadding="3" cellspacing="1" align="center" class="border">
	<tr>
		<th class="tdbg_main" colspan="3">欢迎使用短消息接收，<%=Cl.MemberName%></th>
	</tr>
	<tr>
		<td class="tdbg" valign="middle" align="center" colspan="3">
		<a href="User_Message.asp?action=delet&id=<%=rs("id")%>&ComeUrl=<%=ComeUrl%>"><img src="<%=Cl.WebDir%>images/Message/delete.gIf" border="0" alt="删除消息" /></a>&nbsp;
		<a href="User_Message.asp?action=new"><img src="<%=Cl.WebDir%>images/Message/write.gIf" border="0" alt="发送消息" /></a> &nbsp;
		<a href="User_Message.asp?action=new&touser=<%=Cl.HTMLEncode(rs("sEnder"))%>&id=<%=request("id")%>"><img src="<%=Cl.WebDir%>images/Message/reply.gIf" border="0" alt="回复消息" /></a>&nbsp;
		<a href="User_Message.asp?action=fw&id=<%=request("id")%>"><img src="<%=Cl.WebDir%>images/Message/fw.gIf" border="0" alt="转发消息" /></a></td>
	</tr>
	<tr>
		<td class="title" height="25">
		<%If request("action")="outread" Then%>
		在<b><%=rs("sEndtime")%></b>，您发送此消息给<b><%=Cl.HTMLEncode(rs("incept"))%></b>！
		<%Else%>
		在<b><%=rs("sEndtime")%></b>，<b><%=Cl.HTMLEncode(rs("sEnder"))%></b>给您发送的消息！
		<%End If%></td>
	</tr>
	<tr>
		<td  class="tdbg" valign="top" align="left">
		<b>消息标题：<%=Cl.HTMLEncode(rs("title"))%></b>
		<hr size="1" />
		<%=Cl.UBBCode(Replace(rs("content"),Vbcrlf,"<br>"))%>
	  </td>
	</tr>
	<%
	rs.close:Set rs=Nothing
	sql="Select id,sEnder from " & Db.MessageTable & " where incept='"&Cl.MemberName&"' and flag=0 and issEnd=1 and id>"&Cl.GetClng(request("id")&" order by sEndtime")
	Set rs=Cl.Execute_U(sql)
	If not (rs.eof and rs.bof) Then
	%>
	<tr>
		<td class="tdbg" align="right"><a href="User_Message.asp?action=read&id=<%=rs(0)%>&sEnder=<%=rs(1)%>">[读取下一条信息]</a>		</td>
	</tr>
	<%
	End If
	rs.close:Set rs=Nothing
	%>
</table>
<%
	Cl.Update_UserMsg(Cl.MemberName)
	End If
End Sub
'转发信息
Sub fw()
	dim title,content,sEnder
	If request("id")<>"" and isNumeric(request("id")) Then
		sql="Select title,content,sEnder from " & Db.MessageTable & " where (incept='"&Cl.MemberName&"' or sEnder='"&Cl.MemberName&"') and id="&Cl.GetClng(request("id"))
		Set rs=Cl.Execute_U(sql)
		If rs.eof and rs.bof Then
			rs.close:Set rs=Nothing
			Call Cl.OutMsg(0,"请选择相关参数。","javascript:history.go(-1)")
		Else
		title=rs("title"):content=rs("content"):sEnder=rs("sEnder")
		End If
		rs.close:Set rs=Nothing
	End If
%>
<form action="User_Message.asp" method="post" name="messager" id="messager">
<table cellpadding="3" cellspacing="1" align="center" class="border">
  <tr> 
	<th colspan="2" height="25" class="title">
	  <input type="hidden" name="action" value="sEnd" />
	  发送短消息--请完整输入下列信息</th>
  </tr>
  <tr> 
	<td class="tdbg" valign="middle" width="15%"><b>收件人：</b></td>
	<td  class="tdbg" valign="middle">
	  <input type="text" name="touser" value="<%=request("touser")%>" size="80" />
	  <select name="font" onchange="DoTitle(this.options[this.selectedIndex].value)">
	  <option selected="selected" value="">选择</option>
<%
sql="Select F_Friend from " & Db.FriendTable & " where F_username='"&Cl.MemberName&"' order by F_addtime desc"
Set rs=Cl.Execute_U(sql)
do while not rs.eof
%>
	  <option value="<%=rs(0)%>"><%=rs(0)%></option> 
<%
rs.movenext
loop
rs.close : Set rs=Nothing
%>
	  </select>
	</td>
  </tr>
  <tr> 
	<td class="tdbg" valign="top"><b>标题：</b></td>
	<td class="tdbg" valign="middle">
	  <input type="text" name="title" size="90" maxlength="90" value="Fw：<%=title%>" />
	  &nbsp;
	</td>
  </tr>
  <tr> 
	<td class="tdbg" valign="top"><b>内容：</b></td>
	<td class="tdbg" valign="middle">
	  <textarea cols="76" rows="16" name="message" title="Ctrl+Enter发送">
========== 下面是转发信息 =========
原发件人：<%=sEnder%><%=chr(13)&chr(13)%>
<%=server.htmlencode(content)%>
===================================</textarea>
	</td>
  </tr>
  <tr> 
	<td  class="tdbg" colspan="2">
<b>说明</b>：<br />
① 您可以使用<b>Ctrl+Enter</b>键快捷发送短信<br />
② 可以用英文状态下的逗号将用户名隔开实现群发，最多<b><%=max_sEnd%></b>个用户<br />
③ 标题最多<b>50</b>个字符，内容最多<b><%=max_sms%></b>个字符<br />
	</td>
  </tr>
  <tr class="tdbg"> 
	<td valign="middle" colspan="2" align="center"> 
	  <input type="submit" value="发送" name="Submit" />
	  &nbsp; 
	  <input type="submit" value="保存" name="Submit" />
	  &nbsp; 
	  <input type="reset" name="Clear" value="清除" />
	  &nbsp; 
	  <input type="button" name="close" value="关闭" onclick="window.close()" />
	</td>
  </tr>
</table>
</form>
<%
	DoTitleJs
End Sub

Sub savemsg()
	dim incept,title,message,i,sUname
	If request("touser")="" Then
		Call Cl.OutMsg(0,"您忘记填写发送对象了吧。","javascript:history.go(-1)")
	Else
		incept=Cl.ReplaceBadChar(request("touser"))
		incept=split(incept,",")
	End If
	If request("title")="" Then
		Call Cl.OutMsg(0,"您还没有填写标题呀。","javascript:history.go(-1)")
	ElseIf Cl.strLength(request("title"))>50 Then
		Call Cl.OutMsg(0,"标题限定最多50个字符。","javascript:history.go(-1)")
	Else
		title=Cl.ReplaceBadChar(request("title"))
	End If
	If request("message")="" Then
		Call Cl.OutMsg(0,"内容是必须要填写的噢。","javascript:history.go(-1)")
	ElseIf Cl.strLength(request("message"))>Cint(max_sms) Then
		Call Cl.OutMsg(0,"内容限定最多"&max_sms&"个字符。","javascript:history.go(-1)")
	Else
		message=Cl.ReplaceBadChar(request("message"))
	End If

	for i=0 to ubound(incept)
		sUname=replace(incept(i),"'","")
		sql="Select "&Db.UserName&" from "&Db.UserTable&" where "&Db.UserName&"='"&sUname&"'"
		Set rs=Cl.Execute_U(sql)
		If rs.eof and rs.bof Then
			rs.close:Set rs=Nothing
			Call Cl.OutMsg(0,"系统没有这个用户，看看你的发送对象写对了嘛？","javascript:history.go(-1)")
		End If
		rs.close:Set rs=Nothing
		Select Case request("Submit")
		Case "发送"
			sql="insert into " & Db.MessageTable & " (incept,sEnder,title,content,sEndtime,flag,issEnd) values ('"&sUname&"','"&Cl.MemberName&"','"&title&"','"&message&"',"&SqlNowString_U&",0,1)"
		Case "保存"
			sql="insert into " & Db.MessageTable & " (incept,sEnder,title,content,sEndtime,flag,issEnd) values ('"&sUname&"','"&Cl.MemberName&"','"&title&"','"&message&"',"&SqlNowString_U&",0,0)"
		Case Else
			sql="insert into " & Db.MessageTable & " (incept,sEnder,title,content,sEndtime,flag,issEnd) values ('"&sUname&"','"&Cl.MemberName&"','"&title&"','"&message&"',"&SqlNowString_U&",0,1)"
		End Select
		Cl.Execute_U(sql)
		Cl.Update_UserMsg(sUname)
		If i>Cint(max_sEnd)-1 Then
			Call Cl.OutMsg(0,"最多只能发送给"&max_sEnd&"个用户，您的名单"&max_sEnd&"位以后的请重新发送","javascript:history.go(-1)")	
			exit for
		End If
	next
	if request("Submit")="保存" then
	Call Cl.OutMsg(0,"恭喜您，保存短信息成功。消息已经保存在您的发件箱中。","User_Message.asp")
	else
	Call Cl.OutMsg(0,"恭喜您，发送短信息成功。发送的消息同时保存在您的已发送信息中。","User_Message.asp")
	end if
End Sub

'更改信息
Sub edit()
	dim incept,title,content,id
	If request("id")<>"" and isNumeric(request("id")) Then