admin_email.asp

正版创力4.1SQL商业版!!!ASP版。

<!--#include file="Inc/Const.asp"-->
<!--#include file="../inc/Cl_ClsEmail.asp"-->
<%
'注明出处：此文件改自动网论坛7.1(bbs.dvbbs.net)
Dim XmlDom
Dim FilePath
Dim EmailTitle,EmailBody
FilePath = InstallDir & DatabaseDir & "SendMailLog.config"
FilePath = Server.MapPath(FilePath)

if Not Cl.TrueOtherPurview("Email") then
	Cl.ShowErr("<br /><li>您无此操作权限！</li>")
end If

Header
Call Main()
Footer

Sub Main()
%>
<table cellpadding="3" cellspacing="1" border="0" class="Border" align="center">
<tr><th colspan="2" height="23">用户邮件通知</th></tr>
<tr>
<td width="20%" class="tdbg" align="center">
<button Style="width:80;height:50;border: 1px outset ;">注意事项</button>
</td>
<td width="80%" class="tdbg">
	①发送邮件列表只会保留最新十条记录；
	<br />②每次发送邮件请不要设置过多，要根据服务器的情况而定;
	<br />③邮件列表将保留发送的记录，还未发送完的可以在下一次执行发送。
	<br />④批量发送邮件，将会占用服务器资源，请尽量在访问量少的时间进行批量操作。
<!-- <br />⑤
	<br />⑥ -->
</td>
</tr>
<tr><td colspan="2" class="tdbg">
<a href="?">系统群发邮件</a> | <a href="?Act=ShowLog">群发邮件任务记录</a>
</td></tr>
</table>
<%
Select Case Request("Act")
	Case "sendemail" : Call SendStep2()
	Case "ShowLog" : Call ShowLog()
	Case "DelSendLog" : Call DelSendLog()
	Case "SendLog"	: Call SendLog()
	Case Else
	Call SendStep1
End Select
End Sub

'删除记录
Sub DelSendLog()
	Dim DelNodes,DelChildNodes
	Set XmlDom = Server.CreateObject("MSXML.DOMDocument")
	If Not XmlDom.load(FilePath) Then
		ErrMsg = "邮件列表中为空，请填写发邮件后再执行本操作!"
		Cl.ShowErr(ErrMsg)
		Exit Sub
	End If
	'Response.Write Request.Form("DelNodes").count
	For Each DelNodes in Request.Form("DelNodes")
		Set DelChildNodes = XmlDom.DocumentElement.selectSingleNode("SendLog[@AddTime='"&DelNodes&"']")
		If Not (DelChildNodes is Nothing) Then
			XmlDom.DocumentElement.RemoveChild(DelChildNodes)
		End If
	Next
	XmlDom.save FilePath
	Set XmlDom=Nothing
	Call Cl.ShowSuc("所选的记录已删除!")
End Sub

'根据记录发送邮件
Sub SendLog()
	Dim SelNodes,SelChildNodes,SendOrders
	SelNodes = Trim(Request.Form("DelNodes"))
	SendOrders = Trim(Request.Form("SendOrders"))
	If SendOrders="" or Not IsNumeric(SendOrders) Then
		Cl.ShowErr("请填写每次发送邮件的记录数!")
		Exit Sub
	Else
		SendOrders = Clng(SendOrders)
	End If
	Set XmlDom = Server.CreateObject("MSXML.DOMDocument")
	If Not XmlDom.load(FilePath) Then
		Cl.ShowErr("邮件列表中为空，请填写发邮件后再执行本操作!")
		Exit Sub
	End If
	Set SelChildNodes = XmlDom.DocumentElement.selectSingleNode("SendLog[@AddTime='"&SelNodes&"']")
	If SelChildNodes is Nothing Then
		Cl.ShowErr("发送的记录不存在，请填写发邮件后再执行本操作!")
		Exit Sub
	End If

	Dim EmailTitle,EmailBody,Total,SearchStr,LastUserID,Remain
	Dim Sql,Rs,i,ii
	Total = SelChildNodes.getAttribute("Total")
	Remain = SelChildNodes.getAttribute("Remain")
	EmailTitle = SelChildNodes.selectSingleNode("EmailTitle").text
	EmailBody = SelChildNodes.selectSingleNode("EmailBody").text
	EmailBody = Replace(EmailBody, CHR(10) & CHR(10), "</P><P> ")
	EmailBody = Replace(EmailBody, CHR(10), "<br /> ")
	SearchStr = SelChildNodes.selectSingleNode("Search").text
	LastUserID = Int(SelChildNodes.getAttribute("LasterUserID"))
	If Remain="0" Then
		Cl.ShowErr("已经发送完毕!")
		Exit Sub
	End If
	SQL = "Select Top "&SendOrders&" UserID,"&Db.UserName&","&Db.UserEmail&" From "&Db.UserTable&" where UserID>=" & LastUserID
	If SearchStr<>"" Then
		SQL = SQL &" and "& SearchStr
	End If
	SQL = SQL & " order by UserID "
	SET Rs = Cl.Execute_U(SQL)
	If Not Rs.eof Then
		SQL=Rs.GetRows(-1)
		Rs.close:Set Rs = Nothing
	Else
		Cl.ShowErr("已经发送完毕!")
		Exit Sub
	End If
	%>
	<table cellpadding="0" cellspacing="0" border="0" width="95%" class="Border" align="center">
	<tr><td colspan="2" class="tdbg">下面开始发送邮件给目标用户，总共发送<%=Total%>封，目前剩余发送<%=Remain%>封，每次发送最限为<%=SendOrders%>封。
		<table width="400" border="0" cellspacing="1" cellpadding="1">
		<tr>
	<td bgcolor="000000">
	<table width="400" border="0" cellspacing="0" cellpadding="1">
	<tr><td bgcolor="ffffff" height="9"><img src="../Images/bar/bar3.gif" width="0" height="16" id="img2" name="img2" align="absmiddle" /></td>
	</tr></table>
	</td></tr></table>
	<span id="txt2" name="txt2" style="font-size:9pt">0</span><span style="font-size:9pt">%</span></td>
	</tr>
	</table>
	<table cellpadding="0" cellspacing="0" border="0" width="95%" class="Border" align="center">
	<tr><td colspan="2" class="tdbg">
	<span id="txt3" name="txt3" style="font-size:9pt">	</span>
	</td>
	</tr></table>
	<%
	Dim ClEmail
	Set ClEmail = New Cls_SendMail
	ClEmail.SendObject = Cint(Cl.Web_Setting(17))	'设置选取组件
	ClEmail.ServerLoginName = Cl.Web_Setting(19)	'您的邮件服务器登录名
	ClEmail.ServerLoginPass = Cl.Web_Setting(20)	'登录密码
	ClEmail.SendSMTP = Cl.Web_Setting(18)			'SMTP地址
	ClEmail.SendFromEmail = Cl.Web_Info(8)		'发送来源地址
	ClEmail.SendFromName = Cl.Web_Info(0)		'发送人信息

	For i=0 To Ubound(SQL,2)
		If ClEmail.ErrCode = 0 Then
			ClEmail.SendMail SQL(2,i),EmailTitle,Replace(EmailBody,"{$username}",SQL(1,i))	'执行发送邮件
		End If
		If ClEmail.ErrCode <> 0 Then
			Cl.ShowErr(ClEmail.Description)
			Exit For
		end if
		ii=ii+1
		Response.Write "<script>img2.width=" & Fix((ii/Remain) * 400) & ";" & VbCrLf
		Response.Write "txt2.innerHTML=""发送给"&SQL(1,i)&"（"&SQL(2,i)&"）的邮件完成，正在发送下一个用户邮件，" & FormatNumber(ii/Remain*100,4,-1) & """;" & VbCrLf
		Response.Write "txt3.innerHTML+=""发送给"&SQL(1,i)&"（"&SQL(2,i)&"）的邮件完成<br />"";"
		Response.Write "</script>"
		Response.Flush
		LastUserID = SQL(0,i)
	Next
	Set ClEmail = Nothing
	Remain = Remain -ii
	If Remain<0 Then Remain = 0
	SelChildNodes.attributes.getNamedItem("Remain").text = Remain
	SelChildNodes.attributes.getNamedItem("LasterUserID").text = LastUserID
	SelChildNodes.attributes.getNamedItem("LastTime").text = now()
	XmlDom.documentElement.appendChild(SelChildNodes)
	XmlDom.save FilePath
	Set XmlDom=Nothing
	If Remain>0 Then
	Response.Write "<input type=""button"" value=""继续发送"" onclick=""window.location.reload()"">"
	End If
End Sub

'显示邮件记录列表
Sub ShowLog()
Set XmlDom = Server.CreateObject("MSXML.DOMDocument")
If Not XmlDom.load(FilePath) Then
	ErrMsg = "邮件列表中为空，请填写发邮件后再执行本操作!"
	Cl.ShowErr(ErrMsg)
	Exit Sub
End If
Dim Node,SendLogNode,Childs
Set SendLogNode = XmlDom.DocumentElement.SelectNodes("SendLog")
Childs = SendLogNode.Length	'列表数
If Childs>10 Then
	Dim objRemoveNode,i
	For i=0 To (Childs-11)
	XmlDom.documentElement.removeChild(SendLogNode.item(i))
	Next
	XmlDom.save FilePath
End If
%>
<script language="JavaScript" type="text/javascript">
function CheckAll(form)
{
  for (var i=0;i<form.elements.length;i++)
    {
    var e = form.elements[i];
    if (e.name != "chkall"&&e.disabled!=true)
       e.checked = form.chkall.checked;
    }
}
</script>
<br />
<table cellpadding="3" cellspacing="1" border="0" class="Border" align="center">
	<tr><td colspan="9" height="23" class="title">发送邮件列表</td></tr>
	<tr class="title2" height="23">
		<td width="1%" align="center" nowrap="nowrap">选取</td>
		<td width="20%" align="center">标题</td>
		<td width="10%" align="center" nowrap="nowrap">总共发送数目</td>
		<td width="10%" align="center" nowrap="nowrap">剩余发送数目</td>
		<td width="10%" align="center">操作者</td>
		<td width="10%" align="center">操作者IP</td>
		<td width="10%" align="center">添加时间</td>
		<td width="10%" align="center">更新时间</td>
		<td width="10%" align="center">操作</td>
	</tr>
	<form action="?" method="post" name="TheForm" id="TheForm">
	<tr><td colspan="9" class="tdbg" height="23">每次发送邮件
      <input type="text" name="SendOrders" value="10" size="4" />
	封</td></tr>
<%
Dim SearchStr,Topic
i=0
For Each Node in SendLogNode
	'SearchStr = Node.selectSingleNode("Search").text
	Topic = Node.selectSingleNode("EmailTitle").text
	'Node.getAttribute("MasterName")
%>
	<tr>
  <td class="tdbg" align="center"><input type="checkbox" name="DelNodes" value="<%=Node.getAttribute("AddTime")%>" /></td>
		<td class="tdbg" align="center"><%=Topic%></td>
		<td class="tdbg"><%=Node.getAttribute("Total")%></td>
		<td class="tdbg"><%=Node.getAttribute("Remain")%></td>
		<td class="tdbg" align="center"><%=Node.getAttribute("MasterName")%></td>
		<td class="tdbg"><%=Node.getAttribute("MasterIP")%></td>
		<td class="tdbg"><%=Node.getAttribute("AddTime")%></td>
		<td class="tdbg"><%=Node.getAttribute("LastTime")%></td>
  <td class="tdbg" align="center"><input type="submit"  onclick="this.form.Act.value='SendLog';Selchecked(this.form.DelNodes,<%=i%>);" value="发送" /></td>
	</tr>
<%
i=i+1
Next
%>
	<tr>
		<td colspan="9" class="tdbg">
		  <input type="hidden" name="Act" value="DelSendLog" />
          <input type="submit" name="Submit" value="删除记录"  onclick="{if(confirm('注意：所删除的记录将不能恢复！')){this.form.submit();return true;}return false;}" />  
          <input type="checkbox" name="chkall" value="on" onclick="CheckAll(this.form)" />
  全选</td>
	</tr>
	</form>
</table>
<script language="JavaScript" type="text/javascript">
<!--
function Selchecked(obj,n){
if (obj[n]){
	obj[n].checked=true;
}else{
	obj.checked=true;
}
}
//-->
</script>
<%
Set XmlDom = Nothing
End Sub

'填写发送邮件信息
Sub SendStep1()
dim EmailObjInstalled,EmailObjName
Select Case Cint(Cl.Web_Setting(17))
Case 1
EmailObjInstalled=Cl.ChkObjInstalled("JMail.Message")
EmailObjName="Jmail"
Case 2
EmailObjInstalled=Cl.ChkObjInstalled("CDONTS.NewMail")
EmailObjName="CDONTS"
Case 3
EmailObjInstalled=Cl.ChkObjInstalled("Persits.MailSender")
EmailObjName="AspEmail"
Case Else
EmailObjInstalled=False
EmailObjName="已关闭"
End Select
%>
<br />
<table cellpadding="3" cellspacing="1" border="0" class="Border" align="center">
<form action="?" method="post" name="TheForm" id="TheForm">
	<tr><td colspan="2" height="23" class="title">用户邮件通知</td></tr>
	<tr>
		<td class="tdbg" align="right">用户类别：</td>
		<td class="tdbg">
		  <input type="radio" name="UserType" value="1" checked="checked" onclick="UType(this.value)" />
		用户名单
		<input type="radio" name="UserType" value="2" onclick="UType(this.value)" />
		输入Email
		<input type="radio" name="UserType" value="3" onclick="UType(this.value)" />
		用户组
		<input type="radio" name="UserType" value="0" onclick="UType(this.value)" />
		所有用户
		</td>
	</tr>
	<tr id="ToUserName">
		<td class="tdbg" align="right">用 户 名：</td>
		<td class="tdbg"> <input type="text" name="UserName" size="80" />
		<br />
		请输入用户名：(多个用户名请以英文逗号“,”分隔,注意区分大小写)</td>
	</tr>
	<tr id="ToUserEmail" style="display:none;">
		<td class="tdbg" align="right">用户Email：</td>
		<td class="tdbg"> <input type="text" name="UserEmail" size="80" />
		<br />
		请输入Email：(多个Email请以英文逗号“,”分隔,注意区分大小写)</td>
	</tr>
	<tr id="ToUserGroupID" style="display:none;">
		<td class="tdbg" align="right">用 户 组：</td>
		<td class="tdbg">
			<table width="100%" border="0" cellspacing="1" cellpadding="3" align="center">
			<tr><td>
			<%
			Dim Node
			For Each Node In Application(Cl.CacheName & "_usergrouplist").DocumentElement.selectNodes("usergroup[@id!=5]")
			Response.write "<input type=""checkbox"" name=""UserGroupID"" value="""&Node.selectSingleNode("@id").text&""" />"&Node.selectSingleNode("@groupname").text&"&nbsp;"
			Next
			Set Node = Nothing
			%>
			</td></tr>
			<tr><td height="20" class="tdbg"><input type="button" value="打开高级设置" name="OPENSET" onclick="openset(this,'UpSetting')" /></td></tr>
			<tr><td height="20" id="UpSetting" style="display:NONE" class="tdbg">
				<table width="100%" border="0" cellspacing="1" cellpadding="3" align="center">
				<tr><td height="20" colspan="4">符合条件设置(以下条件将对选择的用户组生效)</td>
				</tr>
				<tr>
					<td class="tdbg" width="15%">最后登陆时间：</td>
					<td class="tdbg" width="35%">
					  <input type="text" name="LoginTime" onkeyup="CheckNumer(this.value,this,'')" size="6" />
					天 &nbsp;
					<input type="radio" name="LoginTimeType" checked="checked" value="0" />
					多于 
					<input type="radio" name="LoginTimeType" value="1" />
					少于
					</td>
					<td class="tdbg" width="15%">注册时间：</td>
					<td class="tdbg" width="35%">
					  <input type="text" name="RegTime" onkeyup="CheckNumer(this.value,this,'')" size="6" />
					天 &nbsp;
					<input type="radio" name="RegTimeType" checked="checked" value="0" />
					多于 
					<input type="radio" name="RegTimeType" value="1" />
					少于
					</td>
				</tr>
				<tr>
					<td class="tdbg">登陆次数：</td>
					<td class="tdbg"><input type="text" name="Logins" size="6" onkeyup="CheckNumer(this.value,this,'')" />
					次 &nbsp;
					<input type="radio" name="LoginsType" checked="checked" value="0" />
					多于 
					<input type="radio" name="LoginsType" value="1" />
					少于
					</td>