www.gusucode.com > 全球营销软件站整站源码4月最新数据 4.0源码程序 > 801wyxqf\adminadmin\sys\admin_maillist.asp

    <!--#include file="../../conn.asp"-->
<!--#include file="../inc/setup.asp"-->
<!--#include file="../inc/const.asp"-->
<!--#include file="../inc/check.asp"-->
<!--#include file="../../inc/cls_editor.asp" -->
<!--#include file="../../inc/chkinput.asp"-->
<!--#include file="../../inc/cls_email.asp" -->
<%
Server.ScriptTimeout = 99999
Admin_header
'=====================================================================
' 软件名称：801w软件代理系统
' 当前版本：801wAsp 801w cn 801w com
' 文件名称：admin_main.asp
' 更新日期：2010-2-16
' 官方网站：801w代理系统(www.801w.cn www.801w.com) QQ：274667447
'=====================================================================
' Copyright 2003-2010 801w.cn - All Rights Reserved.
' 801wasp is a trademark of 801w.cn
'=====================================================================
%>
<table class="table1" cellspacing="1" cellpadding="3" align="center" border="0">
	<tr>
		<td class="tableline linetitle" width="200" align="left">在线列表管理</td>
		<td class="tableline" width="*" align="right"><a href="admin_setting.asp">基本设置</a>
			 - <a href="admin_maillist.asp">邮件列表</a>
			 - <a href="admin_maillist.asp?action=mail">发送邮件</a>
			 - <a href="admin_link.asp">友情连接</a>
			 - <a href="admin_vote.asp">投票管理</a>
			 - <a href="../users/admin_master.asp"><font color="red">管理员管理</font></a>
		</td>
	</tr>
</table>
<%
Dim Action
Action = LCase(Request("action"))
If Not ChkAdmin("MailList") Then
	Call Transfer_error()
End If
Select Case Trim(Action)
Case "send"
	Call Send_Mail()
Case "sends"
	Call Send_Email()
Case "mail"
	Call showsend()
Case Else
	Call showmain()
End Select
If FoundErr = True Then
	ReturnError(ErrMsg)
End If
Admin_footer
SaveLogInfo(AdminName)
NewAsp.PageEnd

Sub showmain()
%>
<script src="../script/checkmail.js" type="text/javascript"></script>
<form name="myform" method="post" action="?action=send" onsubmit="return checkPost()">
<table border="0" align="center" cellpadding="3" cellspacing="1" class="tableborder">
<tr>
	<th  colspan="2">选择</th>
</tr>
<tr>
	<td class="tablerow1" width="20%" align="right"><b>注意事项：</b></td>
	<td class="tablerow1" width="80%">在完整填写以下表单后点击发送，信息将发送到所有注册时完整填写了信箱的用户，邮件列表的使用将消耗大量的服务器资源，请慎重使用。</td>
</tr>
<tr>
	<td class="tablerow2" align="right"><b>邮件用户：</b></td>
	<td class="tablerow2"><select name="Grade" size="1">
	<%
	Dim Rs
	Set Rs=NewAsp.Execute("SELECT Grades,GroupName 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
	%><option value="-1">所有用户</option>
	</select>
	</td>
</tr>
<tr>
	<td class="tablerow1" align="right"><b>邮件标题：</b></td>
	<td class="tablerow1"><input type="text" name="topic" size="60"></td>
</tr>
<tr>
	<td class="tablerow2" align="right"><b>邮件内容：</b></td>
	<td class="tablerow2">
	<%
	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"
	oEditor.InstanceName	= "content"
	oEditor.Execute()
	Set oEditor = Nothing
	%>
	</td>
</tr>
<tr>
	<td class="tablerow1" align="right"><b>&nbsp;</b></td>
	<td class="tablerow1"><input type="reset" name="reset_button" value="清 除" class="button">&nbsp;&nbsp;<input type="submit" name="submit_button" value="发送邮件" class="button"></td>
</tr>
</table>
</form>
<%
End Sub

Sub showsend()
%>
<script src="../script/checkmail.js" type="text/javascript"></script>
<form name="myform" method="post" action="?action=sends" onsubmit="return checkPost()">
<table border="0" align="center" cellpadding="3" cellspacing="1" class="tableborder">
<tr>
	<th  colspan="2">选择</th>
</tr>
<tr>
	<td class="tablerow1" width="20%" align="right"><b>发送说明：</b></td>
	<td class="tablerow1" width="80%">多个E-Mial地址请用英文逗号“,”分开。</td>
</tr>
<tr>
	<td class="tablerow2" width="20%" align="right"><b>电子邮件：</b></td>
	<td class="tablerow2" width="80%"><input type="text" name="useremail" size="60" value="<%=Server.HTMLEncode(Request("useremail")&"")%>"></td>
</tr>
<tr>
	<td class="tablerow1" align="right"><b>邮件标题：</b></td>
	<td class="tablerow1"><input type="text" name="topic" size="60"></td>
</tr>
<tr>
	<td class="tablerow2" align="right"><b>邮件内容：</b></td>
	<td class="tablerow2">
	<%
	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"
	oEditor.InstanceName	= "content"
	oEditor.Execute()
	Set oEditor = Nothing
	%>
	</td>
</tr>
<tr>
	<td class="tablerow1" align="right"><b>&nbsp;</b></td>
	<td class="tablerow1"><input type="reset" name="reset_button" value="清 除" class="button">&nbsp;&nbsp;<input type="submit" name="submit_button" value="发送邮件" class="button"></td>
</tr>
</table>
</form>
<%
End Sub

Sub Send_Mail()
	Dim useremail, topic, mailbody, alluser
	Dim Rs,SQL
	If Trim(Request.Form("topic")) = "" Then
		Errmsg = Errmsg + "<li>请输入邮件标题。</li>"
		FoundErr = True
	Else
		topic = Trim(Request.Form("topic"))
	End If
	If Trim(Request.Form("content")) = "" Then
		Errmsg = Errmsg + "<li>请输入邮件内容。</li>"
		FoundErr = True
	Else
		mailbody = Request.Form("content")
	End If
	If NewAsp.MainSetting(10)="0" Then
		Errmsg = Errmsg + "<li>系统未开启邮件功能。</li>"
		FoundErr = True
	End If
	If FoundErr Then Exit Sub
	On Error Resume Next
	If cmEmail.ErrCode = 0 Then
		If Not IsObject(Conn) Then ConnectionDatabase
		Set Rs=NewAsp.CreateAXObject("ADODB.Recordset")
		If NewAsp.CheckNumeric(Request.Form("Grade"))<0 Then
			SQL = "SELECT userid,username,usermail FROM [NC_user]"
		Else
			SQL = "SELECT userid,username,usermail FROM [NC_user] WHERE UserGrade=" & NewAsp.ChkNumeric(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")
					cmEmail.SendMail useremail,topic,mailbody
				End If
				Rs.movenext
			Loop

			If cmEmail.Count>0 Then
				Succeed("<li>邮件发送完成。</li><li>成功发送"&cmEmail.Count&"封邮件。</li>")
			Else
				Errmsg = cmEmail.Description
				FoundErr = True
			End If
		End If
		Rs.Close
		Set Rs = Nothing
	Else
		Errmsg = Errmsg + "<li>由于系统错误，邮件发送失败。</li>"
		FoundErr = True
	End If
End Sub

Sub Send_Email()
	Dim useremail, topic, mailbody, i
	Dim EmailArry
	If Trim(Request.Form("topic")) = "" Then
		Errmsg = Errmsg + "<li>请输入邮件标题。</li>"
		FoundErr = True
	Else
		topic = Trim(Request.Form("topic"))
	End If
	If Trim(Request.Form("content")) = "" Then
		Errmsg = Errmsg + "<li>请输入邮件内容。</li>"
		FoundErr = True
	Else
		mailbody = Request.Form("content")
	End If
	If Trim(Request.Form("useremail")) = "" Then
		Errmsg = Errmsg + "<li>请输入邮件地址。</li>"
		FoundErr = true
	'ElseIf IsValidEmail(Request.Form("useremail")) = False Then
	'	Errmsg = Errmsg + "<li>你输入的Email有误，请重新输入。</li>"
	'	FoundErr = True
	Else
		useremail = Trim(Request("useremail"))
	End If
	If NewAsp.MainSetting(10)="0" Then
		Errmsg = Errmsg + "<li>系统未开启邮件功能。</li>"
		FoundErr = True
	End If
	If FoundErr Then Exit Sub
	
	If CLng(NewAsp.MainSetting(10))>0 Then
		If cmEmail.ErrCode = 0 Then
			EmailArry=Split(useremail, ",")
			For i=0 To UBound(EmailArry)
				useremail=EmailArry(i)
				If IsValidEmail(useremail) Then
					cmEmail.SendMail useremail,topic,mailbody
				End If
			Next
			If cmEmail.Count>0 Then
				Succeed("<li>邮件成功发送。</li><li>主题："&topic&"</li>")
			Else
				Errmsg = cmEmail.Description
				FoundErr = True
			End If
		Else
			Errmsg = Errmsg + "<li>由于系统错误，邮件发送失败。</li>"
			FoundErr = True
		End If
	Else
		Errmsg = Errmsg + "<li>系统未开启邮件功能。</li>"
		FoundErr = True
	End If
End Sub
%>