Rutina para enviar mails

[Willi Quintana]

Hola amigo, estoy con FW1608,y harbour y BC7
Salu2

[karinha]

Willi, con Harbour no funcionó, mira:



Con xHarbour, funciona perfecto.

Saludos.

[karinha]

Willi, este funciona perfecto con HARBOUR 3.2

Code: Select all  Expand view  RUN

// 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
*/
 

Regards, saludos.

[karinha]

Willi, con gmail.com también funciona.

Code: Select all  Expand view  RUN

   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.
 

Saludos.