user_message_code.asp

个人网站比较简短

<!--#include file="CommonCode.asp"-->
<!--#include file="../Include/PowerEasy.Common.Manage.asp"-->

<%
'**************************************************************
' Software name: PowerEasy SiteWeaver
' Web: http://www.powereasy.net
' Copyright (C) 2005－2008 佛山市动易网络科技有限公司 版权所有
'**************************************************************

Const MaxMessageNum = 100           '用户最多接收短消息条数，超过的系统会自动删除
Const MaxTitleLength = 50           '短消息主题最大长度
Const MaxContentLength = 1000       '短消息内容最大长度

Dim rs, sql, Passed
Dim MessageID, ManageType, BoxName, ActionName, MessageCount

Sub Execute()
    MessageID = Trim(Request("MessageID"))
    ManageType = Trim(Request("ManageType"))
    Passed = Trim(Request("Passed"))
    If Passed = "" Then
        Passed = Session("Passed")
    End If
    If Passed = "" Then
        Passed = "All"
    End If
    Session("Passed") = Passed


    Select Case ManageType
    Case "Inbox"
        BoxName = "收件箱"
    Case "Outbox"
        BoxName = "草稿箱"
    Case "IsSend"
        BoxName = "已发送"
    Case "Recycle"
        BoxName = "废件箱"
    Case Else
        BoxName = "收件箱"
        ManageType = "Inbox"
    End Select

    If Action = "" Then Action = "Manage"

    FileName = "User_Message.asp?Action=" & Action & "&ManageType=" & ManageType
    strFileName = FileName & "&Field=" & strField & "&keyword=" & Keyword

    Call DelOutMessage
    Select Case Action
    Case "New", "Edit", "Re", "Fw"
        ActionName = "写短信"
        Call SendMessage
    Case "SendMessage", "SaveMessage"
        ActionName = "发送短信"
        Call SaveMessage
    Case "SendEdit", "SaveEdit"
        ActionName = "保存短信内容"
        Call SaveEdit
    Case "ReadInbox", "ReadOther"
        ActionName = "阅读短消息"
        Call Read
    Case "Del", "Delete"
        ActionName = "删除短信"
        Call Del
    Case "Clear"
        ActionName = "清空收件箱"
        Call Clear
    Case "Manage"
        Call main
    End Select
    If FoundErr = True Then
        Call WriteErrMsg(ErrMsg, ComeUrl)
    End If
End Sub

Sub main()
    Call ShowJS_Main("短消息")
    Response.Write "<br><table width='100%' border='0' align='center' cellpadding='0' cellspacing='0'>"
    Response.Write "  <tr>"
    Response.Write "    <td height='22'>" & GetPath() & "</td>"
    Response.Write "    <td width='100'>" & GetSpace() & "</td>"
    Response.Write "  </tr>"
    Response.Write "</table>"
    Response.Write "<table width='100%' border='0' cellpadding='0' cellspacing='0'><tr>"
    Response.Write "    <form name='myform' method='Post' action='User_Message.asp' onsubmit='return ConfirmDel();'>"
    Response.Write "     <td><table class='border' border='0' cellspacing='1' width='100%' cellpadding='0'>"
    Response.Write "          <tr class='title' height='22'> "
    Response.Write "            <td height='22' width='30' align='center'><strong>选中</strong></td>"
    'Response.write "            <td width='25' align='center'><strong>ID</strong></td>"
    If ManageType = "Inbox" Or ManageType = "Recycle" Then
        Response.Write "            <td width='120' align='center' ><strong>发件人</strong></td>"
    Else
        Response.Write "            <td width='120' align='center' ><strong>收件人</strong></td>"
    End If
    Response.Write "            <td align='center' ><strong>短消息主题</strong></td>"
    Response.Write "            <td width='140' align='center' ><strong>日期</strong></td>"
    Response.Write "            <td width='80' align='center' ><strong>大小</strong></td>"
    Response.Write "            <td width='40' align='center' ><strong>已读</strong></td>"
    Response.Write "            <td width='80' align='center' ><strong>操作</strong></td>"
    Response.Write "          </tr>"

    sql = "Select * From PE_Message"
    Select Case ManageType
    Case "Inbox"
        sql = sql & " where IsSend = 1 and DelR = 0 and Incept = '" & UserName & "'"
    Case "Outbox"
        sql = sql & " where Sender = '" & UserName & "' and IsSend = 0 and delS = 0"
    Case "IsSend"
        sql = sql & " where Sender = '" & UserName & "' and IsSend = 1 and delS = 0"
    Case "Recycle"
        sql = sql & " where ((Sender = '" & UserName & "' and delS = 1) or (Incept = '" & UserName & "' and DelR = 1))"
    Case Else
        sql = sql & " where IsSend = 1 and DelR = 0 and Incept = '" & UserName & "'"
    End Select
    If Keyword <> "" Then
        Select Case strField
        Case "Title"
            sql = sql & " and Title like '%" & Keyword & "%' "
        Case "Content"
            sql = sql & " and Content like '%" & Keyword & "%' "
        Case Else
            sql = sql & " and Title like '%" & Keyword & "%' "
        End Select
    End If
    If Passed = "True" And ManageType = "Inbox" And Action = "Manage" Then
        sql = sql & " and flag =" & PE_True & ""
    ElseIf Passed = "False" And ManageType = "Inbox" And Action = "Manage" Then
        sql = sql & " and flag =" & PE_False & ""
    End If
    Select Case ManageType
    Case "Inbox"
        sql = sql & " order by Flag,ID desc"
    Case "Outbox", "IsSend", "Recycle"
        sql = sql & " order by ID desc"
    Case Else
        sql = sql & " order by Flag,ID desc"
    End Select

    Dim rsMessage
    Set rsMessage = Server.CreateObject("ADODB.Recordset")
    rsMessage.Open sql, Conn, 1, 1
    If rsMessage.BOF And rsMessage.EOF Then
        totalPut = 0
        Response.Write "<tr class='tdbg'><td colspan='20' align='center'><br>没有任何短消息！<br><br></td></tr>"
    Else
        totalPut = rsMessage.RecordCount
        If CurrentPage < 1 Then
            CurrentPage = 1
        End If
        If (CurrentPage - 1) * MaxPerPage > totalPut Then
            If (totalPut Mod MaxPerPage) = 0 Then
                CurrentPage = totalPut \ MaxPerPage
            Else
                CurrentPage = totalPut \ MaxPerPage + 1
            End If
        End If
        If CurrentPage > 1 Then
            If (CurrentPage - 1) * MaxPerPage < totalPut Then
                rsMessage.Move (CurrentPage - 1) * MaxPerPage
            Else
                CurrentPage = 1
            End If
        End If

        Dim MessageNum
        MessageNum = 0
        Do While Not rsMessage.EOF
            Response.Write "      <tr class='tdbg' onmouseout=""this.className='tdbg'"" onmouseover=""this.className='tdbgmouseover'"">"
            Response.Write "        <td width='30' align='center'><input name='MessageID' type='checkbox' onclick='unselectall()' id='MessageID' value='" & rsMessage("ID") & "'></td>"
            'Response.write "        <td width='25' align='center'>" & rsMessage("ID") & "</td>"
            If ManageType = "Inbox" Or ManageType = "Recycle" Then
                Response.Write "        <td width='120' align='center' >" & rsMessage("Sender") & "</td>"
            Else
                Response.Write "        <td width='120' align='center' >" & rsMessage("Incept") & "</td>"
            End If
            Response.Write "        <td>"
            Select Case ManageType
            Case "Inbox"
                Response.Write "<a href='User_Message.asp?Action=ReadInbox&MessageID=" & rsMessage("ID") & "'>"
            Case "Outbox"
                Response.Write "<a href='User_Message.asp?Action=Edit&MessageID=" & rsMessage("ID") & "'>"
            Case Else
                Response.Write "<a href='User_Message.asp?Action=ReadOther&MessageID=" & rsMessage("ID") & "'>"
            End Select
            If rsMessage("Flag") = 1 Then
                Response.Write PE_HTMLEncode(rsMessage("Title"))
            Else
                Response.Write "<font color=blue>" & PE_HTMLEncode(rsMessage("Title")) & "</font>"
            End If
            Response.Write "</a></td>"
            Response.Write "      <td width='140' align='center'>" & rsMessage("SendTime") & "</td>"
            Response.Write "      <td width='80' align='center'>" & Len(rsMessage("Content")) & "Byte</td>"
            Response.Write "    <td width='40' align='center'>"
            If rsMessage("Flag") = 1 Then
                Response.Write "<font color=green><b>√</b></font>"
            Else
                Response.Write "<font color=red><b>×</b></font>"
            End If
            Response.Write "    </td>"
            Response.Write "    <td width='80' align='center'>"
            If ManageType = "Recycle" Then
                Response.Write "<a href='User_Message.asp?Action=Del&ManageType=" & ManageType & "&MessageID=" & rsMessage("ID") & "' onclick=""return confirm('确定要删除此短消息吗？删除的消息将不可恢复。');"">删除</a>"
            Else
                Response.Write "<a href='User_Message.asp?Action=Del&ManageType=" & ManageType & "&MessageID=" & rsMessage("ID") & "' onclick=""return confirm('确定要删除此短消息吗？');"">删除</a>"
            End If
            Response.Write "</td>"
            Response.Write "</tr>"

            MessageNum = MessageNum + 1
            If MessageNum >= MaxPerPage Then Exit Do
            rsMessage.MoveNext
        Loop
    End If
    rsMessage.Close
    Set rsMessage = Nothing
    Response.Write "</table>"
    Response.Write "<table width='100%' border='0' cellpadding='0' cellspacing='0'>"
    Response.Write "  <tr>"
    Response.Write "    <td width='200' height='30'><input name='chkAll' type='checkbox' id='chkAll' onclick='CheckAll(this.form)' value='checkbox'>选中本页显示的所有短消息</td><td>"
    Response.Write "<input name='submit1' type='submit' value='删除选定的短消息' onClick=""document.myform.Action.value='Del'"" >"
    Response.Write "&nbsp;&nbsp;<input name='submit1' type='submit' value='清空" & BoxName & "' onClick=""document.myform.Action.value='Clear'"" >"
    Response.Write "<input name='Action' type='hidden' id='Action' value=''>"
    Response.Write "<input name='ManageType' type='hidden' id='ManageType' value='" & ManageType & "'>"
    Response.Write "  </td></tr>"
    Response.Write "</table>"
    Response.Write "</td>"
    Response.Write "</form></tr></table>"
    
    Response.Write ShowPage(strFileName, totalPut, MaxPerPage, CurrentPage, True, True, "条短消息", True)

    Response.Write "<br>"
    Response.Write "<table width='100%' border='0' cellpadding='0' cellspacing='0' class='border'>"
    Response.Write "  <tr class='tdbg'>"
    Response.Write "   <td width='80' align='right'><strong>短消息搜索：</strong></td>"
    Response.Write "   <td>" & GetSearchForm() & "</td>"
    Response.Write "  </tr>"
    Response.Write "</table>"
End Sub


Sub SendMessage()
    If MaxSendNum <= 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>对不起，你没有发送短消息的权限！"
        Exit Sub
    End If
    If MessageID <> "" And IsValidID(MessageID) = False Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>指定的短消息ID错误！</li>"
        Exit Sub
    End If
    Response.Cookies("SendMessage") = "No"

    Dim inceptUser, Sender, SendTime, Title, Content, i
    Dim chatloglist
    MessageID = PE_CLng(MessageID)
    inceptUser = Request("inceptUser")
    Select Case Action
    Case "Edit"
        sql = "Select * from PE_Message where Sender='" & UserName & "' and IsSend=0 and ID=" & MessageID
    Case "Re"
        sql = "SELECT * from PE_Message where Incept='" & UserName & "' and ID=" & MessageID
    Case "Fw"
        sql = "SELECT * from PE_Message where (Incept='" & UserName & "' or Sender='" & UserName & "') and ID=" & MessageID
    End Select

    If MessageID <> "" And IsNumeric(MessageID) And sql <> "" Then
        Set rs = Conn.Execute(sql)
        If Not (rs.BOF And rs.EOF) Then
            Sender = rs("Sender")
            SendTime = rs("SendTime")
            Select Case Action
            Case "Re"
                inceptUser = rs("Sender")
                Title = "Re: " & rs("Title")
                Content = Content & "======在 " & SendTime & " 您来信中写道：======" & "<br>"
                Content = Content & rs("Content") & "<br>"
                Content = Content & "================================================" & "<br>"
            Case "Fw"
                Title = "Fw: " & rs("Title")
                Content = Content & "============== 下面是转发信息 ==============" & "<br>"
                Content = Content & "原发件人：" & Sender & " " & "<br>"
                Content = Content & "原发件内容：" & "<br>"
                Content = Content & rs("Content") & "<br>"
                Content = Content & "============================================" & "<br>"
            Case "Edit"
                inceptUser = rs("Incept")
                Title = rs("Title")
                Content = rs("Content")
            End Select
            Content = Server.HTMLEncode(Content)
        Else
            FoundErr = True
            ErrMsg = ErrMsg & "<li>参数错误！</li>"
            Set rs = Nothing
            Exit Sub
        End If
        Set rs = Nothing
    End If