Untitled Document

<%@ LANGUAGE="VBScript" %>

  <%	'**************************************************************************

'* ASP FormMail                                                           *

'*                                                                        *

'* Do not remove this notice.                                             *

'*                                                                        *

'* Copyright 1999-2008 by Mike Hall.                                      *

'* Please see http://www.brainjar.com for documentation and terms of use. *

'**************************************************************************
 '- Customization of these values is required, see documentation. ----------

  allowedHosts = Array("www.examplo.com.br","examplo.com.br") 'Coloque aqui o seu dominio

  mailComp   = "CDOSYS" ' Não MEXER

  smtpServer = "localhost" ' Não MEXER

  fromAddr = "email@exemplo.com.br" 'Coloque o seu email para onde sera enviado o formulario
 allowedRecipients = Array()

  allowedEnvars     = Array("HTTP_USER_AGENT", "REMOTE_ADDR", "REMOTE_USER")
 allowCcToFlag = true
 botCheckFlag    = false

  botCheckID      = "MyBotCheckID"

  botCheckMinTime = 5
 '- End required customization section. ------------------------------------
 'Initialize.

  Response.Buffer = true

  errorMsgs = Array()
 'Check for form data.

  if Request.ServerVariables("Content_Length") = 0 then

  call AddErrorMsg("No form data submitted.")

  end if
 'If bot checking is enabled, check the elapsed time.

  if botCheckFlag then

  startTime = Session(botCheckID)

  if not IsDate(startTime) then

  call AddErrorMsg("Invalid submission.")

  elseif DateDiff("s", startTime, Now()) < botCheckMinTime then

  call AddErrorMsg("Invalid submission.")

  end if

  end if
 'Check if the referering host is allowed.

  if UBound(allowedHosts) >= 0 then

  host = GetHost(Request.ServerVariables("HTTP_REFERER"))

  if host = "" then

  call AddErrorMsg("No referer.")

  elseif not InList(host, allowedHosts) then

  call AddErrorMsg("Unauthorized host: '" & host & "'.")

  end if

  end if
 'Check the email recipients.

  if Request.Form("_recipients") = "" then

  call AddErrorMsg("No email recipient(s) specified.")

  else

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

  for each addr in recipients

  addr = Trim(addr)

  if not IsValidEmailAddress(addr) then

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

  elseif UBound(allowedRecipients) >= 0 then

  if not inList(addr, allowedRecipients) then

  call AddErrorMsg("Unauthorized email address in recipient list: " & addr & ".")

  end if

  end if

  next

  recipients = Join(recipients, ",")

  end if
 'Check for a cc-to or reply-to address.

  ccToAddr = ""

  replyToAddr = ""

  name = Trim(Request.Form("_ccToField"))

  if name <> "" then

  if not allowCcToFlag then

  call AddErrorMsg("Configuration error: use of _ccToField not permitted.")

  else

  ccToAddr = Request.Form(name)

  if ccToAddr <> "" then

  if not IsValidEmailAddress(ccToAddr) then

  call AddErrorMsg("Invalid email address in " & name & " field: " & ccToAddr & ".")

  end if

  end if

  end if

  else

  name = Trim(Request.Form("_replyToField"))

  if name <> "" then

  replyToAddr = Request.Form(name)

  if replyToAddr <> "" then

  if not IsValidEmailAddress(replyToAddr) then

  call AddErrorMsg("Invalid email address in " & name & " field: " & replyToAddr & ".")

  end if

  end if

  end if

  end if
 'Get the subject text.

  subject = Request.Form("_subject")
 'If required fields are specified, check 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
 'If a field order was given, use it. Otherwise use the order the fields

  'were received in.

  str = ""

  if Request.Form("_fieldOrder") <> "" then

  fieldOrder = Split(Request.Form("_fieldOrder"), ",")

  for each name in fieldOrder

  if str <> "" then

  str = str & ","

  end if

  str = str & Trim(name)

  next

  fieldOrder = Split(str, ",")

  else

  fieldOrder = FormFieldList()

  end if
 'If there were no errors, build the email note and send it.

  if UBound(errorMsgs) < 0 then
 'Build table of form fields and values.

  body = "<table border=""0"" cellpadding=""2"" cellspacing=""0"">" & vbCrLf

  for each name in fieldOrder

  body = body _

  & "<tr valign=""top"">" _

  & "<td><strong>" & name & ":</strong></td>" _

  & "<td>" & Request.Form(name) & "</td>" _

  & "</tr>" & vbCrLf

  next

  body = body & "</table>" & vbCrLf
 'Add a table for any requested environment variables.

  if Request.Form("_envars") <> "" then

  body = body _

  & "<p>&nbsp;</p>" & vbCrLf _

  & "<table border=""0"" cellpadding=""2"" cellspacing=""0"">" & vbCrLf

  envars = Split(Request.Form("_envars"), ",")

  for each name in envars

  name = Trim(name)
 'Only show environment variables in the permitted list.

  showEnvar = true

  if UBound(allowedEnvars) >= 0 then

  showEnvar = InList(name, allowedEnvars)

  end if

  if showEnvar then

  body = body _

  & "<tr valign=""top"">" _

  & "<td><strong>" & name & ":</strong></td>" _

  & "<td>" & Request.ServerVariables(name) & "</td>" _

  & "</tr>" & vbCrLf

  end if

  next

  body = body & "</table>" & vbCrLf

  end if
 'Send it.

  str = SendMail()

  if str <> "" then

  AddErrorMsg(str)

  else

  'Clear the bot check timestamp.

  Session.Contents.Remove(botCheckID)
 'Redirect if a URL was given.

  if Request.Form("_redirectUrl") <> "" then

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

  end if

  end if
 end if %>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">

  <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">

  <head>

  <meta http-equiv="Content-Type" content="text/html;charset=utf-8" />

  <title>Form Mail</title>

  <style type="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;

  font-family: Arial, Helvetica, sans-serif;

  font-size: 10pt;

  padding: 2px 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 %></li>

  <%		next %>

  </ul>

  <p><a href="#" onclick="history.go(-1); return false;">Back</a></p>

  <%	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><strong><% = name %></strong></td>

  <td><% = Request.Form(name) %></td>

  </tr>

  <%		next %>

  </table>

  <%		if Request.Form("_continueUrl") <> "" then %>

  <p><a href="<% = Request.Form("_continueUrl") %>">Continue</a></p>

  <%		end if

  end if %>

  </body>

  </html>

  <%	'==========================================================================

  ' Functions and subroutines.

  '==========================================================================
 '--------------------------------------------------------------------------

  ' Adds an error message to the list.

  '--------------------------------------------------------------------------

  sub AddErrorMsg(msg)
 dim n
 n = UBound(errorMsgs)

  Redim Preserve errorMsgs(n + 1)

  errorMsgs(n + 1) = msg
 end sub
 '--------------------------------------------------------------------------

  ' Extracts the host name from a URL.

  '--------------------------------------------------------------------------

  function GetHost(url)
 dim i, str
 GetHost = ""
 'Strip down to host or IP address and port number, if any.

  if Left(url, 7) = "http://" then

  str = Mid(url, 8)

  elseif Left(url, 8) = "https://" then

  str = Mid(url, 9)

  end if

  i = InStr(str, "/")

  if i > 1 then

  str = Mid(str, 1, i - 1)

  end if

  GetHost = str
 end function
 '--------------------------------------------------------------------------

  ' Returns true if the given string is in the given array.

  '--------------------------------------------------------------------------

  function InList(str, list)
 dim item
 InList = false
 'Scan the list.

  for each item in list

  if str = item then

  InList = true

  exit function

  end if

  next
 end function
 '--------------------------------------------------------------------------

  ' Returns true if the given email address is in valid format.

  '--------------------------------------------------------------------------

  function IsValidEmailAddress(addr)
 dim list, item

  dim i, c
 IsValidEmailAddress = true
 'Exclude any address with '..'.

  if InStr(addr, "..") > 0 then

  IsValidEmailAddress = false

  exit function

  end if
 'Split email address into the user and domain names.

  list = Split(addr, "@")

  if UBound(list) <> 1 then

  IsValidEmailAddress = false

  exit function

  end if
 'Check both names.

  for each item in list
 'Make sure the name is not zero length.

  if Len(item) <=  0 then

  IsValidEmailAddress = false

  exit function

  end if
 'Make sure only valid characters appear in the name.

  for i = 1 to Len(item)

  c = Lcase(Mid(item, i, 1))

  if InStr("abcdefghijklmnopqrstuvwxyz&_-.", c) <= 0 and not IsNumeric(c) then

  IsValidEmailAddress = false

  exit function

  end if

  next
 'Make sure the name does not start or end with invalid characters.

  if Left(item, 1) = "." or Right(item, 1) = "." then

  IsValidEmailAddress = false

  exit function

  end if
 next
 'Check for a '.' character in the domain name.

  if InStr(list(1), ".") <= 0 then

  IsValidEmailAddress = false

  exit function

  end if
 end function
 '--------------------------------------------------------------------------

  ' Builds an array of form field names ordered as they were received.

  ' Note that fields whose name starts with an underscore are ignored.

  '--------------------------------------------------------------------------

  function FormFieldList()
 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
 '--------------------------------------------------------------------------

  ' Sends email based on mail component. Uses global variables for parameters

  ' because there are so many.

  '--------------------------------------------------------------------------
 function SendMail()
 dim mailObj, cdoMessage, cdoConfig

  dim addrList
 SendMail = ""
 'Send email (CDONTS version). Note: CDONTS has no error checking.

  if mailComp = "CDONTS" then

  set mailObj = Server.CreateObject("CDONTS.NewMail")

  mailObj.BodyFormat = 0

  mailObj.MailFormat = 0

  mailObj.From = fromAddr

  mailObj.To = recipients

  if ccToAddr <> "" then

  mailObj.Value("Reply-To") = Trim(ccToAddr)

  mailObj.CC = Trim(ccToAddr)

  elseif replyToAddr <> "" then

  mailObj.Value("Reply-To") = Trim(replyToAddr)

  end if

  mailObj.Subject = subject

  mailObj.Body = body

  mailObj.Send

  set mailObj = Nothing

  exit function

  end if
 'Send email (CDOSYS version).

  if mailComp = "CDOSYS" then

  set cdoMessage = Server.CreateObject("CDO.Message")

  set cdoConfig = Server.CreateObject("CDO.Configuration")

  cdoConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

  cdoConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = smtpServer

  cdoConfig.Fields.Update

  set cdoMessage.Configuration = cdoConfig

  cdoMessage.From =  fromAddr

  cdoMessage.To = recipients

  if ccToAddr <> "" then

  cdoMessage.ReplyTo = Trim(ccToAddr)

  cdoMessage.CC = Trim(ccToAddr)

  elseif replyToAddr <> "" then

  cdoMessage.ReplyTo = Trim(replyToAddr)

  end if

  cdoMessage.Subject = subject

  cdoMessage.HtmlBody = body

  on error resume next

  cdoMessage.Send

  if Err.Number <> 0 then

  SendMail = "Email send failed: " & Err.Description & "."

  end if

  set cdoMessage = Nothing

  set cdoConfig = Nothing

  exit function

  end if
 'Send email (JMail version).

  if mailComp = "JMail" then

  set mailObj = Server.CreateObject("JMail.SMTPMail")

  mailObj.Silent = true

  mailObj.ServerAddress = smtpServer

  mailObj.Sender = fromAddr

  mailObj.Subject = subject

  addrList = Split(recipients, ",")

  for each addr in addrList

  mailObj.AddRecipient Trim(addr)

  next

  if ccToAddr <> "" then

  mailObj.ReplyTo = Trim(ccToAddr)

  mailObj.AddRecipientCC Trim(ccToAddr)

  elseif replyToAddr <> "" then

  mailObj.ReplyTo = Trim(replyToAddr)

  end if

  mailObj.ContentType = "text/html"

  mailObj.Body = body

  if not mailObj.Execute then

  SendMail = "Email send failed: " & mailObj.ErrorMessage & "."

  end if

  exit function

  end if
 'Send email (ASPMail version).

  if mailComp = "ASPMail" then

  set mailObj = Server.CreateObject("SMTPsvg.Mailer")

  mailObj.RemoteHost  = smtpServer

  mailObj.FromAddress = fromAddr

  for each addr in Split(recipients, ",")

  mailObj.AddRecipient "", Trim(addr)

  next

  if ccToAddr <> "" then

  mailObj.ReplyTo = Trim(ccToAddr)

  mailObj.AddCC "", Trim(ccToAddr)

  elseif replyToAddr <> "" then

  mailObj.ReplyTo = Trim(replyToAddr)

  end if

  mailObj.Subject = subject

  mailObj.ContentType = "text/html"

  mailObj.BodyText = body

  if not mailObj.SendMail then

  SendMail = "Email send failed: " & mailObj.Response & "."

  end if

  exit function

  end if
 end function %>
fim teste