Clipper On Line • Ver Tópico - Rotinas Para Emails

Rotinas Para Emails

Discussão sobre a biblioteca Fivewin - O Clipper para Windows.

Moderador: Moderadores

 

Rotinas Para Emails

Mensagempor Kapiaba » 07 Dez 2017 10:03

Rotinas para envio de emails com fontes anexas.

Abs.
Anexos
SNDMAIL.ZIP
(61.71 KiB) Baixado 27 vezes
RMAIL.ZIP
(989.63 KiB) Baixado 27 vezes
Kapiaba
Colaborador

Colaborador
 
Mensagens: 1369
Data de registro: 07 Dez 2012 15:14
Cidade/Estado: São Paulo
Curtiu: 271 vezes
Mens.Curtidas: 84 vezes

Rotinas Para Emails

Mensagempor Kapiaba » 11 Dez 2017 10:05

Bom dia, alguém tem essa função e a DLL mais atuais? Não consgio enviar email via yahoo com esta rotina. Não dá erro, mas o programa fica travado.

DLL muito antiga e não sei quem é o autor.

06/06/2010 11:54 109.056 sndmail.dll
06/06/2010 11:54 3.160 sndmail.lib

#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


Obg. Abs.
Kapiaba
Colaborador

Colaborador
 
Mensagens: 1369
Data de registro: 07 Dez 2012 15:14
Cidade/Estado: São Paulo
Curtiu: 271 vezes
Mens.Curtidas: 84 vezes

Rotinas Para Emails

Mensagempor Kapiaba » 12 Dez 2017 14:14

Problema resolvido com Harbour 3.2 Many thanks Rubens!

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

Colaborador
 
Mensagens: 1369
Data de registro: 07 Dez 2012 15:14
Cidade/Estado: São Paulo
Curtiu: 271 vezes
Mens.Curtidas: 84 vezes




Retornar para FiveWin

Quem está online

Usuários vendo este fórum: Nenhum usuário registrado online e 1 visitante


Faça uma doação para o forum
cron
v
Olá visitante, seja bem-vindo ao Fórum Clipper On Line!
Efetue o seu login ou faça o seu Registro