Hola amigo, estoy con FW1608,y harbour y BC7
Salu2
Rutina para enviar mails
-
Willi Quintana
- Posts: 859
- Joined: Sun Oct 09, 2005 10:41 pm
- Location: Cusco - Perú
- Contact:
Re: Rutina para enviar mails
Willi, con Harbour no funcionó, mira:
Con xHarbour, funciona perfecto.
Saludos.
Con xHarbour, funciona perfecto.
Saludos.
João Santos - São Paulo - Brasil
Re: Rutina para enviar mails
Willi, este funciona perfecto con HARBOUR 3.2
Regards, saludos.
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 := "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
*/
João Santos - São Paulo - Brasil
Re: Rutina para enviar mails
Willi, con gmail.com también funciona.
Saludos.
Code: Select all
aFiles := aArquivo // pode ser uma matriz com vários endereços
cSubject := cAssunto
aQuem := "kapiabafwh@gmail.com" // cFrom
cMsg := cMENSAGEM
cServerIp := "smtp.gmail.com" // servidor smtp
cFrom := "kapiabafwh@gmail.com"
cUser := "kapiabafwh@gmail.com" // cEMAIL
cPass := "XXXXXXXXXXXXX" // cSENHAEMAIL
vPORTSMTP := 465
aCC := ""
aBCC := ""
lConf := .F.
lSSL := .T. // OR .F. // gmail is .T.
João Santos - São Paulo - Brasil