<%@ LANGUAGE="VBSCRIPT" %>
<% Response.Buffer = True %>
<% Server.ScriptTimeout = 900 %>
<%
'***********************************************************************
' System : ASPBanner Unlimited
' Author : Christopher Williams of CJWSoft www.CJWSoft.com
'
' COPYRIGHT NOTICE
'
' See attached Software License Agreement
'
' (c) Copyright 2000 - 2003 by CJWSoft. All rights reserved
'***********************************************************************
%>
<% CHECKFOR = "Admin" %>
<%
Active = "Any"
Access_Level = "Any"
MYSQL = Request("MYSQL")
Action = Request("Action")
Subject = Request("Subject")
If Subject = "" Then
Subject = "ASPBanner System Message"
End IF
Message = Request("Message")
FromName = Request("FromName")
If FromName = "" Then
FromName = "ASPBanner System Admin"
End IF
FromEmail = Request("FromEmail")
If FromEmail = "" Then
FromEmail = Application("EmailNotification")
End If
If MYSQL = "" Then
MYSQL = "SELECT FIRST_NAME, Last_Name, EMAIL, Access_Level, Active FROM Banner_Users WHERE (EMAIL IS NOT NULL) "
If Access_Level <> "Any" Then
Access_Level = "'" & Replace(Access_Level,", ","','") & "'"
MYSQL = MYSQL & " AND (Access_Level IN (" & Access_Level & ")) "
End If
If Active <> "Any" Then
MYSQL = MYSQL & " AND (Active = " & Active & ") "
End If
End If
Function IsValidEmail(Email)
ValidFlag = False
If (Email <> "") And (InStr(1, Email, "@") > 0) And (InStr(1, Email, ".") > 0) Then
atCount = 0
SpecialFlag = False
For atLoop = 1 To Len(Email)
atChr = Mid(Email, atLoop, 1)
If atChr = "@" Then atCount = atCount + 1
If (atChr >= Chr(32)) And (atChr <= Chr(44)) Then SpecialFlag = True
If (atChr = Chr(47)) Or (atChr = Chr(96)) Or (atChr >= Chr(123)) Then SpecialFlag = True
If (atChr >= Chr(58)) And (atChr <= Chr(63)) Then SpecialFlag = True
If (atChr >= Chr(91)) And (atChr <= Chr(94)) Then SpecialFlag = True
Next
If (atCount = 1) And (SpecialFlag = False) Then
BadFlag = False
tAry1 = Split(Email, "@")
UserName = tAry1(0)
DomainName = tAry1(1)
If (UserName = "") Or (DomainName = "") Then BadFlag = True
If Mid(DomainName, 1, 1) = "." then BadFlag = True
If Mid(DomainName, Len(DomainName), 1) = "." then BadFlag = True
ValidFlag = True
End If
End If
If BadFlag = True Then ValidFlag = False
IsValidEmail = ValidFlag
End Function
%>
<% =App_Name %>
>
<%
ErrorMessage = Request("ErrorMessage")
If ErrorMessage <> "" Then %>
<% End If %>
<%
If Action <> "SendEmail" Then
Set ConnBannerSystem = Server.CreateObject("ADODB.Connection")
Set CmdQueryUsers = Server.CreateObject("ADODB.Recordset")
ConnBannerSystem.Open BannerConnectionString
CmdQueryUsers.Open MYSQL, ConnBannerSystem , 1, 3
UserCount = CmdQueryUsers.RecordCount
%>
Return
To Main Screen
This will send email to <% =UserCount %> User(s)
<% End If %>
<%
If Action = "SendEmail" Then
FromEmail = Request("FromEmail")
If NOT IsValidEmail(FromEmail) And FromEmail <> "" Then
ErrorMessage = ErrorMessage & Server.URLEncode("That does not appear to be a valid email address.\n\n")
End IF
If FromEmail = "" Then
ErrorMessage = ErrorMessage & Server.URLEncode("You need to enter a valid email address.\n\n")
End IF
If Request("FromName") = "" Then
ErrorMessage = ErrorMessage & Server.URLEncode("You need to enter a From Name.\n\n")
End IF
If Request("Subject") = "" Then
ErrorMessage = ErrorMessage & Server.URLEncode("You need to enter a Subject.\n\n")
End IF
If Request("Message") = "" Then
ErrorMessage = ErrorMessage & Server.URLEncode("You need to enter a Message.\n\n")
End IF
If ErrorMessage <> "" Then
Response.Redirect "send_mass_email.asp" & "?ErrorMessage=" & ErrorMessage & "&MYSQL=" & Server.URLEncode(MYSQL) & "&FromEmail=" & Server.URLEncode(FromEmail) & "&FromName=" & Server.URLEncode(FromName) & "&Subject=" & Server.URLEncode(Subject) & "&Message=" & Server.URLEncode(Message)
Response.End
End If
Set ConnBannerSystem = Server.CreateObject("ADODB.Connection")
Set CmdQueryUsers = Server.CreateObject("ADODB.Recordset")
ConnBannerSystem.Open BannerConnectionString
CmdQueryUsers.Open MYSQL, ConnBannerSystem , 1, 3
UserCount = CmdQueryUsers.RecordCount
While Not CmdQueryUsers.EOF
If IsValidEmail(CmdQueryUsers("Email")) Then
If Application("CDONTS_Installed") = true Then
Set objCDO = Server.CreateObject("CDONTS.NewMail")
objCDO.To = CmdQueryUsers("Email")
objCDO.From = FromEmail
objCDO.Subject = Subject
objCDO.Body = Message
objCDO.Send
Set objCDO = Nothing
End If
If Application("SASMTPMAIL_Installed") = true Then
If Application("ASPMail_Installed") = true then
Set Mailer = Server.CreateObject("SMTPsvg.Mailer")
Else
Set Mailer = Server.CreateObject("SoftArtisans.SMTPMail")
End If
Mailer.FromName = FromEmail
Mailer.FromAddress = FromEmail
Mailer.addrecipient CmdQueryUsers("First_Name") & " " & CmdQueryUsers("Last_Name") , CmdQueryUsers("Email")
Mailer.bodytext = Replace(Message,vbCrLf,"
")
Mailer.contenttype = "text/html"
Mailer.encoding = 2
Mailer.subject = Subject
Mailer.wordwrap = true
Mailer.wordwraplen = 50
Mailer.RemoteHost = Application("SASMTPMAIL_RemoteHost")
Mailer.timeout = 120
Mailer.Priority = 3
Mailer.SendMail
set Mailer = nothing
End If
If Application("JMAIL_Installed") = true Then
Set JMail = Server.CreateObject("JMail.SMTPMail")
JMail.ServerAddress = Application("JMAIL_ServerAddress")
JMail.Sender = FromEmail
JMail.Subject = Subject
JMail.AddRecipient CmdQueryUsers("Email")
JMail.Body = Message
JMail.Priority = 3
JMail.Execute
Set JMail = Nothing
End If
If Application("AspEmail_Installed") = true Then
Set Mail = Server.CreateObject("Persits.MailSender")
Mail.Host = Application("AspEmail_MailHost")
Mail.From = FromEmail
Mail.FromName = FromEmail
Mail.AddAddress CmdQueryUsers("Email")
Mail.Subject = Subject
Mail.Body = Message
Mail.Send
Set Mail = Nothing
End If
End If
CmdQueryUsers.MoveNext
Wend
%>
Emails have been successfully sent to <% =UserCount %> User(s).
Click here to return to the main
Admin Area
<%
End IF
%>