📄 admin_mail.asp

📁 个人网站比较简短
💻 ASP
📖 第 1 页 / 共 2 页
字号:
12 下一页
<!--#include file="Admin_Common.asp"-->
<!--#include file="../Include/PowerEasy.SendMail.asp"-->
<!--#include file="../Include/PowerEasy.Common.Front.asp"-->
<%
Const NeedCheckComeUrl = True  '是否需要检查外部访问
Const PurviewLevel = 2      '0--不检查，1--超级管理员，2--普通管理员
Const PurviewLevel_Channel = 0   '0--不检查，1--频道管理员，2--栏目总编，3--栏目管理员
Response.Write "<html><head><title>邮件订阅管理</title>" & vbCrLf
Response.Write "<meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbCrLf
Response.Write "<link href='Admin_Style.css' rel='stylesheet' type='text/css'>" & vbCrLf
Response.Write "</head>" & vbCrLf
Response.Write "<body leftmargin='2' topmargin='0' marginwidth='0' marginheight='0'>" & vbCrLf
Response.Write "<table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' class='border'>" & vbCrLf
Response.Write "  <tr class='topbg'>" & vbCrLf
Response.Write "    <td height='22' colspan='2' align='center'><strong>邮 件 订 阅 管 理</strong>"
Response.Write "    </td>" & vbCrLf
Response.Write "  </tr>" & vbCrLf
Response.Write "</table>" & vbCrLf
Action = Trim(request("Action"))
Select Case Action
Case "Send"
    Call SendMaillist
Case "Preview"
    Call PreviewMail
Case "user"
    Call UserList
Case "SetChannel"
    Call SetChannel
Case "SaveSet"
    Call SaveSet
Case Else
    Call main
End Select

If FoundErr = True Then
    Call WriteErrMsg(ErrMsg, ComeUrl)
End If
Response.Write "</body></html>"
Call CloseConn

Sub main()
    Dim rsChannelList, sqlChannelList
    sqlChannelList = "select M.ChannelID,M.IsUse, C.ChannelName,M.UserID from PE_MailChannel M left join PE_Channel C On  C.ChannelID = M.ChannelID  order by OrderID"
    Set rsChannelList = Conn.Execute(sqlChannelList)
    Response.Write "  <form name='myform' method='post' onSubmit='return CheckForm();' action=''>"
    Response.Write "<table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' class='border'>"
    Response.Write "  <tr class='title' height='22'>"
    Response.Write "    <td align='center'><strong>频道名称</strong></td>"
    Response.Write "    <td width='100' align='center'><strong>订阅数量</strong></td>"
    Response.Write "    <td width='100' align='center'><strong>是否启用</strong></td>"
    Response.Write "    <td align='center'><strong>操作</strong></td>"
    Response.Write "  </tr>" & vbCrLf
    Do While Not rsChannelList.EOF
        Response.Write "  <tr class='tdbg' onmouseout=""this.className='tdbg'"" onmouseover=""this.className='tdbgmouseover'"">"
        Response.Write "    <td align='center'>" & rsChannelList("ChannelName") & "</td>"
        Response.Write "    <td align='center'>"
        Dim MailNum, arrMailNum
        If rsChannelList("UserID") = "" Or IsNull(rsChannelList("UserID")) Then
            MailNum = 0
        Else
            arrMailNum = Split(rsChannelList("UserID"), ",")
            MailNum = UBound(arrMailNum) + 1
        End If
        Response.Write "   " & MailNum & " </td>"
        Response.Write "    <td align='center'>"
        If rsChannelList("IsUse") = PE_CBool(PE_True) Then Response.Write "√"
        Response.Write "    </td>"
        Response.Write "    <td align='center'>"
        Response.Write "    <a href='Admin_Mail.asp?Action=user&iChannelID=" & rsChannelList("ChannelID") & "'>列出订阅者</a>"
        Response.Write "    &nbsp;|&nbsp;"
        Response.Write "    <a href='Admin_Mail.asp?Action=Preview&iChannelID=" & rsChannelList("ChannelID") & "'>邮件发送预览</a>"
        Response.Write "    &nbsp;|&nbsp;"
        Response.Write "   <a href='Admin_Mail.asp?Action=Send&iChannelID=" & rsChannelList("ChannelID") & "'> 发送订阅邮件</a>"
        Response.Write "    &nbsp;|&nbsp;"
        Response.Write "   <a href='Admin_Mail.asp?Action=SetChannel&iChannelID=" & rsChannelList("ChannelID") & "'> 频道设置</a>"
        Response.Write "    </td>"
        Response.Write "</tr>"
        rsChannelList.MoveNext
    Loop
    Response.Write "</table>"
    rsChannelList.Close
    Set rsChannelList = Nothing
End Sub

Sub SendMaillist()
    Dim iChannelID, rsChannel
    iChannelID = PE_Clng(Trim(request("iChannelID")))
    If iChannelID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要发送的频道ID</li>"
        Exit Sub
    Else
        iChannelID = PE_Clng(iChannelID)
    End If
    Set rsChannel = Conn.Execute("select * from PE_Channel where ChannelID=" & iChannelID)
    If rsChannel.bof And rsChannel.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>找不到指定的频道！</li>"
        rsChannel.Close
        Set rsChannel = Nothing
        Exit Sub
    End If
    Dim i, j, k, rs
    i = 0
    j = 0
    k = 0
    Dim usql, rsu, UserName, umail
    usql = "select * from PE_MailChannel where ChannelID =" & iChannelID
    Set rsu = Server.CreateObject("adodb.recordset")
    rsu.Open usql, Conn, 1, 3
    If rsu.bof And rsu.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>该频道还没有订阅者</li>"
        rsu.Close
        Set rsu = Nothing
    Else
        UserID = rsu("UserID")
        Dim PE_Mail
        Set PE_Mail = New SendMail
        If UserID = "" Or IsNull(UserID) Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>发送列表为空</li>"
        Else
            Response.Write "<li>正在发送中，请等待</li>"
            Dim ArrUserID, intTemp, sqlMail, rsMail

            ArrUserID = Split(UserID, ",")
            For intTemp = 0 To UBound(ArrUserID)
                sqlMail = "select * from PE_User where [UserID] =" &  PE_Clng(ArrUserID(intTemp))
                Set rsMail = Server.CreateObject("adodb.recordset")
                rsMail.Open sqlMail, Conn, 1, 1
                If rsMail.bof And rsMail.EOF Then
                    Dim arrUser, UserNum, tempUserID

                    arrUser = ""
                    tempUserID = Split(UserID, ",")
                    UserNum = 0
                    If UserNum <> UBound(tempUserID) Then
                        If arrUser = "" Then
                            arrUser = UserID
                        Else
                            If tempUsertempID(0) <> TempArr(intTemp) Then
                                tempUser = arrUser & "," & ArrUserID(0)
                            End If
                        End If
                        UserNum = UserNum + 1
                    End If
                    rsu("UserID") = arrUser
                    rsu.Update
                Else
                    umail = Trim(rsMail("Email"))
                    If IsValidEmail(umail) = True Then
                        ErrMsg = PE_Mail.Send(umail, rsMail("UserName"), "邮件订阅", " " & Content & " ", SiteName, WebmasterEmail, 3)
                        If ErrMsg = "" Then
                            i = i + 1
                            Response.Write "<li>成功向用户" & rsMail("UserName") & "（" & umail & "）发送邮件！</li>"
                        Else
                            j = j + 1
                            Response.Write "<li><font color='red'>向用户" & rsMail("UserName") & "（" & umail & "）发送邮件失败！</font></li>"
                        End If
                        Response.Flush
                    Else
                        k = k + 1
                    End If
                    rsMail.Close
                    Set rsMail = Nothing
                End If
            Next
            Response.Write "<li>本次成功发送邮件：" & i & "封</li>"
            If j > 0 Then Response.Write "<li>发送邮件失败：" & j & "封<li>"
            If k > 0 Then Response.Write "<li>未发送邮件：" & j & "封（邮件地址错误）<li>"
            Response.Write "<br><br><a href='Admin_Mail.asp'><<  返回邮件订阅管理</a>"
            Set PE_Mail = Nothing
            rsu.Close
            Set rsu = Nothing
        End If
    End If
End Sub

Sub PreviewMail()
    Response.Write "" & Content & " "
End Sub

Sub UserList()
    Dim iChannelID, rsChannel
    iChannelID = PE_Clng(Trim(request("iChannelID")))
    strFileName = "Admin_Mail.asp?action=user&iChannelID=" & iChannelID
    If iChannelID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要发送的频道ID</li>"
        Exit Sub
    Else
        iChannelID = PE_Clng(iChannelID)
    End If
    Set rsChannel = Conn.Execute("select * from PE_Channel where ChannelID=" & iChannelID)
    If rsChannel.bof And rsChannel.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>找不到指定的频道！</li>"
        rsChannel.Close
        Set rsChannel = Nothing
        Exit Sub
    End If
    Dim usql, rsu
    usql = "select * from PE_MailChannel  where ChannelID =" & iChannelID
    Set rsu = Server.CreateObject("adodb.recordset")
    rsu.Open usql, Conn, 1, 1
    If rsu.bof And rsu.EOF Then
        Call WriteErrMsg("<li>该频道还没有订阅者！</li>", "Admin_Mail.asp")
        rsu.Close
        Set rsu = Nothing
        Exit Sub
    End If
    totalPut = UBound(Split(rsu("UserID"), ",")) + 1
    If (SearchType = 1 Or SearchType = 2) And totalPut > 100 Then
        totalPut = 100
    End If
    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
    Dim rsUserList, sqlUserList
    If rsu("UserID") = "" Or IsNull(rsu("UserID")) Then
        Call WriteErrMsg("<li>该频道还没有订阅者！</li>", "Admin_Mail.asp")
        rsu.Close
        Set rsu = Nothing
        Exit Sub
    Else
        sqlUserList = "Select top " & MaxPerPage & " * From PE_User U inner join PE_UserGroup G on U.GroupID=G.GroupID where U.UserID in (" & rsu("UserID") & ") "
    End If
    Response.Write "<table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' class='border'><tr class='title' height='22' align='center'><td>订阅了 " & rsChannel("ChannelName") & " 频道的会员列表</td></tr></table>"

    Response.Write "<table width='100%'    border='0' cellpadding='0' cellspacing='0'>"
    Response.Write "  <tr>"
    ' Response.Write "  <form name='myform' method='Post' action='Admin_User.asp'>"
    Response.Write "      <td >"
    Response.Write "      <table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' class='border'>"
    Response.Write "        <tr class='title' height='22' align='center'>"
    Response.Write "          <td width='70'> 用户名</td>"
    Response.Write "          <td>会员类型</td>"
    Response.Write "          <td>所属会员组</td>"
    Response.Write "          <td width='60'><a href='" & strFileName & "&MaxPerPage=" & MaxPerPage & "&OrderType=Balance'>资金余额<a></td>"
    Response.Write "          <td width='60'><a href='" & strFileName & "&MaxPerPage=" & MaxPerPage & "&OrderType=Point'>可用" & PointName & "数</a></td>"
12 下一页
💿 文件大小 7095 K
👤 上传用户 foreverlovely
📂 所属分类家庭/个人应用
🏷️ 相关标签

#网站 #比较
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -