% Option Explicit %>
<%
'****************************************************************************************
'** Copyright Notice
'**
'** Web Wiz Guide - Web Wiz Mailing List
'**
'** Copyright 2001-2004 Bruce Corkhill All Rights Reserved.
'**
'** This program is free software; you can modify (at your own risk) any part of it
'** under the terms of the License that accompanies this software and use it both
'** privately and commercially.
'**
'** All copyright notices must remain in tacked in the scripts and the
'** outputted HTML.
'**
'** You may use parts of this program in your own private work, but you may NOT
'** redistribute, repackage, or sell the whole or any part of this program even
'** if it is modified or reverse engineered in whole or in part without express
'** permission from the author.
'**
'** You may not pass the whole or any part of this application off as your own work.
'**
'** All links to Web Wiz Guide and powered by logo's must remain unchanged and in place
'** and must remain visible when the pages are viewed unless permission is first granted
'** by the copyright holder.
'**
'** This program is distributed in the hope that it will be useful,
'** but WITHOUT ANY WARRANTY; without even the implied warranty of
'** MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER
'** WARRANTIES WHETHER EXPRESSED OR IMPLIED.
'**
'** You should have received a copy of the License along with this program;
'** if not, write to:- Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom.
'**
'**
'** No official support is available for this program but you may post support questions at: -
'** http://www.webwizguide.info/forum
'**
'** Support questions are NOT answered by e-mail ever!
'**
'** For correspondence or non support questions contact: -
'** info@webwizguide.info
'**
'** or at: -
'**
'** Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom
'**
'****************************************************************************************
'Set the response buffer to false as we may need to puase while the e-mails are being sent
Response.Buffer = False
'If the session variable is False or does not exsist then redirect the user to the unauthorised user page
If Session("blnIsUserGood") = False or IsNull(Session("blnIsUserGood")) = True then
'Reset Server Variables
Set rsCommon = Nothing
adoCon.Close
Set adoCon = Nothing
'Redirect to unathorised user page
Response.Redirect"unauthorised_user_page.htm"
End If
'Set the script timeout to 6 hours incase there are lots of e-mails to send
Server.ScriptTimeout = 21600
'Dimension variables
Dim blnHTMLFormat 'set to true if HTML
Dim strEmailType 'Holds the email type (i.e. HTML/Plain text)
Dim strSubject 'Holds the email subject
Dim strMessage 'Holds the email newsletter
Dim strEmailBody 'Holds the email newsletter
Dim laryCatID 'Array to hold the categories to send mail to
Dim lngLoopCounter 'Holds the loop counter
Dim lngNumberOfMembers 'Holds the number of members email is sent to
Dim strMembersEmail 'Holds the email address
Dim strUserName 'Holds the user name of the member
Dim strMailFormat 'Holds the mail format
'Initiliase variables
lngLoopCounter = 0
'Read in the form details
strSubject = Request.Form("subject")
strMessage = Request.Form("message")
blnHTMLFormat = CBool(Request.Form("HTML"))
'Set the email type to display
If blnHTMLFormat Then
strEmailType = "HTML"
strMailFormat = "HTML"
Else
strEmailType = "Plain Text"
strMailFormat = "text"
End If
'Get the list of who to send the emails to from the database
'***** START WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ******
If blnLCode Then
strSQL = "SELECT DISTINCT TOP " & intSendValue & " " & strDbTable & "Members.* "
Else
strSQL = "SELECT DISTINCT " & strDbTable & "Members.* "
End If
'***** END WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ******
strSQL = strSQL & "FROM " & strDbTable & "Members INNER JOIN " & strDbTable & "MemCat ON " & strDbTable & "Members.Mail_ID = " & strDbTable & "MemCat.Mail_ID "
'Get the mail format and check user is active
If blnHTMLFormat Then
strSQL = strSQL & "WHERE " & strDbTable & "Members.Active = " & strDBTrue & " AND " & strDbTable & "Members.HTMLformat = " & strDBTrue & " "
Else
strSQL = strSQL & "WHERE " & strDbTable & "Members.Active = " & strDBTrue & " AND " & strDbTable & "Members.HTMLformat = " & strDBFalse & " "
End If
'Get the cat ID's if any
If isEmpty(Request.Form("catID")) = false Then
strSQL = strSQL & "AND ("
'For each checked category box add to the sql query
For each laryCatID in Request.Form("catID")
'Loop counter
lngLoopCounter = lngLoopCounter + 1
'See if an OR is needed
If lngLoopCounter > 1 Then strSQL = strSQL & " OR "
'SQL to get the category
strSQL = strSQL & "" & strDbTable & "MemCat.Cat_ID =" & CLng(laryCatID)
Next
strSQL = strSQL & ")"
End If
'Set the order by cluase
strSQL = strSQL & " ORDER BY " & strDbTable & "Members.Mail_ID ASC;"
'Set the cursor type so we can do a record count
rsCommon.CursorType = 3
'Query the database
rsCommon.Open strSQL, adoCon
'Rset loop counter
lngLoopCounter = 0
'Get the number of mailing list members this email is being sent to
lngNumberOfMembers = rsCommon.RecordCount
%>
Sending <% = strEmailType %> Newsletter
Your Newletters are being sent. Now!!
Do not Hit Refresh or some members will receive the Newsletter twice!
This may take some time depending on the speed of the mail server and how many e-mail's there are to send.
<%
'Create email object
Call createMailObject(strMailComponent)
'Loop through the recordset and send the e-mail to everyone in the mailing list
Do While NOT rsCommon.EOF
'Initliase email body
strEmailBody = strMessage
'Read in details
strMembersEmail = rsCommon("Email")
strUserName = rsCommon("Name")
''Replace code with the persons user name
strEmailBody = Replace(strEmailBody, "#name#", strUserName, 1, -1, 1)
'***** START WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ******
'Write a remove from mailing list message to add to the end of the e-mail in HTML Format
strEmailBody = strEmailBody & mailBody(strMailFormat, strMembersEmail, blnLCode)
'***** END WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ******
'Send the email
Call SendMail(strUserName, strMembersEmail, strMailComponent, strMailFormat)
'loop counter to count how many e-mails have been sent
lngLoopCounter = lngLoopCounter + 1
'Update the text box displaying the number of e-mails sent
Response.Write(vbCrLf & "")
'Move to the next record in the recordset
rsCommon.MoveNext
Loop
'Drop email component
Call dropMailObject(strMailComponent)
'Write a message saying that all the e-mails have been sent
Response.Write(vbCrLf & "
Your Newsletter has finshed being sent ![]()
")
'If the applifcation has reached in maximum then display a message to the user
If blnLCode Then
Response.Write("
You are using the free version of Web Wiz Mailing List ver. " & strVersion & "" & _
vbCrLf & "
Due to spammers abusing this software the free version has several limitations including only sending to the first " & intSendValue & " members of your Mailing List.
" & _
vbCrLf & "These restrictions where put in place as a number of spammers abused previous versions of the software which has lead to Web Wiz Guide being blacklisted by Anti-spam organisations.
" & _
vbCrLf & "To remove the limitations form this software and to remove the powered by links back to Web Wiz Guide a link removal key can be purchased from http://www.webwizguide.info/purchase/" & _
vbCrLf & "Thank-you for your co-operation on this matter.
")
End If
Response.Write("
Return to the the Administration Menu ")
'Reset Server Variables
rsCommon.Close
Set rsCommon = Nothing
adoCon.Close
Set adoCon = Nothing
%>