Baixando anexos de e-Mail via AdvPL

Hoje vou mostrar como baixar anexos de e-Mail via AdvPL.

Algumas vezes, temos a necessidade de fazer importações de arquivos que chegam através de e-Mails.

Seja arquivos xml ou txt, via AdvPL é possível fazer o download diretamente da caixa de entrada. Para isso, basta instanciar a classe tMailManager, passando os dados de acesso ao provedor de e-Mail.

Em seguida, ler o conteúdo dos e-Mails e quando tiver um anexo, baixar o arquivo para dentro da Protheus Data, e depois movê-lo de pasta do provedor (se for IMAP).

Para ilustrarmos o cenário comentado, abaixo o código fonte desenvolvido:

//Bibliotecas
#Include "Protheus.ch"
#Include "RWMake.ch"
#Include "Ap5Mail.ch"

Static nVez := 2 //Se for caixas no hotmail.com / outlook.com, deve-se rodar a rotina duas vezes seguidas, pois ele não consegue "mover" de pasta na primeira vez

/*/{Protheus.doc} zBxMail
Função para buscar anexos de e-Mails da Locaweb / Uol
@author Atilio
@since 27/09/2018
@version 1.0
@type function
@obs Abaixo algumas observacoes:

	1 - Essa funcao utiliza a classe tMailManager com contas IMAP, mas tambem e possivel utilizar com POP
	2 - Se for uma conta em hotmail.com / outlook.com, deve-se rodar a rotina duas vezes seguidas, pois ele não consegue "mover" de pasta na primeira vez
		Portanto, se estiver usando dessa forma, altere a variavel nVez para 1, para que assim ele execute "2 vezes"
	3 - Essa rotina baixa emails para a pasta \x_importacao\ dentro da Protheus Data, porem voce pode configurar para outros diretorios, dentro da Protheus Data
	4 - O download e feito a partir da linha 184, onde nesse exemplo e efetuado download de qualquer txt vindo por email, mas e possivel aplicar outros filtros
		com os atributos do objeto oMessage
/*/

User Function zBxMail()
	Local cArqSem     := "\x_importacao\semaforo_email.lck"
	Private lJobPvt   := .F.

	If nVez <= 2
		//Alert("zBxMail -  Processo iniciado - "+Time())
	
		//Se não tiver aberto o dicionário (rotina executada sem abrir o Protheus)
		If Select("SX2") <= 0
			RPCClearEnv()
			 
			RPCSetEnv("01","","","","","")
			lJobPvt := .T.
	
		Else
			If ! MsgYesNo("Deseja acessar a caixa de entrada e baixar os arquivos TXT?", "Atenção")
				Return
			EndIf
		EndIf
		
		//Se existir o semáforo, dá mensagem de erro
		If File(cArqSem)
			//Alert("zBxMail -  Semáforo existente (" + MemoRead(cArqSem) + ") - "+Time())
			
			//Mostrando mensagem
			If ! lJobPvt
				Aviso("Atenção", "Semáforo existente (Processo iniciado em " + MemoRead(cArqSem) + ")")
			EndIf
			
		Else
			
			
			//Chamando o processamento de dados
			Processa({|| fProcessa() }, "Processando...")
		
			//Mostrando mensagem de conclusão
			If ! lJobPvt
				Aviso("Atenção", "Processo concluído.")
			EndIf
			
			FErase(cArqSem)
		EndIf
	
		//Atilio, 27/02/2019, para caixas Hotmail, rodar 2x para mover de pasta
		nVez++	
		u_zBxMail()
	EndIf
	
	//Alert("zBxMail -  Processo finalizado - "+Time())
Return

/*---------------------------------------------------------------*
 | Func.: fProcessa                                              |
 | Desc.: Função de processamento para buscar os arquivos        |
 *---------------------------------------------------------------*/

Static Function fProcessa()
	Private cDirBase  := GetSrvProfString("RootPath", "")
	Private cDirPad   := "\x_importacao\"
	Private cConta    := ''
	Private cSenha    := ''
	Private cSrvFull  := ''
	Private cServer   := ''
	Private nPort     := 0

	//Definindo dados da conta
	cConta    := "email@empresa.com.br"
	cSenha    := "Sua Senha XXX"
	cSrvFull  := "servidor.com.br:993"
	cServer   := Iif(':' $ cSrvFull, SubStr(cSrvFull, 1, At(':', cSrvFull)-1), cSrvFull)
	nPort     := Iif(':' $ cSrvFull, Val(SubStr(cSrvFull, At(':', cSrvFull)+1, Len(cSrvFull))), 110)
	
	//Se o último caracter não for barra, retira ela
	If SubStr(cDirBase, Len(cDirBase), 1) == '\'
		cDirBase := SubStr(cDirBase, 1, Len(cDirBase)-1)
	EndIf
	
	//O diretório cheio, será o caminho absoluto + conteúdo do parâmetro, por exemplo, D:\TOTVS\TOTVS Protheus\Protheus_Data\x_importacao_email
	cDirFull := cDirBase + cDirPad
	
	//Chama a importação
	fBaixa()
Return

/*---------------------------------------------------------------*
 | Func.: fBaixa                                                 |
 | Desc.: Função que baixa as mensagens do e-Mail                |
 *---------------------------------------------------------------*/

Static Function fBaixa()
	Local aArea := GetArea()
	Local cArqINI
	Local cBkpConf
	Local nRet
	Local nNumMsg
	Local nMsgAtu
	Local oManager
	Local oMessage
	Local nAnexoAtu
	Local nTotAnexo
	Local aInfAttach
	Local lOk
	Local lEntrou
	
	//Altera o arquivo appserver.ini, deixando como IMAP
	cArqINI  := GetSrvIniName()
	cBkpConf := GetPvProfString( "MAIL", "Protocol", "", cArqINI )
	WritePProString('MAIL', 'PROTOCOL', 'IMAP', cArqINI)

	//Cria a conexão base no gerenciamento
	oManager := tMailManager():New()
	oManager:SetUseSSL(.T.)
	oManager:SetUseTLS(.T.)
	oManager:Init(cServer, "", cConta, cSenha, nPort, 0)
	
	//Caso não consiga setar 120 segundos como timeout (2 minutos), não continua
	If oManager:SetPopTimeOut(120) != 0
		//Alert("zBxMail -  Falha ao setar o timeout" )
	Else
		
		//Faz a conexão com IMAP
		nRet := oManager:IMAPConnect()
		
		//Se não conseguir conectar, mostra qual é a mensagem de erro
		If nRet != 0
			//Alert("zBxMail -  Falha ao conectar" )
			//Alert("zBxMail - ERROR - " + StrZero(nRet, 6), oManager:GetErrorString(nRet))
			
		Else
			//Alert("zBxMail -  Sucesso ao conectar" )

			//Busca o número de mensagens na caixa de entrada
			nNumMsg := 0
			oManager:GetNumMsgs(@nNumMsg)
			
			//Se houver mensagens a serem processadas
			If nNumMsg > 0
				ProcRegua(nNumMsg)
				
				//Percorre o número de mensagens
				For nMsgAtu := 1 To nNumMsg
					IncProc("Baixando e-Mail " + cValToChar(nMsgAtu) + " de " + cValToChar(nNumMsg) + "...")
					
					//Buscando a mensagem atual
					oMessage := tMailMessage():new()
					oMessage:Clear()
					oMessage:Receive(oManager, nMsgAtu)

					//Busca o total de Anexos
					nTotAnexo := oMessage:GetAttachCount()
					
					//Limpando a flag
					lOk := .T.
					lEntrou := .F.
					
					//Percorre todos os anexos
					For nAnexoAtu := 1 To nTotAnexo
						//Busca as informações do anexo
						aInfAttach := oMessage:GetAttachInfo(nAnexoAtu)
						
						//Se tiver conteúdo, e for do tipo TXT
						If ! Empty(aInfAttach[1]) .And. Upper(Right(AllTrim(aInfAttach[1]),4)) == '.TXT' //.And. "REMETENTE" $ Upper(oMessage:cFrom)
							lEntrou := .T.
							
							//Salva o arquivo na pasta correta
							If oMessage:SaveAttach(nAnexoAtu, cDirFull + aInfAttach[1])
								
								//Alert("+================================+")
								//Alert("zBxMail -  e-Mail Lido com Anexo: ")
								//Alert("e-Mail Origem:      " + cConta)
								//Alert("Número da Mensagem: " + cValToChar(nMsgAtu))
								//Alert("De:                 " + oMessage:cFrom)
								//Alert("Cópia:              " + oMessage:cCc)
								//Alert("Assunto:            " + oMessage:cSubject)
								//Alert("Número Anexo:       " + cValToChar(nAnexoAtu))
								//Alert("Anexo " + StrZero(nAnexoAtu, 3) + ":          " + aInfAttach[1] )
								//Alert("Corpo:              " + oMessage:cBody)
								//Alert("+================================+")
								
							Else
								lOk := .F.
								//Alert("zBxMail -  Erro ao salvar anexo " + cValToChar(nAnexoAtu) + ": " + aInfAttach[1] )
							EndIf
						EndIf

					Next nAnexoAtu

					//Se o anexo tiver sido salvo com sucesso
					If lOk
						If lEntrou
							If ! (oManager:MoveMsg(nMsgAtu, "Importados"))
								//Alert("zBxMail -  Não foi possível mover a mensagem - " + cValToChar(nMsgAtu) + "...")
							EndIf
						Else
							If ! (oManager:MoveMsg(nMsgAtu, "Processados"))
								//Alert("zBxMail -  Não foi possível mover a mensagem - " + cValToChar(nMsgAtu) + "...")
							EndIf
						EndIf
					EndIf

					//Alert(CRLF)
				Next nMsgAtu
				
			Else
				//Alert("zBxMail -  Não existem mensagens para processamento...")
			EndIf

			//Desconecta do servidor IMAP
			oManager:IMAPDisconnect()
		EndIf
	EndIf
	
	//Volta a configuração de Protocol no arquivo appserver.ini
	WritePProString('MAIL', 'PROTOCOL', cBkpConf, cArqINI)
	
	RestArea(aArea)
Return

Bom pessoal, por hoje é só.

Abraços e até a próxima.

Dan Atilio (Daniel Atilio)
Especialista em Engenharia de Software pela FIB. Entusiasta de soluções Open Source. E blogueiro nas horas vagas.

Deixe uma resposta