📄 user_message.asp
字号:
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%option explicit%>
<!--#include file="../Conn.asp"-->
<!--#include file="../SysCls/KS_UserCommonCls.asp"-->
<%
'===================================================================================================================
'软件名称：科汛网站管理系统
'当前版本：科汛网站管理系统 V2.2 SP2 Free
'Copyright (C) 2005-2006 Kesion.Com All rights reserved.
'产品咨询QQ：9537636,41904294
'技术支持QQ：111394,54004407
'程序版权：科汛网络
'程序开发：科汛网络开发组（总策划：林文仲）
'E-Mail :kesioncms@hotmail.com webmaster@kesion.com
'官方网站：http://www.kesion.com
'演示站点：http://test.kesion.com
'郑重声明:
' ①、免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接,商业版本无此要求;
' ②、任何个人或组织不得在授权允许的情况下删除、修改、拷贝本软件及其他副本上一切关于版权的信息；
' ③、科汛网络保留此软件的法律追究权利
'===================================================================================================================
Dim KSCls
Set KSCls = New User_Message
KSCls.Execute()
Set KSCls = Nothing
Class User_Message
Private KSCMS,KSUser
Private Max_sEnd
Private Max_sms
Private Action
Private RS,SqlStr,ComeUrl
Private FoundErr,Errmsg
Private i
Private Sub Class_Initialize()
Max_sEnd=10 '群发限制人数
Max_sms=1000 '内容最多字符数
Set KSCMS=New CommonCls
Set KSUser = New UserCls
End Sub
Private Sub Class_Terminate()
Set KSCMS=Nothing
Set KSUser=Nothing
End Sub
Public Sub Execute()
IF Cbool(KSUser.UserLoginChecked)=false Then
Response.Write "<script>location.href='Login.asp';</script>"
Exit Sub
End If
Action=Lcase(request("action"))
ComeUrl=Cstr(Request.ServerVariables("HTTP_REFERER"))
If ComeUrl="" Then ComeUrl="User_Message.asp"
KSUser.LoadHead()
%>
<script language = "JavaScript">
function CheckForm()
{
if (document.myform.Touser.value=='')
{
alert('请输入收信人!')
document.myform.Touser.focus();
return false;
}
if (document.myform.title.value=='')
{
alert('请输入信件主题!')
document.myform.title.focus();
return false;
}
if (frames["MessageContent"].CurrMode!='EDIT') {alert('其他模式下无法保存，请切换到设计模式');return false;}
document.myform.message.value=frames["MessageContent"].KS_EditArea.document.body.innerHTML;
if (document.myform.message.value=='')
{
alert("请输入信件内容！");
frames["MessageContent"].KS_EditArea.focus();
return false;
}
return true;
}
</script>
<TABLE height="540" cellSpacing=0 width=772 align=center border=0>
<TR>
<TD vAlign=top bgColor=#FFFFFF>
<table width="100%" border="0" cellspacing="0" cellpadding="0">
<tr>
<td height="32"> 当前位置 >> <a href="<%=KSCMS.GetConfig("WebUrl")%>"><%=KSCMS.GetConfig("WebName")%></a> >> <a href="index.asp">会员中心</a> >> 用户短消息功能 </td>
</tr>
<tr>
<td>
<%
KSUser.LoadMenu()
%>
</td>
</tr>
</table>
<%
IF Action<>"read" And Action<>"outread" Then
KSUser.MessageMenu()
Else
Response.Write "<br>"
End IF
Select Case Action
Case "new" : sendMessage
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 : MessageMain
End Select
%>
</TD>
</TR>
</TABLE>
<%
KSUser.LoadFoot()
End Sub
'发送信息
Sub sendMessage()
dim SendTime,title,content
If KSCMS.G("ID")<>"" and isNumeric(KSCMS.G("ID")) Then
Set rs=server.createobject("adodb.recordSet")
SqlStr="Select SendTime,title,content from KS_Message where Incept='"&KSUser.Get_UserName&"' and id="&Clng(KSCMS.G("ID"))
RS.open SqlStr,Conn,1,1
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" name="myform" method="post" id="myform" onsubmit="return CheckForm();">
<table cellpadding=3 cellspacing=1 align=center class=border>
<tr>
<th colspan=3 align=center><b>发送短消息（请输入完整信息）</b></th>
</tr>
<tr>
<td valign=middle><b>收件人：</b></td>
<td valign=middle>
<input type=hidden name="action" value="sEnd">
<input type=text name="Touser" value="<%=KSCMS.G("Touser")%>" size=80>
<Select name=font onchange=DoTitle(this.options[this.selectedIndex].value)>
<OPTION selected value="">选择</OPTION>
<%
Set rs=server.createobject("adodb.recordSet")
SqlStr="Select friend from KS_Friend where Username='"&KSUser.Get_UserName&"' order by Addtime desc"
RS.open SqlStr,Conn,1,1
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 valign=top width=15%><b>标题：</b></td>
<td valign=middle>
<input type=text name="title" size=90 maxlength=90 value="<%=title%>">
</td>
</tr>
<tr>
<td valign=top width=15%><b>内容：</b></td>
<td valign=middle>
<textarea cols=76 rows=16 name="message" style="display:none" title="Ctrl+Enter发送">
<%If KSCMS.G("ID")<>"" Then%>
============= 在 <%=SendTime%> 您来信中写道： ==============<br>
<%=server.htmlencode(content)%>
=======================================================
<%End If%>
</textarea>
<iframe id='MessageContent' name='MessageContent' src='../Editor.asp?ID=message&style=0&ChannelID=9998' frameborder=0 scrolling=no width='100%' height='270'></iframe>
</td>
</tr>
<tr>
<td 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 valign=middle colspan=2 align=center>
<input type=Submit value="发送" name=Submit>
<input type=Submit value="保存" name=Submit>
<input type="reSet" name="Clear" value="清除">
<%If request("reaction")="chatlog" Then%>
<input type=button value="关闭聊天记录" name="chatlog" onClick="location.href='?action=new&id=<%=KSCMS.G("ID")%>&Touser=<%=KSCMS.G("Touser")%>'">
<%Else
If KSCMS.G("ID")<>"" and isNumeric(KSCMS.G("ID")) Then
%>
<input type=button value="查看聊天记录" name="chatlog" onClick="location.href='?action=new&id=<%=KSCMS.G("ID")%>&Touser=<%=KSCMS.G("Touser")%>&reaction=chatlog'">
<%Else%>
<input type=button value="查看聊天记录" name="chatlog" disabled>
<% End IF
End If%>
<input type="button" name="close" value="关闭" onClick="window.close()">
</td>
</tr>
<%If request("reaction")="chatlog" Then%>
<tr Class=title>
<td colspan=3>我与<%=KSCMS.G("Touser")%>的聊天记录</td>
</tr>
<%If KSUser.Get_UserName=KSCMS.G("Touser") Then%>
<tr>
<td colspan=3>自己跟自己的聊天记录没什么好看的：）</td>
</tr>
<%Else%>
<%
Set rs=server.createobject("adodb.recordSet")
SqlStr="Select * from KS_Message where ((Incept='"&KSUser.Get_UserName&"' and Incept='"&replace(KSCMS.G("Touser"),"'","")&"') or (sEnder='"&replace(KSCMS.G("Touser"),"'","")&"' and Incept='"&KSUser.Get_UserName&"')) and delS=0 order by SendTime desc"
RS.open SqlStr,Conn,1,1
If RS.eof and RS.bof Then
%>
<tr>
<td colspan=3>还没有任何聊天记录！</td>
</tr>
<%
Else
Do While not RS.eof
%>
<tr>
<td height=25 colspan=3>
<%If rs("sEnder")=KSUser.Get_UserName Then%>
在<b><%=rs("SendTime")%></b>，您发送此消息给<b><%=KSCMS.HTMLEncode(rs("Incept"))%></b>！
<%Else%>
在<b><%=rs("SendTime")%></b>，<b><%=KSCMS.HTMLEncode(rs("sEnder"))%></b>给您发送的消息！
<%End If%></td>
</tr>
<tr>
<td valign=top align=left colspan=3>
<b>消息标题：<%=KSCMS.HTMLEncode(rs("title"))%></b><hr size=1>
<%=KSCMS.HTMLEncode(rs("content"))%>
</td>
</tr>
<%
RS.movenext
loop
End If
RS.close:Set rs=Nothing
%>
<%End If%>
<%End If%>
</table>
</form>
<%
DoTitleJs
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -