<%@Language = VBScript %>
<% Option Explicit %>
<%
'#File: MailListAdmin_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:
'#	a is the value for "a" in the query string, which can be any of the following:
'#		0 - Print the Configurations for the current list
'#		1 - Print the email form to email a message to members of the current list
'#		2 - Mail the message to current list
'#		8 - Print the members of the current list
'#		9 - View all the currently configured Mailing Lists 
'#
'#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 Windows 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 "MailList_basic.asp".
'#
'#RUNNING:
'#	1) The URL to address the Admin interface is:
'#		http://www.yourdomain.com/scripts/MailListAdmin_basic.asp?a=9
'#
'#ADDITIONAL FEATURES AVAILABLE IN THE ADVANCED VERSION:
'#		1) Print the Add form to add an email to the current list
'#		2) Adding an email to the current list directly, bypassing any
'#		confirmation emails
'#		3) Removing an email from the current list directly, bypassing any
'#		confirmation emails
'#		4) Removing several emails from the current list directly, bypassing
'#		any confirmation emails
'#		5) Displaying the Remove the form to remove an email from the current list
'#		6) Web interface to update current list settings
'#		7) Web interface to Create a new list
'#		8) Web interface to Delete a list
'#		9) Web interface to Update URLs 
'#		10) Support for MULTIPLE lists
'#		11) Exporting mail list data to Excel, Word, and a text editor
'#		12) Sorting member data by email address or date joined
'#
'#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 programs is stored 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	04/08/05	Fixed a bug. "r_send_html_format" 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. New features added.
'#		1.01	06/18/02	Corrected a mailing bug which stopped the program from emailing
'#					every member on the list.
'#		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, subject, from , message, datafile
a = Request("a")
e = Request("e")
subject = Request("subject")
from = Request("from")
message = Request("message")
Dim Abbreviation, AnError, ErrorMessage, Title, Admin_Email, Mail_List_Data_File
Dim Email_Admin_With_List_Update, Mail_Subscribe_Thank_You_Letter, Send_HTML_Format
Dim datestring, output, msg_body, reqMsg, email_address, emails, key
Dim fso, file, line, line_arr, found
AnError = False
%>
<HTML>
<HEAD>
<TITLE>Mailing List 
<%
If (IsNumeric(a)) Then
	a = Cint(a)
	If (a<>0 AND a<>1 AND a<>2 AND a<>8 AND a<>9) Then
		a = 9				
	End If
Else
	AnError = True
	ErrorMessage = ("<H3>An error occurred. You are not accessing this script with the correct URL Query String.<BR><BR>See the documentation for more details.</H3>" & vbcrlf)
End If
Title = C_TITLE
Mail_List_Data_File = C_MAIL_LIST_DATA_FILE
If (NOT AnError AND (a <> 9)) Then
	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)
	Response.Write ("for: """ & Title & """" & vbcrlf)
End If
%>
</TITLE>
</HEAD>
<BODY BGCOLOR="#FFFFFF">
<% 
If (AnError) Then
	Response.Write("<H3>" & ErrorMessage & "</H3>")
Else '###No error
%>
<TABLE WIDTH="100%" BORDER="0" CELLPADDING="3" CELLSPACING="0">
<TR><TD BGCOLOR="#FF69B4" COLSPAN="2">
<H2>Mail List Administrative Interface 
</H2>
</TD></TR>
<TR VALIGN="top">
<TD>
<BR>
<%
'#Print the left hand column of buttons.
%>
<FORM ACTION="<%=Admin_Script_URL%>" METHOD="post">
<INPUT TYPE="hidden" NAME="a" VALUE="8">
<INPUT TYPE="submit" VALUE="View Current Members" STYLE="width:200;">
</FORM>
<FORM ACTION="<%=Admin_Script_URL%>" METHOD="post">
<INPUT TYPE="hidden" NAME="a" VALUE="1">
<INPUT TYPE="submit" VALUE="Email Members" STYLE="width:200;">
</FORM>
<FORM>
<INPUT TYPE="button" VALUE="Add a Member" onClick="alert('Available in the ADVANCED version.');return true;" STYLE="width:200;">
</FORM>
<FORM>
<INPUT TYPE="button" VALUE="Remove a Member" onClick="alert('Available in the ADVANCED version.');return true;" STYLE="width:200;">
</FORM>
<FORM>
<INPUT TYPE="button" VALUE="Export List Data" onClick="alert('Available in the ADVANCED version.');return true;" STYLE="width:200;">
</FORM>
<FORM ACTION="<%=Admin_Script_URL%>" METHOD="post">
<INPUT TYPE="hidden" NAME="a" VALUE="0">
<INPUT TYPE="submit" VALUE="View/Update List Settings" STYLE="width:200;">
</FORM>
<FORM>
<INPUT TYPE="button" VALUE="View List Stats" onClick="alert('Available in the ADVANCED version.');return true;" STYLE="width:200;">
</FORM>
<BR><HR WIDTH="200" ALIGN="left"><BR>
<FORM ACTION="<%=Admin_Script_URL%>" METHOD="post">
<INPUT TYPE="hidden" NAME="a" VALUE="9">
<INPUT TYPE="submit" VALUE="View All Lists" STYLE="width:200;">
</FORM>
<FORM>
<INPUT TYPE="button" VALUE="View/Update URLs" onClick="alert('Available in the ADVANCED version.');return true;" STYLE="width:200;">
</FORM>
<FORM>
<INPUT TYPE="button" VALUE="Create a New List" onClick="alert('Available in the ADVANCED version.');return true;" STYLE="width:200;">
</FORM>
<FORM>
<INPUT TYPE="button" VALUE="Delete a List" onClick="alert('Available in the ADVANCED version.');return true;" STYLE="width:200;">
</FORM>
</TD>
<TD>
<BR>
<%
If (a = 0) Then
	'#Print the configurations for the current list.
%>
<FORM>
<TABLE BORDER="3" CELLPADDING="3" CELLSPACING="1">
<TR><TD COLSPAN="2" BGCOLOR="#CCCCCC"><H3>Current Configurations for: <%=Title%></H3></TD></TR>
<TR><TD><B>Mail List Abbreviation:</B></TD><TD>N/A</TD></TR>
<TR><TD><B>URL for Members to add themselves to this list:</B></TD><TD><A HREF="<%=Script_URL%>"><NOBR><%=Script_URL%></NOBR></A></TD></TR>
<TR><TD><B>URL for Members to remove themselves to this list:</B></TD><TD><NOBR>Available in the advanced version</NOBR></TD></TR>
<TR><TD><B>Mail List Title:</B><BR>The full title for this list.</TD><TD><INPUT TYPE="text" NAME="ltitle" SIZE="40" VALUE="<%=Title%>"></TD></TR>
<TR><TD><B>Email a "thank you" message to each new subscriber?:</B><BR>
Selecting "yes" will have the program email the new subscriber a "thank you" message for joining "<%=Title%>".</TD>
<TD>
<SELECT>
<%
Response.Write ("<OPTION VALUE=""True""")
If (Mail_Subscribe_Thank_You_Letter) Then
	Response.Write (" SELECTED")
End If
Response.Write (">Yes" & vbcrlf)
Response.Write ("<OPTION VALUE=""False""")
If (Not Mail_Subscribe_Thank_You_Letter) Then
	Response.Write (" SELECTED")
End If
Response.Write (">No" & vbcrlf)
%>
</SELECT>
</TD></TR>
<TR><TD><B>Administrator's Email:</B></TD><TD><INPUT TYPE="text" SIZE="40" VALUE="<%=Admin_Email%>"></TD></TR>
<TR><TD><B>Email Admin with each list update?:</B><BR>
Selecting "yes" will have the program email the administrator everytime someone confirms their addition or removal from this list.</TD><TD>
<SELECT NAME="emailadmin">
<%
Response.Write ("<OPTION VALUE=""True""")
If (CBool(Email_Admin_With_List_Update)) Then
	Response.Write (" SELECTED")
End If
Response.Write (">Yes" & vbcrlf)
Response.Write ("<OPTION VALUE=""False""")
If (Not CBool(Email_Admin_With_List_Update)) Then
	Response.Write (" SELECTED")
End If
Response.Write (">No" & vbcrlf)
%>
</SELECT>
</TD></TR>
<TR><TD><B>Send HTML formatted messages by default?:</B>
</TD><TD>
<SELECT>
<%
Response.Write ("<OPTION VALUE=""True""")
If (Send_HTML_Format) Then
	Response.Write (" SELECTED")
End If
Response.Write (">Yes" & vbcrlf)
Response.Write ("<OPTION VALUE=""False""")
If (Not Send_HTML_Format) Then
	Response.Write (" SELECTED")
End If
Response.Write (">No" & vbcrlf)
%>
</SELECT>
</TD></TR>
<TR>
<TD><B>Datafile for this mail list:</B><BR>Full operating system path, including the file name.<BR>
<B>NO BACKSLASHES "\"!</B><BR>
Examples:<BR>
<CODE>F:/Inetpub/wwwroot/scripts/maillist/listdata.txt<BR>
/var/home/public_html/somedir/datafile.txt</CODE></TD>
<TD><INPUT SIZE="50" TYPE="text" VALUE="<%=Mail_List_Data_File%>"></TD>
</TR>
<TR><TD>&nbsp;</TD><TD><INPUT TYPE="button" VALUE="Update <%=Title%>!" onClick="alert('Available in the ADVANCED version.');return true;"></TD></TR>
</TABLE>
</FORM>
<%
ElseIf (a = 1) Then
	'#Print the Email form to mail a message to the members.
	Set fso = Server.CreateObject("Scripting.FileSystemObject")
	If (fso.FileExists(C_MAIL_LIST_DATA_FILE)) Then
		Set file = fso.GetFile(C_MAIL_LIST_DATA_FILE)
		If (file.Size <> 0) Then

%>
<SCRIPT LANGUAGE="JavaScript">	
function Preview() {
	if (!document.Compose.send_html_format[1].checked) {
	    alert("Preview is for HTML documents only");
	} else {
	    var prevWnd=window.open("", "prvw", "width=500,height=580,scrollbars=yes,resizable=yes,status=0");
	    prevWnd.document.open();
	    prevWnd.document.writeln(
		'<HTML><TITLE>HTML Preview: ' + document.Compose.subject.value + '</TITLE><BODY bgcolor=#ffffff><TABLE WIDTH="100%" BORDER="0"><TR><TD><B>HTML Message Preview:</B></TD><TD ALIGN="right"><A HREF="javascript:window.close()">Close</A></TD></TR></TABLE><BR><TABLE BORDER="1" WIDTH="100%" CELLPADDING="5" CELLSPACING="0" BORDERCOLOR="#000000"><TR><TD>'
	    );
	    prevWnd.document.writeln(document.Compose.message.value);
	    prevWnd.document.writeln('</TD></TR></TABLE></BODY></HTML>');
	    prevWnd.document.close();
	}
}
</SCRIPT>
<H3>
Email members of: <%=Title%>
</H3>
<FORM NAME="Compose" ACTION="<%=Admin_Script_URL%>" METHOD="post">
<INPUT TYPE="hidden" NAME="a" VALUE="2">
From: <INPUT TYPE="text" NAME="from" SIZE="40" VALUE="<%=Admin_Email%>"><BR>
<BR>
Subject: <INPUT TYPE="text" NAME="subject" SIZE="40"><BR>
<BR>
Message: <BR>
<TEXTAREA NAME="message" ROWS="25" COLS="72" WRAP="VIRTUAL"></TEXTAREA><BR>
<BR>
Send as: 
<%
Response.Write("<INPUT TYPE=""radio"" NAME=""send_html_format"" VALUE=""False""")
If (NOT Send_HTML_Format) Then
	Response.Write(" CHECKED")
End If
Response.Write(">Text&nbsp;&nbsp;")
Response.Write("<INPUT TYPE=""radio"" NAME=""send_html_format"" VALUE=""True""")
If (Send_HTML_Format) Then
	Response.Write(" CHECKED")
End If
Response.Write(">HTML&nbsp;&nbsp;")
%>
[<A HREF="JavaScript:Preview();">Preview</A>]<BR>
<BR>
<INPUT TYPE="submit" VALUE="Mail the members of: <%=Title%>"><BR>
</FORM>
<%
		Else '###No members
			Response.Write ("<H3>There are no members currently subscribed to the mail list """ & Title & """.</H3>" & vbcrlf)
		End If
		Set file = Nothing
	Else
		Response.Write ("<H3>There are no members currently subscribed to the mail list """ & Title & """.</H3>" & vbcrlf)
	End If
	Set fso = Nothing
ElseIf  (a = 2) Then
	'#Mail the message to the members on the list.
	If (StrComp(subject,"") = 0) Then
		Response.Write ("<H3>You need to provide a subject for your email.</H3>" & vbcrlf)
	ElseIf (StrComp(from,"") = 0) Then
		Response.Write ("<H3>You need to specify a ""from"" address for your email.</H3>" & vbcrlf)
	Else
		Set fso = Server.CreateObject("Scripting.FileSystemObject")
		If (fso.FileExists(Mail_List_Data_File)) Then
			Set file = fso.OpenTextFile(Mail_List_Data_File, 1)
			Dim successes, failures, errnum, errdesc
			Set successes = CreateObject("Scripting.Dictionary")
			Set failures = CreateObject("Scripting.Dictionary")
			While Not file.AtEndOfStream
				line = file.ReadLine
				line_arr = Split(line, "|")
				email_address = Trim(line_arr(0))
				Set reqMsg = Server.CreateObject("CDONTS.NewMail")
				If (CBool(Send_HTML_Format)) Then
					reqMsg.BodyFormat = 0
					reqMsg.Mailformat = 0
					msg_body = "<HTML><HEAD><TITLE>" & Title & "</TITLE></HEAD><BODY>" & vbcrlf
				Else
					reqMsg.BodyFormat = 1
					reqMsg.Mailformat = 1
				End If
				msg_body = message & vbcrlf
				If (CBool(Send_HTML_Format)) Then
					msg_body = msg_body & "<BR><BR>"
				End If
				msg_body = msg_body & vbcrlf & vbcrlf & "You are receiving this email because you subscribed to: " & Title & vbcrlf & vbcrlf
				If (CBool(Send_HTML_Format)) Then
					msg_body = msg_body & "<BR><BR>"
				End If
				msg_body = msg_body & vbcrlf & vbcrlf
				If (CBool(Send_HTML_Format)) Then
					msg_body = msg_body & "<BR><BR></BODY></HTML>"
				End If
				Err.Clear
				On Error Resume Next
				reqMsg.Send Admin_Email, email_address, subject, msg_body
				errnum = Err.number
				errdesc = Err.Description
				On Error Goto 0				
				Set reqMsg = Nothing
				If (errnum = 0) Then
					successes.Add email_address, 1
				Else
					failures.Add email_address, 1
				End If
			Wend
			If (failures.Count > 0 AND successes.Count > 0) Then
				Response.Write ("<A HREF=""#failures"">Click to view members who could not be emailed emailed</A><BR>" & vbcrlf)
				Response.Write ("<A HREF=""#successes"">Click to view members successfully emailed</A><BR>" & vbcrlf)
				Response.Write ("<BR><HR><BR>" & vbcrlf)
			End If
			If (failures.Count > 0) Then
				Response.Write ("<A NAME=""failures""> </A>" & vbcrlf)
				Response.Write ("<H3>These " & failures.Count & " member(s) were not emailed:</H3>" & vbcrlf)
				For Each key In failures 
					Response.Write (key & "<BR>" & vbcrlf)
				Next
			End If
			Response.Write ("<A NAME=""successes""> </A>" & vbcrlf)
			If (successes.Count > 0) Then
				Response.Write ("<H3>Successfully sent an email to these " & successes.Count & " member(s):</H3>" & vbcrlf)
				For Each key In successes 
					Response.Write (key & "<BR>" & vbcrlf)
				Next
			Else
				Response.Write ("<H3>No members were successfully emailed.</H3>" & vbcrlf)
			End If
			failures.RemoveAll
			successes.RemoveAll
			Set failures = Nothing
			Set successes = Nothing
		Else
			Response.Write ("<H3>Error! There are no members currently subscribed to the mail list """ & Title & """!</H3>" & vbcrlf)
		End If
	End If
ElseIf  (a = 8) Then
	'#Print the current list of members. 
	Dim ScriptObject
	Set fso = Server.CreateObject("Scripting.FileSystemObject")
	If (fso.FileExists(Mail_List_Data_File)) Then
		Set ScriptObject = Server.CreateObject("Scripting.FileSystemObject")
		Set file = ScriptObject.GetFile(Mail_List_Data_File)
		If (file.Size > 0) Then
%>
	<TABLE BGCOLOR="#FFFFFF" BORDER="3" CELLPADDING="3" CELLSPACING="0">
	<TR BGCOLOR="#CCCCCC">
	<TD COLSPAN="3">
		<TABLE BORDER="0">
		<TR>
		<TD><H3><%=Title%> Members:</H3></TD>
		<TD>[export]</TD>
		</TR>
		<TR><TD><BR></TD></TR>
		<TR>
		<TD>
		<FORM>
		Display:
		<SELECT>
		<OPTION>as saved in datafile</OPTION>
		<OPTION>email addresses ascending order</OPTION>
		<OPTION>email addresses descending order</OPTION>
		<OPTION>date joined ascending order</OPTION>
		<OPTION>date joined descending order</OPTION>
		</SELECT>
		<INPUT TYPE="button" VALUE="Go!" onClick="alert('Available in the ADVANCED version.');return true;">
		</FORM>
		</TD>
		</TR>	
		</TABLE>
	</TD>
	</TR>
	<FORM>
	<TR><TH>Remove?</TH><TH>Email Address</TH><TH>Date Joined</TH></TR>
<%
			Set file = fso.OpenTextFile(Mail_List_Data_File, 1)
			Do While Not file.AtEndOfStream
				line = file.ReadLine
				If (line <> "") Then
					line_arr =  Split(line, "|")
					Response.Write ("<TR>" & vbcrlf)
					Response.Write ("<TH><INPUT NAME=""es"" TYPE=""checkbox"" VALUE=""" & Trim(line_arr(0)) & """></TH>" & vbcrlf)
					Response.Write ("<TD>" & line_arr(0) & "</TD>" & vbcrlf)
					Response.Write ("<TD>" & line_arr(1) & "</TD>" & vbcrlf)
					Response.Write ("</TR>" & vbcrlf)
				End If
			Loop
			file.Close
			Response.Write ("<TR><TH><INPUT TYPE=""button"" VALUE=""Remove Checked"" onClick=""alert('Available in the ADVANCED version.');return true;""></TH><TD>&nbsp;</TD><TD>&nbsp;</TD></TR>" & vbcrlf)
			Response.Write ("</TABLE>" & vbcrlf & "</FORM>" & vbcrlf)
		Else
			Response.Write ("<H3>The mail list """ & Title & """ currently has no members.</H3>" & vbcrlf)
		End If
	Else 
		Response.Write ("<H3>The mail list """ & Title & """ currently has no members.</H3>" & vbcrlf)
	End If
	Set file = Nothing
	Set fso = Nothing			
ElseIf  (a = 9) Then
	'#View all current lists
%>
<TABLE BORDER="3" CELLPADDING="3" CELLSPACING="1">
<TR><TD COLSPAN="4" BGCOLOR="#CCCCCC"><H3>All Mail Lists. Click on a list for specifics.</H3></TD></TR>
<TR><TH>List Abbreviation</TH><TH>List Title</TH><TH COLSPAN="2">&nbsp;</TH></TR>
<%
	Set fso = Server.CreateObject("Scripting.FileSystemObject")
	Response.Write ("<TR>" & vbcrlf)
	Response.Write ("<TD>Basic Test List</TD>" & vbcrlf)
	Response.Write ("<TD>" & C_TITLE & "</TD>" & vbcrlf)
	Response.Write ("<TD>[<A HREF=""" & ADMIN_SCRIPT_URL & "?a=0"">Update</A>]</TD>" & vbcrlf)
	If (fso.FileExists(C_MAIL_LIST_DATA_FILE)) Then
		Set file = fso.GetFile(C_MAIL_LIST_DATA_FILE)
		If (file.Size <> 0) Then
			Response.Write ("<TD>[<A HREF="""& ADMIN_SCRIPT_URL & "?a=8"">Members</A>]</TD>" & vbcrlf)
		Else
			Response.Write ("<TD>No Members</TD>" & vbcrlf)
		End If
		Set file = Nothing
	Else
		Response.Write ("<TD>No Members</TD>" & vbcrlf)
	End If
	Response.Write ("</TR>" & vbcrlf)
	Set fso = Nothing
	Response.Write ("</TABLE>" & vbcrlf)
End If
%>
</TD>
</TR>
</TABLE>
<%
End If '###Not AnError
%>
<BR>
</BODY>
</HTML>