Her er så koden:
'Set the response buffer to false as we may need to puase while the e-mails are being sent
Response.Buffer = False
Server.ScriptTimeout = 64800
'Dimension variables
Dim rsMailList 'Database recordset variable
Dim strEmailBody 'Holds the body of the e-mail
Dim strAppendToEmail 'Holds the link to get removed from the mailing list
Dim strSubject 'Holds the subject of the e-mail
Dim blnEmailSent 'Set to true if the e-mail has been sent
Dim blnPreviewEmailSent 'Set to true if a preview e-mail has been sent
Dim lngNumberOfMembers 'Holds the number of mailing list members
Dim intEmailSentLoopCounter 'Lopp counter to count the number of e-mails sent
'Initialise variables
blnEmailSent = False
blnPreviewEmailSent = False
lngNumberOfMembers = 0
intEmailSentLoopCounter = 0
'If the session variable is False or does not exsist then redirect the user to the unauthorised user page
%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<title>Send E-mail to Mailing List Members</title>
<script language="JavaScript">
<!-- Hide from older browsers...
//Function to check form is filled in correctly before submitting
function CheckForm() {
var errorMsg = "";
//Check for a Subject
if (document.frmSendmail.subject.value == ""){
errorMsg += "\n\tE-mail Subject \t- Skriv en tekst i Emne-feltet";
}
//Check for the e-mail body
if (document.frmSendmail.body.value==""){
errorMsg += "\n\tE-mail Body \t- Skriv en tekst i Besked-feltet";
}
//If there is aproblem with the form then display an error
if (errorMsg != ""){
msg = "_____________________________________________________________\n\n";
msg += "Dine email blev ikke sendt - der var nogle problemer med formularen.\n";
msg += "Prøv at rette fejl og forsøg så igen.\n";
msg += "_____________________________________________________________\n\n";
msg += "Følgende felter skal rettes: -\n";
errorMsg += alert(msg + errorMsg + "\n\n");
return false;
}
return true;
}
// -->
</script>
</head>
<body bgcolor="#FFFFFF" text="#000000">
<div align="center"><b><font size="5" face="Arial, Helvetica, sans-serif">Send en </font></b> <b><font size="5" face="Arial, Helvetica, sans-serif">Nyhedsmail</font></b> <a href="../dbadmin/te_admin.asp" target="_self">
<br>
Tilbage til hovedmenuen</a>
<br>
<br>
<%
'If the e-mail is to be sent to all members then send it to all the mailing list members
If Request.Form("Submit") = "Send til Alle" Then
'Create the email body
'Read in the body of the e-mail
strEmailBody = Request.Form("body")
strSubject = Request.Form("subject")
'If the e-mail is in HTML format then change the format of the e-mail
If Request.Form("format") = "HTML" OR Request.Form("format") = "advHTML" Then
'Replace new lines with HTML new lines if requested
If Request.Form("format") = "HTML" AND Request.Form("lineBreak") = "true" Then strEmailBody = Replace(strEmailBody, vbCrLf, "<br>", 1, -1, 1)
'Let the e-mail client know were using HTML
strEmailBody = "<html><body>" & strEmailBody
End If
'Strip out Norton Internet Security add blocking code that messes up emails
strEmailBody = Replace(strEmailBody, "<SCRIPT> window.open=NS_ActualOpen; </SCRIPT>", "", 1, -1, 1)
'Create recordset object
Set rsMailList = Server.CreateObject("ADODB.Recordset")
'Initalise the strSQL variable with an SQL statement to query the database
strSQL = "SELECT Maillingliste.* FROM Maillingliste;"
'Set the cursor type so we can do a record count
rsMailList.CursorType = 3
'Query the database
rsMailList.Open strSQL, adoCon
'Get the number of mailing list members
lngNumberOfMembers = rsMailList.RecordCount
'Create email object
Call createMailObject(strMailComponent)
'Display the HTML for sending the mail
'Display a message on the screen incase the user thinks nothing is happening and hits refresh sending the e-mail's twice
Response.Write("<b><font size=""4"">Emailen er ved at blive sendt</b><br>Du ikke trykke på opdater-knappen - så vil Alle modtage mailen flere gange!</font><br><br>Det kan godt tage et stykke tid...<br>")
'Display the number of e-mails sent and how many left to send
Response.Write("<form name=""frmSent"">Der er blevet sendt <input type=""text"" size=""4"" name=""sent"" value=""0""> antal emails ud af en total på " & lngNumberOfMembers & "</form>")
'Loop through the recordset and send the e-mail to everyone in the mailing list
Do While NOT rsMailList.EOF
'loop counter to count how many e-mails have been sent
intEmailSentLoopCounter = intEmailSentLoopCounter + 1
'Update the text box displaying the number of e-mails sent
Response.Write(vbCrLf & "<script langauge=""JavaScript"">document.frmSent.sent.value = " & intEmailSentLoopCounter & ";</script>")
'Write a remove from mailing list message to add to the end of the e-mail in HTML Format
strAppendToEmail = mailBody(Request.Form("format"), rsmailList("ID"), blnLCode)
'Send the email
Call SendMail(rsmailList("Email"), strMailComponent, Request.Form("format"))
'Move to the next record in the recordset
rsMailList.MoveNext
Loop
'Write a message saying that all the e-mails have been sent
Response.Write(vbCrLf & "<br><font size=""5""><b>Din email er nu blevet sendt til alle.</b></font></div>")
'Drop email component
Call dropMailObject(strMailComponent)
'Set up the page response
blnEmailSent = True
'Reset server objects
rsMailList.Close
Set rsMailList = Nothing
'Else if this is a preview e-mail then send the preview to the web master
ElseIf Request.Form("Submit") = "Send en testmail til mig selv" Then
'Save the e-mail to a session variable so we can read it back
If Request.Form("format") = "advHTML" Then Session("strMailBody") = Request.Form("body")
'Read in the body of the e-mail
strEmailBody = Request.Form("body")
strSubject = Request.Form("subject")
'If the e-mail is in HTML format then change the format of the e-mail
If Request.Form("format") = "HTML" OR Request.Form("format") = "advHTML" Then
'Replace new lines with HTML new lines if requested
If Request.Form("format") = "HTML" AND Request.Form("lineBreak") = "true" Then strEmailBody = Replace(strEmailBody, vbCrLf, "<br>", 1, -1, 1)
'Let the e-mail client know were using HTML
strEmailBody = "<html><body>" & strEmailBody
End If
'Strip out Norton Internet Security add blocking code that messes up emails
strEmailBody = Replace(strEmailBody, "<SCRIPT> window.open=NS_ActualOpen; </SCRIPT>", "", 1, -1, 1)
'Create email object
Call createMailObject(strMailComponent)
'Write a remove from mailing list message to add to the end of the e-mail in HTML Format
strAppendToEmail = mailBody(Request.Form("format"), "webmaster0001", blnLCode)
'Send the email
Call SendMail(strTestEmailAddress, strMailComponent, Request.Form("format"))
'Drop email component
Call dropMailObject(strMailComponent)
'Set up the page response
blnPreviewEmailSent = True
End If
'Clean up
Set strCon = Nothing
Set adoCon = Nothing
'If the e-mail's have not been sent then show the form for the user to fill in
If NOT blnEmailSent = True Then
'If a preview of the e-mail has ben sent then tell the user
If blnPreviewEmailSent = True Then
Response.Write "<br><font size=""5""><b>En testmail er blevet sendt til dig selv</b></font><br><br>"
End If
'Select which type of form e-mail format to use
Select Case Request.QueryString("Format")
Case "advHTML"
%>
<!-- #include file="advanced_mail_form_inc.asp" -->
<% Case "HTML" %>
<!-- #include file="html_mail_form_inc.asp" -->
<% Case Else %>
<!-- #include file="plain_mail_form_inc.asp" -->
<%
End Select
End If
%>
<br>
<div align="center"> </div>
</body>
</html>
