>* CDO2000.prg
> 
>#DEFINE cdoSendPassword "h ttp://schemas.microsoft.com/cdo/configuration/sendpassword"
>#DEFINE cdoSendUserName "h ttp://schemas.microsoft.com/cdo/configuration/sendusername"
>#DEFINE cdoSendUsingMethod "h ttp://schemas.microsoft.com/cdo/configuration/sendusing"
>#DEFINE cdoSMTPAuthenticate "h ttp://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
>#DEFINE cdoSMTPConnectionTimeout "h ttp://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
>#DEFINE cdoSMTPServer "h ttp://schemas.microsoft.com/cdo/configuration/smtpserver"
>#DEFINE cdoSMTPServerPort "h ttp://schemas.microsoft.com/cdo/configuration/smtpserverport"
>#DEFINE cdoSMTPUseSSL "h ttp://schemas.microsoft.com/cdo/configuration/smtpusessl"
>#DEFINE cdoURLGetLatestVersion "h ttp://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: Attachment 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
>