Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

jrcardozo

Classe para envio de e-mails

Por , em ASP Clássico

Recommended Posts

jrcardozo    4

jrcardozo
Postado

Pra quem desenvolve muitos sites localmente e na hora de upar pro servidor do cliente percebe que lá não tem o mesmo componente de e-mail que você usa nos testes locais, desenvolvi essa classe simples que utiliza os principais componentes de e-mail.

 

Sintam-se a vontade para usar e melhorar, mas para isso, mantenham os créditos...ok?

 

<%
'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\jonathan.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)] - "jonathan@site.com"
	dim emailPara						'Endereço(s) de e-mail do(s) destinatário(s) ["" (string)] - "jonathan@site.com;cardozo@teste.com"	
	dim emailCC							'Endereço(s) de e-mail do(s) destinatário(s) das cópias ["" (string)] - "jonathan@site.com;cardozo@teste.com"	
	dim emailCCO						'Endereço(s) de e-mail do(s) destinatário(s) das cópias ocultas ["" (string)] - "jonathan@site.com;cardozo@teste.com"	
	dim emailResposta				'Endereço de e-mail para receber a resposta ["" (string)] - "jonathan@site.com"
	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.<br>ERROR NUMBER: "&err.number&"<br>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&"<br>")	
				elseif tipoDestino = 2 then
					Response.Write("ERRO - E-mail CC inválido: "&arrayEmail(i)&"<br>")				
				elseif tipoDestino = 3 then
					Response.Write("ERRO - E-mail CCo inválido: "&arrayEmail(i)&"<br>")
				elseif tipoDestino = 4 then
					Response.Write("ERRO - E-mail para Resposta inválido: "&arrayEmail(i)&"<br>")
				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,"<br>",vbNewLine),"<br/>",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			 = "jonathan@teste.com"
	mail.emailPara		 = "jonathan@local.com;outro@email.com"
	mail.importancia	 = 0
	mail.assunto			 = "assunto do meu e-mail"
	mail.mensagem		 = "linha 1<br>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
%>

Compartilhar este post

Link para o post
Compartilhar em outros sites

jrcardozo    4

jrcardozo
Postado

teria que saber exatamente o motivo deste erro. Qualquer codigo não é livre de erros, mas esse que criei tem o objetivo de facilitar quando for hospegar um site pois cada servidor tem sua lista de componentes

Compartilhar este post

Link para o post
Compartilhar em outros sites

Francis Robinson    0

Francis Robinson
Postado

este seu codigo dá pra usar no cdosys sem dar o erro '8004020f' e possa enviar emails diferentes tanto pro distinatario e remetente emails diferente

 

possivel ?

Sobre o código de erro citado vi em outro forum uma possível solução dê uma olhada no link http://forum.ievolutionweb.com/index.php?s...tart=#entry9405 Resposta do EduardoFonseca no dia 16/08/2006 - 01:35 .

 

Espero ter ajudado.

Compartilhar este post

Link para o post
Compartilhar em outros sites

jrcardozo    4

jrcardozo
Postado

valeu a dica, é que o CDOSYS é nativo do windows server 2003. Essa classe é para quem prefere componentes especificos ou utiliza outros servidores que não tenham um componente padrão

Compartilhar este post

Link para o post
Compartilhar em outros sites
Ir para a lista de tópicos ASP Clássico
×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.

  Aceito