[ÇóÖú]¹ØÓÚÓʼþ·¢Ë͵ÄASP´úÂëÌÖÂÛ

¿É°®µÄÈË

×Ô¼ºÐ´Á˸öÓʼþÁÐ±í£¬ÆäÖÐÓиöÎļþÊÇÓÃÀ´Ö´Ðз¢Ë͵ģ¬¿ØÖÆÿ·¢Ò»·âÔÝÍ£10Ã룬20·âºóÔÝÍ£5·ÖÖÓ¡£¿ÉÊDz»Ö´ÐС£ÎªÊ²Ã´ÄØ£¿£¿ÄÄÀïÓÐ´í£¬´ó¼Ò°ïÎÒ¿´¿´¡£ÎÒÓõÄÊÇWINDOWS SERVER2003+SMTP¡£ÏÈлÁË£¬Çë°ÑÄã¸ÄµÄÌùÏÂÃæ¸úÌù¡£¾ßÌå´úÂëÈçÏ£º
¡°
<% Option Explicit %>
<!--#include file="common.asp" -->
<!--#include file="functions/functions_send_mail.asp" -->
<%
'****************************************************************************************
'** Copyright Notice
'**
'** Web Wiz Guide - Web Wiz Mailing List
'**
'** Copyright 2001-2005 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
'See if anyone is sellected to send newslleter to
If isEmpty(Request.Form("catID")) AND CBool(Request.Form("allCats")) = false Then
strSQL = "Select " & strDbTable & "Members.* FROM " & strDbTable & "Members Where " & strDbTable & "Members.ID_Code='webwizmailinglistxxxxx1';"

'Else get the members to send to
Else

'***** START WARNING - REMOVAL or MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ******
If blnLCode Then
strSQL = "Select DISTINCT TOP " & intRelayType & " " & 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;"
End If

'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
%>
<html>
<head>
<!--#include file="includes/browser_page_encoding_inc.asp" -->
<title>Send Newsletter</title>
<!--//
/* *******************************************************
Application: Web Wiz Mailing List ver.<% = strVersion %>
Author: Bruce Corkhill
Info: http://www.webwizmailinglist.com
Available FREE: http://www.webwizmailinglist.com
Copyright: Bruce Corkhill ?001-2005. All rights reserved
******************************************************* */
//-->
<link href="web_wiz_mailing_list_access2000_v4.6/mailing_list/includes/admin_default_style.css" rel="stylesheet" type="text/css">
<style type="text/css">
<!--
body {
background-image: url('web_wiz_mailing_list_access2000_v4.6/mailing_list/images/admin_bg.gif');
}
.style1 {color: #FF0000}
-->
</style>
</head>
<body bgcolor="#FFFFFF" text="#000000" background="web_wiz_mailing_list_access2000_v4.6/mailing_list/images/admin_bg.gif">
<div align="center" class="text"><span class="heading">Sending <% = strEmailType %> Newsletter</span>
<br /><br />
<span class="bold">Your Newsletters are being sent</b> to the SMTP server. Now!!<br />
<br />
</span><span class="lgText style1">Do not Hit Refresh or some members will receive the Newsletter more than once!</font></span><span class="text"><br />
<br />
This may take some time depending on the speed of your SMTP mail server, network speed, and how many email's there are to send.<br />
<br />
</span>
<form name="frmSent">
<span class="text">There are <input type="text" size="4" name="sent" value="0">
Newsletters sent to the SMTP server out of a total of
<% = lngNumberOfMembers %></span> <br>
<br>
<span class="text">There have been <input type="text" size="4" name="err" value="0"> errors sending emails<br>
Full details of any errors returned by the email component will be shown in the text box below. <br>
<textarea name="errMsg" cols="60" rows="8" id="errMsg">Error messages:-
</textarea>
<br>
</span><span class="smText">Errors are coursed by things like malformed emails address, the SMTP server maybe down, etc.<br />
Check the textarea above for detailed error messages on any errors sending Newsletters.
</span>
</form>
<%
'################# SendMail Throttle #################
' Mod to pause the script for x minutes after x sent email
' Written by David Francis for a person (alexr) on the forum Tuesday 29 Aug, 2006 8:01 am
' If you like it, use it or have comment, please visit www.davidfrancis.org
' Caveat: This was written for a small list on a localhost, it will max out the cpu
' use at your own risk
Dim pCount ' To keep track of the number sent
Dim nPause ' The number of email sent between pauses
Dim wTime ' Holds the wait time after nPause specified number
Dim wTime2 ' The amount of time between each email.

pCount = 1 ' Simple interval counter
nPause = 5 ' Number of email sent before long pause
wTime = Now() + (600 / (24 * 60* 60)) '5 minutes or long pause
wTime2 = Now() + (10 / (24 * 60* 60)) '10 seconds between each email
'################# /SendMail Throttle #################
'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")

'Null values can course crashes so remove them
If isNull(strUserName) Then strUserName = ""

'Replace code with the user details
strEmailBody = Replace(strEmailBody, "#name#", strUserName, 1, -1, 1)
strEmailBody = Replace(strEmailBody, "#email#", strMembersEmail, 1, -1, 1)
strEmailBody = Replace(strEmailBody, "#unsubscribe#", "<a href=""" & strWebsiteAddress & "default.asp?email=" & strMembersEmail & """>" & strWebsiteAddress & "/default.asp?email=" & strMembersEmail & "</a>", 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)

'################# SendMail Throttle #################
if pCo