user_message.asp

网人分类信息5.0商业版。非常优秀的分类信息系统。比较少见。

<!--#include file="Cook.asp" -->
<!--#include file="../API/HiAPI/Class_API.asp"-->
<%
If Int(WR_Mail(17)) < 1 Then Call WRMPS.ErrView("·系统短消息功能尚未开启！", 0)
Dim Action,i,N,WM_Addresser,WM_Addressee,WM_Message,WM_Title,W,WM_Type,WM_Key,messageCount,mUrl,S,messageCount1,messageCount2,cID
Action = WRMPS.CheckStr(Request("Action"),0)
ID = WRMPS.CheckStr(Request("ID"),1)
Page = WRMPS.CheckStr(Request("Page"),1)
W = WRMPS.CheckStr(Request("W"),0)
S = WRMPS.CheckStr(Request("S"),0)
Content = PageTop()
Content = Content & UserPath(",<a href=User_Message.asp>短信中心</a>")

Set Rso = Conn.Execute("Select WM_Message From WM_Member Where WM_ID = "&MemID)
If Not Rso.Eof Then
  messageCount = Rso(0)
Else
  Call WRMPS.ErrView("·未知错误！", 0)
End If
Rso.Close

Function MenuTop(Str)
  MenuTop =  MenuTop & "<div class=MessageMenu><table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""5"" align=center><tr align=center><td width=""70%""><table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""5"" align=center><tr align=center>" & vbCrlf
  MenuTop =  MenuTop & "<td><a href=User_Message.asp><img src=""img/msg_take.gif"" border=0><br>收件箱</a></td>" & vbCrlf
  MenuTop =  MenuTop & "<td><a href=?W=Sender><img src=""img/msg_send.gif"" border=0><br>发件箱</a></td>" & vbCrlf
  MenuTop =  MenuTop & "<td><a href=?Action=Send><img src=""img/msg_write.gif"" border=0><br>撰写</a></td>" & vbCrlf
  If ID = "" Or W = "Sender" Or Str=1 Then MenuTop =  MenuTop & "<td><img src=""img/msg_re_no.gif"" border=0><br>回复</td>" & vbCrlf Else MenuTop =  MenuTop & "<td><a href=?Action=Send&ID="&ID&"&W="&W&"&Page="&Page&"><img src=""img/msg_Re.gif"" border=0><br>回复</a></td>" & vbCrlf
  If ID = "" Or Str=1 Then MenuTop =  MenuTop & "<td><img src=""img/msg_transmit_no.gif"" border=0><br>转发</td>" & vbCrlf Else MenuTop =  MenuTop & "<td><a href=?Action=Send&ID="&ID&"&W="&W&"&S=Transmit&Page="&Page&"><img src=""img/msg_transmit.gif"" border=0><br>转发</a></td>" & vbCrlf
  If ID = "" Or W = "Sender" Or Action <> "View" Or Str=1 Then MenuTop =  MenuTop & "<td><img src=""img/msg_del_no.gif"" border=0><br>删除</td>" & vbCrlf Else  MenuTop =  MenuTop & "<td><a href=?Action=Del&ID="&ID&"&W="&W&"&Page="&Page&" onclick=""return confirm('确定删除？');""><img src=""img/msg_del.gif"" border=0><br>删除</a></td>" & vbCrlf
  MenuTop =  MenuTop & "</tr></table></td><td width=""30%"">"
  MenuTop =  MenuTop & "<div style='float:right;height:18px;text-align:center'>信箱容量："&Split(messageCount,"|")(0)&"/"&Int(UserFlag(13))&" ["&WRMPS.GetFormatpercent(Split(messageCount,"|")(0)/Int(UserFlag(13)))&"]</div><br><div style='float:right;width:150px;border:1px #999999 solid;padding:1px;text-align:left' title="""&Split(messageCount,"|")(0)&"/"&Int(UserFlag(13))&" ["&WRMPS.GetFormatpercent(Split(messageCount,"|")(0)/Int(UserFlag(13)))&"]""><div style='width:"&round(Split(messageCount,"|")(0)/Int(UserFlag(13))*150,0)&"px;background:#FF0000'></div></div>"
  MenuTop =  MenuTop & "</td></tr></table></div>" & vbCrlf
End Function

Select Case Action
  Case "Del"
      cID = WRMPS.CheckStr(Request("cID"),0)
	  cID = Replace(Replace(cID, " ", ""), "&nbsp;", "")
	  If cID = "" Then cID = ID
      If cID = "" Then Call WRMPS.ErrView("·操作错误",0)
	  cID = Split(cID,",")
	  For i = 0 To UBound(cID)
	    Set Rs = Conn.Execute("Select WM_Addressee,WM_Key From WM_Message Where WM_ID = "&Int(cID(i))&" and WM_Addressee = '"&MemName&"'")
	    If Not Rs.Eof Then
		    messageCount1 = Int(Split(messageCount,"|")(0))-1
		    messageCount2 = Int(Split(messageCount,"|")(1))
		    If Rs(1) = 0 Then messageCount2 = messageCount2-1
			If messageCount1 < 0 Then messageCount1 = 0
			If messageCount2 < 0 Then messageCount2 = 0
            messageCount = messageCount1 & "|" & messageCount2
		    Conn.Execute("Update WM_Member Set WM_Message = '"&messageCount&"' Where WM_ID = "&MemID)
	    Else
	      Call WRMPS.ErrView("·操作错误",0)
	    End If
		Rs.CLose
		Conn.Execute("Delete From WM_Message Where WM_ID = "&Int(cID(i)))
	  Next
	  Call WRMPS.ErrView("·消息删除成功<meta http-equiv=refresh content='1;URL=?Page="&Page&"&W="&W&"'>",0)
	
  Case "SendSave"
    WM_Addressee = WRMPS.CheckStr(Request("WM_Addressee"),0)
    WM_title = WRMPS.CheckStr(Request("WM_title"),0)
    WM_Message = WRMPS.CheckStr(Request("WM_Message"),2)
	If WM_Addressee = "" Then Call WRMPS.ErrView("·请填写消息收件人",0)
	If WM_Addressee = MemName Then Call WRMPS.ErrView("·您不能给自己发送消息",0)
	If WM_title = "" Then Call WRMPS.ErrView("·请输入消息标题",0)
	If WM_Message = "" Then Call WRMPS.ErrView("·请输入消息内容",0)
    If Len(WM_title) > 50 Then Call WRMPS.ErrView("·消息标题不能超过50字符",0)
    If Len(WM_Message) > Int(UserFlag(13)) Then Call WRMPS.ErrView("·消息内容不能超过"&Int(UserFlag(13))&"字符",0)
	Set Rs = Conn.Execute("Select WM_ID,WM_Message,WM_Flag From WM_Member Where WM_UserName = '"&WM_Addressee&"'")
	If Rs.Eof Then
	  Call WRMPS.ErrView("·用户不存在<meta http-equiv=refresh content='1;URL=?Action=View&ID="&ID&"&W="&W&"&Page="&Page&"'>",0)
	Else
	  If ID <> "" Then mUrl="?Action=View&ID="&ID&"&W="&W&"&Page="&Page Else mUrl = "?W="&W&"&Page="&Page
	  Dim uFlag
	  uFlag = Rs(2)
	  If Int(Split(Rs(1),"|")(0)) >= Int(Split(Split(uFlag,"§")(4),"|")(3)) Then Call WRMPS.ErrView("·发送不成功，对方的短消息空间已达上限<meta http-equiv=refresh content='1;URL="&mUrl&"'>",0)
      If WRDB.SendMessage(WM_Addressee,MemName,WM_title,WM_Message) Then
	    Call WRDB.SaveConsume(0,MemName,0,Int(FlagMsg(2)),Int(FlagMsg(1)),0,"成功发送短消息")
	    Call WRMPS.ErrView("·消息发送成功<meta http-equiv=refresh content='1;URL="&mUrl&"'>",1)
	  Else 
	    Call WRMPS.ErrView("·消息发送失败，请重新发送<meta http-equiv=refresh content='1;URL="&mUrl&"'>",0)
	  End If
	End If
  
  Case "Send"
    WM_Addresser = WRMPS.CheckStr(Request("Addressee"),0)
	If WM_Addresser = MemName Then Call WRMPS.ErrView("·您不能给自己发送消息<meta http-equiv=refresh content='1;URL=User_Message.asp'>",0)
    If ID <> "" Then
	  Set Rs = Conn.Execute("Select WM_Addressee,WM_Message,WM_Title,WM_Addresser,WM_Type From WM_Message Where WM_ID = "&ID)
	  If Not Rs.Eof Then
		WM_Addressee = Rs(0):WM_Message = Rs(1):WM_Title = Rs(2):WM_Addresser = Rs(3):WM_Type = Rs(4)
	    If WM_Type = 1 Then Call WRMPS.ErrView("·您不能回复或转发系统消息",0)
		If Left(WM_Title,3) = "Fw：" Or Left(WM_Title,3) = "Re：" Then WM_Title = Right(WM_Title,Len(WM_Title)-3)
		If S = "Transmit" Then
		  WM_Addressee = "":WM_Addresser="":WM_Message=WRMPS.CheckStr(WM_Message,3)
		  If WM_Title <> "" and IsNull(WM_Title) = False Then WM_Title = "Fw："&WM_Title
		Else
	      WM_Message = ""
		  If WM_Title <> "" and IsNull(WM_Title) = False Then WM_Title = "Re："&WM_Title
		End If
	  End If
	End If
	Content = Content & MenuTop(WM_Type)
    Content = Content & "<div class=Message><table width='100%' cellpadding=2 cellspacing=1 border=0 align=center>" & vbCrLf
    Content = Content & "<form action='?Action=SendSave&W="&W&"&S="&S&"&Page="&Page&"' name=myform method=POST>" & vbCrLf
    Content = Content & "<input name=ID type=hidden value="&ID&">" & vbCrlf
    Content = Content & "<input name=Page type=hidden value="&Page&">" & vbCrlf
    Content = Content & "  <tr>" & vbCrlf
    Content = Content & "    <td width=""25%"" align=right><font color=red>*</font> 收件人：</td>" & vbCrlf
    Content = Content & "	<td width=""75%""><input name=""WM_Addressee"" type=""text"" size=""30"" value="""&WM_Addresser&"""></td>" & vbCrlf
    Content = Content & "  </tr>" & vbCrlf
    Content = Content & "  <tr>" & vbCrlf
    Content = Content & "    <td align=right><font color=red>*</font> 标　题：</td>" & vbCrlf
    Content = Content & "	<td><input name=""WM_title"" type=""text"" size=""42"" maxlength=""45"" value="""&WRMPS.LeachHTML(WM_Title)&"""></td>" & vbCrlf
    Content = Content & "  </tr>" & vbCrlf
    Content = Content & "  <tr>" & vbCrlf
    Content = Content & "    <td align=right><font color=red>*</font> 内　容：</td>" & vbCrlf
    Content = Content & "	<td><p style=""line-height:180%""><textarea name=""WM_Message"" cols=40 rows=5 onKeyUp=""textLimitCheck(this, "&Int(UserFlag(13))&");"">"&Server.HTMLEncode(WM_Message)&"</textarea></td>" & vbCrlf
    Content = Content & "  </tr>" & vbCrlf
    Content = Content & "  <tr>" & vbCrlf
    Content = Content & "    <td></td>" & vbCrlf
    Content = Content & "	<td><input type=""submit"" name=""Submit"" value="" 发 送 "" onclick=""Loading.style.display=''""></td>" & vbCrlf
    Content = Content & "  </tr>" & vbCrlf
    Content = Content & "</Form></table></div>" & vbCrLf

  Case "View"
	  Set Rs=server.createobject("adodb.recordset")
      Sql = "select WM_ID,WM_Addresser,WM_Addressee,WM_Title,WM_Message,WM_Time,WM_Key,WM_Type from WM_Message where WM_ID="&ID