1353 lines
37 KiB
Plaintext
1353 lines
37 KiB
Plaintext
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, [,], [,], 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
|