cdosys e e-mails inválidos

[gprevidi 0]

Oi pessoal,

 

é o seguinte: eu tenho meu site hospedado no terra, e agora eles trocaram a infra-estrutura e mudou o componente de e-mail, era o cdonts foi pra cdosys...

até ai tudo bem.

 

o componente funciona tranquilo, mas quando eu ponho ele a paginar e enviar e-mail de uma lista em um DB access, ele vai enviando normalmente até chegar a um e-mail e trancar.

entrei em contato com o terra e me disseram que o problema era que estes e-mails que trancavam eram inválidos. e eles realmente eram. a solução seria remover estes inválidos, mas são 3800 e-mails, e deve ter vários inválidos.

 

existe alguma solução para isso? tipo caso o e-mail não envie, seguir adiante?

 

segue o código:

abraços!

 

<%

IF Request.QueryString("pagina")="" then
		assunto = request.form("subject")
		corpo = request.form("body")
		session("assunto") = assunto
		session("corpo") = corpo
ELSE
		corpo = session("corpo")
		assunto = session("assunto")
END IF



'Efetuando a conexão com a base de dados criada -----------------------
cnpath="DBQ=" & Server.MapPath("db.mdb")
DataSource = "Driver={Microsoft Access Driver (*.mdb)}; " & cnpath 
Set conn = Server.CreateObject("ADODB.Connection") 
conn.Open DataSource
'----------------------------------------------------------------------

'Vamos criar o objeto Record Set -> neste caso é necessário declará-lo,
'pois vamos utilizar algumas funções deste objeto
Set RS = Server.CreateObject("adodb.recordset")

RS.PageSize = 2 'quantidade de registros por página. Você pode alterar sem conforme precise.

'Vamos fazer a busca na tabela contatos
SQL = "select email from lista"
RS.Open SQL,Conn,3,3

'Vamos agora verificar exceções do tipo “fim de arquivo” (EOF), se a página atual é menor
'que zero, se é maior que o número total de páginas, etc.
IF RS.EOF then
   Response.Write "nenhum registro encontrado"
   Response.End 'paramos o programa
ELSE
   'Definindo em qual pagina o visitante está
   IF Request.QueryString("pagina")="" then
	  intpagina=1
   ELSE
	  IF cint(Request.QueryString("pagina"))<1 then
		 intpagina=1
	  ELSE
		 IF cint(Request.QueryString("pagina"))> RS.PageCount then
			intpagina=RS.PageCount
		 ELSE
			intpagina=Request.QueryString("pagina")
		 END IF
	  END IF
   END IF
END IF
'Fim das verificações de exceções

'Usamos a propriedade AbsolutePage para dizer ao RS que página ele está
RS.AbsolutePage=intpagina

' Inicia o contador que vai controlar os registros mostrados
intrec=0

'Enquanto o contador for menor que a quantidade de registros mostrados ou
' não for o final do arquivo
While intrec < RS.PageSize and not RS.EOF


'------------------- AQUI VEM TUDO O QUE SERÁ PAGINADO -----------------------

Set objCDOSYSMail = Server.CreateObject("CDO.Message") 
Set objCDOSYSCon = Server.CreateObject ("CDO.Configuration") 

objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail-fwd"
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30 
objCDOSYSCon.Fields.update 

Set objCDOSYSMail.Configuration = objCDOSYSCon 
objCDOSYSMail.From = "email@servidor.com.br"
objCDOSYSMail.To = rs("email")

objCDOSYSMail.Subject = assunto
'objCDOSYSMail.TextBody = request.form("body")
objCDOSYSMail.HtmlBody = corpo
'objCDOSYSMail.fields.update 
objCDOSYSMail.Send 

Set objCDOSYSMail = Nothing 
Set objCDOSYSCon = Nothing 
   
   response.write RS("email") & "<BR>"
   
'-----------------------------------------------------------------------------

   RS.MoveNext

   ' Acrescenta +1 ao contador
   intrec=intrec+1
   'Se for EOF (fim de arquivo), imprimir branco na tela
   IF RS.EOF then
	  response.write " "
   END IF
Wend 'fim do loop


session("corpo") = corpo
session("assunto") = assunto

'Se não estivermos no último registro contado, então é mostrado o link p/ a próxima página
IF strcomp(intpagina,RS.PageCount) <> 0 then
%>
   <a href="paginacao.asp?pagina=<%=intpagina + 1%>">Próxima</a>
<%
END IF
%>

[jrcardozo 4]

já tentou fazer uma validação de email antes de enviar? será que isso não resolve?

[gprevidi 0]

mas o erro não acontece só quando eu envio no campo destinatário "bablabalbala" e sim qualquer e-mail que esteja com a caixa cheia ou e-mail deletados, etc.

 

essa validação que tu está falando seria algo como checar se existe @?? acho que não adiantaria, ne?

[gprevidi 0]

existe algum método que realmente valide o e-mail, não só analisando se possui @ e não possui elementes errados?

 

abraços

[jrcardozo 4]

segue a gunção para validar email:

ASP

Function verificaEmail(StrEmail)

 'StrEmail = string contendo o email para verificar

 'Cria o objeto de expressões regulares

 Set ObjRegEx = New RegExp

 'Máscara a ser verificada

 ObjRegEx.Pattern    = "^[w-.]{1,}@([da-zA-Z-]{1,}.){1,}[da-zA-Z-]{2,3}$"

 ObjRegEx.IgnoreCase = true

 retVal = ObjRegEx.Test(StrEmail)

 set ObjRegEx = nothing

 If not retVal Then

  'call redPagina("","","MascMail-01","")

  'Response.End()

  'stremail = "ERRO"

 End If

 verificaEmail = StrEmail  

End Function

veja se com isso resolve

[gprevidi 0]

Ele me retornou isso:

 

Microsoft VBScript compilation  error '800a03ea'

Syntax error

/cdosys/paginacao.asp, line 83

Function verificaEmail(StrEmail)
^

apliquei assim:

 

Function verificaEmail(StrEmail)
 StrEmail = rs("Email")
 'Cria o objeto de expressões regulares
 Set ObjRegEx = New RegExp
 'Máscara a ser verificada
 ObjRegEx.Pattern	= "^[\w-\.]{1,}\@([\da-zA-Z-]{1,}\.){1,}[\da-zA-Z-]{2,3}$"
 ObjRegEx.IgnoreCase = true
 retVal = ObjRegEx.Test(StrEmail)
 set ObjRegEx = nothing
 If not retVal Then
   response.write StrEmail & " - INVÁLIDO! <BR>"
else
				Set objCDOSYSMail = Server.CreateObject("CDO.Message") 
				Set objCDOSYSCon = Server.CreateObject ("CDO.Configuration") 
				
				objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail-fwd"
				objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
				objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
				objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30 
				objCDOSYSCon.Fields.update 
				
				Set objCDOSYSMail.Configuration = objCDOSYSCon 
				objCDOSYSMail.From = "email@servidor.com.br"
				objCDOSYSMail.To =  rs("Email")
				objCDOSYSMail.Subject = assunto
				'objCDOSYSMail.TextBody = request.form("body")
				objCDOSYSMail.HtmlBody = corpo
				'objCDOSYSMail.fields.update 
				objCDOSYSMail.Send 
				
				Set objCDOSYSMail = Nothing 
				Set objCDOSYSCon = Nothing 
   
			   response.write rs("Email") & "<BR>"

 End If
 verificaEmail = StrEmail  
End Function

[gprevidi 0]

olá,

 

acho que estou resolvendo o problema

utilizei o comando On Error Resume Next, e ele pula os e-mails inválidos... mas agora o que está acontecendo é que para alguns destinatários estão sendo enviados 5, 10 ou 15 cópias...

será que é algum erro no código?

 

 

Do While Not RS.eof		
		Set objCDOSYSMail = Server.CreateObject("CDO.Message") 
		Set objCDOSYSCon = Server.CreateObject ("CDO.Configuration") 
		objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail-fwd"
		objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
		objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
		objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30 
		objCDOSYSCon.Fields.update 
		Set objCDOSYSMail.Configuration = objCDOSYSCon 
		objCDOSYSMail.From = RSBODY("From_Email")
		objCDOSYSMail.To =  RS("Email")
		objCDOSYSMail.Subject = Request("Subject")
		If (Request("Format") = "Text") Then
			objCDOSYSMail.TextBody = Request("Body")
		Else
			objCDOSYSMail.HTMLBody = Request("Body")
		End If	
		RS.movenext
		On Error Resume Next	
		objCDOSYSMail.Send 
	
	Loop

	Set objCDOSYSMail = Nothing 
	Set objCDOSYSCon = Nothing