vfp邮件.html格式,VFP 实现自动发邮件代码

* Win 2000 、XP 以上版本中发邮件的VFP代码

* 可发附件

* 发件无任何提示

IF !FILE(GETENV("windir")+"\SYSTEM32\CDOSYS.DLL")

MESSAGEBOX("系统不支持该功能！ ",16,"消息")

RETURN .F.

ENDIF

objMail = CREATEOBJECT("CDO.Message")

* 设置邮件

objMail.To = "收件人" &&收件人列表

objMail.Subject = "主题"

objMail.TextBody = "这是测试邮件的内容"

objMail.AddAttachment("C:\aaa.txt") &&添加一个附件

* 设置发件服务器

objMail.From = "发件人" &&发件人，服务器验证用

objMail.Configuration.Fields(3).value = "**********" &&发件口令

objMail.Configuration.Fields(4).value = "xxxx" &&发件人用户名

objMail.Configuration.Fields(9).value = "smtp.163.com" &&SMTP服务器

objMail.Configuration.Fields.Update()

* 发送邮件

objMail.Send()

如果觉得好就顶一下

想使用更多的功能可以搜索一下CDO.MESSAGE或CDOSYS.DLL

上面发的这个如果OUTLOOK中没有设定邮件帐号的话会发送失败的,昨天刚做了一个发送邮件的函数,这个不管OUTLOOK中有无设置均可发送.觉得

有用的话自己看吧 :)

* 邮件发送测试

local cTo,cSub,cAtta,cBody,cSmtp,cFrom,cUid,cPwd,cErrMsg

cTo = "收件人"

cSub = "主题"

cBody = "测试发件"

cAtta = "C:\aaa.txt;C:\bbb.txt"

cSmtp = "smtp.163.com"

cFrom = "发件人"

cUid = "youuid"

cPwd = "****************"

cErrMsg = SendMail(cTo,"","",cSub,cBody,cAtta,cSmtp,cFrom,cUid,cPwd)

IF EMPTY(cErrMsg)

MESSAGEBOX("邮件发送成功！ ",64,"系统消息")

ELSE

MESSAGEBOX(cErrMsg,64,"发送邮件出错消息")

ENDIF

* 邮件发送函数

FUNCTION SendMail(; &&参数列表

cMail,; && 收件人列表

cCC,; && 抄送收件人列表

cBCC,; && 密件抄送收件人列表

cSubject,; && 主题

cBody,; && 邮件内容

cAttachFile,; && 附件文件列表

cSmtp,; && SMTP服务器名或地址(必须)

cFrom,; && 发件人邮件地址(需验证发信的服务器需要)

cUid,; && 用户名(需验证发信的服务器需要)

cPwd) && 口令(需验证发信的服务器需要)

* 参数错误判断

* ...............

* ...............

LOCAL cError,cErrMsg,m,n,i,j,k,objFields

m.cErrMsg = ""

m.cError = ON("ERROR")

ON ERROR m.cErrMsg = MESSAGE()

*服务器设置

m.objMail = CREATEOBJECT("CDO.Message")

* 清除原默认配置

m.objFields = m.objMail.Configuration.Fields

FOR i = 0 TO objFields.Count - 1

m.objFields.Delete(i)

ENDFOR

m.objFields.Update

* 设置发信服务配置

m.objConf = m.objMail.Configuration

m.objConf.Fields.Append("http://schemas.microsoft.com/cdo/configuration/languagecode",2)

m.objConf.Fields(0).value = "zh-cn"

m.objConf.Fields.Append("http://schemas.microsoft.com/cdo/configuration/postusing",2)

m.objConf.Fields(1).value = 0

m.objConf.Fields.Append("http://schemas.microsoft.com/cdo/configuration/sendemailaddress",2)

m.objConf.Fields(2).value = m.cFrom &&发送邮件地址

m.objConf.Fields.Append("http://schemas.microsoft.com/cdo/configuration/sendpassword",2)

m.objConf.Fields(3).value = m.cPwd &&发件口令

m.objConf.Fields.Append("http://schemas.microsoft.com/cdo/configuration/sendusername",2)

m.objConf.Fields(4).value = m.cUid &&用户名

m.objConf.Fields.Append("http://schemas.microsoft.com/cdo/configuration/sendusing",2)

m.objConf.Fields(5).value = 2

m.objConf.Fields.Append("http://schemas.microsoft.com/cdo/configuration/smtpaccountname",2)

m.objConf.Fields(6).value = "网易服务器" &&Smtp名称

m.objConf.Fields.Append("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate",2)

m.objConf.Fields(7).value = 1

m.objConf.Fields.Append("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout",2)

m.objConf.Fields(8).value = 180

m.objConf.Fields.Append("http://schemas.microsoft.com/cdo/configuration/smtpserver",2)

m.objConf.Fields(9).value = m.cSmtp &&SMTP服务器

m.objConf.Fields.Append("http://schemas.microsoft.com/cdo/configuration/smtpserverport",2)

m.objConf.Fields(10).value = 25

m.objConf.Fields.Append("http://schemas.microsoft.com/cdo/configuration/usemessageresponsetext",2)

m.objConf.Fields(11).value = .T.

m.objConf.Fields.Append("urn:schemas:calendar:timezoneid",2)

m.objConf.Fields(12).value = 21

m.objConf.Fields.Update

*邮件设置

*注：邮件地址和附件文件可以同时多个，在字符串中使用分号(;)分隔

m.objMail.To = m.cMail &&收件人

m.objMail.CC = m.cCC &&抄送

objMail.BCC = m.cBCC &&密件抄送

m.objMail.Subject = m.cSubject &&主题

m.objMail.TextBody = m.cBody &&内容

objMail.From = m.cFrom &&发件人(服务器要校验的)

*根据附件列表添加附件

IF !EMPTY(m.cAttachFile)

m.cAttachFile = m.cAttachFile + ";"

m.j = 0

m.n = OCCURS(";", m.cAttachFile)

FOR m.i = 1 TO m.n

m.k = AT(";", m.cAttachFile, m.i)

m.cFile = SUBSTR(m.cAttachFile, m.j+1, m.k-m.j-1)

IF !FILE(m.cFile)

*!* MESSAGEBOX("附件文件["+m.cFile+"没找到！ ",16,"出错消息")

ON ERROR &cError

RETURN m.cErrMsg

ENDIF

objMail.AddAttachment(m.cFile) &&添加附件

m.j = m.k

ENDFOR

ENDIF

*发送邮件

m.objMail.Send

ON ERROR &cError

RETURN m.cErrMsg

ENDFUNC

***********************************************************************