CDO 2000 class for sending emails

Submitted by Sergey on May 1, 2008 - 09:38

The CDO2000 class allows to send emails w/o user intervention using a SMTP server.

An example on how to use the class can be found at CDO 2000 class for sending emails.

Note 1 CDO 2000 is included in Windows 2000 and later.

Note 2 A character set of any body part is controlled by Charset property. The default is "us-ascii".

* CDO2000.prg
 
#DEFINE cdoSendPassword "http://schemas.microsoft.com/cdo/configuration/sendpassword"
#DEFINE cdoSendUserName "http://schemas.microsoft.com/cdo/configuration/sendusername"
#DEFINE cdoSendUsingMethod "http://schemas.microsoft.com/cdo/configuration/sendusing"
#DEFINE cdoSMTPAuthenticate "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
#DEFINE cdoSMTPConnectionTimeout "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
#DEFINE cdoSMTPServer "http://schemas.microsoft.com/cdo/configuration/smtpserver"
#DEFINE cdoSMTPServerPort "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
#DEFINE cdoSMTPUseSSL "http://schemas.microsoft.com/cdo/configuration/smtpusessl"
#DEFINE cdoURLGetLatestVersion "http://schemas.microsoft.com/cdo/configuration/urlgetlatestversion"
#DEFINE cdoAnonymous 0	&& Perform no authentication (anonymous)
#DEFINE cdoBasic 1	&& Use the basic (clear text) authentication mechanism.
#DEFINE cdoSendUsingPort 2	&& Send the message using the SMTP protocol over the network.
#DEFINE cdoXMailer "urn:schemas:mailheader:x-mailer"
 
DEFINE CLASS cdo2000 AS Custom
 
	PROTECTED aErrors[1], nErrorCount, oMsg, oCfg, cXMailer
 
	nErrorCount = 0
 
	* Message attributes
	oMsg = Null
 
	cFrom = ""
	cReplyTo = ""
	cTo = ""
	cCC = ""
	cBCC = ""
	cAttachment = ""
 
	cSubject = ""
	cHtmlBody = ""
	cTextBody = ""
	cHtmlBodyUrl = ""
 
	cCharset = ""
 
	* Priority: Normal, High, Low or empty value (Default)
	cPriority = ""
 
	* Configuration object fields values
	oCfg = Null
	cServer = ""
	nServerPort = 25
	* Use SSL connection
	lUseSSL = .F.
	nConnectionTimeout = 30			&& Default 30 sec's
	nAuthenticate = cdoAnonymous
	cUserName = ""
	cPassword = ""
	* Do not use cache for cHtmlBodyUrl
	lURLGetLatestVersion = .T.
 
	* Optional. Creates your own X-MAILER field in the header
	cXMailer = "VFP CDO 2000 mailer Ver 1.1.100 2010"
 
	PROTECTED PROCEDURE Init
		This.ClearErrors()
	ENDPROC
 
	* Send message
	PROCEDURE Send
 
		IF This.GetErrorCount() > 0
			RETURN This.GetErrorCount()
		ENDIF
 
		WITH This
			.ClearErrors()
			.oCfg = CREATEOBJECT("CDO.Configuration")
			.oMsg = CREATEOBJECT("CDO.Message")
			.oMsg.Configuration = This.oCfg
		ENDWITH
 
		* Fill message attributes
		LOCAL lnind, laList[1], loHeader, laDummy[1], lcMailHeader
 
		IF This.SetConfiguration() > 0
			RETURN This.GetErrorCount()
		ENDIF
 
		IF EMPTY(This.cFrom)
			This.AddError("ERROR : From is empty.")
		ENDIF
		IF EMPTY(This.cSubject)
			This.AddError("ERROR : Subject is empty.")
		ENDIF
 
		IF EMPTY(This.cTo) AND EMPTY(This.cCC) AND EMPTY(This.cBCC)
			This.AddError("ERROR : To, CC and BCC are all empty.")
		ENDIF
 
		IF This.GetErrorCount() > 0
			RETURN This.GetErrorCount()
		ENDIF
 
		This.SetHeader()
 
		WITH This.oMsg
 
			.From     = This.cFrom
			.ReplyTo  = This.cReplyTo
 
			.To       = This.cTo
			.CC       = This.cCC
			.BCC      = This.cBCC
			.Subject  = This.cSubject
 
			* Create HTML body from external HTML (file, URL)
			IF NOT EMPTY(This.cHtmlBodyUrl)
				.CreateMHTMLBody(This.cHtmlBodyUrl)
			ENDIF
 
			* Send HTML body. Creates TextBody as well
			IF NOT EMPTY(This.cHtmlBody)
				.HtmlBody = This.cHtmlBody
			ENDIF
 
			* Send Text body. Could be different from HtmlBody, if any
			IF NOT EMPTY(This.cTextBody)
				.TextBody = This.cTextBody
			ENDIF
 
			IF NOT EMPTY(This.cCharset)
				IF NOT EMPTY(.HtmlBody)
					.HtmlBodyPart.Charset = This.cCharset
				ENDIF
 
				IF NOT EMPTY(.TextBody)
					.TextBodyPart.Charset = This.cCharset
				ENDIF
			ENDIF
 
			* Process attachments
			IF NOT EMPTY(This.cAttachment)
				* Accepts comma or semicolon
				* VFP 7.0 and later
				*FOR lnind=1 TO ALINES(laList, This.cAttachment, [,], [;])
				* VFP 6.0 and later compatible
				FOR lnind=1 TO ALINES(laList, CHRTRAN(This.cAttachment, [,;], CHR(13) + CHR(13)))
					lcAttachment = ALLTRIM(laList[lnind])
					* Ignore empty values
					IF EMPTY(laList[lnind])
						LOOP
					ENDIF
 
					* Make sure that attachment exists
					IF ADIR(laDummy, lcAttachment) = 0
						This.AddError("ERROR: Attacment not Found - " + lcAttachment)
					ELSE
						* The full path is required.
						IF 	UPPER(lcAttachment) <> UPPER(FULLPATH(lcAttachment))
							lcAttachment = FULLPATH(lcAttachment)
						ENDIF
						.AddAttachment(lcAttachment)
					ENDIF
				ENDFOR
			ENDIF
 
			IF NOT EMPTY(This.cCharset)
				.BodyPart.Charset = This.cCharset
			ENDIF
 
			* Priority
			IF NOT EMPTY(This.cPriority)
				lcMailHeader = "urn:schemas:mailheader:"
				.Fields(lcMailHeader + "Priority")   = LOWER(This.cPriority)
				.Fields(lcMailHeader + "Importance") = LOWER(This.cPriority)
				DO CASE
				CASE This.cPriority = "High"
					.Fields(lcMailHeader + "X-Priority") = 1 && 5=Low, 3=Normal, 1=High
				CASE This.cPriority = "Normal"
					.Fields(lcMailHeader + "X-Priority") = 3 && 5=Low, 3=Normal, 1=High
				CASE This.cPriority = "Low"
					.Fields(lcMailHeader + "X-Priority") = 5 && 5=Low, 3=Normal, 1=High
				ENDCASE
				.Fields.Update()
			ENDIF
		ENDWITH
 
		IF This.GetErrorCount() > 0
			RETURN This.GetErrorCount()
		ENDIF
 
		This.oMsg.Send()
 
		RETURN This.GetErrorCount()
 
	ENDPROC
 
	* Clear errors collection
	PROCEDURE ClearErrors()
		This.nErrorCount = 0
		DIMENSION This.aErrors[1]
		This.aErrors[1] = Null
		RETURN This.nErrorCount
	ENDPROC
 
	* Return # of errors in the error collection
	PROCEDURE GetErrorCount
		RETURN This.nErrorCount
	ENDPROC
 
	* Return error by index
	PROCEDURE GetError
		LPARAMETERS tnErrorno
		IF	tnErrorno <= This.GetErrorCount()
			RETURN This.aErrors[tnErrorno]
		ELSE
			RETURN Null
		ENDIF
	ENDPROC
 
	* Populate configuration object
	PROTECTED PROCEDURE SetConfiguration
 
		* Validate supplied configuration values
		IF EMPTY(This.cServer)
			This.AddError("ERROR: SMTP Server isn't specified.")
		ENDIF
		IF NOT INLIST(This.nAuthenticate, cdoAnonymous, cdoBasic)
			This.AddError("ERROR: Invalid Authentication protocol ")
		ENDIF
		IF This.nAuthenticate = cdoBasic ;
				AND (EMPTY(This.cUserName) OR EMPTY(This.cPassword))
			This.AddError("ERROR: User name/Password is required for basic authentication")
		ENDIF
 
		IF 	This.GetErrorCount() > 0
			RETURN This.GetErrorCount()
		ENDIF
 
		WITH This.oCfg.Fields
 
			* Send using SMTP server
			.Item(cdoSendUsingMethod) = cdoSendUsingPort
			.Item(cdoSMTPServer) = This.cServer
			.Item(cdoSMTPServerPort) = This.nServerPort
			.Item(cdoSMTPConnectionTimeout) = This.nConnectionTimeout
 
			.Item(cdoSMTPAuthenticate) = This.nAuthenticate
			IF This.nAuthenticate = cdoBasic
				.Item(cdoSendUserName) = This.cUserName
				.Item(cdoSendPassword) = This.cPassword
			ENDIF
			.Item(cdoURLGetLatestVersion) = This.lURLGetLatestVersion
			.Item(cdoSMTPUseSSL) = This.lUseSSL
 
			.Update()
		ENDWITH
 
		RETURN This.GetErrorCount()
 
	ENDPROC
 
	*----------------------------------------------------
	* Add message to the error collection
	PROTECTED PROCEDURE AddError
		LPARAMETERS tcErrorMsg
		This.nErrorCount = This.nErrorCount + 1
		DIMENSION This.aErrors[This.nErrorCount]
		This.aErrors[This.nErrorCount] = tcErrorMsg
		RETURN This.nErrorCount
	ENDPROC
 
	*----------------------------------------------------
	* Format an error message and add to the error collection
	PROTECTED PROCEDURE AddOneError
		LPARAMETERS tcPrefix, tnError, tcMethod, tnLine
		LOCAL lcErrorMsg, laList[1]
		IF INLIST(tnError, 1427,1429)
			AERROR(laList)
			lcErrorMsg = TRANSFORM(laList[7], "@0") + "  " + laList[3]
		ELSE
			lcErrorMsg = MESSAGE()
		ENDIF
		This.AddError(tcPrefix + ":" + TRANSFORM(tnError) + " # " + ;
			tcMethod + " # " + TRANSFORM(tnLine) + " # " + lcErrorMsg)
		RETURN This.nErrorCount
	ENDPROC
 
	*----------------------------------------------------
	* Simple Error handler. Adds VFP error to the objects error collection
	PROTECTED PROCEDURE Error
		LPARAMETERS tnError, tcMethod, tnLine
		This.AddOneError("ERROR: ", tnError, tcMethod, tnLine )
		RETURN This.nErrorCount
	ENDPROC
 
	*-------------------------------------------------------
	* Set mail header fields, if necessary. For now sets X-MAILER, if specified
	PROTECTED PROCEDURE SetHeader
		LOCAL loHeader
		IF NOT EMPTY(This.cXMailer)
			loHeader = This.oMsg.Fields
			WITH loHeader
				.Item(cdoXMailer) =  This.cXMailer
				.Update()
			ENDWITH
		ENDIF
	ENDPROC
 
	*----------------------------------------------------
	*
	PROTECTED PROCEDURE cPriority_assign(tvVal)
		* Check for incorrect values
		IF INLIST("~" + PROPER(tvVal) + "~", "~High~", "~Normal~", "~Low~") OR EMPTY(tvVal)
			This.cPriority = PROPER(ALLTRIM(tvVal))
		ELSE
			This.AddError("ERROR: Invalid value for cPriority property.")	
		ENDIF
	ENDPROC
 
ENDDEFINE
Your rating: None Average: 5 (5 votes)

CDO 2000 Mail UI

Submitted by Gianni Sassanelli (not verified) on September 4, 2010 - 04:50.

Hi Sergey,
Thank's for you excellent posts.

I need an help for CDO MAIL
Do you know If is possible send a conditionally mail such as DISPLAY methods of mapi or Send(True) of CDO1.0 ??
Please help me if possible
thank's
Gianni

Re: CDO 2000 Mail UI

Submitted by Sergey on September 4, 2010 - 20:23.

Hi Gianni,

CDO 2000 does not rely on any email client installed on PC and as result cannot use them to display email before sending.

Extended MAPI wrapper for VFP

Submitted by Gianni Sassanelli (not verified) on September 6, 2010 - 04:37.

It's ok
do you know any EXTENDED MAPI wrapper that is usable by VFP ?

I don't know about c++ then i searching for a C++ develepper that can vrite a FLL to use it by VFP

this because CDO is excellent but i think that it have 2 problems
1° don't is user interactive
2° don't save sended messages into Sended mail folder of default profile that user corrently use.

Can you say me how do you do this feature?

Re: Extended MAPI wrapper for VFP

Submitted by Sergey on September 6, 2010 - 11:56.

Hi Gianni ,

Craig Boyd posted free VFP Extended MAPI FLL in his blog at http://www.sweetpotatosoftware.com/SPSBlog.

Hi i try to send xls file ,

Submitted by Tommy (not verified) on November 22, 2010 - 03:43.

Hi
i try to send xls file , but can't open att file .
can u help me?
thx a lot
Tommy

I use CDO 2000 to send all

Submitted by Sergey on November 22, 2010 - 07:44.

I use CDO 2000 to send all kinds of attachments and don't have any problems with it.

Some enhancements

Submitted by Cesar (not verified) on December 12, 2010 - 00:40.

Thanks a lot Sergey, this class is really great, and I've been using it in production with 100% of satisfaction, and it included in the sources of FoxyPreviewer - http://foxypreviewer.codeplex.com/
Just wanted to pass to you some few enhancements that I made:

1 - The error handling works perfectly. But noticed that the error messages returned by the class in most cases bring a CHR(0) in the message. The VFP MESSAGEBOX() command can't show texts that have CHR(0) correctly, because it thinks that the string has ended when it finds it. So I just included this line in the method "AddOneError":

lcErrorMsg = CHRTRAN(lcErrorMsg, CHR(0), "")

2 - I've added the possibility of setting the "Priority" and "Ask for read receipt".
Included 2 properties: "lPriority" and "lReadReceipt"
In procedure "Send", included the code below:

* http://support.microsoft.com/kb/302839
IF This.lReadReceipt
   This.oMsg.Fields("urn:schemas:mailheader:disposition-notification-to") = This.cTo
   This.oMsg.Fields("urn:schemas:mailheader:return-receipt-to") = This.cTo
   This.oMsg.Fields.Update()
ENDIF
 
* Set priority if needed
IF This.lPriority
   This.oMsg.Fields("Priority").Value = 1   && -1=Low, 0=Normal, 1=High
   This.oMsg.Fields.Item("urn:schemas:mailheader:X-Priority") = 1 && -1=Low, 0=Normal, 1=High
   This.oMsg.Fields.Item("urn:schemas:httpmail:importance") = 1
   This.oMsg.Fields.Update()
ENDIF

Thanks again for this class and for the samples for using it with the several SMTP email servers. The BEREZNIKEROPEDIA ROCKS !!!

Regards

Re: Some enhancements

Submitted by Sergey on December 13, 2010 - 08:21.

Hi Cesar,

Thank you for kind words and updates.

1 - CHR(0) shouldn't be in the message in the first place. I removed the item that has value of CHR(0) from the error message created.
2 - Per your suggestion, implemented cPriority property with values 'High", "Normal" and "Low"

Thanks again,

Sergey

CDO2000 Implementation

Submitted by Herb Ellerbock (not verified) on June 25, 2011 - 22:45.

Hi Sergey,

I'm getting the following error(s) when running the code below:

"ERROR: :1429 # SEND # 252 # 0x00000213 CDO.Message.1 The transport failed to connect to the server."

Can you throw any light on this?

TIA, Herb

* SendMail.prg
 
* Outlook Express is configured to send e-mail but is not the default e-mail client.
* That should provide CDO with the registry entries it needs??
 
* loMail = NEWOBJECT("CDO2000", "CDO2000.fxp")
loMail	= CREATEOBJECT("CDO2000")
 
WITH loMail
	* Mailer Setup
	.cServer		= "smtp.live.com"
	.nServerPort	= 25
	.lUseSSL		= .T.
	.nAuthenticate	= 1
 
	* Sender's Credentials
 	.cUserName	= user_addr
	.cPassword	= user_pword
 
	* Email details
 	.cFrom		= .cUserName
	.cTo		= mail_to
	.cSubject		= mail_title
	.cTextBody	= mail_body
 
	* Attachment(s)
	.cAttachment	= attachment
 
ENDWITH
 
...
 
RETURN

Re: CDO2000 Implementation

Submitted by Sergey on June 27, 2011 - 06:16.

Hi Herb,

The error "The transport failed to connect to the server" means that either server at smtp.live.com is unaccessible or port 25 is blocked by firewall.

Outlook Express is not required for this class to work because all necessary configuration parameters are provided in the class properties.

CDO2000 Implementation

Submitted by Herb Ellerbock (not verified) on June 27, 2011 - 19:34.

Thanks Sergey,
It works much better now that I've replaced your "smtp.live.com" with my SMTP server name.

cannot send mail, 25 port is open

Submitted by andrus (not verified) on November 21, 2011 - 08:31.

I tried to send mail from foxypreviewer but got error

---------------------------
Error sending email
---------------------------
Error sending email:
#1429 - send - 0x00000211 The message could not be sent to the SMTP server. The transport error code was 0x80040217. The server response was not available

Message was not sent
---------------------------
OK
---------------------------

telnet smptserver.com 25

shows that port is open.
How to fix or diagnose this ?
I'm using Windows 7 64 bit.