Rotinas Para Emails
Enviado: 07 Dez 2017 10:03
Rotinas para envio de emails com fontes anexas.
Abs.
Abs.
#include "Fivewin.ch"
STATIC hDll
FUNCTION MAIN()
LOCAL cFrom := "joao@pleno.com.br"
LOCAL cServer := "smtp.pleno.com.br"
LOCAL cTo := "joao@pleno.com.br"
LOCAL cSubjeCt := "Test with sendmail.dll"
LOCAL cMessage := "Test with sendmail.dll - Email Body"
LOCAL cSender := "joao@pleno.com.br"
LOCAL cUser := "joao@pleno.com.br"
LOCAL cPassword := "xxxxxxx"
LOCAL aAttach := {}
LOCAL aCc := "" //???
LOCAL lHtml := .F.
LOCAL cPort := "587"
LOCAL lNotification := .F. // cFrom
LOCAL lRet
lRet := SENDMAIL( cFrom, cServer, cTo, cSubject, cMessage, cSender, cUser, cPassword, aAttach, aCc, lHtml, cPort, lNotification )
IF lRet
? "Message sent successfully perfect with FWH17.01"
ELSE
? "Unsent message check windows live mail"
ENDIF
RETURN NIL
FUNCTION SENDMAIL( cFrom, cServer, cTo, cSubject, cMessage, cSender, cUser, cPassword, aAttach, aCc, lHtml, cPort, lNotification )
LOCAL cMsgFile := CTEMPFILE()
LOCAL cCmd := "SndMail -f " + cFrom + " -X " + cServer + " -r " + cTo + " -s " + ["] + cSubject + ["] + " -b " + cMsgFile
LOCAL nRes
LOCAL i
DEFAULT lHtml := "<html" $ LOWER( cMessage )
MEMOWRIT( cMsgFile, cMessage + CRLF )
IF !EMPTY( aAttach )
FOR i = 1 TO LEN( aAttach )
cCmd += " -a " + ["] + aAttach[ i ] + ["]
NEXT
ENDIF
IF !EMPTY( cSender )
cCmd += " -F " + ["] + cSender + ["]
ENDIF
IF !EMPTY( cUser )
cCmd += " -h LOGIN -u " + cUser
ENDIF
IF !EMPTY( cPassword )
cCmd += " -p " + cPassword
ENDIF
IF !EMPTY( aCc )
FOR i = 1 TO LEN( aCc )
cCmd += " -c " + ["] + aCc[ i ] + ["]
NEXT
ENDIF
IF lHtml
cCmd += " -H"
ENDIF
IF !EMPTY( cPort )
cCmd += " -P " + cPort
ENDIF
IF !EMPTY( lNotification )
cCmd += " -t " + ["] + "Disposition-Notification-To: " + cFrom + ["]
ENDIF
hDLL = LOADLIBRARY( "sndmail.dll" )
IF hDll = 0
? [Install sndmail.dll.. ]
__QUIT()
ELSE
SMTPLIBOPEN() // OPEN sndmail.dll
ENDIF
nRes = SMTPSENDMAIL( cCmd )
SMTPLIBCLOSE()
FREELIBRARY( hDLL )
FERASE( cMsgFile )
RETURN nRes = 0
DLL STATIC FUNCTION SMTPLIBOPEN() AS VOID;
PASCAL FROM "USmtpLibOpen" LIB hDll
DLL STATIC FUNCTION SMTPSENDMAIL( cCmd AS STRING ) AS LONG;
PASCAL FROM "USmtpCmdLineSendMail" LIB hDll
DLL STATIC FUNCTION SMTPLIBCLOSE() AS VOID;
PASCAL FROM "USmtpLibClose" LIB hDll
// END OF PROGRAM
// 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 := "joao@pleno.com.br" // cFrom
cMsg := cMENSAGEM
cServerIp:= "smtp.pleno.com.br" // servidor smtp
cFrom := "joao@pleno.com.br"
cUser := "joao@pleno.com.br" // cEMAIL
cPass := "XXXXXXX" // 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 )
********************************************************************************
/*
Function EMAIL_ORCAMENTO()
LOCAL cTela := SAVESCREEN(00,00,24,79)
LOCAL GetList := {}
LOCAL nRECNO := RECNO()
LOCAL cCOR := SETCOLOR()
LOCAL cAssunto := 'Orcamento '+Space(40)
PRIVATE cORCAME := cDIRORC+'OR'+RIGHT(ORC->NUMERO_,6)+'.PDF'
PRIVATE aQUEM := SPACE(50)
PRIVATE cEMAIL := ALLTRIM(PERS->EMAIL)+'@gmail.com'
PRIVATE cSENHAEMAIL := ALLTRIM(PERS->SENHAEMAIL)
PRIVATE cMsgTela := 'Enviando Orcamento !!! Aguarde ...'
If ! File( cOrcame )
ImpOrc_Email()
EndIf
DbSelectArea('CLI')
DbSetOrder(2)
DbGoTop()
IF DbSeek( ORC->CODCLI_ )
aQUEM := CLI->EMAIL
ENDIF
DbSelectArea('ORC')
SetCursor(1)
WHILE (.T.)
JANELA(11,05,21,76,"ENVIO DE EMAIL: ORCAMENTO")
COR("GETS")
cFROM := ALLTRIM(PERS->RAZAO) + ' <'+cEMAIL+'>' // "MDV Informatica e papelaria "
cAssunto2 := Space(50)
cAssunto3 := Space(50)
cAssunto4 := Space(50)
cMENSAGEM := ;
''+HTML_EOL()+;
'A'+HTML_EOL()+;
ALLTRIM(CLI->NOME)+HTML_EOL()+;
''+HTML_EOL()+;
'Segue em anexo Orcamento solicitado'+HTML_EOL()+;
''+HTML_EOL()+;
''+HTML_EOL()
@ 13,10 SAY 'Emitente:' GET cFROM WHEN 1>2
@ 14,10 SAY 'Para....:' GET aQUEM VALID !EMPTY( aQuem )
@ 15,10 SAY 'Assunto.:' GET cASSUNTO VALID !EMPTY(cASSUNTO)
@ 17,10 SAY 'Obs.....:' Get cAssunto2
@ 18,10 SAY ' ' Get cAssunto3
@ 19,10 SAY ' ' Get cAssunto4
READ
IF ESC()
EXIT
ENDIF
cMensagem += AllTrim(cAssunto2) +HTML_EOL()+ AllTrim(cAssunto3) + HTML_EOL()+AllTrim(cAssunto4)+HTML_EOL()+HTML_EOL()
cMensagem += 'Atenciosamente,'+HTML_EOL()+;
''+HTML_EOL()+;
+ALLTRIM(PERS->RAZAO)+HTML_EOL()
aFILES := { cORCAME }
Envia_Email( aFILES, cASSUNTO, cMensagem,, .T.)
EXIT
ENDDO
SetCursor(0)
SETCOLOR( cCOR )
RESTSCREEN(0,0,24,79, cTELA )
RETURN NIL
*/