/*
* CDOMail.prg
* Componente para enviar correo usando los servicios CDO Mail
*
http://msdn.microsoft.com/en-us/library ... 8v=exchg.6 5%29.aspx
*
* Copyright 2007, 2011 Jose Lalin <jlalin en xailer.com>
* 2011 Bingen
* + Soporte de adjuntos
*
* All rights reserved
*/
*/
#include "Xailer.ch"
//---------------------------------------------------------- --------------------
CLASS TCDOMail FROM TComponent
PUBLISHED:
PROPERTY cServer INIT ""
PROPERTY nPort INIT 25
PROPERTY lAuthenticate INIT .F.
PROPERTY lSSL INIT .F.
PROPERTY cUser INIT ""
PROPERTY cPassword INIT ""
PROPERTY aAttachments INIT {}
PROPERTY cFrom INIT ""
PROPERTY cTO INIT ""
PROPERTY cCC INIT ""
PROPERTY cBCC INIT ""
PROPERTY cSubject INIT ""
PROPERTY cMessage INIT ""
PROPERTY lHTML INIT .F.
PUBLIC:
DATA lInstalled INIT .F. READONLY
METHOD Create( oParent ) CONSTRUCTOR // --> Self
METHOD Free() // --> Nil
METHOD Send() // --> lSuccess
METHOD CreateSqlFile()
RESERVED:
DATA oObj
ENDCLASS
//---------------------------------------------------------- --------------------
METHOD Create( oParent ) CLASS TCDOMail
LOCAL oError
Super:Create( oParent )
TRY
::oObj := CreateObject( "CDO.Message" )
IF ValType( ::oObj ) == "O"
::lInstalled := .T.
ENDIF
CATCH
::lInstalled := .F.
END
RETURN Self
//---------------------------------------------------------- --------------------
METHOD Free() CLASS TCDOMail
Super:Free()
::oObj := Nil
RETURN Nil
//---------------------------------------------------------- --------------------
METHOD Send() CLASS TCDOMail
LOCAL oCfg := CreateObject( "CDO.Configuration" )
LOCAL lSuccess := .F.
LOCAL cFile
WITH OBJECT oCfg:Fields
:Item( "
http://schemas.microsoft.com/cdo/config ... smtpserver" ):Value := ::cServer
:Item( "
http://schemas.microsoft.com/cdo/config ... pserverpor t" ):Value := ::nPort
:Item( "
http://schemas.microsoft.com/cdo/config ... pauthentic ate" ):Value := IIF( ::lAuthenticate, 1, 0 )
:Item( "
http://schemas.microsoft.com/cdo/config ... smtpusessl" ):Value := IIF( ::lSSL, 1, 0 )
:Item( "
http://schemas.microsoft.com/cdo/config ... ndusername" ):Value := ::cUser
:Item( "
http://schemas.microsoft.com/cdo/config ... ndpassword" ):Value := ::cPassword
:Item( "
http://schemas.microsoft.com/cdo/config ... /sendusing" ):Value := 2
:Update()
END
WITH OBJECT ::oObj
:Configuration := oCfg
:From := ::cFrom
:To := ::cTo
:Subject := ::cSubject
:Cc := ::cCC
:Bcc := ::cBCC
IF ::lHTML
:HTMLBody := ::cMessage
ELSE
:TextBody := ::cMessage
ENDIF
FOR EACH cFile IN ::aAttachments
If File(cFile)
:Addattachment := cFile
Endif
NEXT
TRY
lSuccess := ( :Send() == Nil )
CATCH
lSuccess := .F.
END
END
oCfg := Nil
RETURN lSuccess
//---------------------------------------------------------- --------------------
CLASS TCDOGMail FROM TCDOMail
PUBLISHED:
PROPERTY cServer INIT "smtp.gmail.com"
PROPERTY nPort INIT 465
PROPERTY lAuthenticate INIT .T.
PROPERTY lSSL INIT .T.
ENDCLASS
//---------------------------------------------------------- --------------------
//Ejemplo de uso
/*
WITH OBJECT TCDOMail():New(self)
:cServer := "smtp.test.com"
:cUser := "
myself@test.com"
:nPort := 465
:lAuthenticate := .T.
:lSSL := .T.
:cPassword := "MyPassword"
:cTO := "
destinatary@google.com"
:cFrom := "My Self"
:aAttachments := {"c:ads_err.adi","c:ads_err.dbf"}
:cSubject := "This is the subject."
:cMessage := "The text of the message ........................."
:Create()
IF :lInstalled
If !:Send()
MsgInfo('Error al envia Correo, revise los datos de la configuración de envio.')
Else
Msginfo("Correo enviado con éxito")
Endif
else
MsgInfo('Servidor de Correo no Instalado imposible enviar email desde el programa.')
endif
:End()
END WITH
*/
//Si no existe el archivo de mensajes crearlo
METHOD CreateSqlFile( oParent ) CLASS TCDOMail
Local cSelect:="Create Table If Not Exists emailsent ("+;
" Id Int(9) Primary key Auto_Increment Not Null,"+;
" Fecha DateTime ,"+;
" Remitente VarChar(50) Default '',"+;
" Destinatario VarChar(50) Default '',"+;
" Mensaje VarChar(250) Default '',"+;
" DiasValidez Int(3) Default 0 ,"+;
" Visto TinyInt(1) Default 0 ,"+;
" FechaVisto DateTime )"+;
" ENGINE=InnoDB CHARACTER SET latin1 COLLATE latin1_spanish_ci "
Appdata:oControlDb:Execute(cSelect,"Error de creación de la tabla de mensajes")
Return Nil