admin_mail.asp

个人网站比较简短

    Response.Write "          <td width='60'>剩余天数</td>"
    Response.Write "          <td width='60'><a href='" & strFileName & "&MaxPerPage=" & MaxPerPage & "&OrderType=UserExp'>可用积分</a></td>"
    Response.Write "          <td width='120'>最后登录IP<br>最后登录时间</td>"
    Response.Write "          <td width='40'>登录<br>次数</td>"
    Response.Write "          <td width='40'>状态</td>"
    Response.Write "        </tr>"

    If CurrentPage > 1 Then
        sqlUserList = sqlUserList & " and U.UserID < (select min(UserID) from (select top " & ((CurrentPage - 1) * MaxPerPage) & " U.UserID from PE_User U where U.UserID in (" & rsu("UserID") & ")  order by U.UserID desc)) "
    End If
    sqlUserList = sqlUserList & "order by U.UserID desc"
    Set rsUserList = Server.CreateObject("Adodb.RecordSet")
    rsUserList.Open sqlUserList, Conn, 1, 1
    If rsUserList.bof And rsUserList.EOF Then
        Response.Write "<tr><td colspan='20' height='50' align='center'>共找到 <font color=red>0</font> 个会员</td></tr>"
    Else
        If (SearchType = 1 Or SearchType = 2 Or SearchType = 3 Or SearchType = 4) And CurrentPage > 1 Then
            If (CurrentPage - 1) * MaxPerPage < totalPut Then
                rsUserList.Move (CurrentPage - 1) * MaxPerPage
            Else
                CurrentPage = 1
            End If
        End If
        Dim UserNum
        UserNum = 0
        Do While Not rsUserList.EOF
            Response.Write "      <tr class='tdbg' onmouseout=""this.className='tdbg'"" onmouseover=""this.className='tdbgmouseover'"" align=center>"
            Response.Write "        <td><a href='Admin_User.asp?Action=Show&UserID=" & rsUserList("UserID") & "'>" & rsUserList("UserName") & "</a></td>"
            Response.Write "        <td>"
            If PE_Clng(rsUserList("UserType")) > 4 Then
                Response.Write arrUserType(0)
            Else
                Response.Write arrUserType(PE_Clng(rsUserList("UserType")))
            End If
            Response.Write "        </td>"
            Response.Write "        <td>" & rsUserList("GroupName") & "</td>"
            Response.Write "        <td align='right'>" & FormatNumber(PE_CDbl(rsUserList("Balance")), 2, vbTrue, vbFalse, vbTrue) & "</td>"
            Response.Write "        <td>"
            If rsUserList("UserPoint") <= 0 Then
                Response.Write "<font color=red>" & rsUserList("UserPoint") & "</font> " & PointUnit & ""
            Else
                If rsUserList("UserPoint") <= 10 Then
                    Response.Write "<font color=blue>" & rsUserList("UserPoint") & "</font> " & PointUnit & ""
                Else
                    Response.Write rsUserList("UserPoint") & " " & PointUnit & ""
                End If
            End If
            Response.Write "</td>"
            Response.Write "<td>"
            If rsUserList("ValidNum") = -1 Then
                Response.Write "无限期"
            Else
                ValidDays = ChkValidDays(rsUserList("ValidNum"), rsUserList("ValidUnit"), rsUserList("BeginTime"))
                If ValidDays <= 0 Then
                    Response.Write "<font color='red'>" & ValidDays & "</font> 天"
                Else
                    Response.Write ValidDays & " 天"
                End If
            End If
            Response.Write "        </td>"
            Response.Write "        <td>" & PE_Clng(rsUserList("UserExp")) & "分</td>"
            Response.Write "        <td>" & rsUserList("LastLoginIP") & "<br>" & rsUserList("LastLoginTime") & "</td>"
            Response.Write "        <td>"
            If rsUserList("LoginTimes") <> "" Then
                Response.Write rsUserList("LoginTimes")
            Else
                Response.Write "0"
            End If
            Response.Write "        </td>"
            Response.Write "        <td>"
            If rsUserList("IsLocked") = True Then
                Response.Write "<font color=red>已锁定</font>"
            Else
                Response.Write "正常"
            End If
            Response.Write "        </td>"
            Response.Write "      </tr>"

            UserNum = UserNum + 1
            If UserNum >= MaxPerPage Then Exit Do
            rsUserList.MoveNext
        Loop
    End If
    rsUserList.Close
    Set rsUserList = Nothing
    Response.Write "<br>"
    rsu.MoveNext
    rsu.Close
    Set rsu = Nothing
    Response.Write "      </table>"
    Response.Write "      </td>"
    'Response.Write "  </form>"
    Response.Write "  </tr>"
    Response.Write "</table><br>"
    Response.Write " <table width='100%'><tr><td> <a href='Admin_Mail.asp'>>>返回邮件订阅管理</a></td>"
    If totalPut > 0 Then
        Response.Write "<td align=center>"
        Response.Write ShowPage(strFileName, totalPut, MaxPerPage, CurrentPage, True, True, "个会员", True)
        Response.Write "</td>"
    End If
    Response.Write "</tr></table>"
End Sub

Function Content()
    Dim iChannelID, rsChannel
    iChannelID = PE_Clng(Trim(request("iChannelID")))
    If iChannelID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要发送的频道ID</li>"
        Exit Function
    Else
        iChannelID = PE_Clng(iChannelID)
    End If
    Set rsChannel = Conn.Execute("select * from PE_MailChannel M inner join PE_Channel C on M.ChannelID=C.ChannelID where M.ChannelID=" & iChannelID)
    If rsChannel.bof And rsChannel.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>找不到指定的频道！</li>"

        rsChannel.Close
        Set rsChannel = Nothing
        Exit Function
    End If
    If rsChannel("IsUse") = PE_CBool(PE_False) Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>该频道没有开启邮件订阅功能！</li>"
        rsChannel.Close
        Set rsChannel = Nothing
        Exit Function
    End If
    Dim ArrClass
    ArrClass = PE_replace(rsChannel("arrClass"), "|", ",")
	If IsValidID (ArrClass) = False then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>栏目ID有错误，请检查该频道的设置，不同栏目ID之间用|隔开！</li>"
        Exit Function		
	End If 
    Dim sql, rsArticle, strcontent, CountNum
    sql = "select top " & rsChannel("SendNum") & " * from PE_Article where Status=3 and Deleted=" & PE_False & "   and  ChannelID = " & iChannelID
    Dim tempSql
    If IsNull(rsChannel("arrClass")) Or rsChannel("arrClass") = "" Or rsChannel("arrClass") = "0" Then
    Else
        sql = sql & " and ClassID In(" & ArrClass & ")"
    End If
    sql = sql & " order by ArticleID desc "
    Set rsArticle = Server.CreateObject("adodb.recordset")
    rsArticle.Open sql, Conn, 1, 1
    strcontent = strcontent & "<table width='580' height='116' border='0' align='center' cellpadding='0' cellspacing='0' style='border:0px;'>"
    strcontent = strcontent & "  <tr valign=middle>"
    strcontent = strcontent & "    <td align=center style='line-height: 30px; font-size:15pt; color: #ffffff; background-color:#e15e27;'>" & SiteName & "邮件订阅" & "</td>"
    strcontent = strcontent & "  </tr>"
    strcontent = strcontent & "  <tr>"
    strcontent = strcontent & "   <td height='37' style='border-right:1px solid #e15e27; border-left:1px solid #e15e27;'><table width='100%' border='0' cellpadding='6' cellspacing='0' >"
    strcontent = strcontent & "       <tr>"
    strcontent = strcontent & "        <td bgcolor='#ffeacb'><span style='font-size:14px; line-height:160%'>您好,"
    strcontent = strcontent & "         感谢您成功订阅本站:" & SiteName & "<br>您订阅的频道是  <a href=" & SiteUrl & "/" & rsChannel("ChannelDir") & "><b>" & rsChannel("ChannelName") & "</b></a>   下面是您订阅的文章列表</span></td>"
    strcontent = strcontent & "        </tr>"
    strcontent = strcontent & "      <tr>"
    strcontent = strcontent & "        <td><table width='100%'>"
    strcontent = strcontent & " <tr bgcolor='#fgeacb'><td width='10%'><b>序号</b></td><td width='50%'><b>标题</b></td><td width='20%'><b>作者</b></td><td width='20%'><b>更新时间</b></td></tr>"
    CountNum = 1
    Do While Not rsArticle.EOF
        strcontent = strcontent & " <tr><td wdith='10%'>" & CountNum & "</td><td width='50%'><a href=" & SiteUrl & "/" & GetInfoUrl(rsArticle("ArticleID"), "Article", 1) & ">" & rsArticle("Title") & "</td><td width='20%'>" & rsArticle("Inputer") & "</td><td width='20%'>" & rsArticle("UpdateTime") & "</td><tr>"
        CountNum = CountNum + 1
        rsArticle.MoveNext
    Loop
    strcontent = strcontent & "</talbe></td>"
    strcontent = strcontent & "      </tr>  "
    strcontent = strcontent & "        <tr width='100%'>"
    strcontent = strcontent & "          <td width='100%' height='80'  colspan='5'  style='border-top:1px solid #CCCCCC;border-bottom:1px solid #e15e27;'><a href=" & SiteUrl & ">点击访问本站点！</a><br>"
    strcontent = strcontent & "            </td>"
    strcontent = strcontent & "        </tr>"
    strcontent = strcontent & "  </table></td></tr>"
    strcontent = strcontent & "</table>"
    rsArticle.Close
    Set rsArticle = Nothing
    Content = strcontent
End Function

Sub SetChannel()
    Dim iChannelID, rsChannel
    Dim rsChannelList, sqlChannelList
    iChannelID = PE_Clng(Trim(request("iChannelID")))
    sqlChannelList = "select * from PE_MailChannel M inner join PE_Channel C on M.ChannelID=C.ChannelID Where M.ChannelID=" & iChannelID
    Set rsChannelList = Conn.Execute(sqlChannelList)
    If rsChannelList.bof And rsChannelList.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>找不到指定频道！</li>"
        rsChannelList.Close
        Set rsChannelList = Nothing
        Exit Sub
    End If
    Response.Write "  <form name='myform' method='post'  action='Admin_Mail.asp?Action=SaveSet'>"
    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 align='center'><strong>是否启用订阅功能</strong></td>"
    Response.Write "    <td align='center'><strong>发送文章数</strong></td>"
    Response.Write "    <td align='center'><strong>加入邮件订阅的栏目</strong></td>"
    Response.Write "  </tr>" & vbCrLf
    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'><INPUT name=IsUse type=CheckBox "
    If rsChannelList("Isuse") = PE_CBool(PE_True) Then Response.Write "Checked"
    Response.Write ">需要启用请打勾</td>"
    Response.Write "    <td align='center'><INPUT name=SetNum type=Text maxlength='3' size='12' value='" & rsChannelList("SendNum") & "' ></td>"
    Response.Write "    <td align='center'><INPUT name=arrClass type=Text maxlength='200' size='30' value='" & rsChannelList("ArrClass") & "' ></td>"

    Response.Write "</tr>"

    Response.Write "</table>"
    Response.Write "<p align='center'><input name='Submit'  type='submit' id='Action' value='保存设置'><input name='iChannelID' type='hidden' id='iChannelID' value='" & iChannelID & " '> </p>"
    Response.Write "</form>"
    rsChannelList.Close
    Set rsChannelList = Nothing
End Sub

Sub SaveSet()
    Dim iChannelID, rsChannel, IsUse, SetNum, ArrClass
    iChannelID = PE_Clng(Trim(request("iChannelID")))
    IsUse = Trim(request("IsUse"))
    If IsUse <> "" Then
        IsUse = PE_True
    Else
        IsUse = PE_False
    End If
    SetNum = PE_Clng(Trim(request("SetNum")))
    ArrClass = ReplaceBadChar(Trim(request("ArrClass")))
    Dim sqlSave, rsSave
    sqlSave = "select * from PE_MailChannel where ChannelID=" & iChannelID
    Set rsSave = Server.CreateObject("Adodb.RecordSet")
    rsSave.Open sqlSave, Conn, 1, 3
    If rsSave.bof And rsSave.EOF Then
        Response.Write "请指定频道ID"
        Exit Sub
        rsSave.Close
        Set rsSave = Nothing
    End If
    rsSave("arrClass") = ArrClass
    rsSave("SendNum") = SetNum
    rsSave("IsUse") = IsUse
    rsSave.Update
    rsSave.Close
    Set rsSave = Nothing
    Call WriteSuccessMsg("保存设置成功", "Admin_Mail.asp")
End Sub
%>