* Clasa oEmail
* oEmail > oThunderbirdEmailCmd
* oEmail > oCDO
* oEmail > oOutlook
* oEmail > oMapi

* getoEmail: citeste optiunile de email din ROA\settings.ini si intoarce obiectul oMail
* loMail = getoEmail()
* loMail.cTo = 'test@test.ro'
* loMail.EmailSetAttachment('c:\factura.pdf')
* lnErrors = loMail.Send()
* if lnErrors > 0
* messageb(loMail.GetErrorMessage)
* end if

*!* 07.04.2020
*!* Am adaugat clasa trimiterea de email prin client Mapi


#Define oAnonymous 0	&& Perform no authentication (anonymous)
#Define oBasic 1	&& Use the basic (clear text) authentication mechanism.

* https://www.berezniker.com/content/pages/visual-foxpro/cdo-2000-class-sending-emails

#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 xlCellTypeVisible			12
#Define xlSourceRange				4
#Define	xlHtmlStatic				0

#Define olFolderSentMail			5
#Define olFormatHTML				2

#Define wdFormatOriginalFormatting	16	&& Preserves original formatting of the pasted material

#Define SUCCESS_SUCCESS  0
#Define MAPI_DIALOG	8
#Define MAPI_ORIG	0
#Define MAPI_TO		1
#Define MAPI_CC		2
#Define MAPI_BCC	3
*--------------------------------------------------------------------------------------------
SET PATH to "D:\ROA\COMUNROA\;D:\ROA\ROAFACTURARE\COMUN\utile\email\;" ADDITIVE 
TEXT TO lcExemplu NOSHOW
loEmail = getoEmail()
IF TYPE('loEmail') = 'O'
	loEmail.cTo = 'mmarius28@gmail.com'
	loEmail.cSubject = "Test email " + Ttoc(Datetime(), 3)

	loEmail.EmailSetAttachment('e:\2017-11-10-001.jpg')
	loEmail.EmailSetAttachment('e:\3. fisa-voluntarului-lideri-de-unitate.docx')
	lnErrors = loEmail.Send()
	MESSAGEBOX(IIF(m.lnErrors > 0 , loEmail.GetErrorMessage(), 'Succes'))
ENDIF 
ENDTEXT

llThunderbirdCMD = .F.
llCDO = .T.
llOutlook = .F.
llMapi = .F.
Do Case
	Case m.llThunderbirdCMD
		loEmail = Createobject("oThunderbirdEmailCmd")
	Case m.llCDO
		loEmail = Createobject("oCDO")
	Case m.llOutlook
		loEmail = Createobject("oOutlook")
	Case m.llMapi
		loEmail = Createobject("oMapi")
	Otherwise
		Return
Endcase

**************************
* CDO Specific
loEmail.cServer = "mail.romfast.ro"
loEmail.nServerPort = 25
loEmail.cUserName = ""
loEmail.cPassword = ""
loEmail.lUseSSL = .F.
loEmail.nAuthenticate = Iif(Empty(loEmail.cUserName), oAnonymous, oBasic)
**************************

**************************
* Thunderbird Specific
loEmail.EmailSetExePath('C:\Program Files (x86)\Mozilla Thunderbird\thunderbird.exe')
loEmail.EmailSetWait()
**************************

**************************
* Outlook Specific
loEmail.EmailSetPreview(.T.)
loEmail.EmailSetDisplayWithoutInfo(.T.)
**************************

loEmail.cFrom = "marius.mutu@romfast.ro"
loEmail.cTo = "mmarius28@gmail.com"
loEmail.cCC = ""
loEmail.cBCC = ""
loEmail.cSubject = "Test email " + Iif(m.llCDO, 'CDO', Iif(m.llOutlook, 'OUTLOOK', Iif(m.llThunderbirdCMD, 'THUNDERBIRDCMD', 'OTHERS'))) + " " + Ttoc(Datetime(), 3)
loEmail.cHtmlBody = "Test <b>atasamente</b>" && FILETOSTR('d:\roa\factura_emailbody_acn.html')

loEmail.EmailSetAttachment('e:\2017-11-10-001.jpg')
loEmail.EmailSetAttachment('e:\3. fisa-voluntarului-lideri-de-unitate.docx')
loEmail.EmailSendWithoutAttachments(.F.)

lnErrors = loEmail.Send()
Messagebox(Iif(m.lnErrors > 0, loEmail.GetErrorMessage(), 'Succes'))


* -----------------------------------
* Citeste optiunile din settings.ini si intoarce un obiect oEmail configurat cu optiuni
Procedure getoEmail

	Local loMail As "oThunderbirdEmailCMD" Of "email.fxp"
	Local lcBodyBorderouContent, lcBodyContent, lcBodyContentTemplate, lcBodyFile, lcBodyFileGeneral
	Local lcBodyFileSchema, lcDisplayWithoutInfo, lcEmailBCC, lcEmailBCCGeneral, lcEmailBCCSchema
	Local lcEmailCC, lcEmailCCGeneral, lcEmailCCSchema
	Local lcEmailFrom, lcEmailFromGeneral, lcEmailFromSchema, lcEmailFromName, lcEmailFromNameGeneral, lcEmailFromNameSchema
	Local lcEmailHtml, lcEmailMode, lcEmailPassword, lcEmailPort, lcEmailSSL
	Local lcEmailServer, lcEmailUserName, lcExePath, lcPreview, lcSendWithoutAttachments
	Local lcSettingsSample, lcSubjectBoderouTemplate, lcSubjectTemplate, lcSubjectTemplateGeneral
	Local lcSubjectTemplateSchema, lcWait, llDisplayEmail, llDisplayWithoutInfo, llEmailSSL, llPreview
	Local llSendWithoutAttachments, llWait, lnEmailPort
	llDisplayEmail = .F.
	lcBodyContent = ""

	TEXT To lcSettingsSample Noshow
[email]
mailserver=mail.server.ro
port=25
username=
password=
emailapp=OUTLOOK
other_emailapp=OUTLOOK/CDO/THUNDERBIRDCMD/MAPI
ssl=0

[email_factura]
bodyfile=D:\ROA\factura_emailbody.html
bodyfile[_schema]=D:\ROA\factura_emailbody_schema.html
subject=Factura <nrfact> <datafact> <client>
from=office@server.ro
html=1
cc=
bcc=
pdfsufix=factura
pdfpath=D:\ROA\PDF\
pdfhasimage=0
emailpreview=1
displaysent=1
cc=
bcc=
	ENDTEXT

	lcEmailMode =  goApp.ReadIni('email', 'emailapp') && THUNDERBIRDCMD/OUTLOOK/CDO/MAPI
	If Empty(m.lcEmailMode)
		lcEmailMode = 'CDO'
		goApp.WriteIni('email', 'emailapp', m.lcEmailMode)
	Endif
	lcEmailMode = Upper(m.lcEmailMode)

	TEXT TO m.lcBodyContentTemplate TEXTMERGE noshow
Buna ziua, 
<br />
<br />
Aveti atasata factura <nrfact> din <datafact> pentru servicii prestate de <<ALLTRIM(goFirma.firma)>>. Va rugam sa o listati si sa o inregistrati in contabilitate.
<br />
<br />
Pentru sugestii de imbunatatire a raportarilor sau daca doriti sa le primiti pe alta adresa, dati un reply la acest email.
<br/>
<br/>

<div>
--<br />
Cu stima,
<br />
<br />
	ENDTEXT

	lcBodyFileSchema = goApp.ReadIni('email_factura', 'bodyfile_' + m.gcS) && bodyfile_ACN
	lcBodyFileGeneral = goApp.ReadIni('email_factura', 'bodyfile')
	lcBodyFile = Iif(!Empty(m.lcBodyFileSchema), m.lcBodyFileSchema, m.lcBodyFileGeneral)

	If Empty(m.lcBodyFile) Or !File(m.lcBodyFile)
		If AMESSAGEBOX('Doriti sa creati un fisier pentru continutul emailului(DA) sau sa alegeti un fisier (NU)?', 4 + 32, _Screen.Caption) = 6
			lcBodyFile = Putfile('Fisier continut email', 'factura_emailbody.html', 'html')
			If !Empty(m.lcBodyFile)
				Strtofile(m.lcBodyContentTemplate, m.lcBodyFile)
			Endif
		Else
			lcBodyFile = Getfile('HTML', 'Alegeti fisierul continut email:', 'Alege', 1, 'Continut email')
		Endif
		goApp.WriteIni('email_factura', 'bodyfile', m.lcBodyFile)
	Endif

	If File(m.lcBodyFile)
		lcBodyContent = Filetostr(m.lcBodyFile)
	Endif

	If Empty(m.lcBodyContent)
		lcBodyContent = m.lcBodyContentTemplate
	Endif

	**********
	TEXT TO m.lcBodyContentTemplate TEXTMERGE noshow
Buna ziua, 
<br />
<br />
Aveti atasat borderoul de facturi nr. <nr> din <data> si documentele asociate pentru serviciile prestate de <<ALLTRIM(goFirma.firma)>>.
<br />
Va rugam sa listati facturile si sa le inregistrati in contabilitate.
<br /><br />
De asemenea, va rugam sa dati un reply la acest email pentru confirmarea primirii facturilor.
<br/>
<br/>

<div>
--<br />
Cu stima,
<br />
<br />
	ENDTEXT

	lcBodyFileSchema = goApp.ReadIni('email_factura', 'bodyfile_borderou_' + m.gcS) && bodyfile_ACN
	lcBodyFileGeneral = goApp.ReadIni('email_factura', 'bodyfile_borderou')
	lcBodyFile = Iif(!Empty(m.lcBodyFileSchema), m.lcBodyFileSchema, m.lcBodyFileGeneral)
	lcBodyBorderouContent = ''
	If Empty(m.lcBodyFile) Or !File(m.lcBodyFile)
		If AMESSAGEBOX('Doriti sa creati un fisier pentru continutul emailului borderou (DA) sau sa alegeti un fisier (NU)?', 4 + 32, _Screen.Caption) = 6
			lcBodyFile = Putfile('Fisier continut email', 'borderou_emailbody.html', 'html')
			If !Empty(m.lcBodyFile)
				Strtofile(m.lcBodyContentTemplate, m.lcBodyFile)
			Endif
		Else
			lcBodyFile = Getfile('HTML', 'Alegeti fisierul continut email:', 'Alege', 1, 'Continut email')
		Endif
		goApp.WriteIni('email_factura', 'bodyfile_borderou', m.lcBodyFile)
	Endif

	If File(m.lcBodyFile)
		lcBodyBorderouContent = Filetostr(m.lcBodyFile)
	Endif

	If Empty(m.lcBodyContent)
		lcBodyBorderouContent = m.lcBodyContentTemplate
	Endif

	**********

	lcEmailFromSchema  =  goApp.ReadIni('email_factura', 'from_' + m.gcS)
	lcEmailFromGeneral =  goApp.ReadIni('email_factura', 'from')
	lcEmailFrom = Iif(!Empty(m.lcEmailFromSchema), m.lcEmailFromSchema, m.lcEmailFromGeneral)
	If Empty(m.lcEmailFrom )
		goApp.WriteIni('email_factura', 'from_' + m.gcS, 'test@server.ro')
	Endif

	lcEmailFromNameSchema  =  goApp.ReadIni('email_factura', 'from_name_' + m.gcS)
	lcEmailFromNameGeneral =  goApp.ReadIni('email_factura', 'from_name')
	lcEmailFromName = Iif(!Empty(m.lcEmailFromNameSchema), m.lcEmailFromNameSchema, m.lcEmailFromNameGeneral)
	If Empty(m.lcEmailFromName)
		goApp.WriteIni('email_factura', 'from_name_' + m.gcS, '')
	Endif

	lcEmailCCSchema  =  goApp.ReadIni('email_factura', 'cc_' + m.gcS)
	lcEmailCCGeneral =  goApp.ReadIni('email_factura', 'cc')
	lcEmailCC = Iif(!Empty(m.lcEmailCCSchema), m.lcEmailCCSchema, m.lcEmailCCGeneral)
	If Empty(m.lcEmailCC )
		goApp.WriteIni('email_factura', 'cc_' + m.gcS, '')
	Endif

	lcEmailBCCSchema  =  goApp.ReadIni('email_factura', 'bcc_' + m.gcS)
	lcEmailBCCGeneral =  goApp.ReadIni('email_factura', 'bcc')
	lcEmailBCC = Iif(!Empty(m.lcEmailBCCSchema), m.lcEmailBCCSchema, m.lcEmailBCCGeneral)
	If Empty(m.lcEmailBCC )
		goApp.WriteIni('email_factura', 'bcc_' + m.gcS, '')
	Endif

	lcSubjectTemplateSchema  =  goApp.ReadIni('email_factura', 'subject_' + m.gcS)
	lcSubjectTemplateGeneral = goApp.ReadIni('email_factura', 'subject')
	lcSubjectTemplate = Iif(!Empty(m.lcSubjectTemplateSchema), m.lcSubjectTemplateSchema, m.lcSubjectTemplateGeneral)
	If Empty(m.lcSubjectTemplate)
		lcSubjectTemplate = 'Factura <nrfact> <datafact> <client>'
		goApp.WriteIni('email_factura', 'subject', m.lcSubjectTemplate)
	Endif
	***********
	lcSubjectTemplateSchema  =  goApp.ReadIni('email_factura', 'subject_boderou_' + m.gcS)
	lcSubjectTemplateGeneral = goApp.ReadIni('email_factura', 'subject_borderou')
	lcSubjectBorderouTemplate = Iif(!Empty(m.lcSubjectTemplateSchema), m.lcSubjectTemplateSchema, m.lcSubjectTemplateGeneral)
	If Empty(m.lcSubjectBoderouTemplate)
		lcSubjectBoderouTemplate = 'Borderou facturi nr. <nr> din <data> - <client>'
		goApp.WriteIni('email_factura', 'subject_borderou', m.lcSubjectBoderouTemplate)
	Endif
	***********

	lcPreview = Alltrim(goApp.ReadIni('email_factura', 'preview'))
	If Empty(m.lcPreview)
		lcPreview = "1"
		goApp.WriteIni('email_factura', 'preview', m.lcPreview)
	Endif
	llPreview = (m.lcPreview = "1")

	lcWait = Alltrim(goApp.ReadIni('email_factura', 'wait'))
	If Empty(m.lcWait)
		lcWait = "0"
		goApp.WriteIni('email_factura', 'wait', m.lcWait)
	Endif
	llWait = (m.lcWait = "1")

	* Display the email window if empy(to, cc, subject) or return error
	lcDisplayWithoutInfo = Alltrim(goApp.ReadIni('email_factura', 'display_without_info'))
	If Empty(m.lcDisplayWithoutInfo)
		lcDisplayWithoutInfo = "0"
		goApp.WriteIni('email_factura', 'display_without_info', m.lcDisplayWithoutInfo)
	Endif
	llDisplayWithoutInfo = (m.lcDisplayWithoutInfo = "1")

	* Send email without attachments or return error
	lcSendWithoutAttachments = Alltrim(goApp.ReadIni('email_factura', 'send_without_attachments'))
	If Empty(m.lcSendWithoutAttachments)
		lcSendWithoutAttachments = "0"
		goApp.WriteIni('email_factura', 'send_without_attachments', m.lcSendWithoutAttachments)
	Endif
	llSendWithoutAttachments = (m.lcSendWithoutAttachments = "1")

	lcEmailHtml = goApp.ReadIni('email_factura', 'html')
	If Empty(m.lcEmailHtml )
		goApp.WriteIni('email_factura', 'html', '1')
	Endif

	lcEmailServer = goApp.ReadIni('email', 'mailserver')
	If Empty(m.lcEmailServer)
		goApp.WriteIni('email', 'mailserver', 'test.server.ro')
	Endif
	lcEmailPort = goApp.ReadIni('email', 'port')
	If Empty(m.lcEmailPort)
		goApp.WriteIni('email', 'port', '25')
	Endif
	lnEmailPort = Int(Val(m.lcEmailPort))

	lcEmailUserName = goApp.ReadIni('email', 'username')
	If Empty(m.lcEmailUserName)
		goApp.WriteIni('email', 'username', 'test')
	Endif
	lcEmailPassword = goApp.ReadIni('email', 'password')
	If Empty(m.lcEmailPassword )
		goApp.WriteIni('email', 'password', 'test')
	Endif
	lcEmailSSL = goApp.ReadIni('email', 'ssl')
	If Empty(m.lcEmailSSL)
		goApp.WriteIni('email', 'ssl', '0')
	Endif
	llEmailSSL = Int(Val(m.lcEmailSSL))

	lcExePath = goApp.ReadIni('email', 'exepath')
	If Empty(m.lcExePath)
		goApp.WriteIni('email', 'exepath', '')
	Endif

	Do Case
		Case m.lcEmailMode = 'THUNDERBIRDCMD'
			loMail = Newobject("oThunderbirdEmailCMD", "email.fxp")
		Case m.lcEmailMode = 'OUTLOOK'
			loMail = Newobject("oOutlook", "email.fxp")
		Case m.lcEmailMode = 'MAPI'
			loMail = Newobject("oMapi", "email.fxp")
		Otherwise
			loMail = Newobject("oCDO", "email.fxp")
	Endcase

	**************************
	* CDO Specific
	loMail.cServer = m.lcEmailServer
	loMail.nServerPort = m.lnEmailPort
	loMail.cUserName = m.lcEmailUserName
	loMail.cPassword = m.lcEmailPassword
	loMail.lUseSSL = m.llEmailSSL
	loMail.nAuthenticate = Iif(Empty(loMail.cUserName), 0, 1)

	**************************
	* Thunderbird Specific
	loMail.EmailSetExePath(m.lcExePath)
	loMail.EmailSetWait(m.llWait) && wait and dont't advance to the next email until send is pressed
	**************************

	**************************
	* Outlook Specific
	loMail.EmailSetPreview(m.llPreview)
	loMail.EmailSetDisplayWithoutInfo(m.llDisplayWithoutInfo)
	**************************

	loMail.cFrom = m.lcEmailFrom
	loMail.cFromName = m.lcEmailFromName
	loMail.cCC = m.lcEmailCC
	loMail.cBCC = m.lcEmailBCC

	loMail.cSubject = m.lcSubjectTemplate
	loMail.cHtmlBody = m.lcBodyContent

	loMail.cBorderouSubject = m.lcSubjectBorderouTemplate
	loMail.cBorderouBody = m.lcBodyBorderouContent

	loMail.EmailSendWithoutAttachments(m.llSendWithoutAttachments)

	Return loMail
Endproc && getoEmail

* -----------------------------------
* oEmail.Send
* > EmailSend
* >> EmailCreateCfg
* >> EmailSetConfiguration
* >> EmailSetHeader
* >> EmailSetParameters
Define Class oEmail As Custom

	Protected aErrors[1], nErrorCount, oMsg, oCfg, cXMailer

	nErrorCount = 0

	* Message attributes
	oMsg = Null

	cFrom = ""
	cFromName = ""
	cReplyTo = ""
	cTo = ""
	cCC = ""
	cBCC = ""
	cAttachment = "" && attachment file list separated by comma
	nAttachments = 0 && number of attachment files

	cSubject = "" && subiect email factura
	cHtmlBody = "" && continut email factura
	cTextBody = ""
	cHtmlBodyUrl = ""

	cBorderouSubject = "" && subiect email borderou
	cBorderouBody = "" && continut email borderou

	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 = oAnonymous
	cUserName = ""
	cPassword = ""
	* Do not use cache for cHtmlBodyUrl
	lURLGetLatestVersion = .T.

	* Optional. Creates your own X-MAILER field in the header
	cXMailer = ""

	cEmailExePath = ''
	cEmailProfile = ''

	lEmailWait = .F. && wait for the email to be sent, to advance to the next email

	lEmailPreview = .F. && preview each mail (default .F.)
	lDisplayEmailWithoutInfo = .F. && display mail without from, to, subject, body, attachment
	lCanDisplayEmailWithoutInfo = .T. && can the email without from, to, subject, body be displayed to user? (CDO does not display anything, for now)

	lFirstEmail = .T. && after the first email becomes .F., in case you want to do some things only the first time (eg: show the Sent folder in Outlook)
	lSendWithoutAttachments = .F. && if email can be sent without attachment (Default = .F.)

	lReadReceipt = .T. && confirmare de citire
	lPriority    = .F. && prioritate
					
	Protected Procedure Init
		This.ClearErrors()
	Endproc


	* Send message
	* Return Number of Errors (0 = succes)
	Procedure Send

		Local lnErrorCount
		lnErrorCount = This.GetErrorCount()
		If m.lnErrorCount > 0
			This.ClearMessage()
			Return m.lnErrorCount
		Endif

		With This
			.ClearErrors()
			.EmailCreateCfg() && abstract, to be implemented
		Endwith

		* Check server, user, password
		lnErrorCount = This.SetConfiguration()

		If m.lnErrorCount = 0
			* If email without info doesn't display to the user, add error
			If !(This.lDisplayEmailWithoutInfo And This.lCanDisplayEmailWithoutInfo)
				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.")
					* Nu permit trimiterea de emailuri (cu facturi) fara TO. 
					* Altfel le trimite doar la CC/BCC, adica trimite copia inapoi.
					* CC/BCC sunt fixe in settings.ini si nu ma intereseaza daca sunt sau nu completate
					This.AddError("ERROR : To is empty.")
				Endif
			Endif
		Endif && SetConfiguration

		lnErrorCount = This.GetErrorCount()
		If m.lnErrorCount = 0
			This.EmailSetHeader()
			This.EmailSetParameters()
		Endif

		lnErrorCount = This.GetErrorCount()
		If m.lnErrorCount = 0
			This.AddAttachments()

			* If email without attachment doesn't display to the user, add error
			If !(This.lDisplayEmailWithoutInfo And This.lCanDisplayEmailWithoutInfo)
				If !This.lSendWithoutAttachments And Empty(This.EmailGetAttachmentsNumber())
					This.AddError("ERROR : There are no attachments.")
				Endif
			Endif
		Endif

		* Send Email
		lnErrorCount = This.GetErrorCount()
		If m.lnErrorCount = 0
			This.EmailSend()
			lnErrorCount = This.GetErrorCount()
		Endif

		This.lFirstEmail = .F.
		This.ClearMessage()

		Return m.lnErrorCount
	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

	* Return all error messages into one message
	Procedure GetErrorMessage
		Lparameters tlClearErrors
		* tlClearErrors (optional): clear all error messages

		Local lcErrorMessage, lnError, lnErrors
		lnErrors = This.GetErrorCount()
		lcErrorMessage = ''
		For lnError = 1 To m.lnErrors
			lcErrorMessage = m.lcErrorMessage + This.Geterror(m.lnError) + '***'
		Endfor

		* Clear errors
		If m.tlClearErrors
			This.ClearErrors()
		Endif

		Return m.lcErrorMessage
	Endproc && GetErrorMessage

	* 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, oAnonymous, oBasic)
			This.AddError("ERROR: Invalid Authentication protocol ")
		Endif
		If This.nAuthenticate = oBasic ;
				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

		* Populate configuration objects
		This.EmailSetConfiguration()

		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

	Procedure EmailSetProfile
		Lparameters tcProfile
		This.cEmailProfile = m.tcProfile
	Endproc

	Procedure EmailSetExePath
		Lparameters tcExePath
		This.cEmailExePath = m.tcExePath
	Endproc

	Procedure EmailSetWait
		Lparameters tlWait
		This.lEmailWait = m.tlWait
	Endproc && EmailSetWait


	*-------------------------------------------------------
	* Add a file to the attachement list
	Procedure EmailSetAttachment
		Lparameters tcFile
		If !Empty(m.tcFile) And Type('tcFile') = 'C'
			This.cAttachment = This.cAttachment + Iif(!Empty(This.cAttachment), ",", "") + m.tcFile
		Endif
	Endproc && SetAttachment

	*-------------------------------------------------------
	* Overwrite the attachement list with a list of files
	Procedure EmailSetAttachments
		Lparameters tcFiles
		If !Empty(m.tcFiles) And Type('tcFiles') = 'C'
			This.cAttachment = m.tcFiles
		Endif
	Endproc && SetAttachment

	*-------------------------------------------------------
	* Empty the recipient list in subclass
	Procedure EmailClearMessage
		* To be implemented
	Endproc && EmailClearMessage

	Procedure ClearMessage
		This.EmailClearMessage()
		This.cTo = ""
		This.cHtmlBody = ""
		This.cSubject = ""
		This.cAttachment = ""
	Endproc && ClearMessage

	Procedure EmailSendWithoutAttachments
		Lparameters tlSendWithoutAttachments
		This.lSendWithoutAttachments = m.tlSendWithoutAttachments
	Endproc


	Procedure AddAttachments
		Local laList[1], laDummy[1]
		Local lcAttachment, lnAttachment, lnAttachments

		* Process attachments
		If Not Empty(This.cAttachment)
			* Accepts comma or semicolon
			lnAttachments = Alines(laList, This.cAttachment, [,], [;])
			For lnAttachment = 1 To m.lnAttachments
				lcAttachment = Alltrim(laList[m.lnAttachment])
				* Ignore empty values
				If Empty(laList[m.lnAttachment])
					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
					This.EmailAddAttachment(lcAttachment)
				Endif
			Endfor
		Endif
	Endproc && AddAttachments

	Procedure EmailAddAttachment
		Lparameters tcAttachment
		* To be implemented
	Endproc && EmailAddAtachment

	Procedure EmailGetAttachmentsNumber
		Return Getwordcount(This.cAttachment, [,])
	Endproc

	Procedure EmailSetPreview
		Lparameters tlSetPreview
		This.lEmailPreview = m.tlSetPreview
	Endproc && EmailSetPreview

	Procedure EmailSetDisplayWithoutInfo
		Lparameters tlSetDisplay
		This.lDisplayEmailWithoutInfo = m.tlSetDisplay
	Endproc && EmailSetDisplayWithoutInfo

	*-------------------------------------------------------
	* Create configuration objects
	Procedure EmailCreateCfg
		* to be implemented
	Endproc

	*-------------------------------------------------------
	* Set mail header fields, if necessary. For now sets X-MAILER, if specified
	Procedure EmailSetHeader
		* to be implemented
	Endproc

	*-------------------------------------------------------
	* Set to, from, atachments..
	Procedure EmailSetParameters
		* to be implemented
	Endproc

	*-------------------------------------------------------
	* Set server, username, password
	* Return Number of Errors (0 = success)
	Procedure EmailSetConfiguration()
		* to be implemented
		Return 0
	Endproc


	*-------------------------------------------------------
	* Send email
	Procedure EmailSend
		* to be implemented
	Endproc

	*-------------------------------------------------------
	* Add Error
	Procedure EmailAddError
		Lparameters tcErrorMessage
		This.AddError("ERROR : " + Transform(m.tcErrorMessage))
	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 && oEmail

*-----------------------------------------------------------
*!*	 	oEmail.Send
*!*	 	 > EmailCreateCfg
*!*	 	 > EmailSetConfiguration
*!*	 	 > EmailSetHeader
*!*	 	 > EmailSetParameters
*!*	 	 > EmailSend
Define Class oThunderbirdEmailCmd As oEmail
	Procedure EmailSend

		Local loRun As 'api_apprun' Of 'process.vcx'
		Local lcBody, lcCommandLine, lcExePath, lcProfile

		lcProfile = This.cEmailProfile
		lcExePath = This.cEmailExePath
		lcBody = Iif(!Empty(This.cHtmlBody), This.cHtmlBody, This.cTextBody)

		If Empty(This.cHtmlBody)
			lcBody = Strtran(m.lcBody, Chr(13) + Chr(10), [<br/>], 1, 1000, 1)
			lcBody = Strtran(m.lcBody, Chr(13), [<br/>], 1, 1000, 1)
		Else
			lcBody = Strtran(m.lcBody, Chr(13) + Chr(10), [], 1, 1000, 1)
			lcBody = Strtran(m.lcBody, Chr(13), [], 1, 1000, 1)
		Endif
		lcBody = Strtran(m.lcBody, [,], [&#44;], 1, 1000, 1)

		lcCommandLine = ["] + m.lcExePath + ["] + ;
			IIF(!Empty(m.lcProfile), [-profile "] + m.lcProfile + ["], []) + ;
			[ -compose ] + ;
			IIF(!Empty(This.cFrom), [from="] + This.cFrom + ["], []) + ;
			IIF(!Empty(This.cTo), [,to="] + This.cTo + ["], []) + ;
			IIF(!Empty(This.cCC), [,cc="] + This.cCC + ["], []) + ;
			IIF(!Empty(This.cBCC), [,bcc="] + This.cBCC + ["], []) + ;
			IIF(!Empty(This.cSubject), [,subject="] + This.cSubject + ["], []) + ;
			IIF(!Empty(m.lcBody), [,body="] + m.lcBody + ["], []) + ;
			IIF(!Empty(This.cAttachment), [,attachment='] + This.cAttachment + ['], [])

		If !'process.vcx' $ Lower(Set("Classlib"))
			Set Classlib To 'D:\ROA\ROAACNPRO\COMUN\clase\process.vcx' Additive
		Endif

		loRun = Createobject('api_apprun')

		If File (m.lcExePath)
			loRun.iccommandline = m.lcCommandLine
			If This.lEmailWait
				loRun.launchappandwait()
			Else
				loRun.launchapp()
			Endif
		Else
			This.EmailAddError('Thunderbird exe path ' + m.lcExePath + ' does not exist!')
		Endif

	Endproc && EmailSend
Enddefine && ThunderbirdEmailCMD

*-----------------------------------------------------------
*!*	 	oEmail.Send
*!*	 	 > EmailCreateCfg
*!*	 	 > EmailSetConfiguration
*!*	 	 > EmailSetHeader
*!*	 	 > EmailSetParameters
*!*	 	 > EmailSend
Define Class oCDO As oEmail

	Protected oMsg, oCfg


	* Message attributes
	oMsg = Null
	* Configuration object fields values
	oCfg = Null

	Procedure Init
		DoDefault()
		Local loEx As Exception

		This.lCanDisplayEmailWithoutInfo = .T.

		* Optional. Creates your own X-MAILER field in the header		
		This.cXMailer = "VFP CDO 2000 mailer Ver 1.1.100 2010"
	Endproc
	*-------------------------------------------------------
	Procedure EmailCreateCfg
		Local loEx As Exception
		Try
			This.oMsg = Createobject("CDO.Message")
			This.oCfg = Createobject("CDO.Configuration")
			This.oMsg.Configuration = This.oCfg
		Catch To loEx
			This.AddError('ERROR: CDO Configuration could not be instantiated ' + Transform(loEx.ErrorNo) + ' ' + loEx.Message)
		Endtry
	Endproc

	*-------------------------------------------------------
	* Populate configuration object
	Procedure EmailSetConfiguration
		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
	Endproc

	*-------------------------------------------------------
	* Set mail header fields, if necessary. For now sets X-MAILER, if specified
	Procedure EmailSetHeader
		Local loHeader
		If Not Empty(This.cXMailer)
			loHeader = This.oMsg.Fields
			With loHeader
				.Item(cdoXMailer) =  This.cXMailer
				.Update()
			Endwith
		Endif
	Endproc

	*-------------------------------------------------------
	Procedure EmailSetParameters
		* Fill message attributes
		Local lcMailHeader
		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

			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
			
			* by CChalom - Codes included to allow Receipt return and Priority
			* http://support.microsoft.com/kb/302839
			IF This.lReadReceipt = .T. 
				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			
		Endwith
	Endproc

	Procedure EmailAddAttachment
		Lparameters tcAttachment

		This.oMsg.AddAttachment(m.tcAttachment)
	Endproc

	*------------------------------
	Procedure EmailClearMessage
		This.oMsg = Null
		This.oCfg = Null
	Endproc && EmailClearMessage

	*----------------------------------------------------	
	* Send message
	Procedure EmailSend
		SET STEP ON 
		* Daca nu sunt completate toate informatiile arat emailul utilizatorului
		Local _goFP As "PreviewHelper"
		Local llCancelled, llEmailDisplay, llEmailPreview, lnError, lcFoxy, lcDirMare, llCancelled 
		LOCAL loEx as Exception 

		llEmailDisplay = This.lDisplayEmailWithoutInfo And (Empty(This.cTo) Or Empty(This.cSubject) Or (!This.lSendWithoutAttachments And Empty(This.EmailGetAttachmentsNumber())))
		llEmailPreview = This.lEmailPreview

		&& Daca nu arat fiecare email, il trimit automat
		If !(m.llEmailPreview Or m.llEmailDisplay)
			If This.oMsg.Send() > 0
				For lnError = 1 To This.oMsg.GetErrorCount()
					This.AddError(This.oMsg.Geterror(m.lnError))
				Endfor
			Endif
		Else
			TRY
				lcDirMare = Addbs(Left(m.gcAppPath, Rat("\", m.gcAppPath, 2) -1))
				lcFoxy = m.lcDirMare + 'COMUNROA\foxypreviewer.app'
				IF FILE(m.lcFoxy)
					Do (m.lcFoxy)
					
					_goFP = Createobject("PreviewHelper")
					With This
						*_goFP.cdestFile = m.lcImageFile
						*!*			m.loExHandler = Newobject('ExtensionHandler')
						*!*			_goFP._oExHandler = m.loExHandler
						_goFP.lemailAUTO = .F.
						_goFP.cemailTo = .cTO
						_goFP.cemailCC = .cCC
						_goFP.cemailBCC = .cBCC
						_goFP.cemailSubject = .cSubject
						_goFP.cEmailBody = .cHtmlBody
						_goFP.cAttachments = This.cAttachment
					ENDWITH 
					llCancelled = .F.
					Do Form pr_sendmail2.scx To m.llCancelled Name _goFP._oEmailSheet
					IF m.llCancelled
						This.AddError('CDO Email Preview Utilizatorul a anulat emailul')
					ELSE 
						With This
							.cTo      = _goFP.cemailTo      && "vfpimaging@hotmail.com" && "somebody@otherdomain.com, somebodyelse@otherdomain.com"
							.cCC      = _goFP.cEmailCC
							.cBCC     = _goFP.cEmailBCC
							.cSubject = _goFP.cemailSubject && "FOXYPREVIEWER email"
							.cReplyTo = _goFP.cEmailReplyTo

							If Empty(_goFP.cEmailBody)
								_goFP.cEmailBody = "<HTML><BR></HTML>"
							Endif

							If Upper(Left(_goFP.cEmailBody, 6)) == "<HTML>"
								.cHtmlBody = _goFP.cEmailBody
							Else
								.cTextBody = _goFP.cEmailBody
							Endif

							* Curat lista de atasamente anterioara si adaug atasamentele din formular
							.cAttachment = _goFP._cAttachment

							.lReadReceipt = _goFP.lReadReceipt
							.lPriority    = _goFP.lPriority
						Endwith

						This.EmailSetParameters()
						This.oMsg.Attachments.DeleteAll()
						This.AddAttachments()
						
						If This.oMsg.Send() > 0
							For lnError = 1 To This.oMsg.GetErrorCount()
								This.AddError(This.oMsg.Geterror(m.lnError))
							Endfor
						ENDIF
					ENDIF && llCancelled	
				ELSE 
					This.AddError('CDO Email Preview ' + m.lcFoxy + ' nu exista' + ' ' + loEx.Message + ' Linia: ' + TRANSFORM(loEx.Lineno) + ' Cod: ' + loEx.LineContents)
				ENDIF && FILE(m.lcFoxy) 
			Catch To loEx
				This.AddError('CDO Email Preview ' + ' ' + loEx.Message + ' Linia: ' + TRANSFORM(loEx.Lineno) + ' Cod: ' + loEx.LineContents)
				*Messagebox(loEx.Message, 0 + 48, _Screen.Caption)
			Endtry
		Endif && m.llEmailPreview Or m.llEmailDisplay
	Endproc && EmailSend
	
Enddefine && oCDO

Define Class oOutlook As oEmail
	oOutlook = Null
	oMailItem = Null

	Procedure Init
		DoDefault()
		Local loEx As Exception
		Try
			This.oOutlook = Createobject('outlook.application')
		Catch To loEx
			This.AddError('ERROR: OUTLOOK could not be instantiated ' + Transform(loEx.ErrorNo) + ' ' + loEx.Message)
		Endtry

	Endproc && Init
	************************************	
	Procedure EmailCreateCfg
		Local loEx As Exception

		If !Isnull(This.oOutlook)
			Try
				* Create Mail Item
				This.oMailItem = This.oOutlook.CreateItem(0)
			Catch To loEx
				This.AddError('ERROR: OUTLOOK MailItem could not be instantiated ' + Transform(loEx.ErrorNo) + ' ' + loEx.Message)
			Endtry
		Endif
	Endproc && EmailCreateCfg

	************************************
	Procedure EmailSetParameters
		Local lcAttachment, lnAttachment
		With This.oMailItem
			.To = This.cTo
			.Subject = This.cSubject
			.CC = This.cCC
			.BCC = This.cBCC
			.BodyFormat = olFormatHTML
			.HtmlBody = This.cHtmlBody
		Endwith
	Endproc && EmailSetParameters

	Procedure EmailAddAttachment
		Lparameters tcAttachment

		This.oMailItem.Attachments.Add(m.tcAttachment)
	Endproc

	*------------------------------
	Procedure EmailClearMessage
		This.oMailItem = Null
	Endproc && EmailClearMessage

	*------------------------------
	Procedure EmailSend
		Local llEmailDisplay, llEmailPreview, loDefaultFolder, loMailItem, loNameSpace
		loMailItem = This.oMailItem
		* Display Sent folder only for the first email, so that the emails will get send
		If This.lFirstEmail
			loNameSpace = This.oOutlook.getnamespace('MAPI')
			loDefaultFolder = loNameSpace.GetDefaultFolder(olFolderSentMail) && SentMail
			loDefaultFolder.Display()
		Endif

		* Daca nu sunt completate toate informatiile arat emailul utilizatorului
		llEmailDisplay = This.lDisplayEmailWithoutInfo And (Empty(This.cTo) Or Empty(This.cSubject) Or (!This.lSendWithoutAttachments And Empty(This.EmailGetAttachmentsNumber())))
		llEmailPreview = This.lEmailPreview

		&& Daca nu arat fiecare email, il trimit automat
		If m.llEmailPreview Or m.llEmailDisplay
			loMailItem.Display
		Else
			loMailItem.Send
		Endif

		This.oMailItem = Null
		loMailItem = ""
	Endproc && EmailSend

Enddefine &&oOutlook

*---------------------------------
Define Class oMapi As oEmail
	snd = .F.
	rcp = .F.
	att = .F.

	*-------------------------------------------------------
	Procedure EmailCreateCfg
		Local loEx As Exception
		Try
			This.snd = Createobject("TRecipients")
			This.rcp = Createobject("TRecipients")
			This.att = Createobject("TAttachments")
		Catch To loEx
			This.AddError('ERROR: Mapi Configuration could not be instantiated ' + Transform(loEx.ErrorNo) + ' ' + loEx.Message)
		Endtry
	Endproc

	*-------------------------------------------------------
	Procedure EmailSetParameters
		Local lcRecipient, lnRecipient, lnRecipients

		This.AddSender(This.cFromName, This.cFrom)
		This.AddRecipient(This.cTo, MAPI_TO)
		This.AddRecipient(This.cCC, MAPI_CC)
		This.AddRecipient(This.cBCC, MAPI_BCC)
	Endproc

	Procedure AddSender(lcSndName, lcSndAddr)
		Local lnClass
		lnClass = MAPI_ORIG
		If Type("lcSndAddr") <> "C"
			lcSndAddr = lcSndName
		Endif

		This.snd.AppendItem(m.lnClass, lcSndName, lcSndAddr)
	Endproc && AddSender

	* ---------------------------
	* Fill To, CC, BCC
	Procedure AddRecipient
		Lparameters tcRecipientList, tnClass
		* tcRecipientpList: comma delimited list of recipients
		* tnClass: MAPI_TO, MAPI_CC, MAPI_BCC

		Local lcRecipientAddress, lcRecipientList, lcRecipientName, lnClass, lnRecipient, lnRecipients
		lnClass = Iif(Type('tnClass') = 'N', m.tnClass, MAPI_TO)
		lcRecipientList = Iif(Type('tcRecipientList') = 'C', m.tcRecipientList, '')
		lnRecipients = Getwordcount(m.lcRecipientList, [,])
		For lnRecipient = 1 To m.lnRecipients
			lcRecipientAddress = Getwordnum(m.lcRecipientList, m.lnRecipient, [,])
			lcRecipientName = m.lcRecipientAddress
			This.rcp.AppendItem(m.lnClass, m.lcRecipientName, m.lcRecipientAddress)
		Endfor
	Endproc && AddRecipient

	Procedure EmailAddAttachment
		Lparameters tcAttachment
		Return This.att.AppendItem(m.tcAttachment)
	Endproc

	Procedure EmailClearMessage
		This.rcp.ClearItems
		This.att.ClearItems
	Endproc && EmailClearMessage


	*----------------------------------------------------	
	* Send message
	Procedure EmailSend

		Local lcMapiMessage, loSubject, loBody, ii, lnResult, lcStoredPath
		loSubject = Createobject("PChar", This.cSubject)
		loBody = Createobject("PChar", This.cHtmlBody)
		lcStoredPath = Sys(5) + Sys(2003)

		* assembling MapiMessage structure
		lcMapiMessage = num2dword(0) + ;
			num2dword(loSubject.getAddr()) + num2dword(loBody.getAddr()) + ;
			num2dword(0) + num2dword(0) + num2dword(0) + num2dword(0) + ;
			num2dword(This.snd.getAddr()) + ;
			num2dword(This.rcp.ItemCount) + num2dword(This.rcp.getAddr()) + ;
			num2dword(This.att.ItemCount) + ;
			num2dword(Iif(This.att.ItemCount = 0, 0, This.att.getAddr()))

		Declare Integer MAPISendMail In mapi32;
			INTEGER lhSession, Integer ulUIParam, String @lpMessage, ;
			INTEGER flFlags, Integer ulReserved


		* Daca nu sunt completate toate informatiile arat emailul utilizatorului
		llEmailDisplay = This.lDisplayEmailWithoutInfo And (Empty(This.cTo) Or Empty(This.cSubject) Or (!This.lSendWithoutAttachments And Empty(This.EmailGetAttachmentsNumber())))
		llEmailPreview = This.lEmailPreview
		Set Step On
		&& Daca nu arat fiecare email, il trimit automat
		If m.llEmailPreview Or m.llEmailDisplay
			lnResult = MAPISendMail(0, 0, @lcMapiMessage, MAPI_DIALOG, 0)
		Else
			lnResult = MAPISendMail(0, 0, @lcMapiMessage, 0, 0)
		Endif
		If (m.lnResult <> 0)
			This.AddError("ERROR : Message not sent.")
		Endif

		Set Default To (lcStoredPath)
		Return (lnResult = 0) && sendmessage
	Endproc

Enddefine && oMapi

*------------------------------------------------------
* oMapi helper classes
Define Class TRecipients As Custom  && array of recipients
	ItemCount = 0
	Dimen arrRecip[1]
	RcpsBuffer = .F.

	Procedure Destroy
		This.UnlockData
		This.ClearItems

	Procedure getAddr
		This.LockData
		Return This.RcpsBuffer.getAddr()

	Procedure LockData
		This.UnlockData

		Local lcBuffer, ii
		lcBuffer = ""
		For ii = 1 To This.ItemCount
			lcBuffer = lcBuffer + This.arrRecip[ii].GetValue()
		Endfor
		This.RcpsBuffer = Createobject("PChar", lcBuffer)

	Procedure UnlockData
		If Type("THIS.RcpsBuffer") = "O"
			This.RcpsBuffer.ReleaseString
			This.RcpsBuffer = .F.
		Endif

	Procedure AppendItem(lnClass, lcName, lcAddress)
		This.ItemCount = This.ItemCount + 1
		Dimen This.arrRecip[THIS.ItemCount]
		This.arrRecip[THIS.ItemCount] = Createobject("TRecipient", lnClass, lcName, lcAddress)

	Procedure ClearItems
		Local ii
		For ii = 1 To This.ItemCount
			This.arrRecip[ii].ReleaseRecipient
			This.arrRecip[ii] = .F.
		Endfor
		This.ItemCount = 0
		Dimen This.arrRecip[1]
Enddefine  && trecipients

Define Class TRecipient As Custom
	RcpClass = 0  && 0-sender, 1-primary rec., 2-copy rec., 3-blind copy rec.
	RcpName = .F.
	RcpAddress = .F.
	RcpBuffer = ""

	Procedure Init(lnClass, lcName, lcAddress)
		This.InitRecipient(lnClass, lcName, lcAddress)

	Procedure Destroy
		This.ReleaseRecipient

	Procedure ReleaseRecipient
		If Type("THIS.RcpAddress") = "O"
			This.RcpAddress.ReleaseString
			This.RcpAddress = .F.
		Endif
		If Type("THIS.RcpName") = "O"
			This.RcpName.ReleaseString
			This.RcpName = .F.
		Endif

	Procedure InitRecipient(lnClass, lcName, lcAddress)
		This.ReleaseRecipient
		This.RcpName = Createobject("PChar", lcName)
		This.RcpAddress = Createobject("PChar", lcAddress)

		This.RcpBuffer = num2dword(0) + ;
			num2dword(lnClass) + ;
			num2dword(This.RcpName.getAddr()) + ;
			num2dword(This.RcpAddress.getAddr()) + ;
			num2dword(0) + num2dword(0)

	Function GetValue
		Return This.RcpBuffer
Enddefine  && trecipient

Define Class TAttachments As Custom
	ItemCount = 0
	Dimen arrAttach[1]
	AttsBuffer = .F.

	Procedure Destroy
		This.UnlockData
		This.ClearItems

	Procedure getAddr
		This.LockData
		Return This.AttsBuffer.getAddr()

	Procedure LockData
		This.UnlockData

		Local lcBuffer, ii
		lcBuffer = ""
		For ii = 1 To This.ItemCount
			lcBuffer = lcBuffer + This.arrAttach[ii].GetValue()
		Endfor
		This.AttsBuffer = Createobject("PChar", lcBuffer)

	Procedure UnlockData
		If Type("THIS.AttsBuffer") = "O"
			This.AttsBuffer.ReleaseString
			This.AttsBuffer = .F.
		Endif

	Procedure AppendItem(lcFilename)
		If File(lcFilename)
			This.ItemCount = This.ItemCount + 1
			Dimen This.arrAttach[THIS.ItemCount]

			This.arrAttach[THIS.ItemCount] = ;
				CREATEOBJECT("TAttachment", lcFilename, This.ItemCount)

			Return Type("THIS.arrAttach[THIS.ItemCount]") = "O"
		Else
			Return .F.
		Endif

	Procedure ClearItems
		Local ii
		For ii = 1 To This.ItemCount
			This.arrAttach[ii].ReleaseAttachment
			This.arrAttach[ii] = .F.
		Endfor
		This.ItemCount = 0
		Dimen This.arrAttach[1]
Enddefine  && tattachments

Define Class TAttachment As Custom
	AttBuffer = ""
	AttFilename = .F.

	Procedure Init(lcFilename, nPosition)
		This.InitAttachment(m.lcFilename, m.nPosition)

	Procedure Destroy
		This.ReleaseAttachment

	Procedure InitAttachment(lcFilename, nPosition)
		*!*	typedef struct {
		*!*	     ULONG ulReserved;
		*!*	     ULONG flFlags;
		*!*	     ULONG nPosition;
		*!*	     LPTSTR lpszPathName;
		*!*	     LPTSTR lpszFileName;
		*!*	     LPVOID lpFileType;
		*!*	} MapiFileDesc, FAR *lpMapiFileDesc;

		This.ReleaseAttachment
		This.AttFilename = Createobject("PChar", lcFilename)

		This.AttBuffer = num2dword(0) + num2dword(0) + ;
			num2dword(m.nPosition) + ;
			num2dword(This.AttFilename.getAddr()) + ;
			num2dword(0) + num2dword(0)

	Procedure ReleaseAttachment
		If Type("THIS.AttFilename") = "O"
			This.AttFilename.ReleaseString
			This.AttFilename = .F.
		Endif

	Function GetValue
		Return This.AttBuffer
Enddefine  && tattachment

Define Class PChar As Custom
	Protected Hmem

	Procedure Init(lcString)
		This.Hmem = 0
		This.setValue(lcString)

	Procedure Destroy
		This.ReleaseString

	Function getAddr  && returns a pointer to the string
		Return This.Hmem

	Function GetValue && returns string value
		Local lnSize, lcBuffer
		lnSize = This.getAllocSize()
		lcBuffer = Space(lnSize)

		If This.Hmem <> 0
			Declare RtlMoveMemory In kernel32 As MemToStr;
				STRING @, Integer, Integer
			= MemToStr(@lcBuffer, This.Hmem, lnSize)
		Endif
		Return lcBuffer

	Function getAllocSize  && returns allocated memory size (string length)
		Declare Integer GlobalSize In kernel32 Integer Hmem
		Return Iif(This.Hmem = 0, 0, GlobalSize(This.Hmem))

	Procedure setValue(lcString) && assigns new string value
		#Define GMEM_FIXED 0
		This.ReleaseString

		Declare Integer GlobalAlloc In kernel32 Integer, Integer
		Declare RtlMoveMemory In kernel32 As StrToMem;
			INTEGER, String @, Integer

		Local lnSize
		lcString = lcString + Chr(0)
		lnSize = Len(lcString)
		This.Hmem = GlobalAlloc(GMEM_FIXED, lnSize)
		If This.Hmem <> 0
			= StrToMem(This.Hmem, @lcString, lnSize)
		Endif

	Procedure ReleaseString  && releases allocated memory
		If This.Hmem <> 0
			Declare Integer GlobalFree In kernel32 Integer
			= GlobalFree(This.Hmem)
			This.Hmem = 0
		Endif
Enddefine  && pchar

Function num2dword(lnValue)
	#Define m0 256
	#Define m1 65536
	#Define m2 16777216
	Local b0, b1, b2, b3
	b3 = Int(lnValue / m2)
	b2 = Int((lnValue - b3 * m2) / m1)
	b1 = Int((lnValue - b3 * m2 - b2 * m1) / m0)
	b0 = Mod(lnValue, m0)
	Return Chr(b0) + Chr(b1) + Chr(b2) + Chr(b3)
Endfunc && num2dword