=SendMailViaLive("soykanozcelik@hotmail.com","XXXXXXXX","blabla@gmail.com","live mail test","deneme mail live.com dan ")
=SendMailViaGmail("soykanozcelik@gmail.com","XXXXXXXX","blabla@hotmail.com","Gmail mail test","deneme mail gmail.com dan")
*------------------------------------------------------------------------------
Function SendMailViaGmail(tcUserName,tcPassword,tcTo,tcSubject,tcBody)
loMail = Newobject("Cdo2000")
With loMail
.cServer = "smtp.gmail.com"
.nServerPort = 465
.lUseSSL = .T.
.nAuthenticate = 1 && cdoBasic
.cUserName = m.tcUserName && "<a href="mailto:yourGmailAccount@gmail.com">yourGmailAccount@gmail.com</a>"
.cPassword = m.tcPassword &&"yourGmailPassword"
* If From address doesn't match any of the registered identities,
* Gmail will replace it with your default Gmail address
.cFrom = .cUserName && "<a href="mailto:yourGmailAccount@gmail.com">yourGmailAccount@gmail.com</a>"
.cTo = m.tcTo && "<a href="mailto:somebody@otherdomain.com">somebody@otherdomain.com</a>, <a href="mailto:somebodyelse@otherdomain.com">somebodyelse@otherdomain.com</a>"
.cSubject = m.tcSubject &&"CDO 2000 email through Gmail SMTP server"
* Uncomment next lines to send HTML body
*.cHtmlBody = "<html><body><b>This is an HTML body<br>" + ;
* "It'll be displayed by most email clients</b></body></html>"
.cTextBody = m.tcBody
*-.cTextBody = "This is a text body." + Chr(13) + Chr(10) + ;
"It'll be displayed if HTML body is not present or by text only email clients"
* Attachments are optional
* .cAttachment = "myreport.pdf, myspreadsheet.xls"
Endwith
If loMail.Send() > 0
For i=1 To loMail.GetErrorCount()
*-? i, loMail.Geterror(i)
Messagebox(loMail.Geterror(i))
Endfor
* Clear errors
loMail.ClearErrors()
Else
*-? "Email sent."
Messagebox("Mail Başarı ile Gönderildi...",64,"Gmail Mail Gönderim",1)
Endif
Endfunc
*------------------------------------------------------------------------------
Function SendMailViaLive(tcUserName,tcPassword,tcTo,tcSubject,tcBody)
loMail = Newobject("Cdo2000")
With loMail
.cServer = "smtp.live.com"
.nServerPort = 25
.lUseSSL = .T.
.nAuthenticate = 1 && cdoBasic
.cUserName = m.tcUserName && "<a href="mailto:yourAccount@live.com">yourAccount@live.com</a>"
.cPassword = m.tcPassword &&"yourPassword"
*.cFrom = "<a href="mailto:yourlAccount@live.com">yourlAccount@live.com</a>"
.cFrom = .cUserName
.cTo = m.tcTo && "<a href="mailto:somebody@otherdomain.com">somebody@otherdomain.com</a>, <a href="mailto:somebodyelse@otherdomain.com">somebodyelse@otherdomain.com</a>"
.cSubject = m.tcSubject && "CDO 2000 email through MSN SMTP server"
* Uncomment next lines to send HTML body
*.cHtmlBody = "<html><body><b>This is an HTML body<br>" + ;
* "It'll be displayed by most email clients</b></body></html>"
.cTextBody = m.tcBody
*-.cTextBody = "This is a text body." + Chr(13) + Chr(10) + ;
"It'll be displayed if HTML body is not present or by text only email clients"
* Attachments are optional
* .cAttachment = "myreport.pdf, myspreadsheet.xls"
Endwith
If loMail.Send() > 0
For i=1 To loMail.GetErrorCount()
*-? i, loMail.Geterror(i)
Messagebox(loMail.Geterror(i))
Endfor
* Clear errors
loMail.ClearErrors()
Else
*-? "Email sent."
Messagebox("Mail Başarı ile Gönderildi...",64,"Live Mail Gönderim",1)
Endif
Endfunc
*--------------------------------------------------------
#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 = ""
* 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(CDOSYS) mailer Ver 1.1 2009"
Protected Procedure Init
This.aErrors = Null
Endproc
* Send message
Procedure Send
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]
If This.SetConfiguration() > 0
Return This.GetErrorCount()
Endif
If Empty(This.cFrom)
This.AddError("HATA : Kimden kısmı boş!")
Endif
If Empty(This.cSubject)
This.AddError("HATA : Konu kısmı boş!")
Endif
If Empty(This.cTo) And Empty(This.cCC) And Empty(cBCC)
This.AddError("HATA : Kime,Karbon Kopya ve Gizli Karbon Kopya alanları boş!")
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(.HtmlBody)
.HtmlBodyPart.Charset = This.cCharset
Endif
If Not Empty(.TextBody)
.TextBodyPart.Charset = This.cCharset
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("HATA: Eklenti Bulunamadı - " + 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
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("HATA: SMTP Sunucu belirtilmedi!")
Endif
If Not Inlist(This.nAuthenticate, cdoAnonymous, cdoBasic)
This.AddError("HATA: Geçersiz Doğrulama Protokolu! ")
Endif
If This.nAuthenticate = cdoBasic ;
AND (Empty(This.cUserName) Or Empty(This.cPassword))
This.AddError("HATA: Kullanıcı Adı/Şifre Gerekli!")
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[4] + " " + 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.AddError("VFP Error: " + TRANSFORM(tnError) + " # " + ;
*!* tcMethod + " # " + TRANSFORM(tnLine) + " # " + MESSAGE())
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
Enddefine
