<%
'Autor : Jonathan R. Cardozo (jonathandj)
'Finalidade : Classe para envio de e-mails independente do componente no servidor
' Suporte aos componentes: ASPEMAIL, ASPMAIL, CDONTS, CDO SYS, DUNDAS
'Data de Criação : 06/01/2008
'Data de Modificação : 06/01/2008
option explicit
class sendEmail
'Descrição [valor Padrão (tipo de entrada)] - exemplo
'[- Disponível em todos os componentes -]
'Separador de e-mail e de anexo valor padrão = ";"
dim anexo 'Caminho(s) físico(s) do(s)anexo(s) ["" (string)] - "c:\upload\jonathan.pdf;c:\teste\cris.doc"
dim separador 'Caracter que identifica a separação da string de anexo [";" (string)]
dim hostEmail 'SMTP do servidor de e-mail ["localhost" (string)]
dim hostPorta 'Porta utilizada pelo servidor [25,(integer)]
dim objeto 'Nome do componente utilizado ["CDONTS" (string)]
dim emailDe 'Endereço de e-mail do remetente ["" (string)] - "cris@unesp.br"
dim emailPara 'Endereço(s) de e-mail do(s) destinatário(s) ["" (string)] - "cris@unesp.br;cris@unesp.br"
dim emailCC 'Endereço(s) de e-mail do(s) destinatário(s) das cópias ["" (string)] - "cris@unesp.br;cris@unesp.br"
dim emailCCO 'Endereço(s) de e-mail do(s) destinatário(s) das cópias ocultas ["" (string)] - "cris@unesp.br;cris@unesp.br"
dim emailResposta 'Endereço de e-mail para receber a resposta ["" (string)] - "cris@unesp.br"
dim importancia 'Prioridade da mensagem 0 = baixa, 1 = normal e 2 = alta [1 (integer)]
dim assunto 'Título do e-mail ["" (string)]
dim mensagem 'Corpo do e-mail com a mensagem desejada ["" (string)]
dim timeOut 'Tempo de conexão com o servidor [60 (integer)]
dim html 'Habilita o uso de tags Html no corpo do e-mail [true (boolean)]
'[- Disponível em alguns os componentes -]
dim confirmacao 'Habilita a confirmação de recebimento de e-mail [false (boolean)]
dim username 'Nome de usuário para autenticação ["" (string)]
dim password 'Senha de usuário para autenticação ["" (string)]
dim emailNomeDe 'Nome do remetende do e-mail (não suportado em DUNDAS)
dim charSet 'Código do conjunto de caracteres ["ISO-8859-1" (string)]
function send()
dim i, componente, arrayEmail, resposta
if inStr("|ASPEMAIL|ASPMAIL|CDO|CDOSYS|CDONTS|DUNDAS|","|"&uCase(trim(objeto&""))&"|") = 0 then objeto = "CDONTS"
if len(trim(hostEmail)&"") = 0 then hostEmail = "localhost"
if not isNumeric(hostPorta) or len(trim(hostPorta)&"") = 0 then hostPorta = 25
if not isNumeric(timeOut) or len(trim(timeOut))&"" = 0 then timeOut = 60
if html <> false or len(trim(html)&"") = 0 then html = true
if confirmacao <> true or len(trim(confirmacao)&"") = 0 then confirmacao = false
if not isNumeric(importancia) or len(trim(importancia)&"") = 0 then importancia = 1
if len(trim(charSet)&"") = 0 then charSet = "ISO-8859-1"
if isNull(emailNomeDe) or isEmpty(emailNomeDe) or len(trim(emailNomeDe)&"") = 0 then emailNomeDe = ""
if len(trim(separador)&"") = 0 then separador = ";"
if len(trim(assunto)&"") = 0 then assunto = " "
password = trim(password)
username = trim(username)
emailDe = lCase(trim(emailDe))
emailPara = lCase(trim(emailPara))
emailCC = lCase(trim(emailCC))
emailCCO = lCase(trim(emailCCO))
assunto = trim(assunto)
mensagem = trim(mensagem)
anexo = trim(anexo)
separador = trim(separador)
charSet = trim(charSet)
if html = false then
mensagem = limpaHtml(mensagem)
end if
if importancia = 0 then
importancia = 5 'baixa
elseif importancia = 2 then
importancia = 1 'alta
else
importancia = 3 'normal
end if
componente = uCase(trim(objeto))
on error resume next
if emailValido(emailDe) and mensagem <> "" then
select case uCase(trim(objeto))
case "ASPMAIL"
set objeto = Server.CreateObject("SMTPsvg.Mailer")
objeto.FromName = emailNomeDe
objeto.FromAddress = emailDe
objeto.RemoteHost = hostEmail
arrayEmail = split(emailPara,";")
for i = 0 to uBound(arrayEmail)
if emailValido(trim(arrayEmail(i))) then
objeto.AddRecipient "", cStr(arrayEmail(i))
end if
next
arrayEmail = split(emailCC,";")
for i = 0 to uBound(arrayEmail)
if emailValido(trim(arrayEmail(i))) then
objeto.AddCc "", cStr(arrayEmail(i))
end if
next
arrayEmail = split(emailCCO,";")
for i = 0 to uBound(arrayEmail)
if emailValido(trim(arrayEmail(i))) then
objeto.AddBcc "", cStr(arrayEmail(i))
end if
next
objeto.Subject = assunto
objeto.Timeout = timeOut
if anexo <> "" then
mensagem = limpaHtml(mensagem)
end if
objeto.BodyText = mensagem
if charSet = "US ASCII" then
charSet = 1
else
charSet = 2
end if
objeto.charset = charset
if html then
objeto.ContentType = "text/html"
end if
if confirmacao then
objeto.ReturnReceipt = true
objeto.ConfirmRead = true
end if
objeto.priority = importancia
if emailValido(emailResposta) then
objeto.replyTo = emailResposta
else
objeto.replyTo = " "
end if
anexarArquivo componente
case "ASPEMAIL"
set objeto = Server.CreateObject("Persits.MailSender")
objeto.Host = hostEmail
objeto.From = emailDe
objeto.FromName = emailNomeDe
objeto.AddReplyTo emailDe
objeto.AddAddress emailPara
objeto.Subject = assunto
if html then
objeto.isHTML = true
else
objeto.isHTML = false
end if
if username <> "" and password <> "" then
objeto.Username = username
objeto.Password = password
end if
objeto.Body = mensagem
objeto.port = hostPorta
objeto.timeOut = timeOut
objeto.charset = charSet
objeto.priority = importancia
if emailValido(emailResposta) then
objeto.AddReplyTo emailResposta
else
objeto.AddReplyTo " "
end if
anexarArquivo componente
case "CDONTS"
set objeto = Server.CreateObject("CDONTS.NewMail")
objeto.to = montaEmail(emailPara, 1)
objeto.Cc = montaEmail(emailCC, 2)
objeto.Bcc = montaEmail(emailCCO, 3)
objeto.from = emailNomeDe & "<" & emailDe & ">"
objeto.subject = assunto
if importancia = 5 then
importancia = 0 'baixa
elseif importancia = 1 then
importancia = 2 'alta
else
importancia = 1 'normal
end if
objeto.Importance = importancia
if charSet = "US ASCII" then
charSet = 1
else
charSet = 0
end if
objeto.BodyFormat = charSet
if html then
objeto.MailFormat = 0
end if
if emailValido(emailResposta) then
objeto.value("Reply-To") = emailResposta
else
objeto.value("Reply-To") = " "
end if
anexarArquivo componente
objeto.body = mensagem
case "CDO" , "CDOSYS"
dim objCDOSYSCon, urlCdoSys
urlCdoSys = "http://schemas.microsoft.com/cdo/configuration/"
Set objCDOSYSCon = Server.CreateObject ("CDO.Configuration")
objCDOSYSCon.fields(""&urlCdoSys&"smtpserver") = hostEmail
objCDOSYSCon.fields(""&urlCdoSys&"smtpserverport") = hostPorta
objCDOSYSCon.fields(""&urlCdoSys&"sendusing") = 2
objCDOSYSCon.fields(""&urlCdoSys&"smtpconnectiontimeout") = timeOut
objCDOSYSCon.fields("urn:schemas:httpmail:importance").value = importancia
if username <> "" and password <> "" then
objeto.fields(""&urlCdoSys&"smtpauthenticate") = 1
objeto.fields(""&urlCdoSys&"sendusername") = username
objeto.fields(""&urlCdoSys&"sendpassword") = password
end if
objCDOSYSCon.fields.update
Set objeto = Server.CreateObject("CDO.Message")
Set objeto.Configuration = objCDOSYSCon
objeto.From = emailNomeDe & "<" & emailDe & ">"
objeto.To = montaEmail(emailPara, 1)
objeto.Cc = montaEmail(emailCC, 2)
objeto.Bcc = montaEmail(emailCCO, 3)
objeto.Subject = assunto
if html then
objeto.HtmlBody = mensagem
else
objeto.TextBody = mensagem
end if
anexarArquivo componente
case "DUNDAS"
set objeto = Server.CreateObject("Dundas.Mailer")
objeto.SMTPRelayServers.Add hostEmail
objeto.TOs.Add montaEmail(emailPara, 1)
objeto.Ccs.Add montaEmail(emailCC, 2) &" "
objeto.Bccs.Add montaEmail(emailCCO, 3)&" "
objeto.fromName = emailDe
objeto.subject = assunto
if importancia = 5 then
importancia = -1 'baixa
elseif importancia = 1 then
importancia = 3 'alta
else
importancia = 1 'normal
end if
objeto.Priority = importancia
objeto.HtmlBodyCharSet = charSet
if html then
objeto.HtmlBody = mensagem
else
objeto.Body = mensagem
end if
objeto.timeOutConnect = timeOut
if emailValido(emailResposta) then
objeto.replyTOs.Add emailResposta
else
objeto.replyTOs.Add " "
end if
if confirmacao then
objeto.ReturnReceipt = true
end if
anexarArquivo componente
objeto.body = mensagem
end Select
end if
if componente = "ASPMAIL" or componente = "DUNDAS" then
objeto.SendMail
resposta = true
else
objeto.send
resposta = true
end if
if err.number <> 0 then
resposta = "ERRO DURANTE TENTATIVA DE ENVIO DE E-MAIL.
ERROR NUMBER: "&err.number&"
ERROR DESCRIPTION: "&err.description
end if
send = resposta
fechaObj(objeto)
fechaObj(objCDOSYSCon)
end function
private sub anexarArquivo(componente)
dim arrayAnexo, i
if len(anexo) > 0 and separador <> "" then
arrayAnexo = split(anexo,separador)
for i = 0 to uBound(arrayAnexo)
if existeArquivo(arrayAnexo(i)) then
if componente = "CDONTS" then
objeto.AttachFile arrayAnexo(i)
elseif componente = "DUNDAS" then
objeto.Attachments.Add arrayAnexo(i)
else
objeto.AddAttachment arrayAnexo(i)
end if
end if
next
end if
end sub
private function montaEmail(stringEmail,tipoDestino)
dim arrayEmail, i, cont
arrayEmail = split(stringEmail,";")
montaEmail = ""
cont = 0
for i = 0 to uBound(arrayEmail)
if emailValido(trim(arrayEmail(i))) then
if inStr(montaEmail, arrayEmail(i)) = 0 then
montaEmail = montaEmail & trim(arrayEmail(i)) &";"
cont = cont + 1
end if
else
if tipoDestino = 1 then
Response.Write("ERRO - E-mail PARA inválido: "&arrayEmail(i)&" ASSUNTO: "&assunto&"
")
elseif tipoDestino = 2 then
Response.Write("ERRO - E-mail CC inválido: "&arrayEmail(i)&"
")
elseif tipoDestino = 3 then
Response.Write("ERRO - E-mail CCo inválido: "&arrayEmail(i)&"
")
elseif tipoDestino = 4 then
Response.Write("ERRO - E-mail para Resposta inválido: "&arrayEmail(i)&"
")
end if
end if
next
end function
public function emailValido(email)
dim regex
set regex = new RegExp
regex.Pattern = "^[\w-\.]{1,}\@([\da-zA-Z-]{1,}\.){1,}[\da-zA-Z-]{2,3}$"
regex.IgnoreCase = true
emailValido = regex.Test(email)
fechaObj(regex)
end function
public sub fechaObj(ByRef obj)
if isobject(obj) then
set obj = nothing
end if
end sub
public function existeArquivo(arquivo)
dim objFso
Set objFso = CreateObject("Scripting.FileSystemObject")
If not objFso.FileExists(arquivo) Then
existeArquivo = false
else
existeArquivo = true
End if
set objFso = nothing
end function
public function limpaHtml(strHtml)
dim objER
strHtml = replace(replace(strHtml,"
",vbNewLine),"
",vbNewLine)
Set objER = New RegExp
objER.IgnoreCase = True
objER.Global = True
objER.Pattern = "<[^>]*>"
strHtml = objER.Replace(strHtml, "")
limpaHtml = strHtml
set objER = nothing
end function
end class
dim mail
set mail = new sendEmail
mail.hostEmail = "smtp.servidor.com.br"
mail.objeto = "aspemail"
mail.emailDe = "cris@unesp.br"
mail.emailPara = "cris@unesp.br;cris@unesp.br"
mail.importancia = 0
mail.assunto = "assunto do meu e-mail"
mail.mensagem = "linha 1
linha 2 da mensagem"
mail.anexo = "c:\inetpub\wwwroot\email\1.txt;c:\inetpub\wwwroot\email\2.txt"
response.write(mail.send)
set mail = nothing
%>