Close Databases All
Set Century On
Set Date Dmy
Set Exact On
Set Ansi On
Set Deleted Off
Set Safety Off

* 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
*--------------------------------------------------------------------------------------------

************************************************
*** Verificare ecluzare sas-uri/camere ecluze RORIS
************************************************
lcDirector = ADDBS(JUSTPATH(SYS(16,0)))


lcConvoaie = m.lcDirector + 'convoaie.dbf'
IF !FILE(m.lcConvoaie)
	CREATE TABLE (m.lcConvoaie) (vye_id C(36), declaratie C(8), ;
	ag N(1), cv N(1), ov N(1), nv N(1), ;
	ag_sasn N(1), cv_sasn N(1), ov_cn N(1), nv_cn N(1), ;
	ag_data T NULL, cv_data T NULL, ov_data T NULL, nv_data T NULL)
	SELECT convoaie
	INDEX on declaratie TAG declaratie 
	USE IN (SELECT('convoaie'))
ENDIF 
USE (m.lcConvoaie) IN 0 SHARED ALIAS convoaie

* transmit doar ecluzarile mai noi decat ultima data de ecluzare
CALCULATE MAX(ag_data), MAX(cv_data), MAX(ov_data), MAX(nv_data) TO lnAgData, lnCVData, lnOVData, lnNVData IN convoaie
ldDataOra = MAX(lnAgData, lnCVData, lnOVData, lnNVData)
	
lnHandle = SQLConnect("roa", "acn","ROMFASTSOFT")
If m.lnHandle <= 0
	Aerror(laEroare)
	WriteLog(laEroare(3))
	Return
Endif

TEXT TO lcsql TEXTMERGE noshow
select distinct vye_id, declaratio as declaratie, agigea as ag, cernavoda as cv, navodari as nv, ovidiu as ov, 
	agigea_data as ag_data, cernavoda_data as cv_data, navodari_data as nv_data, ovidiu_data as ov_data, 
	agigea_sasn as ag_sasn, cernavoda_sasn as cv_sasn, ovidiu_cn as ov_cn, navodari_cn as nv_cn from
(select v.vye_id, v.declaratio, v.generation,
       nvl(vlt.AGIGEA,0) as AGIGEA,
       nvl(vlt.CERNAVODA,0) as CERNAVODA,
       nvl(vlt.NAVODARI,0) as NAVODARI,
       nvl(vlt.OVIDIU,0) as OVIDIU,
       vlt.AGIGEA_DATA,
       vlt.CERNAVODA_DATA,
       vlt.OVIDIU_DATA,
       vlt.NAVODARI_DATA,
       (case when nvl(vlt.AGIGEA,0) = 1 and nvl(vltm.AGIGEA_SAS1,0) = 0 and nvl(vltm.AGIGEA_SAS2,0) = 0 then 1 else 0 end) as AGIGEA_SASN,
       (case when nvl(vlt.CERNAVODA,0) = 1 and nvl(vltm.CERNAVODA_SAS1,0) = 0 and nvl(vltm.CERNAVODA_SAS2,0) = 0 then 1 else 0 end) as CERNAVODA_SASN,
       (case when nvl(vlt.OVIDIU,0) = 1 and nvl(vltm.OVIDIU_C1,0) = 0 and nvl(vltm.OVIDIU_C2,0) = 0 then 1 else 0 end) as OVIDIU_CN,
       (case when nvl(vlt.NAVODARI,0) = 1 and nvl(vltm.NAVODARI_C1,0) = 0 and nvl(vltm.NAVODARI_C2,0) = 0 then 1 else 0 end) as NAVODARI_CN
  From IPS_VVOYAGES v
  join IPS_VVOYAGE_MEMBERS vm
    On v.id = vm.VYE_ID
  left join ips_vvoyage_locks_tab vlt
    on v.id = vlt.vye_id
  left join ips_vvoyage_locks_vms_tab vltm
    on vm.vye_id = vltm.vye_id and vm.id = vltm.vms_id)
    where <<IIF(!EMPTY(m.ldDataOra), 'extract(year from generation) >= ' + ALLTRIM(STR(YEAR(m.ldDataOra)-1)) + ' and ', '')>>(agigea_sasn = 1 or cernavoda_sasn = 1 or ovidiu_cn = 1 or navodari_cn = 1)
    order by declaratio;
ENDTEXT

lnSucces = SQLExec(m.lnHandle, m.lcSql, 'crsConvoaie')
SQLDISCONNECT(m.lnHandle)

lcText = ''
lnConvoaie = 0
If m.lnSucces < 0
	Aerror(laEroare)
	WriteLog(laEroare(3))
Else


	SELECT convoaie
	SET ORDER TO declaratie

	lcText = 'Lista convoaie cu ecluzare, mai noi decat ' + TRANSFORM(m.ldDataOra) + ', care nu au inregistrate sas-ul/camera ecluzei:' + CHR(13) + CHR(10)
	Select crsConvoaie
	SCAN
		SCATTER NAME loRec
		lcDeclaratie = PADR(loRec.declaratie, 8, ' ')

		SELECT convoaie
		IF !SEEK(m.lcDeclaratie)
			APPEND BLANK
		ENDIF 	
		GATHER NAME loRec
		WITH loRec
			IF (.ag_data > m.ldDataOra AND .ag_sasn = 1) OR (.cv_data > m.ldDataOra AND .cv_sasn = 1) OR ;
			(.ov_data > m.ldDataOra AND .ov_cn = 1) OR (.nv_data > m.ldDataOra AND .nv_cn = 1)
				lcText = lcText + m.lcDeclaratie
				lnConvoaie = lnConvoaie + 1				
				
				IF .ag_data > m.ldDataOra AND .ag_sasn = 1 
					lcText = lcText + ', AG (' + TRANSFORM(.ag_data) + ')' 
				ENDIF 
				IF .cv_data > m.ldDataOra AND .cv_sasn = 1
					lcText = lcText + ', CV (' + TRANSFORM(.cv_data) + ')' 
				ENDIF 		
				IF .ov_data > m.ldDataOra AND .ov_cn = 1 
					lcText = lcText + ', OV (' + TRANSFORM(.ov_data) + ')' 
				ENDIF 		
				IF .nv_data > m.ldDataOra AND .nv_cn = 1
					lcText = lcText + ', NV (' + TRANSFORM(.nv_data) + ')' 
				ENDIF 		
				lcText = lcText + CHR(13) + CHR(10)
			ENDIF 	
		ENDWITH 
	ENDSCAN

	lcImportFile = Addbs(Justpath(Sys(16,0))) + 'verificare_roris_ecluze_' + DTOC(DATE(),1) + '.txt'
	Strtofile(m.lcText, m.lcImportFile,1)
ENDIF

USE IN (SELECT('crsConvoaie'))
USE IN (SELECT('convoaie'))

************************************************
lcSetariFile = m.lcDirector + 'settings.ini'
IF !FILE(m.lcSetariFile)
	TEXT TO lcSettings noshow
[email]
mailserver = mail.acn.ro
port = 25
username = facturare@acn.ro
password = fe1VLsNMZDZVJKW
from = compania@acn.ro
to = 
cc = 
bcc = 
sendwithoutresults = 1
	ENDTEXT 	
	STRTOFILE(m.lcSettings,m.lcSetariFile)
ENDIF 
SET STEP ON 
lcSetari = FILETOSTR(m.lcSetariFile)
lnLinii = ALINES(laLinii, lcSetari)
lcMailServer = ''
lcPort = ''
lcUsername = ''
lcPassword = ''
lcFrom = ''
lcTo = ''
lcCC = ''
lcBCC = ''
llSSL = .F.
llSendWithoutResults = .T.
FOR lnLinie = 1 TO lnLinii
	lcLinie = laLinii(m.lnLinie)
	IF AT('=', m.lcLinie) = 0
		LOOP
	ENDIF 	
	lcVariabila = LOWER(ALLTRIM(GETWORDNUM(m.lcLinie, 1, '=')))
	lcValoare = ALLTRIM(GETWORDNUM(m.lcLinie, 2, '='))
	IF m.lcVariabila = 'mailserver'
		lcMailServer = m.lcValoare
	ENDIF 
	IF m.lcVariabila = 'port'
		lcPort = m.lcValoare
	ENDIF 
	IF m.lcVariabila = 'username'
		lcUsername = m.lcValoare
	ENDIF 
	IF m.lcVariabila = 'password'
		lcPassword = m.lcValoare
	ENDIF 
	IF m.lcVariabila = 'from'
		lcFrom = m.lcValoare
	ENDIF
	IF m.lcVariabila = 'to'
		lcTo = m.lcValoare
	ENDIF
	IF m.lcVariabila = 'cc'
		lcCC = m.lcValoare
	ENDIF
	IF m.lcVariabila = 'bcc'
		lcBCC = m.lcValoare
	ENDIF					
	IF m.lcVariabila = 'ssl'
		llSSL = (INT(VAL(m.lcValoare)) = 1)
	ENDIF		
	IF m.lcVariabila = 'sendwithoutresults'
		llSendWithoutResults = (INT(VAL(m.lcValoare)) = 1)
	ENDIF		
ENDFOR 

* Trimit email doar daca sunt rezultate?
IF m.lnConvoaie = 0 AND !m.llSendWithoutResults
	WriteLog('0 convoaie. Nu se trimite email.')
	RETURN 
ENDIF 

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 = m.lcMailServer
loEmail.nServerPort = INT(VAL(m.lcPort))
loEmail.cUserName = m.lcUsername
loEmail.cPassword = m.lcPassword
loEmail.lUseSSL = m.llSSL
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(.F.)
loEmail.EmailSetDisplayWithoutInfo(.T.)
**************************

loEmail.cFrom = lcFrom
loEmail.cTo = m.lcTo
loEmail.cCC = m.lcCC
loEmail.cBCC = m.lcBCC
loEmail.cSubject = ALLTRIM(STR(m.lnConvoaie)) + ' convoaie cu ecluzare, mai noi decat ' + TRANSFORM(m.ldDataOra) + ', care nu au inregistrate sas-ul/camera ecluzei:'

loEmail.cHtmlBody = STRTRAN(m.lcText, CHR(13) + CHR(10),'<br>' + CHR(13)+CHR(10),1,10000,1)
loEmail.cTextBody = '' && m.lcText
loEmail.EmailSendWithoutAttachments(.T.)

SET STEP ON 
lnErrors = loEmail.Send()
ltDataEmail = Datetime()
llSucces = (m.lnErrors = 0)
lcEroare = Iif(!m.llSucces, loEmail.GetErrorMessage(), '')
WriteLog('Email trimis la ' + m.lcTo + ' : ' + IIF(m.llSucces, 'Succes', lcEroare))

* -----------------------------------
* 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.)

	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 = .F.

* 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
	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
	This.oMsg.Send()
	Endproc

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



Procedure WriteLog
	Lparameters tcMesaj
	lcLogFile = Addbs(Justpath(Sys(16,0))) + 'verificare_roris_ecluze.log'
	Strtofile(Transform(Datetime()) + ' ' + Transform(m.tcMesaj) + Chr(13), lcLogFile, 1)
Endproc && WriteLog
