/*
* SMTPMail.prg
* Clase para enviar correo usando el Activex ChilKat Mail
* Manual en https://www.chilkatsoft.com/refdoc/xChilkatEmail2Ref.html
* Ejemplos en https://www.example-code.com/vbscript/smtp.asp
* Copyright 2016 Bingen
*
*/
#include "Xailer.ch"
DYNAMIC CreateObject
DYNAMIC XA_Break
//------------------------------------------------------------------------------
CLASS TSMTPMail FROM TComponent
DATA oChilkat
DATA oServer
DATA oMail
PUBLISHED:
PROPERTY cDLLName INIT "ChilkatAx.dll"
PROPERTY cActivexName INIT "Chilkat_9_5_0"
PROPERTY cKey INIT "xxxxxxxxxxx" Aquí tu clave de Chilkat
PROPERTY cUtility INIT "Envío de emails"
PROPERTY cServer INIT ""
PROPERTY nPort INIT 25
PROPERTY cUser INIT ""
PROPERTY cPassword INIT ""
PROPERTY lAuthenticate INIT .F.
PROPERTY lSSL INIT .F.
PROPERTY lStartTTLS INIT .F.
PROPERTY aAttachments INIT {}
PROPERTY lDelAttachments INIT .F.
PROPERTY aEmbedImages INIT {}
PROPERTY cReference INIT "" //Referencia nuestra que se integra como un Meta en el código html
PROPERTY cFrom INIT ""
PROPERTY cTO INIT ""
PROPERTY cCC INIT ""
PROPERTY cBCC INIT ""
PROPERTY cSubject INIT ""
PROPERTY cMessage INIT ""
PROPERTY lHTML INIT .F.
PROPERTY cCharSet INIT ""
Property aSignature Init {} //2 elementos nombre del archivo con su path y el cId dentro del html
PROPERTY nPriority INIT 3 //Prioridad 1 Máxima 2 Media 3 Normal 4 Menor 5 Mínima
PROPERTY lReceipt INIT .F.
PROPERTY lDeliverReceipt INIT .F.
PROPERTY cReceiptTO INIT ""
PROPERTY nTimeOut INIT 60
PROPERTY lEnviado INIT .F.
PUBLIC:
DATA lInstalled INIT .F. READONLY
DATA nErrorCode INIT 0 READONLY
DATA cErrorDescription INIT "" READONLY
METHOD New( oParent ) CONSTRUCTOR // --> Self
METHOD Create( oParent ) CONSTRUCTOR // --> Self
METHOD Close() // --> Nil
METHOD Free() // --> Nil
METHOD Send() // --> lExito
METHOD EmbedImage( cFilename, cID )
METHOD AddHeader( cHeader, cValue )
PRIVATE:
ENDCLASS
//------------------------------------------------------------------------------
METHOD New( oParent ) CLASS TSMTPMail
//Ver si está instalada la DLL de ChilKat
TRY
::oChilkat := TOleAuto():New( ::cActivexName+".Global" )
IF ValType( ::oChilkat:Version ) == "C"
::lInstalled := .T.
ENDIF
CATCH
::lInstalled := .F.
END
//Si no esta instalada y no hay DLL
If !::lInstalled .And. !File(::cDllName)
MsgError("No se ha localizado el archivo necesario para "+::cUtility+" "+::cDLLName+CRLF+CRLF+"Contacte con el distribuidor de la aplicación para poder utilizar "+::cUtility,"Error envío "+::cUtility+" 1")
Return .F.
Endif
//Si no esta instalada y si hay DLL intentar registrarla
If !::lInstalled .And. File(::cDLLName)
If !DLLRegisterServer( ::cDLLName )
MsgError("No se ha podido registrar el archivo necesario para "+::cUtility+" "+::cDLLName+CRLF+CRLF+"Debería de ejecutar la aplicación con permisos de administrador una sola vez para poder activar "+::cUtility,"Error envío "+::cUtility+" 2")
Return .F.
Else
//Ver de nuevo si está instalada la DLL de ChilKat
TRY
::oChilkat := TOleAuto():New( ::cActivexName+".Global" )
IF ValType( ::oChilkat:Version ) == "C"
::lInstalled := .T.
ENDIF
CATCH
::lInstalled := .F.
END
Endif
Endif
If !::lInstalled
MsgError("No se ha podido poner en marcha el archivo necesario para "+::cUtility+" "+::cDLLName+CRLF+CRLF+"Contacte con el distribuidor de la aplicación para poder utilizar "+::cUtility,"Error envío "+::cUtility+" 3")
Return .F.
Endif
//Si está instalada meterle la clave de ChilKat
IF ::oChilkat:UnlockBundle(::cKey) <> 1
MsgError("No se ha podido poner en marcha el archivo necesario para "+::cUtility+" "+::cDLLName+CRLF+CRLF+"Contacte con el distribuidor de la aplicación para poder utilizar "+::cUtility,"Error envío "+::cUtility+" 4")
Return .F.
ENDIF
::oChilkat := Nil
::Create( oParent )
RETURN Self
//------------------------------------------------------------------------------
METHOD Create( oParent ) CLASS TSMTPMail
::Super:Create( oParent )
::oServer := TOleAuto():New( ::cActivexName+".MailMan" )
RETURN Self
//------------------------------------------------------------------------------
METHOD Close() CLASS TSMTPMail
::Free()
RETURN Nil
//------------------------------------------------------------------------------
METHOD Free() CLASS TSMTPMail
::oServer:CloseSmtpConnection()
::oServer := Nil
::oMail := Nil
::Super:Free()
RETURN Nil
//------------------------------------------------------------------------------
METHOD Send() CLASS TSMTPMail
LOCAL cFile, nItem := 0, cIdString:=""
::lEnviado := .F.
::oServer:SmtpHost := ::cServer
::oServer:SmtpPort := ::nPort
::oServer:SmtpUsername := ::cUser
::oServer:SmtpPassword := ::cPassword
::oServer:SmtpSsl := ::lSSL
::oServer:StartTLS := ::lStartTTLS
::oMail := TOleAuto():New( ::cActivexName+".Email" )
::oMail:From := ::cFrom
::oMail:FromAddress := ::cFrom
If Len(::cTo)>0
::oMail:AddMultipleTo (::cTo)
Endif
If Len(::cCC)>0
::oMail:AddMultipleCC (::cCC)
Endif
If Len(::cBCC)>0
::oMail:AddMultipleBCC (::cBCC)
Endif
::oMail:Subject := ::cSubject
::cMessage:=StrTran(::cMessage,"</data>","<meta name='AppSender' content='"+Application:cTitle+"'> </data>")
::cMessage:=StrTran(::cMessage,"</data>","<meta name='AppSenderVer' content='"+Application:cVersion+"'> </data>")
::cMessage:=StrTran(::cMessage,"</data>","<meta name='AppSenderUser' content='"+GetUserName()+"'> </data>")
::cMessage:=StrTran(::cMessage,"</data>","<meta name='AppSenderStation' content='"+GetComputerName()+"'> </data>")
If Len(::cReference)>0
::cMessage:=StrTran(::cMessage,"</data>","<meta name='AppReference' content='"+::cReference+"'> </data>")
Endif
::oMail:Body := ::cMessage
FOR EACH cFile IN ::aAttachments
IF File( cFile )
Try
::oMail:AddFileAttachment( cFile )
Catch
::cErrorDescription:="Es imposible adjuntar el archivo "+cFile
MsgStop("Es imposible adjuntar al email el archivo "+CRLF+CRLF+;
cFile+CRLF+CRLF+;
"Compruebe que no esté abierto o en uso.","Envío cancelado")
::Close()
Return ::lEnviado
End
ENDIF
NEXT
::oMail:ReturnReceipt := ::lDeliverReceipt
::oMail:AddHeaderField("X-Priority",::nPriority)
For nItem:=1 to Len(::aEmbedImages)
cIdString:=::oMail:AddRelatedFile( ::aEmbedImages[nItem,1] )
::oMail:SetReplacePattern( ::aEmbedImages[nItem,2] ,cIdString )
Next
::lEnviado:=::oServer:SendEmail(::oMail) = 1
IF !::lEnviado
::cErrorDescription:=ChilkatError(::oServer:LastErrorText,::cKey)
Else
If ::lDelAttachments
FOR EACH cFile IN ::aAttachments
Ferase( cFile )
Next
Endif
ENDIF
RETURN ::lEnviado
//------------------------------------------------------------------------------
METHOD EmbedImage( cFilename, cID ) CLASS TSMTPMail
AAdd(::aEmbedImages,{cFilename, cID})
RETURN Nil
//------------------------------------------------------------------------------
METHOD AddHeader( cHeader, cValue ) CLASS TSMTPMail
DEFAULT cValue TO ""
::oMail:AddHeaderField( cHeader, cValue )
RETURN Nil
//------------------------------------------------------------------------------
/*
WITH OBJECT TSMTPMail():New( self )
:cServer := ::oUsuarios:MailServer
:cUser := ::oUsuarios:MailUser
:cPassword := ::oUsuarios:MailPassword
:nPort := ::oUsuarios:MailPort
:lAuthenticate := ::oUsuarios:MailAutenticate
:lSSL := ::oUsuarios:MailSSL
:lStartTTLS := ::oUsuarios:MailTTLS
:cFrom := ::oUsuarios:MailFrom
:cBCC := ::oUsuarios:MailCCO
:lDeliverReceipt := ::oUsuarios:MailConfirm
cDestinatario := PadR( ::oUsuarios:MailFrom, 200 )
:cSubject := "Test de envio de email de la aplicación "+Appdata:cApplicationName
:cMessage := DToC(Date())+" "+Time()+CRLF+CRLF+"Si puede leer este texto el envio de email desde la aplicación " + Appdata:cApplicationName + " ha sido un éxito."
Application:lBusy := .F.
IF MsgEdit( "Dirección del destinatario para la prueba", "Envio de email de prueba", @cDestinatario )
:cTO := cDestinatario
Application:lBusy := .T.
IF :lInstalled
IF !:Send()
MsgStop( "ERROR al enviar Correo a " + cDestinatario + ". revise los datos de la configuración de envio."+CRLF+CRLF+;
"Error code "+Allstring(:nErrorCode)+" "+:cErrorDescription)
ELSE
MsgInfo( "Correo enviado con éxito a " + cDestinatario + ". Revise este correo para comprobar si la configuración es correcta." )
ENDIF
ELSE
MsgStop( 'Servidor de Correo no Instalado imposible enviar email desde la aplicación.' )
ENDIF
ENDIF
:End()
END WITH
*/
