PC Toledo

Em homenagem a Paulo Cesar Toledo
https://pctoledo.org/

Classe pra emails

https://pctoledo.org/viewtopic.php?t=14189

Página 1 de 1

Classe pra emails

Enviado: 22 Mai 2013 15:15
por JoséQuintas
Presentinho, minha classe pra emails.
A classe aceita enviar pelo Harbour, Blat.exe ou CDO.
É só configurar o método preferido.
Eu usava Blat.exe, e adicionei pra poder usar o Habour.
Apenas pra guardar a anotação, adicionei o CDO, mas não testei.
Desta forma, pode usar a classe para qualquer dos 3, ou até adicionar novos usos.
Tá exatamente igual meu fonte de uso (por enquanto), incluindo anotações de testes que fiz ou faria.
Não quis correr o risco de alterar na postagem e digitar errado.
Adicionei recentemente o acDeleteFile, que serve pra excluir arquivos que podem ser apagados depois do envio.
E descobri outra forma de fazer o efeito do "embed" que só o Blat tem, e deixei de usar.
Estou revisando pra eliminar de vez.

Código: Selecionar todos

#define SEND_USING_HARBOUR 1
#define SEND_USING_BLAT    2
#define SEND_USING_CDO     3

CREATE CLASS SendMailClass
   DATA nHowToSend   INIT SEND_USING_HARBOUR
   DATA nPort        INIT 587
   DATA nPriority    INIT 3
   DATA lConfirm     INIT .f.
   DATA lTrace       INIT .f.
   DATA nTimeOut     INIT 10000 // milliseconds
   DATA cServer      INIT ""
   DATA cFrom        INIT ""
   DATA acTo         INIT {}
   DATA acCC         INIT {}
   DATA acBCC        INIT {}
   DATA cFileBody    INIT ""
   DATA cSubject     INIT ""
   DATA cUser        INIT ""
   DATA cPassword    INIT ""
   DATA cServerPop   INIT ""
   DATA acAttachment INIT {}
   DATA acEmbed      INIT {}
   DATA acDeleteFile INIT {}
   METHOD AddTo( xTxtMailList )
   METHOD AddCc( xTxtMailList )
   METHOD AddBcc( xTxtMailList )
   METHOD AddAttachment( xFileName )
   METHOD AddDelete( xFile )
   METHOD AddMailToArray( xTxtMailList, aMailList )
   METHOD Send()
   METHOD SendUsingBlat()
   METHOD SendUsingCDO()
   METHOD SendUsingHarbour()
   END CLASS

METHOD AddTo( xTxtMailList ) CLASS SendMailClass
   ::AddMailToArray( xTxtMailList, ::acTo )
   RETURN NIL

METHOD AddCc( xTxtMailList ) CLASS SendMailClass
   ::AddMailToArray( xTxtMailList, ::acCC )
   RETURN NIL

METHOD AddBcc( xTxtMailList ) CLASS SendMailClass
   ::AddMailToArray( xTxtMailList, ::acBCC )
   RETURN NIL

METHOD AddDelete( xFile ) CLASS SendMailClass
   LOCAL nCont
   IF ValType( xFile ) == "A"
      FOR nCont = 1 TO Len( xFile )
         Aadd( ::acDeleteFile, xFile[ nCont ] )
      NEXT
   ELSE
      Aadd( ::acDeleteFile, xFile )
   ENDIF
   RETURN NIL

METHOD AddMailToArray( xTxtMailList, aMailList ) CLASS SendMailClass
   LOCAL cText, cMail, nPos, nCont
   
   IF ValType( xTxtMailList ) == "C"
      xTxtMailList := { xTxtMailList }
   ENDIF
   FOR nCont = 1 TO Len( xTxtMailList )
      cText := xTxtMailList[ nCont ]
      cText := StrTran( AllTrim( cText ), ";", "," )
      DO WHILE Len( cText ) > 0
         nPos := At( ",", cText + "," )
         cMail := AllTrim( Substr( cText, 1, nPos - 1 ) )
         IF Len( cMail ) != 0
            IF aScan( aMailList, cMail ) == 0
               AAdd( aMailList, cMail )
            ENDIF
         ENDIF
         cText := AllTrim( Substr( cText, nPos + 1 ) )
      ENDDO
   NEXT
   RETURN NIL

METHOD AddAttachment( xFileName ) CLASS SendMailClass
   LOCAL nCont
   
   IF ValType( xFileName ) == "C"
      xFileName := { xFileName }
   ENDIF
   FOR nCont = 1 TO Len( xFileName )
      Aadd( ::acAttachment, xFileName[ nCont ] )
   NEXT
   RETURN NIL

METHOD Send() CLASS SendMailClass
   LOCAL nCont
   IF ::nHowToSend == SEND_USING_HARBOUR
      ::SendUsingHarbour()
   ELSEIF ::nHowToSend == SEND_USING_BLAT
      ::SendUsingBlat()
   ELSEIF ::nHowToSend == SEND_USING_CDO
      ::SendUsingCDO()
   ENDIF
   FOR nCont = 1 TO Len( ::acDeleteFile )
      fErase( ::acDeleteFile )
   NEXT
   RETURN NIL
   
METHOD SendUsingHarbour() CLASS SendMailClass
   hb_SendMail( ;
      ::cServer, ;
      ::nPort, ;
      ::cFrom, ;
      ::acTo, ;
      ::acCc, ;
      ::acBcc, ;
      ::cFileBody, ;
      ::cSubject, ;
      ::acAttachment, ;
      ::cUser, ;
      ::cPassword, ;
      iif( Empty( ::cServerPop ), NIL, ::cServerPop ), ;
      , ; // Priority
      , ; // Confirmation
      , ; // xTrace
      .NOT. Empty( ::cServerPop ) )
   RETURN NIL

METHOD SendUsingCDO() CLASS SendMailClass
   LOCAL oMessage, oConfiguration, nCont, lOk
   oMessage       := win_OleCreateObject( "CDO:Message" )
   oConfiguration := win_OleCreateObject( "CDO:Configuration" )
   oConfiguration:Fields( "http://schemas.microsoft.com/cdo/configuration/sendusing" ):Value := 2 // 1=maquina, 2=servidor
   oConfiguration:Fields( "http://schemas.microsoft.com/cdo/configuration/smtpserver" ):Value := ::cServer
   oConfiguration:Fields( "http://schemas.microsoft.com/cdo/configuration/smtpserverport" ):Value := ::nPort
   oConfiguration:Fields( "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout" ):Value := 30
   oConfiguration:Fields( "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate" ):Value := 1 // 0=anonima, 1=basica, 2=ntlm
   oConfiguration:Fields( "http://schemas.microsoft.com/cdo/configuration/smtpusessl" ):Value := .f. // autenticacao segura
   oConfiguration:Fields( "http://schemas.microsoft.com/cdo/configuration/sendusername" ):Value := ::cFrom
   oConfiguration:Fields( "http://schemas.microsoft.com/cdo/configuration/sendpassword" ):Value := ::cPassword
   oConfiguration:Fields:Update()
   
   oMessage:Configuration := oConfiguration
   oMessage:To            := ::acTo
   oMessage:From          := ::cFrom
   oMessage:Subject       := ::cSubject
//   oMessage:TextBody      := ::cFileBody
   oMessage:TextHtml      := ::cFileBody
   FOR nCont = 1 TO Len( ::acAttachment )
      oMessage:AddAttachment( ::acAttachment[ nCont ] )
   NEXT
   oMessage:Fields( "urn:schemas:mailheader:disposition-notification-to" ):Value := ::cFrom
   oMessage:Fields:Update()
   lOk := .f.
   BEGIN SEQUENCE WITH { |e| Break(e) }
      oMessage:Send()
      lOk := .t.
   END SEQUENCE
   RETURN lOk

METHOD SendUsingBlat() CLASS SendMailClass
   LOCAL cTxt, nCont, cCmd, cBlatCfg
   MEMVAR Sistema
   cTxt := ""
   cTxt += "-server " + ::cServer + HB_EOL()
   cTxt += "-f " + ::cFrom + HB_EOL()
   cTxt += [-subject "] + ::cSubject + ["] + HB_EOL()
   cTxt += [-to ] + ::acTo[ 1 ] 
   IF Len( ::acTo ) > 1
      FOR nCont = 2 TO Len( ::acTo )
         cTxt += [,] + ::acTo[ nCont ] 
      NEXT
   ENDIF
   cTxt += HB_EOL()
   IF Len( ::acCC ) > 0
      cTxt += [-cc ] + ::acCC[ 1 ] + HB_EOL()
      IF Len( ::acCC ) > 1
         FOR nCont = 2 TO Len( ::acCC )
            cTxt += [,] + ::acCC[ nCont ]
         NEXT
      ENDIF
      cTxt += HB_EOL()
   ENDIF
   IF Len( ::acBCC ) > 0
      cTxt += [-bcc ] + ::acBCC[ 1 ]
      IF Len( ::acBCC ) > 1
         FOR nCont = 2 TO Len( ::acBCC )
            cTxt += [,] + ::acBCC[ nCont ]
         NEXT   
      ENDIF
      cTxt += HB_EOL()
   ENDIF   
   cTxt += "-u " + ::cUser + HB_EOL()
   cTxt += "-pw " + ::cPassword + HB_EOL()
   IF .NOT. Empty( ::cServerPop )
      cTxt += "-pu " + ::cUser + HB_EOL()
      cTxt += "-ppw " + ::cPassword + HB_EOL()
   ENDIF   
   cTxt += "-port " + LTrim( Str( ::nPort ) ) + HB_EOL()
   FOR nCont = 1 TO Len( ::acAttachment )
      cTxt += "-attach " + ::acAttachment[ nCont ] + HB_EOL()
   NEXT
//   FOR nCont = 1 TO Len( ::acEmbed )
//      cTxt += "-embed " + ::acEmbed[ nCont ] + HB_EOL()
//   NEXT
   cTxt += [-x "X-JPAID: ] + DriveSerial() + ["] + HB_EOL()
   cTxt += "-html" + HB_EOL()
   cBlatCfg := MyTempFile( "BLA" )
   Aadd( ::acDeleteFile, cBlatCfg )
   HB_MemoWrit( cBlatCfg, cTxt )
   cCmd := "@echo off" + HB_EOL() + "echo." + HB_EOL() + "echo ENVIANDO EMAIL" + HB_EOL() + "echo." + HB_EOL() + ;
      AppPath() + "Blat " + ::cFileBody + " -of " + cBlatCfg + HB_EOL()
   RunCmd( cCmd )
//   AAdd( aThreads, hb_ThreadStart( @RunBlatThread(), cFileName ) )
//   DO WHILE .t.
//      IF hb_ThreadWait( aThreads, 0.1, .t. ) == 1
//         EXIT
//      ENDIF
//      MyInkey(0.5)
//   ENDDO
//   fErase(cFileName)
RETURN NIL

FUNCTION RunBlatThread( cCmd )
   RUN ( cCmd )
   RETURN NIL

Meu uso serve como sugestão:
Tenho essa classe básica, sem nada pessoal, e outra classe que herda esta pra atribuir meu estilo.

Código: Selecionar todos

CREATE CLASS MyMailClass INHERIT SendMailClass
   METHOD Init()
   METHOD Send()
   END CLASS

METHOD Init()
   ::cServer     := "mail.servidor.com.br"
   ::cFrom       := "meuemail@servidor.com.br"
   ::cPassword := "minhasenha"
   RETURN NIL

METHOD Send()
   LOCAL xTela
   SAVE SCREEN TO xTela
   TelaDeStatus( "Enviando email" )
   Super:Send() // pra que reinventar a roda?
   RESTORE SCREEN FROM xTela
   RETURN NIL
No uso padrão:
oMail := MyMailClass():New()
...
oMail:Send()

No uso fora do padrão:
oMail := SendMailClass():New()
...
oMail:Send()

Se quiser Blat:
oMail := MyMailClass():New()
oMail:nHowToSend := 2
...
oMail:Send()

E por aí vai.
Pra quem não conhece, Super:Send() é muito legal.
Acaba permitindo usar SendMailClass:Send() dentro de MyMailClass() sem precisar copiar todo código fonte desse método.

Isso de herança tem mil e uma utilidades.
Como a classe de email funciona, dá pra brincar na classe herdada sem o risco de estragar a classe de enviar emails.
Nesse exemplo usando herança, adicionei a chamada a algo visual, pra mostrar alguma coisa pro usuário enquanto envia email.

Tenho pelo menos um caso de herança que uso pra ajustar CÓDIGO PRA FTP HARBOUR.
Desse jeito não mexo nos fontes originais do Harbour, mas tenho a classe ajustada para meu uso.
Em certa parte a classe de ftp usa uma espécie de DIR > arquivo.txt pra pegar a lista de arquivos, mas o resultado não é padrão, então ela falha no meu site. Por herança, ajustei esse método pro meu site.
Se um dia o código Harbour funcionar pra qualquer site, basta eu retirar esta herança - o fonte Harbour continua intacto.
Divirtam-se.

Classe pra emails

Enviado: 22 Mai 2013 17:28
por fladimir
José agradeço e acredito q a comunidade tb agradece seu empenho e colaboração...

Ficou legal a forma q vc fez... parabéns...


[]´s

Classe pra emails

Enviado: 24 Mai 2013 22:34
por rochinha
:-Y

Classe para emails

Enviado: 24 Mai 2013 23:55
por alxsts
Olá!

Parabéns Quintas!

Quero me juntar aos colegas nos aplausos e agradecer pelo belo trabalho.
Todos os horários são UTC-03:00
Página 1 de 1

Powered by phpBB® Forum Software © phpBB Limited

Traduzido por: Suporte phpBB