Code: Select all
// Enviando email com HARBOUR 3.2 by Rubens MDV Informatica e papelaria
// Modificado Por: Joao Santos em: 12/12/2017 - Many Thanks Rubens.
#include "Fivewin.ch"
#include "Mail.ch"
#include "error.ch"
#include "fileio.ch"
#include "xHb.ch"
#include "hbcompat.ch"
#include "hbssl.ch"
FUNCTION MAIN()
LOCAL aArquivo := ""
LOCAL cAssunto := "PROGRAMA DO RUBENS-> NO MEU HARBOUR FUNCIONA."
LOCAL cMensagem := "MENSAGEM DO EMAIL DO RUBENS"
LOCAL cImagem := ""
LOCAL lInformaEnvio := .T.
Envia_Email( aArquivo, cAssunto, cMensagem, lInformaEnvio )
RETURN NIL
FUNCTION Envia_Email( aArquivo, cAssunto, cMensagem, cImagem, lInformaEnvio )
LOCAL lOk := .T.
LOCAL AFILES, CSUBJECT, AQUEM, CMSG, CSERVERIP, CFROM, CUSER, CPASS, ;
VPORTSMTP, ACC, ABCC, LCONF, LSSL
hb_Default( @aArquivo, {} )
hb_Default( @cAssunto, "XML e PDF de Nota Fiscal" )
hb_Default( @cMensagem, "Envio de Email" )
hb_Default( @cImagem, "" )
hb_Default( @lInformaEnvio, .T. )
//hb_Default(@cFrom,"MDV Informatica e papelaria ")
//hb_Default(@aQuem,"Rubens - MDV Informatica - Hotmail ")
aFiles := aArquivo // pode ser uma matriz com vários endereços
cSubject := cAssunto
aQuem := "kapiabafwh@gmail.com" // cFrom
cMsg := cMENSAGEM
cServerIp := "smtp.mail.gmail.com" // servidor smtp
cFrom := "kapiabafwh@gmail.com"
cUser := "kapiabafwh@gmail.com" // cEMAIL
cPass := "mypassword" // cSENHAEMAIL
vPORTSMTP := 587
aCC := ""
aBCC := ""
lConf := .F.
lSSL := .F. // OR .T.
lOk := Config_Mail( aFiles, ;
cSubject, ;
aQuem, ;
cMsg, ;
cServerIp, ;
cFrom, ;
cUser, ;
cPass, ;
vPORTSMTP, ;
aCC, ;
aBCC, ;
lConf, ;
lSSL, ;
cImagem, ;
lInformaEnvio )
RETURN lOk
//*******************************************************************************
FUNCTION Config_Mail( aFiles, cSubject, aQuem, cMsg, cServerIp, cFrom, cUser, cPass, vPORTSMTP, aCC, aBCC, lConf, lSSL, cImagem, lInformaEnvio )
LOCAL lRet
LOCAL oCfg, oErroMail
LOCAL lAut := .T.
hb_Default( @cImagem, "" )
hb_Default( @lInformaEnvio, .T. )
TRY
oCfg := win_OleCreateObject( "CDO.Configuration" )
WITH OBJECT oCfg:Fields
:Item( "http://schemas.microsoft.com/cdo/configuration/smtpserver" ):Value := cServerIp
:Item( "http://schemas.microsoft.com/cdo/configuration/smtpserverport" ):Value := vPORTSMTP
:Item( "http://schemas.microsoft.com/cdo/configuration/sendusing" ):Value := 2
:Item( "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate" ):Value := lAut
:Item( "http://schemas.microsoft.com/cdo/configuration/smtpusessl" ):Value := lSSL
:Item( "http://schemas.microsoft.com/cdo/configuration/sendusername" ):Value := AllTrim( cUser )
:Item( "http://schemas.microsoft.com/cdo/configuration/sendpassword" ):Value := AllTrim( cPass )
:Update()
END WITH
lRet := .T.
CATCH oErroMail
IF lInformaEnvio
HB_ALERT( WIN_OEMTOANSI( "NÆo foi poss¡vel enviar o e-mail!" + hb_EOL() + ;
"Error: " + Transform( oErroMail:GenCode, nil ) + ";" + hb_EOL() + ;
"SubC: " + Transform( oErroMail:SubCode, nil ) + ";" + hb_EOL() + ;
"OSCode: " + Transform( oErroMail:OsCode, nil ) + ";" + hb_EOL() + ;
"SubSystem: " + Transform( oErroMail:SubSystem, nil ) + ";" + hb_EOL() + ;
"Mensagem: " + oErroMail:Description ), "Aten‡Æo", 150, 10000, 2, .T. )
ENDIF
lRet := .F.
END
//--> FIM DAS CONFIGURAÇOES.
IF lRet
lRet := Envia_Mail( oCfg, ;
cFrom, ;
aQuem, ;
aFiles, ;
cSubject, ;
cMsg, ;
aCC, ;
aBCC, ;
lConf, ;
lAut, ;
lSSL, ;
cServerIp, ;
cImagem, ;
lInformaEnvio )
ENDIF
RETURN lRet
//*******************************************************************************
FUNCTION Envia_Mail( oCfg, cFrom, cDest, aFiles, cSubject, cMsg, aCC, aBCC, vEmaiL_Conf, lAut, lSSL, cServerIp, cImagem, lInformaEnvio )
LOCAL I, OMSG, X
LOCAL aTo
LOCAL lRet
LOCAL nEle, oErroMail
LOCAL cImagem1 := ''
hb_Default( @cImagem, "" )
hb_Default( @lInformaEnvio, .T. )
// hb_Default(@cMsgTela, 'Enviando Email !!! Aguarde ...')
IF !Empty( cImagem )
cImagem1 := ''
ENDIF
aTo := { cDest } //--> PARA
nEle := 1
FOR I := 1 TO Len( aTo )
TRY
// MOSTRA_Email(cMsgTela)
IF lInformaEnvio
MsgWait( "Aguarde, processando o envio do email." )
ENDIF
oMsg := win_OleCreateObject( "CDO.Message" )
WITH OBJECT oMsg
:Configuration := oCfg
:From := cFrom
:To := aTo[i]
:Cc := aCC
:BCC := aBCC
:Subject := cSubject
// ---------------------------------------------------------
// Aqui adiciona a imagem ao corpo da mensagem
// ---------------------------------------------------------
IF !Empty( cImagem )
:AddRelatedBodyPart( hb_DirBase() + "img" + hb_PS() + cImagem, cImagem, 1 )
:Fields:Item( "urn:schemas:mailheader:Content-ID" ):Value := "<" + cImagem + ">"
:Fields:Item( "urn:schemas:mailheader:Content-Disposition" ):Value := "inline"
:Fields:Update()
ENDIF
:HTMLBody := cMsg // + QuebraHTML + IF(!Empty(cImagem), cImagem1, "")
FOR X := 1 TO Len( aFiles )
:AddAttachment( AllTrim( aFiles[x] ) )
//DO EVENTS
NEXT
:Fields( "urn:schemas:mailheader:disposition-notification-to" ):Value := cFrom
:Fields( "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate" ):Value := lAut
:Fields( "http://schemas.microsoft.com/cdo/configuration/smtpusessl" ):Value := lSSL
:Fields( "http://schemas.microsoft.com/cdo/configuration/smtpserver" ):Value := cServerIp
:Fields:update()
//DO EVENTS
:Send()
END WITH
IF lInformaEnvio
// MOSTRA_Email("E-mail enviado com sucesso !!!")
MsgInfo( "E-mail enviado com sucesso!!! Com o Programa do Rubens!" )
millisec( 500 )
// HB_ALERT("E-mail enviado com sucesso", "Aten‡Æo")
ENDIF
lRet := .T.
CATCH oErroMail
IF lInformaEnvio
MsgStop( "Não foi possível enviar a mensagem: " + cSubject + hb_EOL() + ;
"para o email: " + aTo[i] + "." + hb_EOL() + ;
"Erro: " + oErroMail:Description , "Atenção" )
ENDIF
lRet := .F.
END
NEXT
oCfg := Nil
oMsg := Nil
RETURN lRet
//*******************************************************************************
FUNCTION MENSAG( cTEXTO )
RETURN( ALERT( cTEXTO ) )
//*******************************************************************************
FUNCTION StringToArray( cString, cSeparator )
LOCAL nPos
LOCAL aString := {}
cSeparator := ";"
cString := ALLTRIM( cString ) + cSeparator
DO WHILE .T.
nPos := AT( cSeparator, cString )
IF nPos = 0
EXIT
ENDIF
AADD( aString, SUBSTR( cString, 1, nPos - 1 ) )
cString := SUBSTR( cString, nPos + 1 )
ENDDO
RETURN ( aString )
//*******************************************************************************
FUNCTION ArrayToString( aArray, cSeparator )
LOCAL nPos, cString
cSeparator := ";"
cString := ""
FOR nPos = 1 TO LEN( aArray )
cString := cString + aArray[nPos] + cSeparator
NEXT
RETURN ( cString )
//*******************************************************************************
