www.gusucode.com > 艺术签名文章资讯网源代码 > 艺术签名文章资讯网源代码/624/adminhtry/admin_mailist.asp
<!--#include file="setup.asp" --> <!--#include file="check.asp"--> <!--#include file="../inc/chkinput.asp"--> <!--#include file="../inc/email.asp" --> <!--#include file="../inc/cls_editor.asp"--> <% Server.ScriptTimeout = 99999 Admin_header '===================================================================== ' 软件名称:新云网站管理系统 ' 当前版本:NewAsp Site Management System Version 3.0 ' 文件名称:admin_mailist.asp ' 更新日期:2006-12-20 ' 官方网站:新云网络(www.newasp.net www.newasp.cn) QQ:94022511 '===================================================================== ' Copyright 2003-2007 newasp.net - All Rights Reserved. ' newasp is a trademark of newasp.net '===================================================================== Dim useremail, topic, mailbody, alluser, i,Action i = 1 Action = LCase(Request("action")) If Not ChkAdmin("MainList") Then Server.Transfer("showerr.asp") Response.End End If Set Rs = server.CreateObject ("adodb.recordset") If Action = "send" Then Call send_mail() ElseIf Request("action") = "sends" Then Call Send_Email() ElseIf Request("action") = "mail" Then Call semail() Else Call mail() End If If FoundErr = True Then ReturnError(ErrMsg) End If Admin_footer SaveLogInfo(AdminName) CloseConn Sub mail() Response.Write "<script src=""include/checkmail.js"" type=""text/javascript""></script>" & vbNewLine Response.Write "<form name=""myform"" action=""admin_mailist.asp?action=send"" method=""post"" onsubmit=""return checkPost()"">"& vbCrLf Response.Write "<table cellpadding=""2"" cellspacing=""1"" border=""0"" width=""95%"" class=""tableBorder"" align=center>"& vbCrLf Response.Write " <tr>"& vbCrLf Response.Write " <th colspan=""2"">系统邮件列表"& vbCrLf Response.Write " </th>"& vbCrLf Response.Write " </tr>"& vbCrLf Response.Write " <tr>"& vbCrLf Response.Write " <td width=""15%"" class=TableRow1>注意事项:</td>"& vbCrLf Response.Write " <td class=TableRow1>在完整填写以下表单后点击发送,信息将发送到所有注册时完整填写了信箱的用户,邮件列表的使用将消耗大量的服务器资源,请慎重使用。</td>"& vbCrLf Response.Write " </tr>"& vbCrLf Response.Write " <tr>"& vbCrLf Response.Write " <td class=TableRow1>邮件用户:</td>"& vbCrLf Response.Write " <td class=TableRow1><select name=Grade size=1>"& vbCrLf Set Rs = Newasp.Execute("select * from NC_UserGroup order by groupid") Rs.movenext Do While Not Rs.EOF Response.Write " <option value='" & Rs("Grades") & "'>" & Rs("GroupName") & "</option>" Rs.movenext Loop Rs.Close Set Rs = Nothing Response.Write " <option value=''>所有用户</option>" Response.Write " </select>"& vbCrLf Response.Write " </td>"& vbCrLf Response.Write " </tr>"& vbCrLf Response.Write " <tr><input type=""hidden"" name=""useremail"" value=""mail@domain.com"">"& vbCrLf Response.Write " <td class=TableRow1>邮件标题:</td>"& vbCrLf Response.Write " <td class=TableRow1><input type=text name=topic size=60></td>"& vbCrLf Response.Write " </tr>"& vbCrLf Response.Write " <tr>"& vbCrLf Response.Write " <td class=TableRow1>邮件内容:</td>"& vbCrLf Response.Write " <td class=TableRow1>"& vbCrLf Dim oEditor Set oEditor = New Editor_Cls oEditor.UserMode = 0 oEditor.setEditMode = 0 oEditor.ChannelID = 0 oEditor.Width = 590 oEditor.Height = 350 oEditor.BasePath = "../editor/" oEditor.ToolbarSet = "AdminMode"'Default,AdminMode,Simple,UserMode,Basic oEditor.InstanceName = "content" oEditor.Execute() Set oEditor = Nothing Response.Write "</td> </tr>"& vbCrLf Response.Write " <tr> <td class=TableRow1></td>"& vbCrLf Response.Write " <td height=20 class=TableRow1>"& vbCrLf Response.Write " <input type=""reset"" name=""Clear"" value=""清 除"" class=""button""> <input type=""submit"" value=""发送邮件"" name=""Submit1"" class=""button"">"& vbCrLf Response.Write " </td>"& vbCrLf Response.Write " </tr>"& vbCrLf Response.Write " </table>"& vbCrLf Response.Write "</form>"& vbCrLf End Sub Sub send_mail() If Request.Form("topic") = "" Then Errmsg = Errmsg + "<br>" + "<li>请输入邮件标题。" founderr = true Else topic = Request.Form("topic") End If If Request.Form("content") = "" Then Errmsg = Errmsg + "<br>" + "<li>请输入邮件内容。" founderr = true Else mailbody = Request.Form("content") End If If founderr = false Then On Error Resume Next If Len(Request.Form("Grade")) = 0 Then SQL = "select username,usermail from [NC_user]" Else SQL = "select username,usermail from [NC_user] where Grade = " & Request.Form("Grade") End If Rs.Open sql, conn, 1, 1 If Not Rs.EOF And Not Rs.bof Then alluser = Rs.recordcount Do While Not Rs.EOF If Rs("usermail")<>"" Then useremail = Rs("usermail") If Newasp.SendMailType = 0 Then errmsg = errmsg + "<br>" + "<li>本系统不支持发送邮件。" ReturnError(Errmsg) Exit Sub ElseIf Newasp.SendMailType = 1 Then Call jmail(useremail, topic, mailbody) ElseIf Newasp.SendMailType = 2 Then Call Cdonts(useremail, topic, mailbody) ElseIf Newasp.SendMailType = 3 Then Call aspemail(useremail, topic, mailbody) End If i = i + 1 End If Rs.movenext Loop If SendMail = "OK" Then Succeed("<li>成功发送"&i&"封邮件。") Else errmsg = errmsg + "<li>由于系统错误,邮件发送不成功。" ReturnError(Errmsg) End If End If Rs.Close Set Rs = Nothing End If End Sub Sub Send_Email() If Request("topic") = "" Then Errmsg = Errmsg + "<br>" + "<li>请输入邮件标题。" founderr = true Else topic = Request("topic") End If If Request("content") = "" Then Errmsg = Errmsg + "<br>" + "<li>请输入邮件内容。" founderr = true Else mailbody = Request("content") End If If Request("useremail") = "" Then Errmsg = Errmsg + "<br>" + "<li>请输入邮件地址。" founderr = true ElseIf IsValidEmail(Request("useremail")) = False Then Errmsg = Errmsg + "<br>" + "<li>你输入的Email有误,请重新输入。" founderr = true Else useremail = Request("useremail") End If If founderr = false Then If Newasp.SendMailType = 0 Then errmsg = errmsg + "<br>" + "<li>本系统不支持发送邮件。" ReturnError(Errmsg) Exit Sub ElseIf Newasp.SendMailType = 1 Then Call jmail(useremail, topic, mailbody) ElseIf Newasp.SendMailType = 2 Then Call Cdonts(useremail, topic, mailbody) ElseIf Newasp.SendMailType = 3 Then Call aspemail(useremail, topic, mailbody) End If If SendMail = "OK" Then Succeed("<li>你给 "&useremail&" 邮件成功发送。<li>主题:"&topic&"") Else errmsg = errmsg + "<li>由于系统错误,邮件发送不成功。" ReturnError(Errmsg) End If End If End Sub Sub semail() Response.Write "<script src=""include/checkmail.js"" type=""text/javascript""></script>" & vbNewLine Response.Write "<form name=""myform"" action=""admin_mailist.asp?action=sends"" method=""post"" onsubmit=""return checkPost()"">"& vbCrLf Response.Write "<table cellpadding=""2"" cellspacing=""1"" border=""0"" width=""95%"" class=""tableBorder"" align=center>"& vbCrLf Response.Write " <tr>"& vbCrLf Response.Write " <th colspan=""2"">系统邮件列表"& vbCrLf Response.Write " </th>"& vbCrLf Response.Write " </tr>"& vbCrLf Response.Write " <tr>"& vbCrLf Response.Write " <td width=""15%"" class=TableRow1>电子邮件:</td>"& vbCrLf Response.Write " <td class=TableRow1><input type=text name=useremail value="""& vbCrLf Response.Write Request("useremail") Response.Write """ size=40></td>"& vbCrLf Response.Write " </tr>"& vbCrLf Response.Write " <tr>"& vbCrLf Response.Write " <td class=TableRow1>邮件标题:</td>"& vbCrLf Response.Write " <td class=TableRow1><input type=text name=topic size=60></td>"& vbCrLf Response.Write " </tr>"& vbCrLf Response.Write " <tr>"& vbCrLf Response.Write " <td class=TableRow1>邮件内容:</td>"& vbCrLf Response.Write " <td class=TableRow1>" Dim oEditor Set oEditor = New Editor_Cls oEditor.UserMode = 0 oEditor.setEditMode = 0 oEditor.ChannelID = 0 oEditor.Width = 590 oEditor.Height = 350 oEditor.BasePath = "../editor/" oEditor.ToolbarSet = "AdminMode"'Default,AdminMode,Simple,UserMode,Basic oEditor.InstanceName = "content" oEditor.Execute() Set oEditor = Nothing Response.Write "</td> </tr>"& vbCrLf Response.Write " <tr> <td class=TableRow1></td>"& vbCrLf Response.Write " <td height=20 class=TableRow1>"& vbCrLf Response.Write " <input type=""reset"" name=""Clear"" value=""清 除"" class=""button""> <input type=""submit"" value=""发送邮件"" name=""Submit1"" class=""button"">"& vbCrLf Response.Write " </td>"& vbCrLf Response.Write " </tr>"& vbCrLf Response.Write " </table>"& vbCrLf Response.Write "</form>"& vbCrLf End Sub %>