FiveTech Support Forums

#INCLUDE "FIVEWIN.CH"
#include "recursos.ch"
#include "CdoSys.ch"
#include "hbcompat.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"
#define cdoSMTPConnectionTimeout "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
#endif
 //20Us3rP4l3rm011
#define NTRIM(n)    ( LTrim( Str( n ) ) )

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

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

FUNCTION str_replace(cString, cFind, cReplace )
Local cStr,nPos,nTot,cToc1,cToc2

  nPos := AT( upper(cFind), upper(cString) )
  nTot := len( cFind )

  if nPos > 0

     cToc1 := Substr( cString, 1, nPos-1 )
     cToc2 := Substr( cString, nPos + nTot + 1 )

     cStr  := cToc1+cReplace+cToc2

  else

     cStr := cString

  endif

Return cStr

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

Function fEmail_config( cFgAlias )

   Local oDlg, aCtl[ 22 ], oFont,lOk:=.f.

   Local cMailServer := PadR( "tuservidordecorreo.com", 60 ), ;             // servidor de correo
         cFrom       := PadR( "tucuenta@tuservidor.com", 60 ), ;        // remitente
         cTo         := PadR( "", 180 ), ; // destinatario (uno o varios separados con comas)
         cBCC        := PadR( "", 180 ), ; // copias ocultas a (uno o varios separados con comas)
         cAttach     := PadR( "", 2048 ), ;// archivo anexo (uno o varios separados con comas)
         cSubject    := "Informes Vencimiento Documentos "+Dtoc(Date())+" "+time(), ;                              // asunto
         cBody       := "Notificacion automatica de Vencimientos "+CRLF+CRLF+"Sistema de Control", ;                             // cuerpo del mensaje
         nPort       := 25 ,; //465, ;                                      // puerto usado por el servidor de correo // 465 si es Gmail
         cUser       := Space( 60 ), ;                              // nombre de usuario para autenticación 
         cPass       := Space( 30 )                                          // contraseña para autenticación

IF valtype( cFgAlias )=="C"

   cMailServer := ( cFgAlias )->CSERVER
   cFrom       := ( cFgAlias )->CFROM
   cTo         := ( cFgAlias )->CTO
   cBCC        := ( cFgAlias )->CCC
   cSubJect    := ( cFgAlias )->CSUBJECT
   nPort       := ( cFgAlias )->NPORT
   cUser       := ( cFgAlias )->CUSER
   cPass       := ( cFgAlias )->CPASS
   cBody       := ( cFgAlias )->CBODY

Else

   cMailServer := cFgAlias:CSERVER
   cFrom       := cFgAlias:CFROM
   cTo         := cFgAlias:CTO
   cBCC        := cFgAlias:CCC
   cSubJect    := cFgAlias:CSUBJECT
   nPort       := cFgAlias:NPORT
   cUser       := cFgAlias:CUSER
   cPass       := cFgAlias:CPASS

ENDIF


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

    oFont := TFont():New( GetDefaultFontName(), 0, GetDefaultFontHeight(),, )

   DEFINE DIALOG oDlg FROM 0, 0 TO 455, 703 PIXEL FONT oFontb ;
          COLORS CLR_BLUE, CLR_HBROWN ;
          TITLE "Configuracion Servidor de Envio de Informes para empresas" ;
          STYLE nOR( DS_MODALFRAME, WS_POPUP, WS_CAPTION, WS_SYSMENU, WS_3DLOOK )

   @ 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 "&Grabar" OF oDlg ;
            FONT oFont SIZE 53, 16 PIXEL  ;
            ACTION ( lok:=.t.,oDlg:End() )

   @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. )

   IF lok == .t.

     IF valtype( cFgAlias ) == "C"

      ( cFgAlias )->( NET_READ() )

      ( cFgAlias )->CSERVER  := cMailServer
      ( cFgAlias )->CFROM    := cFrom
      ( cFgAlias )->CTO      := cTo
      ( cFgAlias )->CCC      := cBCC
      ( cFgAlias )->CSUBJECT := cSubJect
      ( cFgAlias )->NPORT    := nPort
      ( cFgAlias )->CUSER    := cUser
      ( cFgAlias )->CPASS    := cPass
      ( cFgAlias )->CBODY    := cBody

      ( cFgAlias )->( DBRUNLOCK() )

     ELSE

       cFgAlias:CSERVER := cMailServer
       cFgAlias:CFROM   := cFrom
       cFgAlias:CTO     := cTo
       cFgAlias:CCC     := cBCC
       cFgAlias:CSUBJECT:= cSubJect
       cFgAlias:NPORT   := nPort
       cFgAlias:CUSER   := cUser
       cFgAlias:CPASS   := cPass
       cFgAlias:CBODY   := cBody

       cFgAlias:Save()

     Endif

     if msgnoyes("Desea Comprobar el envio ahora ?")

              Envia_Email( cFgAlias, cTo , cBcc, cSubJect, cAttach )

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

     Endif


    ENDIF

Return Nil

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

Function Envia_Email( cFgAlias, cTo1, cBcc1, cSubject1, cAttach1, cBody1,cDatos )

Local cMailServer,;
      cFrom      ,;
      cTo        ,;
      cBCC       ,;
      cSubJect   ,;
      nPort      ,;
      cUser      ,;
      cPass      ,;
      cBody

    IF valtype( cFgAlias ) == "C"

      cMailServer := ( cFgAlias )->CSERVER
      cFrom       := ( cFgAlias )->CFROM
      cTo         := ( cFgAlias )->CTO
      cBCC        := ( cFgAlias )->CCC
      cSubJect    := ( cFgAlias )->CSUBJECT
      nPort       := ( cFgAlias )->NPORT
      cUser       := ( cFgAlias )->CUSER
      cPass       := ( cFgAlias )->CPASS
      cBody       := ( cFgAlias )->CBODY

   else

      cMailServer := cFgAlias:CSERVER
      cFrom       := cFgAlias:CFROM
      cTo         := cFgAlias:CTO
      cBCC        := cFgAlias:CCC
      cSubJect    := cFgAlias:CSUBJECT
      nPort       := cFgAlias:NPORT
      cUser       := cFgAlias:CUSER
      cPass       := cFgAlias:CPASS
      cBody       := cFgAlias:CBODY

   ENDIF

     DEFAULT cTo1      := cTo
     DEFAULT cSubject1 := cSubject
     DEFAULT cBody1    := cBody
     DEFAULT cAttach1  := ""
      DEFAULT cBcc1     := cBcc

     fSendMail( cMailServer, cFrom, cTo1, cSubject1, cBody1, cAttach1, cBCC1, cUser, cPass, nPort, cDatos )

Return

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

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

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

   Default nPort    := 25, ;
           cSubject := "", ;
           cBody    := "", ;
              cDatos   := "Sin datos que mostrar",;
              cBcc     :="",;
              cUser    :="",;
              cPass    :=""


   cBody := str_replace( cBody, "\DATOS\", cDatos )

   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 )
            :Item( cdoSMTPUseSSL ):Value       := 1
         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 )
         //:MDNRequested  := .T.  // confirmacion de recibido
         //:HTMLBody      := strHTML

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

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

         :Send()
      End With

   Catch oError

      CursorArrow()

      cErrores:=  "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 +" "+ if( ! Empty( oError:FileName ),;
                    ": " + oError:FileName   ,;
                    if( !Empty( oError:Operation ),;
                        ": " + oError:Operation   ,;
                        "" ) )+CRLF

      n := 2    // we don't disscard any info again !

      while ( n < 74 )
          if ! Empty( ProcName( n ) )
             cErrores := CRLF+cErrores+"   Called from: " + ProcFile( n ) + " => " + Trim( ProcName( n ) ) + ;
                           "(" + NTRIM( ProcLine( n ) ) + ")"

          endif
          n++
      end

      ??? cErrores

      oCfg := Nil
      oMsg := Nil
      Return Nil

   End Try

   oCfg := Nil
   oMsg := Nil
   SndPlaySound( GetWinDir() + "\media\Tada.wav", 0 )
   CursorArrow()

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 ), 2048 ) )
   EndIf

   oGet:cText( cAttach )

Return Nil

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

#define olMailItem 0  // Mail object
      oOutlook = CREATEOBJECT( "Outlook.Application" )
      oMail = oOutlook:CreateItem( olMailItem )
      oMail:Recipients:Add( <!-- e --><a href="mailto:'test@mycompany.com">'test@mycompany.com</a><!-- e -->' )
      oMail:Attachments:Add(  "c:\xharbour\test.htm" )
      oMail:Subject = 'Hello'

      // oMail:Body = "This is a test." // Text only body
      oMail:HTMLBody = MEMOREAD( "c:\xharbour\test.htm" )
      oMail:Display = .T.
      oMail:send()