<%@Language = VBScript %>
<% Option Explicit %>
<%
'#File: MailList_basic.asp - Version 3.01
'#
'#	This program was written to support basic mailing-list functionality
'#without being dependent on an actual email alias for the mailing list. This
'#increases the portability while also significantly reducing  the possibilitiy
'#of spammers spamming members.
'#
'#	This particular file will do one of the following depending on the 
'#parameters passed to it:
'#	0 - Print subscribe form. This is done by default. 
'#	1 - Mail confirmation subscribe email to the user requesting to sign up.
'#	2 - Subscribe to the list if the user clicks on the link within their confirmation email.
'#
'#REQUIREMENTS:
'#  1) You must have the file "base64_encode_decode.asp" installed on your server.
'#	It is included as part of the archive.
'#	2) You must have an SMTP server running on the machine this script 
'#	is installed on.
'#	3) Must be running on a Microsoft Server running IIS 4.0 or later.
'#
'#INSTALLATION:
'#	1) Set the path to the "include" statements below. If you keep all your files
'#	in the same directory, you most likely will not have to edit the "include" statements.
'#	2) Set the values located in the "MailListConfigs_basic.asp" 
'#	file. ALL VALUES SHOULD BE ENCLOSED IN QUOTES.
'#	3) Complete the "installation" section of the file "MailListAdmin_basic.asp".
'#
'#RUNNING:
'#	1) The link to print the "Subscribe" form to your users is:
'#		http://www.yourdomain.com/scripts/MailList_basic.asp
'#
'#ADDITIONAL FEATURES AVAILABLE IN THE ADVANCED VERSION
'#	1) Providing the Unsubscribe form to allow users to automatically unsubscribe 
'#	from the list. 
'#	2) Mail confirmation unsubscribe email to the user requesting to be removed.
'#	3) Unsubscribing the user from the list if they click on the link within their confirmation email.
'#	4) Support for multiple lists
'#
'#More details can be found at http://www.davelozinski.com/scripts/
'#
'#WHERE/HOW TO PURCHASE THE ADVANCED VERSION
'#	http://www.davelozinski.com/scripts
'#
'#LICENSE:
'#	You are free to further develop/modify the source code to fit your
'#needs, but you MAY NOT resell and/or redistribute the source code in any  
'#way, manner, fashion, or form without my hand-written consent!
'#
'#	This license grants the purchaser of this archive the permission to
'#have an unlimited number of users use this script at any time.
'#Likewise, the purchaser may have any number of copies of this script as long 
'#as the media that this program resides on or run from is owned by the purchaser. 
'#If not, more licenses MUST be purchased.
'#
'#Examples:
'#	1) If you have your own webserver hosting your various customers, you only need once license 
'#to run the code on your webserver to provide the email functionality to your clients hosted on your server.
'#	2) If you are designing websites for 3 individual clients, each of which wants the email functionality, 
'#and each of which will be hosting their websites and emailer on their own server, 
'#then you need to purchase 3 licenses. 
'#
'#If you modify the source code in anyway for your own purposes, the
'#original header-comments must remain intact.
'#
'#REVISION HISTORY:
'#		3.01	12/03/04	Fixed "l" being undefined.
'#		3.00	07/31/04	Updated with advanced script.
'#		2.10	07/04/04	Updated with advanced script.
'#		2.00	04/12/03	Functionality improved. 
'#		1.01	06/18/02	Corrected a Mail formatting issue
'#		1.00	03/01/02	Original Version
'#
'#CONTACT INFORMATION:
'#	http://www.davelozinski.com/cgi-bin/email_lozinski.pl
'#
%>
<!--#include file="MailListConfigs_basic.asp"-->
<!--#include file="base64_encode_decode.asp"-->
<%
'################################
'#NOTHING BELOW THIS LINE SHOULD NEED TO BE CONFIGURED
'################################
Dim a, e
a = Request("a")
e = Request("e")
Dim AnError, ErrorMessage, Title, Admin_Email, Email_Admin_With_List_Update
Dim Mail_Subscribe_Thank_You_Letter, Send_HTML_Format, Mail_List_Data_File
Dim datestring, output, line_arr, msg_body, reqMsg, subject
Dim fso, file, found, line, errnum, errdesc
AnError = false
If (IsNumeric(a)) Then
	a = Cint(a)		'#0 - Print subscribe form
	If (a>2 OR a<0) Then	'#1 - Mail confirmation subscribe email
		a = 0		'#2 - Subscribe to list
	End If					
Else
	a = 0
End If
%>
<HTML>
<HEAD>
<TITLE>Mailing List 
<%
initCodecs	'#In base64 file
If ((a=1 OR a=2) AND (StrComp(e,"") = 0)) Then
	AnError = True
	ErrorMessage = ("<H3>You need to provide your email address.</H3>" & vbcrlf)
ElseIf (a=1) Then
	If (NOT IsValidEmailAddress(e)) Then
		AnError = True
		ErrorMessage = ("<H3>You need to provide a valid email address.</H3>" & vbcrlf)
	End If
ElseIf (a=2) Then
	If (NOT IsValidEmailAddress(base64Decode(e))) Then
		AnError = True
		ErrorMessage = ("<H3>You need to provide a valid email address.</H3>" & vbcrlf)
	End If
End If
If (NOT AnError) Then
	Title = C_TITLE
	Admin_Email = C_ADMIN_EMAIL
	Email_Admin_With_List_Update = CBool(C_EMAIL_ADMIN_WITH_LIST_UPDATE)
	Mail_Subscribe_Thank_You_Letter = CBool(C_MAIL_SUBSCRIBE_THANK_YOU_LETTER)
	Send_HTML_Format = CBool(C_SEND_HTML_FORMAT)
	Mail_List_Data_File = C_MAIL_LIST_DATA_FILE
	Response.Write ("for: """ & Title & """" & vbcrlf)
End If
%>
</TITLE>
</HEAD>
<BODY BGCOLOR="#FFFFFF">
<%
If (AnError) Then
	Response.Write (ErrorMessage)
Else
	If (a = 1) Then
		'#Mail the confirmation subscribe
		Set reqMsg = Server.CreateObject("CDONTS.NewMail")
		reqMsg.BodyFormat = 0
		reqMsg.Mailformat = 0		
		msg_body = "<HTML><HEAD><TITLE>" & Title & "</TITLE></HEAD><BODY>" & vbcrlf
		msg_body = msg_body & "You are receiving this email because your email address was submitted to "
		msg_body = msg_body & "subscribe to: "
		msg_body = msg_body  & vbcrlf & """" & Title & """." & vbcrlf  & vbcrlf & " <BR><BR> To confirm, click on the link below. " & _
		"If you cannot, copy and paste the URL into your browser. Thank you! <BR><BR> " & vbcrlf & vbcrlf & _
		"<A HREF=""" & SCRIPT_URL
		msg_body = msg_body & "?a=2&e=" & Server.URLEncode(base64Encode(e)) & """>" & SCRIPT_URL & "?a=2&e=" & Server.URLEncode(base64Encode(e))
		msg_body = msg_body & "</A><BR><BR>" & vbcrlf & "</BODY></HTML>" & vbcrlf & vbcrlf
		subject = "Confirmation Email: " & Title
		Err.Clear
		On Error Resume Next
		reqMsg.Send Admin_Email, e, subject, msg_body
		errnum = Err.number
		errdesc = Err.Description
		On Error Goto 0				
		Set reqMsg = Nothing
		If (errnum = 0) Then
			Response.Write ("<H3>Thank you! A confirmation email has been sent to """ & e & """.<BR><BR>" & vbcrlf)
			Response.Write ("You need to click on the URL (or copy and paste it into your browser) to confirm your selection.</H3>" & vbcrlf)
		Else
			Response.Write ("<H3>An error occurred and a confirmation email could not be sent to """ & e & """.<BR><BR>" & vbcrlf)
			Response.Write ("If the problem persists, please contact " & Admin_Email & ". Thank you!</H3>" & vbcrlf)
		End If
	ElseIf (a = 2) Then
		'# Subscribe to the list
		found = False
		Set fso = Server.CreateObject("Scripting.FileSystemObject")
		If fso.FileExists(Mail_List_Data_File) Then
			Set file = fso.OpenTextFile(Mail_List_Data_File, 1)
			While Not file.AtEndOfStream AND Not found
				line = file.ReadLine
				If (line <> "") Then
					line_arr =  Split(line, "|")
					If (StrComp(trim(line_arr(0)),base64Decode(e)) = 0) Then
						found = True
					End If
				End If
			Wend
			file.Close
			If (NOT found) Then
				output = base64Decode(e) & "|"
				datestring = datestring & Year(date)
				datestring = datestring & "-"
				If (Month(date) < 10) Then
					datestring = datestring & "0"
				End If
				datestring = datestring & Month(date)
				datestring = datestring & "-"
				If (Day(date) < 10) Then
					datestring = datestring & "0"
				End If
				datestring = datestring & Day(date)	
				output = output & datestring
				If fso.FileExists(Mail_List_Data_File) Then
					Set file = fso.OpenTextFile(Mail_List_Data_File, 8)
				Else
					Set file = fso.CreateTextFile(Mail_List_Data_File)
				End If
				file.WriteLine (output)
				file.Close
				If (Email_Admin_With_List_Update) Then
					EmailAdmin datestring
				End If
				Response.Write ("<H3>Thank you! You are now subscribed to: " & Title & "</H3>" & vbcrlf)
				If (Mail_Subscribe_Thank_You_Letter) Then
					Set reqMsg = Server.CreateObject("CDONTS.NewMail")
					reqMsg.BodyFormat = 1
					reqMsg.Mailformat = 1
					subject = "Thank you for subscribing to: " & Title
					msg_body = "Thank you for subscribing to " & Title & "!" & vbcrlf & vbcrlf 
					Err.Clear
					On Error Resume Next
					reqMsg.Send Admin_Email, base64Decode(e), subject, msg_body
					errnum = Err.number
					errdesc = Err.Description
					On Error Goto 0				
					Set reqMsg = Nothing
					If (errnum <> 0) Then
						Response.Write ("<H3>An error occurred and a ""thank you"" email could not be sent to """ & base64Decode(e) & """.<BR><BR>" & vbcrlf)
						Response.Write ("If the problem persists, please contact " & Admin_Email & ". Thank you!</H3>" & vbcrlf)
					End If
				End If
			Else '#NOT rs.BOF -- already in the list
				Response.Write("<H3>You have already subscribed to """ & Title & """.<BR><BR>" & vbcrlf)
				Response.Write("<A HREF=""" & SCRIPT_URL & "?a=5&e=" & Server.URLEncode(e) & """>Click here if you wish to unsubscribe.</A></H3>" & vbcrlf)
			End If
			Set file = Nothing
			Set fso = Nothing
		Else
			Response.Write ("<H3>An error occurred, and your confirmation could not be saved. Please try again." & vbcrlf)
			Response.Write ("If you continue to experience problems, please email " & Admin_Email & ". Thank you!</H3>" & vbcrlf)
		End If
	Else
		'#Print the subscribe form by default
	%>
	<H3><%=Title%> : Subscribe</H3>
	<P>
	Enter your email address below. A confirmation email will be sent to your email address.
	</P>
	<FORM ACTION="<%=SCRIPT_URL%>" METHOD="post">
	<INPUT TYPE="hidden" NAME="a" VALUE="1">
	<INPUT TYPE="text" NAME="e" SIZE="40" VALUE=""><BR>
	<BR>
	<INPUT TYPE="submit" VALUE="Subscribe to: <%=Title%>">
	</FORM>
<%
	End If
End If	
%>
	
<BR>
</BODY>
</HTML>

<%
'################################
'#Function IsValidEmailAddress
'#	Checks to make sure a user submitted an email address
'#in a valid format.
'################################
Function IsValidEmailAddress (theAddress)
	Dim re, valid, matches, match
	valid = false
	Set re = New RegExp
	re.IgnoreCase = True
	re.Global = True
	re.Pattern = "^(([\w\-\_])+(\.)*)+\@([\w\-\_]+\.)+[A-Za-z]{2,}$"
	Set matches = re.Execute(theAddress)	'###Done just so we can clean up the re object
	If (matches.Count = 0) Then
		valid = False
	Else
		valid = True
	End If
	Set re = Nothing
	Set matches = Nothing
	IsValidEmailAddress = valid
End Function '### IsValidEmailAddress

'################################
'#function EmailAdmin
'#	Sends an email to the address specified by ADMIN_EMAIL
'#everytime someone confirms to subscribe or unsubscribe
'#from the mailing list. This function is only called if
'#EMAIL_ADMIN_WITH_LIST_UPDATE is set to 1 (true).
'################################
Sub EmailAdmin (lt) 
	Dim reqMsg
	Set reqMsg = Server.CreateObject("CDONTS.NewMail")
	reqMsg.BodyFormat = 1
	reqMsg.Mailformat = 1
	msg_body = """" & base64Decode(e) & """"
	msg_body = msg_body & " subscribed to """ & Title & """ on: "
	msg_body = msg_body & lt & vbcrlf
	subject = "Mail List Update for: " & Title 
	reqMsg.Send Admin_Email, Admin_Email, subject, msg_body
	Set reqMsg = Nothing
End Sub
'################################
%>