Imports System.Drawing Imports System.Web.Mail Partial Class User_Controls_FormMailer Inherits System.Web.UI.UserControl ' get the request object 'Private Request As HttpRequest '************************************************************************************************************************************* 'CONFIGURATION SECTION STARTS HERE '************************************************************************************************************************************* ' Allow posting in cases where the Referer: header has been stripped. Private AllowEmptyReferer As Boolean = False ' Allow any recipient from the form. True allows any recipient. You can set this 'to false and then specify allowed recipients below. This is reccomended but optional Private AllowAnyRecipients As Boolean = True ' Allowed e-mail addresses for formmail.aspx to send e-mail to. The elements of this ' array can be either simple e-mail addresses ("you@your.domain") or domain ' name ("your.domain"). If its a domain name, then *any* address at the domain ' will be allowed. Private AllowMailTo As String() = {"*"} ' If true, then a blank line is printed after each form value in the e-mail. Private DoubleSpacing As Boolean = True ' Max recipients; maximum number of recipients that a form should be allowed to e-mail ' messages to. Private MaxRecipients As Integer = 3 ' No Content - indicates that rather than returning the HTML confirmation page or ' doing a redirect the script will output a header that indicates that no content should ' be returned and that the submitted form should not be replaced. This should be used ' carefully as an unwitting visitor may click the submit button several times thinking ' that nothing has happened. Private NoContent As Boolean = False ' A hash for predefining a list of recipients in the script, and then choosing ' between them using the recipient form field, while keeping all the e-mail ' addresses out of the HTML so that they don't get harvested. ' ' The key is the alias, the value is the e-mail address. ' ' The recipients in RecipientAliases are automatically added to the allowed ' recipients list, so there's no need to list them all in AllowMailTo as well. Private RecipientAliases As New Hashtable() ' Referer: hosts allowed to relay through this script; ' unlike formmail.pl, the option to allow any is *not* possible. Private Referers As String() = {} ' The envelope sender address to use for all e-mails sent by the ' script. This address will receive bounce messages if any of the ' e-mails cannot be delivered. Private Sender As String = "webmaster@nbbithosting.com" ' SMTP relay Private SmtpRelay As String = "mail.nbbithosting.com" ' Wrap text at around 72 columns. Private WrapText As Boolean = True '************************************************************************************************************************ 'END CONFIGURATION SECTION 'DO NOT EDIT BELOW THIS LINE '************************************************************************************************************************ ' Handle the posted form data when the page loads and convert it to an e-mail to send. Protected Sub ProcessMail() If IsPostBack Then Page.Validate() If Page.IsValid Then 'Check the request method of this page is "POST", as if we aren't receiving form data, we can't 'do a damn thing. If Request.HttpMethod <> "POST" Then Me.SetError("Configuration Error: Did not arrive at this page through a POST.") Return End If lblResult.Text = "started" If Not Me.CheckReferer() Then Me.SetError([String].Format("Usage Error: Referer {0} is not permitted.", Request.UrlReferrer.ToString())) Return End If ' Parse out the form fields. Dim metaFields As Hashtable Dim contentFields As Hashtable Me.ParseForm(Me.Request.Form, metaFields, contentFields) ' Split out "required" and validate fields present; if not, redirect to "missing_fields_redirect"; ' if not present, throw error. If metaFields.ContainsKey("required") Then Dim reqFields As String() = DirectCast(metaFields("required"), String).Split(New Char() {","c}) For Each s As String In reqFields If Not contentFields.ContainsKey(s) Then If metaFields.ContainsKey("missing_fields_redirect") Then ' Execution terminates here. Me.Response.Redirect(DirectCast(metaFields("missing_fields_redirect"), String), True) Else Me.SetError([String].Format("User Error: The {0} field was not provided.", s)) Return End If End If Next End If If AllowAnyRecipients Then End If ' Split out the "recipient" metaField around commas; if it doesn't exist, throw error. If Not metaFields.ContainsKey("recipient") Then ' If no recipient specified, use the first member of the AllowMailTo variable, thus ' emulating the formmail behaviour. If Me.AllowMailTo.Length > 0 Then ' Fake it. metaFields.Add("recipient", Me.AllowMailTo(0)) Else Me.SetError("Usage Error: No recipients were specified for the form.") Return End If End If Dim rawRecipients As String() = DirectCast(metaFields("recipient"), String).Split(New Char() {","c}) ' Validate recipient count (MaxRecipients). If (MaxRecipients <> 0) AndAlso (rawRecipients.Length > Me.MaxRecipients) Then Me.SetError([String].Format("Usage Error: Too many recipients; maximum number is {0}.", Me.MaxRecipients)) Return End If ' Perform recipient alias substitution (RecipientAliases) to temp list. Dim trueRecipients As New ArrayList() Dim aliasRecipients As New ArrayList() For Each s As String In rawRecipients If Me.RecipientAliases.ContainsKey(s) Then aliasRecipients.Add(Me.RecipientAliases(s)) Else trueRecipients.Add(s) End If Next ' Validate recipient addresses (AllowMailTo). For Each s As String In trueRecipients Dim valid As Boolean = False For Each v As String In Me.AllowMailTo ' If it ends with the valid string, it's either the same, or in that domain. ' Yeah, partial addresses and domains will also work, this way, but let's not point ' it out, huh? If anyone does anything stupid with this option, it's their own damn ' fault. If s.EndsWith(v) Or v = "*" Then valid = True End If Next If valid = False Then Me.SetError([String].Format("Usage Error: Recipient {0} is not valid for this script.", s)) Return End If Next ' Add aliases back in, format final sending list. Dim sb As New StringBuilder() For Each s As String In aliasRecipients sb.Append(s) sb.Append(",") Next For Each s As String In trueRecipients sb.Append(s) sb.Append(",") Next sb.Remove(sb.Length - 1, 1) Dim recipients As String = sb.ToString() ' Split out and set "subject". Dim subject As String If metaFields.ContainsKey("subject") Then subject = DirectCast(metaFields("subject"), String) Else subject = "WWW Form Submission" End If ' Create message body pre-amble. Dim body As New StringBuilder() body.Append("Below is the result of your feedback form. It was submitted by" & Chr(10) & "") If contentFields.ContainsKey("realname") Then body.Append(DirectCast(contentFields("realname"), String)) Else body.Append("the user") End If If contentFields.ContainsKey("email") Then body.Append([String].Format(" <{0}>", DirectCast(contentFields("email"), String))) End If body.Append([String].Format(" on {0}." & Chr(10) & "", DateTime.Now)) body.Append("--------------------------------------------------------------------------" & Chr(10) & "" & Chr(10) & "") ' Loop on content fields and prepare message body; obey values of ' DoubleSpacing, WrapText, "sort", "print_blank_fields". Dim printBlankFields As Boolean Dim sortOrder As ArrayList If metaFields.ContainsKey("print_blank_fields") Then printBlankFields = True Else printBlankFields = False End If If metaFields.ContainsKey("sort") Then Dim sv As String = DirectCast(metaFields("sort"), String) If sv = "alphabetic" Then sortOrder = Me.GetFields(contentFields) sortOrder.Sort() ElseIf sv.StartsWith("order:") Then sortOrder = New ArrayList() Dim skeys As String() = (sv.Substring(6)).Split(New Char() {","c}) For Each s As String In skeys sortOrder.Add(s) Next Else Me.SetError([String].Format("Usage Error: the sort order {0} is not supported.", sv)) Return End If Else ' Or it can be blank, in which case we take them as they come. sortOrder = Me.GetFields(contentFields) End If ' Loop through the sort order For Each key As String In sortOrder ' Does the field exist? If so, append it if PrintBlankFields, if not, not, ' while wrapping the text. If contentFields.ContainsKey(key) And (Left(key, 2) <> "__") Then If DirectCast(contentFields(key), String) <> [String].Empty Then body.Append([String].Format("{0}" & Chr(10) & "", Me.BuildSingleField(key, DirectCast(contentFields(key), String)))) Else If printBlankFields Then body.Append([String].Format("{0}" & Chr(10) & "", Me.BuildSingleField(key, ""))) End If End If ' If DoubleSpacing, append extra blank line. If Me.DoubleSpacing Then body.Append("" & Chr(10) & "") End If End If Next ' Check for "email" and "realname" values in contentValues to decide whether or not to ' use as sender address. Dim senderaddr As String If contentFields.ContainsKey("email") Then If contentFields.ContainsKey("realname") Then senderaddr = [String].Format("{0} ({1})", DirectCast(contentFields("email"), String), DirectCast(contentFields("realname"), String)) Else senderaddr = DirectCast(contentFields("email"), String) End If Else senderaddr = Me.Sender End If ' Send e-mail to "recipient"s, from "email"/"realname", or Sender, accordingly, going ' though SmtpServer. Me.SendMail(recipients, senderaddr, subject, body.ToString()) ' If redirect, redirect to that page, otherwise... If metaFields.ContainsKey("redirect") Then Response.Redirect(DirectCast(metaFields("redirect"), String), True) End If ' If NoContent, return that code... If Me.NoContent Then Response.StatusCode = 204 Response.[End]() End If ' ...otherwise display "return_link", "return_link_title". If both 'are not present, drop through. If (metaFields.ContainsKey("return_link")) AndAlso (metaFields.ContainsKey("return_link_title")) Then hlReturn.NavigateUrl = DirectCast(metaFields("return_link"), String) hlReturn.Text = DirectCast(metaFields("return_link_title"), String) hlReturn.Visible = True End If lblResult.Text = "Your form was successfully submitted." & Chr(10) & "" End If End If End Sub Private Function BuildSingleField(ByVal key As String, ByVal value As String) As String Dim baseval As String = [String].Format("{0}: {1}", key, value) If Not Me.WrapText Then Return baseval Else ' Wrap the text at the 72nd column. Dim retval As New StringBuilder() ' Loop chopping the text at the 1st space before 72 and appending it as a new line. While baseval.Length > 72 Dim cutPosition As Integer = 72 While (baseval(cutPosition) <> " "c) AndAlso (cutPosition > 0) cutPosition -= 1 End While If cutPosition = 0 Then cutPosition = 72 End If ' if we hit the beginning, hard-cut it. retval.Append(baseval.Substring(0, cutPosition + 1)) retval.Append("" & Chr(10) & "") baseval = baseval.Remove(0, cutPosition + 1) End While ' Append the remains, *without* a new line. retval.Append(baseval) Return retval.ToString() End If End Function Private Function CheckReferer() As Boolean ' Check the referer header of this post against the authorised list; if it is allowed, return ' true; if not allowed, return false. ' Check for empty referer first. If Me.Request.UrlReferrer Is Nothing Then If Me.AllowEmptyReferer Then Return True Else Return False End If End If ' Get the host part. Dim host As String = Me.Request.UrlReferrer.Host For Each s As String In Me.Referers If s = host Then Return True End If Next ' If we don't find it in the array, it's not allowed. Return True End Function Private Function GetFields(ByVal fields As Hashtable) As ArrayList Dim retval As New ArrayList() For Each s As String In fields.Keys retval.Add(s) Next Return retval End Function ' Split up the posted form values into meta-keys that command formmail and content keys that are values ' to return. Private Sub ParseForm(ByVal formValues As NameValueCollection, ByRef metaValues As Hashtable, ByRef contentValues As Hashtable) Dim metaKeys As String() = {"recipient", "subject", "redirect", "return_link_url", "return_link_title", "sort", _ "required", "missing_fields_redirect", "print_blank_fields", "submit", "FormMailer1$Submit", "recaptcha_challenge_field", "recaptcha_response_field"} metaValues = New Hashtable() contentValues = New Hashtable() For Each k As String In formValues.Keys For Each m As String In metaKeys If k.Equals(m) Then metaValues.Add(k, formValues(k)) GoTo iterate End If Next contentValues.Add(k, formValues(k)) iterate: Next ' return the two new Hashtables End Sub Private Sub SendMail(ByVal recipient As String, ByVal sender As String, ByVal subject As String, ByVal body As String) ' Construct the message. Dim msg As New MailMessage() ' TODO: envelope from msg.From = sender msg.[To] = recipient msg.Subject = subject msg.Body = body SmtpMail.SmtpServer = Me.SmtpRelay Try SmtpMail.Send(msg) Catch ex As Exception Me.SetError([String].Format("Your submission could not be delivered: {0}", ex.Message)) Return End Try End Sub ' Set the text of an error message and colorise it. Private Sub SetError(ByVal errorMessage As String) lblResult.Text = errorMessage lblResult.ForeColor = Color.Red End Sub Protected Sub Submit_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Submit.Click If Page.IsValid Then ProcessMail() Else lblResult.Text = "Incorrect" lblResult.ForeColor = Drawing.Color.Red End If End Sub End Class