<%@ LANGUAGE="VBScript" %>
<% Option Explicit %>
<%
Dim referers
'***************************************************************************
'* ASP FormMail                                                            *
'*                                                                         *
'* Do not remove this notice.                                              *
'*                                                                         *
'* Copyright 1999-2002 by Mike Hall.                                       *
'* Please see http://www.brainjar.com for documentation and terms of use.  *
'***************************************************************************
'*                                                                         *
'* Fix for .INFO email address checking 31/03/04                           *
'*                                                                         *
'* Modified for use on LCN NT hosting 27/01/03                             *
'* http://www.lcn.biz                                                      *
'*                                                                         * 
'***************************************************************************

'===========================================================================
'### Customization of this value is required, see documentation.


referers   = Array("www.xs-bass.co.uk")


'### End required customization section.
'===========================================================================
'===========================================================================

Response.Buffer = true

Dim errorMsgs,validReferer,referer,host,recipients,name,fromAddr,subject,required,fieldOrder,body,msg

errorMsgs = Array()

'### Check for form data.

If Request.ServerVariables("Content_Length") = 0 Then

	call AddErrorMsg("No form data submitted.")

End If

'### Check if referer is allowed.

validReferer = false

referer = Request.ServerVariables("HTTP_HOST")

For each host in referers

	If host = referer Then
		validReferer = true
	End If

Next

If not validReferer Then
	If referer = "" Then
		call AddErrorMsg("No referer.")
	Else
		call AddErrorMsg("Invalid referer: '" & referer & "'.")
	End If
End If

'### Check for the recipients field.

If Request.Form("_recipients") = "" Then

	call AddErrorMsg("Missing email recipient.")

End If

'### Check all recipient email addresses.

recipients = Split(Request.Form("_recipients"), ",")

For each name in recipients

	name = Trim(name)

	If not IsValidEmail(name) Then

		call AddErrorMsg("Invalid email address in recipient list: " & name & ".")

	End If
Next

recipients = Join(recipients, ",")

'### Check that the senders email address has been supplied

If Request.Form("_sendersemail") = "" Then

	call AddErrorMsg("Missing senders email address.")

ElseIf not IsValidEmail(Trim(Request.Form("_sendersemail"))) Then

	call AddErrorMsg("Invalid senders email address: " & Request.Form("_sendersemail") & ".")

Else

	fromAddr = Trim(Request.Form("_sendersemail"))

End If

'### Get subject text.

If Request.Form("_subject") = "" Then

	call AddErrorMsg("Missing subject of email.")

Else

	subject = Request.Form("_subject")

End If

'### If required fields are specified, check for them.

If Request.Form("_requiredFields") <> "" Then

	required = Split(Request.Form("_requiredFields"), ",")

	For each name in required

		name = Trim(name)

		If Left(name, 1) <> "_" and Request.Form(name) = "" Then

			call AddErrorMsg("Missing value for " & name)

		End If
	Next

End If

'### Use the order the fields were received in.

fieldOrder = FormFieldList()

'### If there were no errors, build the email message and send it.

If UBound(errorMsgs) < 0 Then

'### Build table of form fields and values.

	body = "Below are the results of your feedback form." & Chr(13) & Chr(10) & Chr(13) & Chr(10)

	For each name in fieldOrder

		body = body & name & ": " & Request.Form(name) & Chr(13) & Chr(10)

	Next

'### Send it.

	SendMail()

'### Redirect if a URL was given.

	If Request.Form("_redirect") <> "" Then

		Response.Redirect(Request.Form("_redirect"))

	End If

End If 

%>

<html>
<head>
<title>Form Mail</title>
<style style="text/css">

body {
  background-color: #ffffff;
  color: #000000;
  font-family: Arial, Helvetica, sans-serif;
  font-size: 10pt;
}

table {
  border: solid 1px #000000;
  border-collapse: collapse;
}

td, th {
  border: solid 1px #000000;
  border-collapse: collapse;
  font-family: Arial, Helvetica, sans-serif;
  font-size: 10pt;
  padding: 2px;
  padding-left: 8px;
  padding-right: 8px;
}

th {
  background-color: #c0c0c0;
}

.error {
  color: #c00000;
}

</style>
</head>
<body>

<%

If UBound(errorMsgs) >= 0 Then

%>
<p class="error">Form could not be processed due to the following errors:</p>
<ul>
<%

	For each msg in errorMsgs

%>
  <li class="error"><% = msg %>
<%

	Next

%>
</ul>
</td></tr></table>
<%

Else

%>
<table cellpadding="0" cellspacing="0">
<tr>
  <th colspan="2" valign="bottom">
  Thank you, the following information has been sent:
  </th>
</tr>
<%

	For each name in fieldOrder

%>
<tr valign="top">
  <td><b><% = name %></b></td>
  <td><% = Request.Form(name) %></td>
</tr>
<%

Next

%>
</table>
<%

End If

%>
</body>
</html>
<%

'### Subroutines and functions.

Sub AddErrorMsg(msg) '# Add an error message to the list.

	Dim n
	n = UBound(errorMsgs)
	Redim Preserve errorMsgs(n + 1)
	errorMsgs(n + 1) = msg

End sub

Function IsValidEmail(email) '# Check for valid syntax in an email address.

	Dim names,name,i,c

	IsValidEmail = true
	names = Split(email, "@")

	If UBound(names) <> 1 Then
		IsValidEmail = false
		Exit function
	End If

	For each name in names
		If Len(name) <=  0 Then
			IsValidEmail = false
			Exit function
		End If

		For i = 1 to Len(name)
			c = Lcase(Mid(name, i, 1))
			If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) Then
				IsValidEmail = false
				Exit function
			End If
		Next

		If Left(name, 1) = "." or Right(name, 1) = "." Then
			IsValidEmail = false
			Exit function
		End if

	Next

	If InStr(names(1), ".") <= 0 Then
		IsValidEmail = false
		Exit function
	End If

	i = Len(names(1)) - InStrRev(names(1), ".")

	If i <> 2 and i <> 3 and i <> 4 Then
		IsValidEmail = false
		Exit function
	End If

	If InStr(email, "..") > 0 Then
		IsValidEmail = false
	End If

End function

Function FormFieldList() '# Build an array of form field names ordered as they were received.

	Dim str,i,name

	str = ""

	For i = 1 to Request.Form.Count
		For each name in Request.Form
			If Left(name, 1) <> "_" and Request.Form(name) is Request.Form(i) Then
				If str <> "" then
					str = str & ","
				End If
				str = str & name
				Exit For
			End If
		Next
	Next

	FormFieldList = Split(str, ",")

End function

Function SendMail()

	Dim mailObj

	'# Send email (CDONTS version), doesn't support reply-to address and has no error checking.

	Set mailObj = Server.CreateObject("CDONTS.NewMail")
	mailObj.BodyFormat = 1
	mailObj.MailFormat = 1
	mailObj.From = fromAddr
	mailObj.To = recipients
	mailObj.Subject = subject
	mailObj.Body = body
	mailObj.Send
	Set mailObj = Nothing

End function 

%>