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 "		    &nbsp; <input type=""reset"" name=""Clear"" value=""清 除"" class=""button"">&nbsp; &nbsp; <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 "		    &nbsp; <input type=""reset"" name=""Clear"" value=""清 除"" class=""button"">&nbsp; &nbsp; <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
%>