1556 lines
47 KiB
Plaintext
1556 lines
47 KiB
Plaintext
* 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, [,], [,], 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 |