您的位置:首页 > 编程语言

CDO.Message发送邮件的实现代码

2017-10-13 09:23 387 查看

#include "hmg.ch"

Function Main

Local cPath:= GetCurrentFolder()+"\", loCfg, loMsg

Local sm_to:="hqhuiyi@163.com"

Local sm_from:="408139391@qq.com"

Local sm_cc:=""

Local sm_bcc:=""

Local sm_userauth:="408139391"

Local sm_passauth:="hy19630911"

Local sm_subject:="Test Message Subject"

Local sm_servsmtp:="smtp.qq.com"

Local sm_portsmtp:=465

Local sm_confirm_read:=.F.

Local sm_Body:='<html><head><meta content="text/html; charset=utf-8" http-equiv="content-type"><title></title></head><body>'+;

   'Test message body</body></html>'

Local sm_TextBody:="Test message body"

Local lSSL:=.T.  

Local sm_priority:=1

Local sm_att:=cPath+"AttSample.zip"

#xcommand TRY              => BEGIN SEQUENCE WITH {|o| break(o)}

#xcommand CATCH [<!oErr!>] => RECOVER [USING <oErr>] <-oErr->

#xcommand FINALLY          => ALWAYS

 

//Please note, when using the :AddAttachment method in your scripts you must use a fully qualified pathname as the argument to the method.  Using just a file name or a relative path will produce the error The specified protocol is unknown

//By repeating the :AddAttachment method you can attach more than one file.

//sm_priority:=2 is for High; =1 for Normal; =0 for Low

//sm_confirm_read:=.T. is for return receipt

TRY

 

 loCfg := CREATEOBJECT( "CDO.Configuration" )

 WITH OBJECT loCfg:Fields

  :Item( "http://schemas.microsoft.com/cdo/configuration/smtpserver" )      :Value := sm_servsmtp

  :Item( "http://schemas.microsoft.com/cdo/configuration/smtpserverport" )  :Value := sm_portsmtp

  :Item( "http://schemas.microsoft.com/cdo/configuration/sendusing" )       :Value := 2

  :Item( "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate" ):Value := .T.

  :Item( "http://schemas.microsoft.com/cdo/configuration/smtpusessl" )      :Value := lSSL

  :Item( "http://schemas.microsoft.com/cdo/configuration/sendusername" )    :Value := sm_userauth

  :Item( "http://schemas.microsoft.com/cdo/configuration/sendpassword" )    :Value := sm_passauth

  :Update()

 END WITH

 loMsg := CREATEOBJECT ( "CDO.Message" )

 WITH OBJECT loMsg

  :BodyPart:Charset := "utf-8"

  :Configuration := loCfg

   :From          := sm_from

  :To            := sm_to

  :Subject       := sm_subject

  :Bcc   := sm_bcc

  :Cc    := sm_cc

  :TextBody  := sm_TextBody   //plain text

  :HTMLBody  := sm_Body   //html text

  :HTMLBodyPart:Charset := "utf-8"

  :AddAttachment (sm_att)

  WITH OBJECT loMsg:Fields

   :Item("urn:schemas:httpmail:importance"):Value := sm_priority

   :Item("urn:schemas:mailheader:X-Priority"):Value := sm_priority-1

   IF sm_confirm_read

    :Item("urn:schemas:mailheader:return-receipt-to"):Value := sm_from

    :Item("urn:schemas:mailheader:disposition-notification-to"):Value := sm_from

   ENDIF

   :Update()

  ENDWITH

  :DSNOptions := 0

  :Send()

  MsgInfo('Success')

 ENDWITH

 

CATCH oError

  MsgStop ( "The email was not sent."+CRLF+;

    "Error:      "+TRANSFORM(oError:GenCode, NIL)+CRLF+;

    "SubCode:   "+TRANSFORM(oError:SubCode, NIL)+CRLF+;

    "OSCode:    "+TRANSFORM(oError:OsCode, NIL)+CRLF+;

    "SubSystem: "+TRANSFORM(oError:SubSystem, NIL)+CRLF+;

    "Description:      "+oError:Description)

END

RETURN

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

'Date: 2010/6/18

'Author: Demon

'QQ: 380401911

'E-mail: still.demon@gmail.com

'Website: http://demon.tw
Const Email_From = "ddd@163.com" '发件人邮箱

Const Password = "password" '发件人邮箱密码

Const Email_To = "380401911@qq.com" '收件人邮箱

Set CDO = CreateObject("CDO.Message") '创建CDO.Message对象

CDO.Subject = "From Demon" '邮件主题

CDO.From = Email_From '发件人地址

CDO.To = Email_To '收件人地址

CDO.TextBody = "Hello world!" '邮件正文

cdo.AddAttachment = "C:\hello.txt" '邮件附件文件路径

Const schema = "http://schemas.microsoft.com/cdo/configuration/" '规定必须是这个,我也不知道为什么

With CDO.Configuration.Fields '用with关键字减少代码输入

.Item(schema & "sendusing") = 2 '使用网络上的SMTP服务器而不是本地的SMTP服务器

.Item(schema & "smtpserver") = "smtp.gmail.com" 'SMTP服务器地址

.Item(schema & "smtpauthenticate") = 1 '服务器认证方式

.Item(schema & "sendusername") = Email_From '发件人邮箱

.Item(schema & "sendpassword") = Password '发件人邮箱密码

.Item(schema & "smtpserverport") = 465 'SMTP服务器端口

.Item(schema & "smtpusessl") = True '是否使用SSL

.Item(schema & "smtpconnectiontimeout") = 60 '连接服务器的超时时间

.Update '更新设置

End With

CDO.Send '发送邮件
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: