ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

Forum AtoutFox : Re: Comment envoyer des emails sans passer par outlook?   

Sujet

rss Flux RSS des derniers messages

Vous devez vous identifier pour pouvoir poser une question ou répondre.

ven. 21 décembre 2018, 07h51
zakrola
Liban Liban

atoutfox.public.association

Re: Comment envoyer des emails sans passer par outlook?


&& this is the code to send email

loMail = NEWOBJECT("Cdo2000", "Cdo2000.fxp")
WITH loMail
.cServer = "smtp.gmail.com" &&ALLTRIM(_180Cdo_Server) &&
.nServerPort = 465 && VAL(_180Cdo_Server_port) &&465 && for msn port is 25 && for yahoo port is 465
.lUseSSL = .T. && _180Cdo_SSL
.nAuthenticate = 1 && cdoBasic
.cUserName = "Your User Name" && alltrim(_180Cdo_UserName) &&
.cPassword = "Your Password" && alltrim(_180Cdo_Passwrod) &&
* If From address doesn't match any of the registered identities,
* Gmail will replace it with your default Gmail address
.cFrom = "Your Email" && alltrim(_180Cdo_EmailId) &&
.cTo = "Destination Email"
.cSubject = "Your Subject"
*CDO 2000 email through Gmail SMTP server
* Uncomment next lines to send HTML body
*!* .cHtmlBody = ""+ALLTRIM(inward_sms.Type)+"
*!* " + ;
*!* ALLTRIM(inward_sms.SmsMessage)+"
*!* "+"
*!* "+ ;
*!* ALLTRIM(_180dFooter)+""
.cTextBody = ""
* Attachments are optional
.cAttachment = [Your Attachment File]
ENDWITH

IF loMail.Send() > 0
FOR i=1 TO loMail.GetErrorCount()
WAIT WINDOW ALLTRIM(STR(i))+" "+loMail.Geterror(i) NOWAIT
ENDFOR
* Clear errors
loMail.ClearErrors()
ELSE
MESSAGEBOX("Email Sent")
*WAIT WINDOW "Email sent. to Mr. Khaled " NOWAIT
_180Send_Self_Cdo_message = .f.
ENDIF


&&this is the cdo2000.prg

#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 CLASS cdo2000 AS Custom

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

nErrorCount = 0

* Message attributes
oMsg = Null

cFrom = ""
cReplyTo = ""
cTo = ""
cCC = ""
cBCC = ""
cAttachment = ""

cSubject = ""
cHtmlBody = ""
cTextBody = ""
cHtmlBodyUrl = ""

cCharset = ""

* Priority: Normal, High, Low or empty value (Default)
cPriority = ""

* Configuration object fields values
oCfg = Null
cServer = ""
nServerPort = 25
* Use SSL connection
lUseSSL = .F.
nConnectionTimeout = 30 && Default 30 sec's
nAuthenticate = cdoAnonymous
cUserName = ""
cPassword = ""
* Do not use cache for cHtmlBodyUrl
lURLGetLatestVersion = .T.

* Optional. Creates your own X-MAILER field in the header
cXMailer = "VFP CDO 2000 mailer Ver 1.1.100 2010"

PROTECTED PROCEDURE Init
This.ClearErrors()
ENDPROC

* Send message
PROCEDURE Send

IF This.GetErrorCount() > 0
RETURN This.GetErrorCount()
ENDIF

WITH This
.ClearErrors()
.oCfg = CREATEOBJECT("CDO.Configuration")
.oMsg = CREATEOBJECT("CDO.Message")
.oMsg.Configuration = This.oCfg
ENDWITH

* Fill message attributes
LOCAL lnind, laList[1], loHeader, laDummy[1], lcMailHeader

IF This.SetConfiguration() > 0
RETURN This.GetErrorCount()
ENDIF

IF EMPTY(This.cFrom)
This.AddError("ERROR : From is empty.")
ENDIF
IF EMPTY(This.cSubject)
This.AddError("ERROR : Subject is empty.")
ENDIF

IF EMPTY(This.cTo) AND EMPTY(This.cCC) AND EMPTY(This.cBCC)
This.AddError("ERROR : To, CC and BCC are all empty.")
ENDIF

IF This.GetErrorCount() > 0
RETURN This.GetErrorCount()
ENDIF

This.SetHeader()

WITH This.oMsg

.From = This.cFrom
.ReplyTo = This.cReplyTo

.To = This.cTo
.CC = This.cCC
.BCC = This.cBCC
.Subject = This.cSubject

* Create HTML body from external HTML (file, URL)
IF NOT EMPTY(This.cHtmlBodyUrl)
.CreateMHTMLBody(This.cHtmlBodyUrl)
ENDIF

* Send HTML body. Creates TextBody as well
IF NOT EMPTY(This.cHtmlBody)
.HtmlBody = This.cHtmlBody
ENDIF

* Send Text body. Could be different from HtmlBody, if any
IF NOT EMPTY(This.cTextBody)
.TextBody = This.cTextBody
ENDIF

IF NOT EMPTY(This.cCharset)
IF NOT EMPTY(.HtmlBody)
.HtmlBodyPart.Charset = This.cCharset
ENDIF

IF NOT EMPTY(.TextBody)
.TextBodyPart.Charset = This.cCharset
ENDIF
ENDIF

* Process attachments
IF NOT EMPTY(This.cAttachment)
* Accepts comma or semicolon
* VFP 7.0 and later
*FOR lnind=1 TO ALINES(laList, This.cAttachment, [,], [;])
* VFP 6.0 and later compatible
FOR lnind=1 TO ALINES(laList, CHRTRAN(This.cAttachment, [,;], CHR(13) + CHR(13)))
lcAttachment = ALLTRIM(laList[lnind])
* Ignore empty values
IF EMPTY(laList[lnind])
LOOP
ENDIF

* Make sure that attachment exists
IF ADIR(laDummy, lcAttachment) = 0
This.AddError("ERROR: Attacment not Found - " + lcAttachment)
ELSE
* The full path is required.
IF UPPER(lcAttachment) <> UPPER(FULLPATH(lcAttachment))
lcAttachment = FULLPATH(lcAttachment)
ENDIF
.AddAttachment(lcAttachment)
ENDIF
ENDFOR
ENDIF

IF NOT EMPTY(This.cCharset)
.BodyPart.Charset = This.cCharset
ENDIF

* Priority
IF NOT EMPTY(This.cPriority)
lcMailHeader = "urn:schemas:mailheader:"
.Fields(lcMailHeader + "Priority") = LOWER(This.cPriority)
.Fields(lcMailHeader + "Importance") = LOWER(This.cPriority)
DO CASE
CASE This.cPriority = "High"
.Fields(lcMailHeader + "X-Priority") = 1 && 5=Low, 3=Normal, 1=High
CASE This.cPriority = "Normal"
.Fields(lcMailHeader + "X-Priority") = 3 && 5=Low, 3=Normal, 1=High
CASE This.cPriority = "Low"
.Fields(lcMailHeader + "X-Priority") = 5 && 5=Low, 3=Normal, 1=High
ENDCASE
.Fields.Update()
ENDIF
ENDWITH

IF This.GetErrorCount() > 0
RETURN This.GetErrorCount()
ENDIF

This.oMsg.Send()

RETURN This.GetErrorCount()

ENDPROC

* Clear errors collection
PROCEDURE ClearErrors()
This.nErrorCount = 0
DIMENSION This.aErrors[1]
This.aErrors[1] = Null
RETURN This.nErrorCount
ENDPROC

* Return # of errors in the error collection
PROCEDURE GetErrorCount
RETURN This.nErrorCount
ENDPROC

* Return error by index
PROCEDURE GetError
LPARAMETERS tnErrorno
IF tnErrorno <= This.GetErrorCount()
RETURN This.aErrors[tnErrorno]
ELSE
RETURN Null
ENDIF
ENDPROC

* Populate configuration object
PROTECTED PROCEDURE SetConfiguration

* Validate supplied configuration values
IF EMPTY(This.cServer)
This.AddError("ERROR: SMTP Server isn't specified.")
ENDIF
IF NOT INLIST(This.nAuthenticate, cdoAnonymous, cdoBasic)
This.AddError("ERROR: Invalid Authentication protocol ")
ENDIF
IF This.nAuthenticate = cdoBasic ;
AND (EMPTY(This.cUserName) OR EMPTY(This.cPassword))
This.AddError("ERROR: User name/Password is required for basic authentication")
ENDIF

IF This.GetErrorCount() > 0
RETURN This.GetErrorCount()
ENDIF

WITH This.oCfg.Fields

* Send using SMTP server
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServer) = This.cServer
.Item(cdoSMTPServerPort) = This.nServerPort
.Item(cdoSMTPConnectionTimeout) = This.nConnectionTimeout

.Item(cdoSMTPAuthenticate) = This.nAuthenticate
IF This.nAuthenticate = cdoBasic
.Item(cdoSendUserName) = This.cUserName
.Item(cdoSendPassword) = This.cPassword
ENDIF
.Item(cdoURLGetLatestVersion) = This.lURLGetLatestVersion
.Item(cdoSMTPUseSSL) = This.lUseSSL

.Update()
ENDWITH

RETURN This.GetErrorCount()

ENDPROC

*----------------------------------------------------
* Add message to the error collection
PROTECTED PROCEDURE AddError
LPARAMETERS tcErrorMsg
This.nErrorCount = This.nErrorCount + 1
DIMENSION This.aErrors[This.nErrorCount]
This.aErrors[This.nErrorCount] = tcErrorMsg
RETURN This.nErrorCount
ENDPROC

*----------------------------------------------------
* Format an error message and add to the error collection
PROTECTED PROCEDURE AddOneError
LPARAMETERS tcPrefix, tnError, tcMethod, tnLine
LOCAL lcErrorMsg, laList[1]
IF INLIST(tnError, 1427,1429)
AERROR(laList)
lcErrorMsg = TRANSFORM(laList[7], "@0") + " " + laList[3]
ELSE
lcErrorMsg = MESSAGE()
ENDIF
This.AddError(tcPrefix + ":" + TRANSFORM(tnError) + " # " + ;
tcMethod + " # " + TRANSFORM(tnLine) + " # " + lcErrorMsg)
RETURN This.nErrorCount
ENDPROC

*----------------------------------------------------
* Simple Error handler. Adds VFP error to the objects error collection
PROTECTED PROCEDURE Error
LPARAMETERS tnError, tcMethod, tnLine
This.AddOneError("ERROR: ", tnError, tcMethod, tnLine )
RETURN This.nErrorCount
ENDPROC

*-------------------------------------------------------
* Set mail header fields, if necessary. For now sets X-MAILER, if specified
PROTECTED PROCEDURE SetHeader
LOCAL loHeader
IF NOT EMPTY(This.cXMailer)
loHeader = This.oMsg.Fields
WITH loHeader
.Item(cdoXMailer) = This.cXMailer
.Update()
ENDWITH
ENDIF
ENDPROC

*----------------------------------------------------
*
PROTECTED PROCEDURE cPriority_assign(tvVal)
* Check for incorrect values
IF INLIST("~" + PROPER(tvVal) + "~", "~High~", "~Normal~", "~Low~") OR EMPTY(tvVal)
This.cPriority = PROPER(ALLTRIM(tvVal))
ELSE
This.AddError("ERROR: Invalid value for cPriority property.")
ENDIF
ENDPROC

ENDDEFINE

Permalink : http://www.atoutfox.org/nntp.asp?ID=0000019257
20 088 messages dans le forum • Liste complète des messages

Publicité

Les pubs en cours :


www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2024.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3