Função que dispara e-Mail com vários anexos em AdvPL

Olá pessoal…

Hoje trago para vocês uma rotina que desenvolvi para disparo de e-mails com opção de múltiplos anexos.

AdvPL

AdvPL

A rotina funciona instanciando a tMailManager e tMailMessage, utizando os seguintes parâmetros:
* MV_RELACNT – Conta de login do e-Mail – Ex.: email@servidor.com.br
* MV_RELPSW – Senha de login do e-Mail – Ex.: senha
* MV_RELSERV – Servidor SMTP do e-Mail – Ex.: smtp.servidor.com.br:587
* MV_RELTIME – TimeOut do e-Mail – Ex.: 120

Para utilizar a rotina, ela recebe até 6 parâmetros de dados, sendo:
cPara – Destinatário que irá receber o e-Mail
cAssunto – Assunto do e-Mail
cCorpo – Corpo do e-Mail (com suporte à html)
aAnexos – Anexos que estarão no e-mail (devem estar na mesma pasta da protheus data)
lMostraLog – Define se será mostrado mensagem de log ao usuário (uma tela de aviso)
lUsaTLS – Define se irá utilizar o protocolo criptográfico TLS

Segue abaixo a rotina desenvolvida.

//Bibliotecas
#Include "Protheus.ch"

/*/{Protheus.doc} zEnvMail
Função para disparo do e-mail utilizando TMailMessage e tMailManager com opção de múltiplos anexos
@author Atilio
@since 26/05/2017
@version 1.0
@type function
	@param cPara, characters, Destinatário que irá receber o e-Mail
	@param cAssunto, characters, Assunto do e-Mail
	@param cCorpo, characters, Corpo do e-Mail (com suporte à html)
	@param aAnexos, array, Anexos que estarão no e-mail (devem estar na mesma pasta da protheus data)
	@param lMostraLog, logical, Define se será mostrado mensagem de log ao usuário (uma tela de aviso)
	@param lUsaTLS, logical, Define se irá utilizar o protocolo criptográfico TLS
	@return lRet, Retorna se houve falha ou não no disparo do e-Mail
@example Exemplos:
	-----
	1 - Mensagem Simples de envio
	u_zEnvMail("teste@servidor.com.br", "Teste", "Teste TMailMessage - Protheus", , .T.)

	-----
	2 - Mensagem com anexos (devem estar dentro da Protheus Data)
	aAnexos := {}
	aAdd(aAnexos, "\pasta\arquivo1.pdf")
	aAdd(aAnexos, "\pasta\arquivo2.pdf")
	aAdd(aAnexos, "\pasta\arquivo3.pdf")
	u_zEnvMail("teste@servidor.com.br", "Teste", "Teste TMailMessage com anexos - Protheus", aAnexos)

@obs Deve-se configurar os parâmetros:
	* MV_RELACNT - Conta de login do e-Mail    - Ex.: email@servidor.com.br
	* MV_RELPSW  - Senha de login do e-Mail    - Ex.: senha
	* MV_RELSERV - Servidor SMTP do e-Mail     - Ex.: smtp.servidor.com.br:587
	* MV_RELTIME - TimeOut do e-Mail           - Ex.: 120
/*/

User Function zEnvMail(cPara, cAssunto, cCorpo, aAnexos, lMostraLog, lUsaTLS)
	Local aArea        := GetArea()
	Local nAtual       := 0
	Local lRet         := .T.
	Local oMsg         := Nil
	Local oSrv         := Nil
	Local nRet         := 0
	Local cFrom        := Alltrim(GetMV("MV_RELACNT"))
	Local cUser        := SubStr(cFrom, 1, At('@', cFrom)-1)
	Local cPass        := Alltrim(GetMV("MV_RELPSW"))
	Local cSrvFull     := Alltrim(GetMV("MV_RELSERV"))
	Local cServer      := Iif(':' $ cSrvFull, SubStr(cSrvFull, 1, At(':', cSrvFull)-1), cSrvFull)
	Local nPort        := Iif(':' $ cSrvFull, Val(SubStr(cSrvFull, At(':', cSrvFull)+1, Len(cSrvFull))), 587)
	Local nTimeOut     := GetMV("MV_RELTIME")
	Local cLog         := ""
	Default cPara      := ""
	Default cAssunto   := ""
	Default cCorpo     := ""
	Default aAnexos    := {}
	Default lMostraLog := .F.
	Default lUsaTLS    := .F.

	//Se tiver em branco o destinatário, o assunto ou o corpo do email
	If Empty(cPara) .Or. Empty(cAssunto) .Or. Empty(cCorpo)
		cLog += "001 - Destinatario, Assunto ou Corpo do e-Mail vazio(s)!" + CRLF
		lRet := .F.
	EndIf

	If lRet
		//Cria a nova mensagem
		oMsg := TMailMessage():New()
		oMsg:Clear()

		//Define os atributos da mensagem
		oMsg:cFrom    := cFrom
		oMsg:cTo      := cPara
		oMsg:cSubject := cAssunto
		oMsg:cBody    := cCorpo

		//Percorre os anexos
		For nAtual := 1 To Len(aAnexos)
			//Se o arquivo existir
			If File(aAnexos[nAtual])

				//Anexa o arquivo na mensagem de e-Mail
				nRet := oMsg:AttachFile(aAnexos[nAtual])
				If nRet < 0
					cLog += "002 - Nao foi possivel anexar o arquivo '"+aAnexos[nAtual]+"'!" + CRLF
				EndIf

			//Senao, acrescenta no log
			Else
				cLog += "003 - Arquivo '"+aAnexos[nAtual]+"' nao encontrado!" + CRLF
			EndIf
		Next

		//Cria servidor para disparo do e-Mail
		oSrv := tMailManager():New()

		//Define se irá utilizar o TLS
		If lUsaTLS
			oSrv:SetUseTLS(.T.)
		EndIf

		//Inicializa conexão
		nRet := oSrv:Init("", cServer, cUser, cPass, 0, nPort)
		If nRet != 0
			cLog += "004 - Nao foi possivel inicializar o servidor SMTP: " + oSrv:GetErrorString(nRet) + CRLF
			lRet := .F.
		EndIf

		If lRet
			//Define o time out
			nRet := oSrv:SetSMTPTimeout(nTimeOut)
			If nRet != 0
				cLog += "005 - Nao foi possivel definir o TimeOut '"+cValToChar(nTimeOut)+"'" + CRLF
			EndIf

			//Conecta no servidor
			nRet := oSrv:SMTPConnect()
			If nRet <> 0
				cLog += "006 - Nao foi possivel conectar no servidor SMTP: " + oSrv:GetErrorString(nRet) + CRLF
				lRet := .F.
			EndIf

			If lRet
				//Realiza a autenticação do usuário e senha
				nRet := oSrv:SmtpAuth(cFrom, cPass)
				If nRet <> 0
					cLog += "007 - Nao foi possivel autenticar no servidor SMTP: " + oSrv:GetErrorString(nRet) + CRLF
					lRet := .F.
				EndIf

				If lRet
					//Envia a mensagem
					nRet := oMsg:Send(oSrv)
					If nRet <> 0
						cLog += "008 - Nao foi possivel enviar a mensagem: " + oSrv:GetErrorString(nRet) + CRLF
						lRet := .F.
					EndIf
				EndIf

				//Disconecta do servidor
				nRet := oSrv:SMTPDisconnect()
				If nRet <> 0
					cLog += "009 - Nao foi possivel disconectar do servidor SMTP: " + oSrv:GetErrorString(nRet) + CRLF
				EndIf
			EndIf
		EndIf
	EndIf

	//Se tiver log de avisos/erros
	If !Empty(cLog)
		cLog := "zEnvMail - "+dToC(Date())+ " " + Time() + CRLF + ;
			"Funcao - " + FunName() + CRLF + CRLF +;
			"Existem mensagens de aviso: "+ CRLF +;
			cLog
		ConOut(cLog)

		//Se for para mostrar o log visualmente e for processo com interface com o usuário, mostra uma mensagem na tela
		If lMostraLog .And. ! IsBlind()
			Aviso("Log", cLog, {"Ok"}, 2)
		EndIf
	EndIf

	RestArea(aArea)
Return lRet

Também foi realizado uma alteração no fonte, para adaptação para quem usa o Envio Locaweb, que é uma conta específica para disparo. Para usar essa funcionalidade, é necessário criar 3 parâmetros MV_X_NCNT,
MV_X_NPSW e MV_X_NSRV (Conta, Senha e Servidor). Abaixo o código.

<br>
//Bibliotecas<br>
#Include "Protheus.ch"</p>
<p>/*/{Protheus.doc} zEnvMail<br>
Função para disparo do e-mail utilizando TMailMessage e tMailManager com opção de múltiplos anexos<br>
@author Atilio<br>
@since 26/05/2017<br>
@version 1.0<br>
@type function<br>
@param cPara, characters, Destinatário que irá receber o e-Mail<br>
@param cAssunto, characters, Assunto do e-Mail<br>
@param cCorpo, characters, Corpo do e-Mail (com suporte à html)<br>
@param aAnexos, array, Anexos que estarão no e-mail (devem estar na mesma pasta da protheus data)<br>
@param lMostraLog, logical, Define se será mostrado mensagem de log ao usuário (uma tela de aviso)<br>
@param lUsaTLS, logical, Define se irá utilizar o protocolo criptográfico TLS<br>
@return lRet, Retorna se houve falha ou não no disparo do e-Mail<br>
@example Exemplos:<br>
-----<br>
1 - Mensagem Simples de envio<br>
u_zEnvMail("teste@servidor.com.br", "Teste", "Teste TMailMessage - Protheus", , .T.)</p>
<p>-----<br>
2 - Mensagem com anexos (devem estar dentro da Protheus Data)<br>
aAnexos := {}<br>
aAdd(aAnexos, "\pasta\arquivo1.pdf")<br>
aAdd(aAnexos, "\pasta\arquivo2.pdf")<br>
aAdd(aAnexos, "\pasta\arquivo3.pdf")<br>
u_zEnvMail("teste@servidor.com.br", "Teste", "Teste TMailMessage com anexos - Protheus", aAnexos)<br>
u_zEnvMail("informatica@patral.com.br", "Teste", "Teste TMailMessage", , .T.)</p>
<p>@obs Deve-se configurar os parâmetros:<br>
* MV_RELACNT - Conta de login do e-Mail    - Ex.: email@servidor.com.br<br>
* MV_RELPSW  - Senha de login do e-Mail    - Ex.: senha<br>
* MV_RELSERV - Servidor SMTP do e-Mail     - Ex.: smtp.servidor.com.br:587<br>
* MV_RELTIME - TimeOut do e-Mail           - Ex.: 120<br>
/*/</p>
<p>User Function zEnvMail(cPara, cAssunto, cCorpo, aAnexos, lMostraLog, lUsaTLS, lNovo)<br>
	Local aArea        := GetArea()<br>
	Local nAtual       := 0<br>
	Local lRet         := .T.<br>
	Local oMsg         := Nil<br>
	Local oSrv         := Nil<br>
	Local nRet         := 0<br>
	Local cFrom        := Alltrim(GetMV("MV_RELACNT"))<br>
	Local cUser        := SubStr(cFrom, 1, At('@', cFrom)-1)<br>
	Local cPass        := Alltrim(GetMV("MV_RELPSW"))<br>
	Local cSrvFull     := Alltrim(GetMV("MV_RELSERV"))<br>
	Local cServer      := ""<br>
	Local nPort        := 0<br>
	Local nTimeOut     := GetMV("MV_RELTIME")<br>
	Local cLog         := ""<br>
	Local cContaAuth   := ""<br>
	Local cPassAuth    := ""<br>
	Local nAtu         := 0<br>
	Local cProcessos   := ""<br>
	Default cPara      := ""<br>
	Default cAssunto   := ""<br>
	Default cCorpo     := ""<br>
	Default aAnexos    := {}<br>
	Default lMostraLog := .F.<br>
	Default lUsaTLS    := .T.<br>
	Default lNovo      := .F.</p>
<p>	//Se tiver em branco o destinatário, o assunto ou o corpo do email<br>
	If Empty(cPara) .Or. Empty(cAssunto) .Or. Empty(cCorpo)<br>
		cLog += "001 - Destinatario, Assunto ou Corpo do e-Mail vazio(s)!" + CRLF<br>
		lRet := .F.<br>
	EndIf</p>
<p>	If lRet<br>
		If lNovo<br>
			cContaAuth := Alltrim(GetMV("MV_X_NCNT"))<br>
			cPassAuth  := Alltrim(GetMV("MV_X_NPSW"))<br>
			cSrvFull   := Alltrim(GetMV("MV_X_NSRV"))<br>
		Else<br>
			cContaAuth := cFrom<br>
			cPassAuth  := cPass<br>
		EndIf<br>
		cServer      := Iif(':' $ cSrvFull, SubStr(cSrvFull, 1, At(':', cSrvFull)-1), cSrvFull)<br>
		nPort        := Iif(':' $ cSrvFull, Val(SubStr(cSrvFull, At(':', cSrvFull)+1, Len(cSrvFull))), 587)</p>
<p>		//Cria a nova mensagem<br>
		oMsg := TMailMessage():New()<br>
		oMsg:Clear()</p>
<p>		//Define os atributos da mensagem<br>
		//oMsg:cDate    := cValToChar(Date())<br>
		oMsg:cFrom    := cFrom<br>
		oMsg:cTo      := cPara<br>
		oMsg:cSubject := cAssunto<br>
		oMsg:cBody    := cCorpo</p>
<p>		//Percorre os anexos<br>
		For nAtual := 1 To Len(aAnexos)<br>
			//Se o arquivo existir<br>
			If File(aAnexos[nAtual])</p>
<p>				//Anexa o arquivo na mensagem de e-Mail<br>
				nRet := oMsg:AttachFile(aAnexos[nAtual])<br>
				If nRet < 0<br>
					cLog += "002 - Nao foi possivel anexar o arquivo '"+aAnexos[nAtual]+"'!" + CRLF<br>
				EndIf</p>
<p>				//Senao, acrescenta no log<br>
			Else<br>
				cLog += "003 - Arquivo '"+aAnexos[nAtual]+"' nao encontrado!" + CRLF<br>
			EndIf<br>
		Next</p>
<p>		//Cria servidor para disparo do e-Mail<br>
		oSrv := tMailManager():New()</p>
<p>		//Define se irá utilizar o TLS<br>
		If lUsaTLS<br>
			oSrv:SetUseTLS(.T.)<br>
		EndIf</p>
<p>		//Inicializa conexão<br>
		nRet := oSrv:Init("", cServer, cUser, cPass, 0, nPort)<br>
		If nRet != 0<br>
			cLog += "004 - Nao foi possivel inicializar o servidor SMTP: " + oSrv:GetErrorString(nRet) + CRLF<br>
			lRet := .F.<br>
		EndIf</p>
<p>		If lRet<br>
			//Define o time out<br>
			nRet := oSrv:SetSMTPTimeout(nTimeOut)<br>
			If nRet != 0<br>
				cLog += "005 - Nao foi possivel definir o TimeOut '"+cValToChar(nTimeOut)+"'" + CRLF<br>
			EndIf</p>
<p>			//Conecta no servidor<br>
			nRet := oSrv:SMTPConnect()<br>
			If nRet <> 0<br>
				cLog += "006 - Nao foi possivel conectar no servidor SMTP: " + oSrv:GetErrorString(nRet) + CRLF<br>
				lRet := .F.<br>
			EndIf</p>
<p>			If lRet<br>
				//Realiza a autenticação do usuário e senha<br>
				nRet := oSrv:SmtpAuth(cContaAuth, cPassAuth)<br>
				If nRet <> 0<br>
					cLog += "007 - Nao foi possivel autenticar no servidor SMTP: " + oSrv:GetErrorString(nRet) + CRLF<br>
					lRet := .F.<br>
				EndIf</p>
<p>				If lRet<br>
					//Envia a mensagem<br>
					nRet := oMsg:Send(oSrv)<br>
					If nRet <> 0<br>
						cLog += "008 - Nao foi possivel enviar a mensagem: " + oSrv:GetErrorString(nRet) + CRLF<br>
						lRet := .F.<br>
					EndIf<br>
				EndIf</p>
<p>				//Disconecta do servidor<br>
				nRet := oSrv:SMTPDisconnect()<br>
				If nRet <> 0<br>
					cLog += "009 - Nao foi possivel disconectar do servidor SMTP: " + oSrv:GetErrorString(nRet) + CRLF<br>
				EndIf<br>
			EndIf<br>
		EndIf<br>
	EndIf</p>
<p>	//Se tiver log de avisos/erros<br>
	If !Empty(cLog)<br>
		//Busca todas as funções<br>
		nAtu := 0<br>
		cProcessos := ""<br>
		/*<br>
		While ! (ProcName(nAtu) == '')<br>
			cProcessos += ProcName(nAtu) + "; "<br>
			nAtu++<br>
		EndDo<br>
		*/</p>
<p>		cLog := "+======================= zEnvMail =======================+" + CRLF + ;<br>
			"zEnvMail  - "+dToC(Date())+ " " + Time() + CRLF + ;<br>
			"Funcao    - " + FunName() + CRLF + ;<br>
			"Processos - " + cProcessos + CRLF + ;<br>
			"Para      - " + cPara + CRLF + ;<br>
			"Assunto   - " + cAssunto + CRLF + ;<br>
			"Corpo     - " + cCorpo + CRLF + ;<br>
			"Existem mensagens de aviso: "+ CRLF +;<br>
			cLog + CRLF +;<br>
			"+======================= zEnvMail =======================+"<br>
		//ConOut(cLog)</p>
<p>		//Se for para mostrar o log visualmente e for processo com interface com o usuário, mostra uma mensagem na tela<br>
		If lMostraLog .And. ! IsBlind()<br>
			Aviso("Log", cLog, {"Ok"}, 2)<br>
		EndIf<br>
	EndIf</p>
<p>	RestArea(aArea)<br>
Return lRet<br>

Esses e outros códigos, estão disponíveis gratuitamente no nosso GitHub, acesse em github.com/dan-atilio/AdvPL.

Bom pessoal, por hoje é só.
Abraços e até a próxima.

Dan_Atilio
Analista e desenvolvedor de sistemas. Técnico em Informática pelo CTI da Unesp. Graduado em Banco de Dados pela Fatec Bauru. Entusiasta de soluções Open Source e blogueiro nas horas vagas.

8 Responses

  1. Andre disse:

    Essa rotina server para enviar e-mail de forma automática através de schedule?

  2. Súlivan disse:

    Muito chique, e muito bem escrito. Parabéns

  3. Bom dia Mestre, rotina excelente, parabéns. Admiro muito seu trabalho, grande abraço.

  4. Ric Bert disse:

    Ótimo exemplo para substituir uma rotina antiga aqui ainda com “SEND MAIL”, que iria ajustar para múltiplos anexos. Obrigado, Daniel!

Deixe uma resposta