<%@LANGUAGE="VBSCRIPT"%>
<%
Page_Title = "Mailing List"
%>
<%
'******************************** Form URL ***********************************'
Dim MM_editAction
MM_editAction = CStr(Request.ServerVariables("SCRIPT_NAME"))
If (Request.QueryString <> "") Then
MM_editAction = MM_editAction & "?" & Server.HTMLEncode(Request.QueryString)
End If
%>
<%
'******************************* Insert Contact **********************************'
If CStr(Request.Form("command_insert")) = "insertform" Then
%>
<%
if(CStr(Request.Form("nametitle")) <> "") then InsertCommand__NameTitleValue = CStr(Request.Form("nametitle"))
if(CStr(Request.Form("forename")) <> "") then InsertCommand__ForenameValue = CStr(Request.Form("forename"))
if(CStr(Request.Form("surname")) <> "") then InsertCommand__SurnameValue = CStr(Request.Form("surname"))
if(CStr(Request.Form("email")) <> "") then InsertCommand__EmailValue = CStr(Request.Form("email"))
if(CStr(Request.Form("addressline1")) <> "") then InsertCommand__AddressLine1Value = CStr(Request.Form("addressline1"))
if(CStr(Request.Form("addressline2")) <> "") then InsertCommand__AddressLine2Value = CStr(Request.Form("addressline2"))
if(CStr(Request.Form("addressline3")) <> "") then InsertCommand__AddressLine3Value = CStr(Request.Form("addressline3"))
if(CStr(Request.Form("addressline4")) <> "") then InsertCommand__AddressLine4Value = CStr(Request.Form("addressline4"))
if(CStr(Request.Form("postcode")) <> "") then InsertCommand__PostcodeValue = CStr(Request.Form("postcode"))
if(CStr(Request.Form("receivebyemail")) <> "") then InsertCommand__ReceiveByEmailValue = CStr(Request.Form("receivebyemail"))
if(CStr(Request.Form("receivebypost")) <> "") then InsertCommand__ReceiveByPostValue = CStr(Request.Form("receivebypost"))
if(CStr(Request.Form("accept")) <> "") then InsertCommand__AcceptValue = CStr(Request.Form("accept"))
%>
<%
If InsertCommand__NameTitleValue = "" Then MSG = MSG + "Please enter the title\n"
If InsertCommand__ForenameValue = "" Then MSG = MSG + "Please enter the forename\n"
If InsertCommand__SurnameValue = "" Then MSG = MSG + "Please enter the surname\n"
If IsEmailValid(InsertCommand__EmailValue) = False Then MSG = MSG + "Please enter a valid email address\n"
' If InsertCommand__AddressLine1Value = "" Then MSG = MSG + "Please enter the address\n"
' If InsertCommand__PostcodeValue = "" Then MSG = MSG + "Please enter the postcode\n"
If InsertCommand__ReceiveByEmailValue <> "Y" And InsertCommand__ReceiveByPostValue <> "Y" Then MSG = MSG + "Please select to receive your newsletter by email or by post.\n"
If InsertCommand__AcceptValue <> "Y" Then MSG = MSG + "Please tick the box to confirm you agree to 20000 voices terms and contitions\n"
If MSG = "" Then
%>
<%
CommandCompleted = "Y"
set InsertCommand = Server.CreateObject("ADODB.Command")
InsertCommand.ActiveConnection = MM_DATA_STRING
InsertCommand.CommandText = "INSERT INTO MailingList (MailingListTitle, MailingListForename, MailingListSurname, MailingListEmail, MailingListAddressLine1, MailingListAddressLine2, MailingListAddressLine3, MailingListAddressLine4, MailingListPostcode, MailingListReceiveByEmail, MailingListReceiveByPost, MailingListSubscribe) VALUES ('" + Replace(InsertCommand__NameTitleValue, "'", "''") + "', '" + Replace(InsertCommand__ForenameValue, "'", "''") + "', '" + Replace(InsertCommand__SurnameValue, "'", "''") + "', '" + Replace(InsertCommand__EmailValue, "'", "''") + "', '" + Replace(InsertCommand__AddressLine1Value, "'", "''") + "', '" + Replace(InsertCommand__AddressLine2Value, "'", "''") + "', '" + Replace(InsertCommand__AddressLine3Value, "'", "''") + "', '" + Replace(InsertCommand__AddressLine4Value, "'", "''") + "', '" + Replace(InsertCommand__PostcodeValue, "'", "''") + "', '" + Replace(InsertCommand__ReceiveByEmailValue, "'", "''") + "', '" + Replace(InsertCommand__ReceiveByPostValue, "'", "''") + "', '" + Replace(InsertCommand__AcceptValue, "'", "''") + "')"
InsertCommand.CommandType = 1
InsertCommand.CommandTimeout = 0
InsertCommand.Prepared = true
On Error Resume Next
InsertCommand.Execute()
If err.number <> 0 Then
MSG = "Your email address is already registered with our mailing list, thankyou.\n"
CommandCompleted = "N"
err.clear
End If
On Error Goto 0
%>
<%
End If
End If
%>
<%
If (CommandCompleted = "Y") Then
mailBody = "Subscribtion to the 20000 voices newsletter via the website." + VBCrLf + VBCrLf
mailBody = mailBody + InsertCommand__NameTitleValue + " " + InsertCommand__ForenameValue + " " + InsertCommand__SurnameValue + VBCrLf + VBCrLf
If InsertCommand__ReceiveByEmailValue = "Y" Then
mailBody = mailBody + "Email : " + InsertCommand__EmailValue + VBCrLf + VBCrLf
End If
If InsertCommand__ReceiveByPostValue = "Y" Then
mailBody = mailBody + "Address : " + VBCrLf + VBCrLf + InsertCommand__AddressLine1Value + VBCrLf + InsertCommand__AddressLine2Value + VBCrLf + InsertCommand__AddressLine3Value + VBCrLf + InsertCommand__AddressLine4Value + VBCrLf + InsertCommand__PostcodeValue + VBCrLf
End If
Set objCDO = Server.CreateObject("CDONTS.NewMail")
objCDO.Subject = "Newsletter Subscription"
objCDO.BodyFormat = 1
objCDO.Body = mailBody
objCDO.To = Website_Email
objCDO.From = "postmaster@20000voices.org"
objCDO.Send
Set objCDO = nothing
End If
%>
<%
'********************************* Redirect ************************************'
If MSG <> "" Then
Session("MSG") = MSG
End If
If (CommandCompleted = "Y") Then
RedirectURL = CStr(Request.ServerVariables("SCRIPT_NAME")) & "?Subscribed=Y"
Response.Status="302 Object moved"
Response.Redirect(RedirectURL)
End If
%>
<%
' ******************************* Functions ********************************
' Function IsEmailValid(strEmail)
' Action: checks if an email is correct.
' Parameter: strEmail - the Email address
' Returned value: on success it returns True, else False.
Function IsEmailValid(strEmail)
Dim strArray
Dim strItem
Dim i
Dim c
Dim blnIsItValid
' assume the email address is correct
blnIsItValid = True
' split the email address in two parts: name@domain.ext
strArray = Split(strEmail, "@")
' if there are more or less than two parts
If UBound(strArray) <> 1 Then
blnIsItValid = False
IsEmailValid = blnIsItValid
Exit Function
End If
' check each part
For Each strItem In strArray
' no part can be void
If Len(strItem) <= 0 Then
blnIsItValid = False
IsEmailValid = blnIsItValid
Exit Function
End If
' check each character of the part
' only following "abcdefghijklmnopqrstuvwxyz_-."
' characters and the ten digits are allowed
For i = 1 To Len(strItem)
c = LCase(Mid(strItem, i, 1))
' if there is an illegal character in the part
If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 And Not IsNumeric(c) Then
blnIsItValid = False
IsEmailValid = blnIsItValid
Exit Function
End If
Next
' the first and the last character in the part cannot be . (dot)
If Left(strItem, 1) = "." Or Right(strItem, 1) = "." Then
blnIsItValid = False
IsEmailValid = blnIsItValid
Exit Function
End If
Next
' the second part (domain.ext) must contain a . (dot)
If InStr(strArray(1), ".") <= 0 Then
blnIsItValid = False
IsEmailValid = blnIsItValid
Exit Function
End If
' check the length oh the extension
i = Len(strArray(1)) - InStrRev(strArray(1), ".")
' the length of the extension can be only 2, 3, or 4
' to cover the new "info" extension
If i <> 2 And i <> 3 And i <> 4 Then
blnIsItValid = False
IsEmailValid = blnIsItValid
Exit Function
End If
' after . (dot) cannot follow a . (dot)
If InStr(strEmail, "..") > 0 Then
blnIsItValid = False
IsEmailValid = blnIsItValid
Exit Function
End If
' finally it's OK
IsEmailValid = blnIsItValid
End Function
%>
<%=Website_Name%> - <%=Page_Title%>