Formulário

Como usar formulário no Windows utilizando ASP FormMail

Primeiramente observe a cópia do “aspmailer.asp “ no final da página.

Configuração

Nas primeiras linhas do arquivo aspmailer.asp altere de acordo como mostra abaixo.
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
Formulario
Copie e cole o formulario em seu codigo, altere os devidos campos de acordo com o texto explicativo de cada campo altere o email, o assunto e a pagina para qual serão direcionada ao enviar o email no campo "_redirect", tambem é possivel incluir e remover mais campos ao formulario adicionando em "_requiredFields" e incluindo mais um input exemplo:
<input name="_requiredFields" type="hidden" value="telefone" >
Telefone: <input name="telefone" type="text" >
Formulario com os principais campos
<form action="aspmailer.asp" method="post">
<input name="_recipients" type="hidden" value="email@dominio.com.br" />
<input name="_subject" type="hidden" value="Fale conosco Form Mail" />
<input name="_requiredFields" type="hidden" value="nome,assunto,email,comentario" />
Nome: <input name="nome" type="text" />
Assunto: <input name="assunto" type="text" />
Email: <input name="email" type="text" />
Comentario: <textarea name="comentario" rows="5" cols="50"></textarea>
<input type="submit" value="Enviar" />
<input type="reset" value="Limpar" />
</form>
Controle de Campos
Abaixo está uma lista destes campos. Note que todos começam com underscore ('_') para distinguir esse form de qualquer outro form. Alguns campos que comecam com underscore ('_') não aparecem no email enviado.
FormMail Campos

aspmailer.asp

<%@ 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.exemplo.com.br","exemplo.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 %>