<% 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 emails 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 Dim lngErrorLoopCounter 'Holds the number of error occured 'Initiliase variables lngLoopCounter = 0 lngErrorLoopCounter = 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 'Save the newsletter (if sellected) If Request.Form("save") Then 'Initliase SQL query strSQL = "SELECT " & strDbTable & "Newsletter.* FROM " & strDbTable & "Newsletter;" 'Set the cursor type property of the record set to Dynamic so we can navigate through the record set rsCommon.CursorType = 2 'Set the Lock Type for the records so that the record set is only locked when it is updated rsCommon.LockType = 3 'Query the database rsCommon.Open strSQL, adoCon 'Add new rs rsCommon.AddNew 'Update rs rsCommon.Fields("Newsletter") = strMessage rsCommon.Fields("Newsletter_subject") = strSubject rsCommon.Fields("Newsletter_note") = Request.Form("saveNote") rsCommon.Fields("Display") = CBool(Request.Form("display")) rsCommon.Fields("HTML") = blnHTMLFormat 'Update db rsCommon.Update 'Close the rs rsCommon.Close 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 ****** 'from members table strSQL = strSQL & "FROM " & strDbTable & "Members " 'only join to the memCat table if categires are to be looked up If isEmpty(Request.Form("catID")) = false AND CBool(Request.Form("allCats")) = false Then strSQL = strSQL & " 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 AND CBool(Request.Form("allCats")) = 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 = 1 'Set the Lock Type so we can do a record count rsCommon.LockType = 1 '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 %> Send Newsletter
Sending <% = strEmailType %> Newsletter

Your Newsletters 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.
There are Newsletters sent out of a total of <% = lngNumberOfMembers %>

There have been errors sending emails
Errors are coursed by things like malformed emails address, the SMTP server maybe down, etc.
If you get allot of errors check your email component settings.
<% 'Create email object Call createMailObject(strMailComponent) 'Set error trapping On Error Resume Next '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 & "") 'Check to see if an error has occured If Err.Number <> 0 Then 'Increase no. of errors if error has occured lngErrorLoopCounter = lngErrorLoopCounter + 1 'Update the text box displaying the number of errors Response.Write(vbCrLf & "") 'Reset error object Err.Number = 0 End If 'Move to the next record in the recordset rsCommon.MoveNext Loop 'Disable error trapping On Error goto 0 '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 from 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 %>