📄 admin_mail.asp

📁 依蓝旅游网站管理系统Elan2008.SP2
💻 ASP
字号:
<%
Option Explicit
Response.Buffer = True
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 1
%>
<!--#Include File="../Conn.asp"-->
<!--#Include File="Admin_CheckPurview.asp"-->
<!--#Include File="../inc/ClassSendMail.asp"-->
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<link href='Admin_Style.css' type='text/css' rel='stylesheet'>
<title>发送电子邮件</title>
<script language="javascript" src="../js/Common.js"></script>
<script language="javascript" src="../js/InstallDir.js"></script>
<script language="javascript" src="../Js/Ajax.js"></script>
</head>
<body>
<%
Dim TestMailObject
TestMailObject = Trim(EL_Common.GetFieldValue("Object_Email", "EL_Config", "1=1"))
If TestMailObject = "" Then
   EL_Common.ShowErrorMsg("您没有在“网站基本信息配置”中选择邮件发送组件")
   Call ApplicationTerminate()
End If
If ObjTest(TestMailObject) = False Then
   EL_Common.ShowErrorMsg("服务器中没有安装"& TestMailObject &"邮件发送组件")
   Call ApplicationTerminate()
End If

If EL_Admin.Purview <> 1 Then
   If EL_Admin.CheckAdminPurview(15, 3) = False Then
      EL_Admin.ShowPurviewError("对不起！您没有足够的管理权限")
   End If
End If


%>
<table width="100%" border="0" cellpadding="0" cellspacing="1" class="Border">
  <tr>
    <td align="center" class="top_25"><strong>发送电子邮件</strong></td>
  </tr>
  <tr>
    <td class="td_50">管理导航：<a href="Admin_Mail.asp">发送邮件</a></td>
  </tr>
</table>
<br>
<%
Select Case Action
   Case "": Call WriteMail()
   Case "Send": Call SendMail()
End Select
Call EL_Common.Bottom()
Call ApplicationTerminate()

Sub SendMail()
   On Error Resume Next
   Dim SendType, ArrGroupID, ArrUserName, ArrEmail
   Dim MailSubject, FromUserName, FromEmail, MailContent
   Dim EL_SendMail, MailConfigCmd, rsMailConfig, SendCount
   
   SendType = EL_Common.ELRequest("SendType", 2)
   ArrGroupID = EL_Common.ELRequest("GroupID", 1)
   ArrUserName = Replace(EL_Common.ELRequest("UserName", 1), "'", "")
   ArrEmail = EL_Common.ELRequest("Email", 1)
   MailSubject = EL_Common.ELRequest("MailSubject", 1)
   FromUserName = EL_Common.ELRequest("Sender", 1)
   FromEmail = EL_Common.ELRequest("SenderEmail", 1)
   MailContent = EL_Common.ELRequest("MailContent", 1)
   SendCount = 0      
   MailContent = "<HTML><BODY bgcolor=""#FFFFFF"">"& MailContent &"</BODY></HTML>"      
   Set EL_SendMail = New ClassSendMail	  
   EL_SendMail.SubjectName = MailSubject
   EL_SendMail.FromUserName = FromUserName
   EL_SendMail.FromEmail = FromEmail
   EL_SendMail.EmailBody = MailContent
      
   Dim UserCmd, rsUser, RowCount, i
   Select Case SendType
      Case 0:
	     Call EL_Common.InitCommonCmd(UserCmd, rsUser, "EL_User", "UserName, Email", "1=1")
		 rsUser.Close()
		 RowCount = UserCmd(0)
		 If RowCount > 0 Then
		    rsUser.Open()
		    For i = 1 To RowCount
			   EL_SendMail.ToEmail = rsUser(1)
			   EL_SendMail.SendMail()
			   Response.Write "<p>"
			   Response.Write "<b class=bluetext>&nbsp;&nbsp;发送邮件至 <span class=redtext>"& rsUser(0) &"："& rsUser(1) &"</span></b><p>"
			   Response.Write "<script>scrollBy(0,document.body.scrollHeight)</script>"
			   Response.Flush()
			   SendCount = SendCount + 1
			   If i<RowCount Then rsUser.MoveNext
			Next
			rsUser.Close()
		 End If
		 Set rsUser = Nothing
		 Set UserCmd = Nothing
		 
	  Case 1:
	     If ArrGroupID = "" Then
		    EL_Common.ShowErrorMsg("请指定会员组")
			Exit Sub
		 End If
		 Call EL_Common.InitCommonCmd(UserCmd, rsUser, "EL_User", "UserName, Email", "GroupID In("& ArrGroupID &")")
		 rsUser.Close()
		 RowCount = UserCmd(0)
		 If RowCount > 0 Then
		    rsUser.Open()
		    For i = 1 To RowCount
			   EL_SendMail.ToEmail = rsUser(1)
			   EL_SendMail.SendMail()
			   Response.Write "<p>"
			   Response.Write "<b class=bluetext>&nbsp;&nbsp;发送邮件至 <span class=redtext>"& rsUser(0) &"："& rsUser(1) &"</span></b><p>"
			   Response.Write "<script>scrollBy(0,document.body.scrollHeight)</script>"
			   Response.Flush()
			   SendCount = SendCount + 1
			   If i<RowCount Then rsUser.MoveNext
			Next
			rsUser.Close()
		 End If
		 Set rsUser = Nothing
		 Set UserCmd = Nothing
		 
	  Case 2:
	     If ArrUserName = "" Then
		    EL_Common.ShowErrorMsg("请指定会员名")
			Exit Sub
		 End If
		 ArrUserName = Replace(ArrUserName, ",", "','")
		 ArrUserName = "'"& ArrUserName &"'"
		 Call EL_Common.InitCommonCmd(UserCmd, rsUser, "EL_User", "UserName, Email", "UserName In("& ArrUserName &")")
		 rsUser.Close()
		 RowCount = UserCmd(0)
		 If RowCount > 0 Then
		    rsUser.Open()
		    For i = 1 To RowCount
			   EL_SendMail.ToEmail = rsUser(1)
			   EL_SendMail.SendMail()
			   Response.Write "<p>"
			   Response.Write "<b class=bluetext>&nbsp;&nbsp;发送邮件至 <span class=redtext>"& rsUser(0) &"："& rsUser(1) &"</span></b><p>"
			   Response.Write "<script>scrollBy(0,document.body.scrollHeight)</script>"
			   Response.Flush()
			   SendCount = SendCount + 1
			   If i<RowCount Then rsUser.MoveNext
			Next
			rsUser.Close()
		 End If
		 Set rsUser = Nothing
		 Set UserCmd = Nothing
		 
	  Case 3:
	     If ArrEmail = "" Then
		    EL_Common.ShowErrorMsg("请指定邮件地址")
			Exit Sub
		 End If
		 ArrEmail = Split(ArrEmail, ",")
		 For i = 0 To UBound(ArrEmail)
		    EL_SendMail.ToEmail = ArrEmail(i)
			EL_SendMail.SendMail()
			Response.Write "<p>"
			Response.Write "<b class=bluetext>&nbsp;&nbsp;发送邮件至 <span class=redtext>"& ArrEmail(i) &"</span></b><p>"
			Response.Write "<script>scrollBy(0,document.body.scrollHeight)</script>"
			Response.Flush()
			SendCount = SendCount + 1
		 Next
		 
   End Select   
   Set EL_SendMail = Nothing
   EL_Common.ShowSuccessMsg("邮件发送成功<br><br>共发送了 <span class=bluetext>"& SendCount &"</span> 封邮件")
   
   EL_Common.ShowScriptError()
End Sub


Sub WriteMail()
On Error Resume Next
Dim SendType, UserName, Email
SendType = EL_Common.ELRequest("SendType", 2)
UserName = EL_Common.ELRequest("UserName", 1)
Email = EL_Common.ELRequest("Email", 1)

If UserName <> "" Then SendType = 2
If Email <> "" Then SendType = 3

%>
<script language="javascript">
function Check(frm){
  var CurrentMode = Editor.CurrentMode;
  if (CurrentMode == 0){
    frm.MailContent.value = Editor.HtmlEdit.document.body.innerHTML; 
  }else if(CurrentMode==1){
    frm.MailContent.value = Editor.HtmlEdit.document.body.innerText;
  }else{
    alert('邮件内容处于预览状态不能保存');
    return false;
  }
  
  if(frm.MailSubject.value == ""){
     alert("请输入邮件主题");
	 frm.MailSubject.focus();
	 return false
  }
  
  if(frm.Sender.value == ""){
     alert("请输入发件人");
	 frm.Sender.focus();
	 return false
  }
  
  if(frm.SenderEmail.value == ""){
     alert("请输入发件人邮件");
	 frm.SenderEmail.focus();
	 return false
  }
  
  if(frm.MailContent.value == ""){
     alert("请输入邮件内容");
	 Editor.HtmlEdit.focus();
	 return false
  }
  
  SubmitOnce(frm);
  return;
}
</script>
<form name="myform" action="Admin_Mail.asp" method="post" onSubmit="return Check(this)">
<table width="100%" border="0" cellpadding="0" cellspacing="1" class="Border">
  <tr>
    <td colspan="2" class="top_25"><strong>发送电子邮件</strong></td>
  </tr>
  <tr>
    <td width="17%" class="td_ItemName"><strong>接收人</strong></td>
    <td width="83%" class="td_25"><table width="100%" border="0" cellspacing="1" cellpadding="0">
      <tr>
        <td colspan="2"><input name="SendType" type="radio" class="nomargin" value="0" <%=EL_Common.SetObjectChecked(0, SendType)%>>
          所有会员</td>
      </tr>
      <tr>
        <td width="15%" nowrap><input name="SendType" type="radio" class="nomargin" value="1" <%=EL_Common.SetObjectChecked(1, SendType)%>>
          指定会员组 </td>
        <td width="85%"><%=ShowGroupCheck(-1)%></td>
      </tr>
      <tr>
        <td><input name="SendType" type="radio" class="nomargin" value="2" <%=EL_Common.SetObjectChecked(2, SendType)%>>
          指定会员 </td>
        <td><input name="UserName" type="text" id="UserName" value="<%=UserName%>" size="47">
          多个用户名间请用<span class="redText">英文逗号</span>分隔</td>
      </tr>
      <tr>
        <td nowrap><input name="SendType" type="radio" class="nomargin" value="3" <%=EL_Common.SetObjectChecked(3, SendType)%>>
          指定邮件地址</td>
        <td><input name="Email" type="text" id="Email" value="<%=Email%>" size="47">
          多个邮件地址请用<span class="redText">英文逗号</span>分隔</td>
      </tr>
    </table></td>
  </tr>
  <tr>
    <td class="td_ItemName"><strong>邮件主题</strong></td>
    <td class="td_25"><input name="MailSubject" type="text" id="MailSubject" size="60"></td>
  </tr>
  <tr>
    <td class="td_ItemName"><strong>发件人</strong></td>
    <td class="td_25"><input name="Sender" type="text" id="Sender" value="<%=EL_Common.ServerHTMLEncode(SiteName)%>" size="60"></td>
  </tr>
  <tr>
    <td class="td_ItemName"><strong>发件人Email</strong></td>
    <td class="td_25"><input name="SenderEmail" type="text" id="SenderEmail" value="<%=WebmasterEmail%>" size="60"></td>
  </tr>
  <tr>
    <td class="td_ItemName"><strong>邮件内容</strong></td>
    <td class="td_25">
	  <textarea name="MailContent" id="MailContent" style="display:none"></textarea>
	<iframe ID='Editor' src='../editor.asp?ChannelID=0&ShowType=2&tContentid=MailContent' frameborder='1' scrolling='no' width='600' height='300' ></iframe></td>
  </tr>
  <tr>
    <td class="td_ItemName">&nbsp;</td>
    <td class="td_50"><input type="submit" name="Submit" value=" 发 送 ">
      <input type="button" name="Submit2" value=" 取 消 " onClick="history.back()">
      <input name="Action" type="hidden" id="Action" value="Send"></td>
  </tr>
</table>
</form>
<%
EL_Common.ShowScriptError()
End Sub
%>
<%
Function ShowGroupCheck(ByVal DefaultGroupID)
   Dim GroupCmd, rsGroup, ReturnString, i, RowCount
   Call EL_Common.InitCommonCmd(GroupCmd, rsGroup, "EL_Group", "GroupID,GroupName", "1=1")
   rsGroup.Close()
   RowCount = GroupCmd(0)
   rsGroup.Open()
   ReturnString = ""
   For i = 1 To RowCount
      If DefaultGroupID = rsGroup(0) Then
	     ReturnString = ReturnString &"<input name='CheckGroup' id='CheckGroup' type='checkbox' value='"& rsGroup(0) &"' checked class='nomargin'> "& EL_Common.ServerHTMLEncode(rsGroup(1)) &" "
	  Else
	     ReturnString = ReturnString &"<input name='CheckGroup' id='CheckGroup' type='checkbox' value='"& rsGroup(0) &"' class='nomargin'> "& EL_Common.ServerHTMLEncode(rsGroup(1)) &" "
	  End If
	  If i<RowCount Then rsGroup.MoveNext
   Next
   rsGroup.Close()
   Set rsGroup = Nothing
   Set GroupCmd = Nothing
   ShowGroupCheck = ReturnString
End Function

Function ObjTest(strObj)
	On Error Resume Next
	ObjTest = False
	Dim TestObj
	Set TestObj=server.CreateObject (strObj)
	If -2147221005 <> Err then
		ObjTest = True
	Else
	   Err.Clear
	End If	
End Function
%>
</body>
</html>
💿 文件大小 4678 K
👤 上传用户 libin2722
📂 所属分类企业管理
🏷️ 相关标签

#Elan #2008 #SP #旅游
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -