Clipper On Line • Ver Tópico - Enviando email com CDOSYS

Enviando email com CDOSYS

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

Moderador: Moderadores

 

Enviando email com CDOSYS

Mensagempor Kapiaba » 06 Ago 2015 16:21

Enviando email com CDOSYS:

http://forums.fivetechsupport.com/viewt ... =6&t=31175

#include "FiveWin.ch"
#include "CdoSys.ch"

#define WS_3DLOOK  4
#define CLR_HBROWN nRGB( 205, 192, 176 )
#define CLR_NBLUE  nRGB( 142, 171, 194 )

Function fEmail()

   Local oDlg, aCtl[ 22 ], oFont

   /*
   Local cMailServer := PadR( "webmail.execompu.com.mx", 60 ), ;             // servidor de correo
         cFrom       := PadR( "pepe@execompu.com.mx", 60 ), ;        // remitente
         cTo         := PadR( "pepe@execompu.com.mx", 180 ), ; // destinatario (uno o varios separados con comas)
         cBCC        := PadR( "pepe@execompu.com.mx", 180 ), ; // copias ocultas a (uno o varios separados con comas)
         cAttach     := PadR( "c:\fwh1505\bitmaps\fivewin.bmp", 180 ), ;// archivo anexo (uno o varios separados con comas)
         cSubject    := "pruebas de correo", ;                              // asunto
         cBody       := "cuerpo del mensaje", ;                             // cuerpo del mensaje
         nPort       := 26, ;                                      // puerto usado por el servidor de correo
         cUser       := "pepe@execompu.com.mx" , ;
         cPass       := "xxxxxxx" , ;
         cSSL        := .T. , ;
         cAuth       := .T.
   */

   Local cMailServer := PadR( "smtp.pleno.com.br",  60 ), ; // servidor de correo
         cFrom       := PadR( "joao@pleno.com.br",  60 ), ; // remitente
         cTo         := PadR( "joao@pleno.com.br", 180 ), ; // destinatario (uno o varios separados con comas)
         cBCC        := PadR( "joao@pleno.com.br", 180 ), ; // copias ocultas a (uno o varios separados con comas)
         cAttach     := PadR( "c:\fwh1306\bitmaps\fivewin.bmp", 180 ), ;// archivo anexo (uno o varios separados con comas)
         cSubject    := "pruebas de correo", ;                              // asunto
         cBody       := "cuerpo del mensaje", ;                             // cuerpo del mensaje
         nPort       := 587, ;                              // puerto usado por el servidor de correo
         cUser       := "joao@pleno.com.br" , ;
         cPass       := "XXXXXXX" , ;
         cSSL        := .T. , ;
         cAuth       := .T.

   DEFINE FONT oFont NAME "Arial" SIZE 0, -16 BOLD

   DEFINE DIALOG oDlg FROM 0, 0 TO 455, 703 PIXEL ;
          COLORS CLR_BLUE, CLR_HBROWN ;
          TITLE "CDOSYS Collaboration Data Objects for Windows 2000" ;
          STYLE nOR( DS_MODALFRAME, WS_POPUP, WS_CAPTION, WS_SYSMENU, WS_3DLOOK )

   oDlg:lHelpIcon := .F.

   @ 10,  5 SAY aCtl[ 1 ] PROMPT "Servidor de Correo:" OF oDlg ;
            FONT oFont UPDATE ;
            COLORS CLR_BLUE, CLR_HBROWN SIZE 70, 11 PIXEL

   @ 10, 80 GET aCtl[ 2 ] VAR cMailServer OF oDlg ;
            FONT oFont  UPDATE  PICTURE "@K" ;
            COLORS CLR_BLUE, CLR_WHITE SIZE 206, 11 PIXEL

   @ 10,294 SAY aCtl[ 3 ] PROMPT "Puerto:" OF oDlg ;
            FONT oFont UPDATE ;
            COLORS CLR_BLUE, CLR_HBROWN SIZE 30, 11 PIXEL

   @ 10,320 GET aCtl[ 4 ] VAR nPort OF oDlg ;
            FONT oFont  UPDATE  PICTURE "@K ####" ;
            COLORS CLR_BLUE, CLR_WHITE SIZE 24, 11 PIXEL

   @ 24,  5 SAY aCtl[ 5 ] PROMPT "Remitente:" OF oDlg ;
            FONT oFont UPDATE ;
            COLORS CLR_BLUE, CLR_HBROWN SIZE 70, 11 PIXEL

   @ 24, 80 GET aCtl[ 6 ] VAR cFrom OF oDlg ;
            FONT oFont  UPDATE  PICTURE "@K" ;
            COLORS CLR_BLUE, CLR_WHITE SIZE 264, 11 PIXEL

   @ 39,  5 SAY aCtl[ 7 ] PROMPT "Destinatario:" OF oDlg ;
            FONT oFont UPDATE ;
            COLORS CLR_BLUE, CLR_HBROWN SIZE 70, 11 PIXEL

   @ 39, 80 GET aCtl[ 8 ] VAR cTo OF oDlg ;
            FONT oFont  UPDATE  PICTURE "@K" ;
            COLORS CLR_BLUE, CLR_WHITE SIZE 264, 11 PIXEL

   @ 54,  5 SAY aCtl[ 9 ] PROMPT "Copia para:" OF oDlg ;
            FONT oFont UPDATE ;
            COLORS CLR_BLUE, CLR_HBROWN SIZE 70, 11 PIXEL

   @ 54, 80 GET aCtl[ 10 ] VAR cBCC OF oDlg ;
            FONT oFont  UPDATE  PICTURE "@K" ;
            COLORS CLR_BLUE, CLR_WHITE SIZE 264, 11 PIXEL

   @ 69,  5 SAY aCtl[ 11 ] PROMPT "Adjuntar:" OF oDlg ;
            FONT oFont UPDATE ;
            COLORS CLR_BLUE, CLR_HBROWN SIZE 70, 11 PIXEL

   @ 69, 80 GET aCtl[ 12 ] VAR cAttach OF oDlg  PICTURE "@K" ;
            FONT oFont  UPDATE ;
            COLORS CLR_BLUE, CLR_WHITE SIZE 253, 11 PIXEL // ACTION fAddAttach( aCtl[ 12 ] ) ; // descomentar para FWH 8.12 o posterior

   @ 69,333 BUTTON "..." OF oDlg SIZE 10, 10 PIXEL ACTION fAddAttach( aCtl[ 12 ] )

   @ 84,  5 SAY aCtl[ 13 ] PROMPT "Asunto:" OF oDlg ;
            FONT oFont UPDATE ;
            COLORS CLR_BLUE, CLR_HBROWN SIZE 70, 11 PIXEL

   @ 84, 80 GET aCtl[ 14 ] VAR cSubject OF oDlg ;
            FONT oFont  UPDATE PICTURE "@K" ;
            COLORS CLR_BLUE, CLR_WHITE SIZE 264, 11 PIXEL

   @ 99,  5 SAY aCtl[ 15 ] PROMPT "Autenticación: Usuario:" OF oDlg ;
            FONT oFont UPDATE ;
            COLORS CLR_BLUE, CLR_HBROWN SIZE 80, 11 PIXEL

   @ 99, 87 GET aCtl[ 16 ] VAR cUser OF oDlg ;
            FONT oFont  UPDATE PICTURE "@K" ;
            COLORS CLR_BLUE, CLR_WHITE SIZE 118, 11 PIXEL

   @ 99,213 SAY aCtl[ 17 ] PROMPT "Contraseña:" OF oDlg ;
            FONT oFont UPDATE ;
            COLORS CLR_BLUE, CLR_HBROWN SIZE 44, 11 PIXEL

   @ 99,259 GET aCtl[ 18 ] VAR cPass OF oDlg PASSWORD ;
            FONT oFont  UPDATE  PICTURE "@K";
            COLORS CLR_BLUE, CLR_WHITE SIZE 85, 11 PIXEL

   @118,  6 SAY aCtl[ 19 ] PROMPT "Cuerpo del mensaje" OF oDlg ;
            SIZE 100, 11 PIXEL ;
            FONT oFont COLORS CLR_BLUE, CLR_HBROWN

   @126, 10 GET aCtl[ 20 ] VAR cBody OF oDlg ;
            FONT oFont MULTILINE  UPDATE ;
            COLORS CLR_BLUE, CLR_WHITE SIZE 330, 72 PIXEL

   @208,213 BUTTON aCtl[ 21 ] PROMPT "&Enviar" OF oDlg ;
            FONT oFont SIZE 53, 16 PIXEL  ;
            ACTION fSendMail( cMailServer, cFrom, cTo, cSubject, cBody, cAttach, cBCC, cUser, cPass, nPort )

   @208,292 BUTTON aCtl[ 22 ] PROMPT "&Salir" OF oDlg ;
            FONT oFont SIZE 53, 16 PIXEL ACTION oDlg:End()

   ACTIVATE DIALOG oDlg CENTERED ;
            VALID ( oFont:End(), .T. )

Return Nil

//---------------------------------------------------------------------------------------------//

Function fSendMail( cMailServer, cFrom, cTo, cSubject, cBody, cAttach, cBCC, cUser, cPass, nPort )

   Local oCfg, oMsg, oError, nEle, cToken, ;
         aAttach  := {}, ;
         lAuth    := ! Empty( cUser ) .and. ! Empty( cPass ), ;
         nSendOpt := 2   // send using: 1 = pickup folder  2 = port
   Local lRet := .F.
       

   Default nPort    := 26, ;
           cSubject := "", ;
           cBody    := ""

   If "GMAIL.COM" $ Upper( cMailServer ) .and. ( Empty( cUser ) .or. Empty( cPass ) )
      MsgStop( "Con GMail son requeridos nombre de usuario y contraseña", "Atención" )
      Return Nil
   EndIf

   CursorWait()

   nEle := 1

   While ! Empty( cToken := StrToken( cAttach, nEle++, "," ) )
      AAdd( aAttach, cToken )
   EndDo

   Try
      oCfg := CreateObject( "CDO.Configuration" )

      With Object oCfg:Fields

         :Item( cdoSMTPServer ):Value     := Trim( cMailServer )
         :Item( cdoSMTPServerPort ):Value := nPort
         :Item( cdoSendUsing ):Value      := nSendOpt

         If lAuth

            :Item( cdoSMTPAuthenticate ):Value := 1
            :Item( cdoSendUserName ):Value     := Trim( cUser )
            :Item( cdoSendPassword ):Value     := Trim( cPass )

            // para las gratuitas(gmail, live, yahoo) es:
            //:Item( cdoSMTPUseSSL ):Value := 1

            //Emails corporativos:
            :Item( cdoSMTPUseSSL ):Value := 0

         EndIf

         :Update()

      End With

      oMsg := CreateObject( "CDO.Message" )

      With Object oMsg

         :Configuration := oCfg
         :From          := Trim( cFrom )
         :To            := Trim( cTo )
         :Subject       := Trim( cSubject )
         :TextBody      := Trim( cBody )

         For nEle := 1 To Len( aAttach )
            :AddAttachment := AllTrim( aAttach[ nEle ] )
         Next

         If ! Empty( cBCC )
            :BCC := Trim( cBCC )
         EndIf

         :Send()

      End With

      lRet := .T.

   Catch oError

      CursorArrow()

      MsgStop( "No se pudo enviar el mensaje" + CRLF  + "Error: " + cValToChar( oError:GenCode) + CRLF + ;
               "SubC: " + cValToChar( oError:SubCode ) + CRLF + "OSCode: " + cValToChar( oError:OsCode ) + CRLF + ;
               "SubSystem: " + cValToChar( oError:SubSystem ) + CRLF + "Mensaje: " + oError:Description )

      oCfg := Nil
      oMsg := Nil

      Return Nil

   End Try

   oCfg := Nil
   oMsg := Nil

   SndPlaySound( GetWinDir() + "\Tada.wav", 0 )

   CursorArrow()

   IF lRet //:= .T.

      MsgInfo( "Mensagem Enviada", "Mensagem Enviada" )

      lRet := .F.

   ENDIF

Return Nil

//---------------------------------------------------------------------------------------------//

Static Function fAddAttach( oGet )

   Local cFile, ;
         cAttach := oGet:VarGet()

   cFile := cGetFile( "*.*", "Selecciona el archivo" )

   If ! Empty( cFile )
      cAttach := Lower( PadR( AllTrim( cAttach ) + If( ! Empty( cAttach ), ",", "" ) + AllTrim( cFile ), 180 ) )
   EndIf

   oGet:cText( cAttach )

Return Nil

/*
Bueno después muchas pruebas he encontrado la solución:

Para las cuentas corporativas hay que cambiar el valor de: ":Item( cdoSMTPUseSSL ):Value" este tiene que ser:
":Item( cdoSMTPUseSSL ):Value := 0"

y para las gratuitas(gmail, live, yahoo) es:
":Item( cdoSMTPUseSSL ):Value := 1"

Espero les sirva
*/

/*
hotmail:
cMailServer := "smtp.live.com"
nPort := 25

Gmail:
cMailServer := "smtp.gmail.com"
nPort := 465
*/

/*
CDOSYS.CH

#ifndef _CDOSYS_CH
#define _CDOSYS_CH
#define cdoSMTPServer       "http://schemas.microsoft.com/cdo/configuration/smtpserver"
#define cdoSMTPServerPort   "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
#define cdoSendUsing        "http://schemas.microsoft.com/cdo/configuration/sendusing"
#define cdoSMTPPickupFolder "http://schemas.microsoft.com/cdo/configuration/smtpserverpickupdirectory"
#define cdoSMTPAuthenticate "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
#define cdoSendUserName     "http://schemas.microsoft.com/cdo/configuration/sendusername"
#define cdoSendPassword     "http://schemas.microsoft.com/cdo/configuration/sendpassword"
#define cdoSMTPUseSSL       "http://schemas.microsoft.com/cdo/configuration/smtpusessl"
#endif
*/


Abs


Kapiaba
Colaborador

Colaborador
 
Mensagens: 1483
Data de registro: 07 Dez 2012 15:14
Cidade/Estado: São Paulo
Curtiu: 284 vezes
Mens.Curtidas: 90 vezes



Retornar para FiveWin

Quem está online

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


Ola Amigo, espero que meu site e forum tem lhe beneficiado, com exemplos e dicas de programacao.
Entao divulgue o link da Doacao abaixo para seus amigos e redes sociais ou faça uma doacao para o site forum...
MUITO OBRIGADO PELA SUA DOACAO!
Faça uma doação para o forum
v
Olá visitante, seja bem-vindo ao Fórum Clipper On Line!
Efetue o seu login ou faça o seu Registro