Progress通过CDO.Message发送邮件

1.自定义类：

 
 /*------------------------------------------------------------------------
    File        : cdoemail.cls
    Purpose     : Send email use CDO.Message (Windows only)
    Syntax      : 
    Description : Compatibility with PROGRESS OPENEDGE 10.1A and above
    Author(s)   : TERRENCE ZHANG
    Created     : May 04 08:49:36 CST 2016
    Notes       : 兼容10.1A起见  故没使用 属性 重载 等后续版本新增的OOP功能
  ----------------------------------------------------------------------*/

CLASS cdoemail:
    DEFINE PROTECTED VARIABLE namespace AS CHARACTER NO-UNDO.
    DEFINE PROTECTED VARIABLE cdoobj AS COMPONENT-HANDLE NO-UNDO.    /*主进程对象*/
    DEFINE PROTECTED VARIABLE cdocfg AS COMPONENT-HANDLE NO-UNDO.   /*控制*/
    DEFINE PROTECTED VARIABLE fso AS COMPONENT-HANDLE NO-UNDO.
    DEFINE PROTECTED VARIABLE myfile AS COMPONENT-HANDLE NO-UNDO.
    
    CONSTRUCTOR PUBLIC cdoemail():
        ASSIGN namespace = "http://schemas.microsoft.com/cdo/configuration/".
        CREATE "CDO.Message" cdoobj NO-ERROR.
        cdocfg = cdoobj:configuration.
    END CONSTRUCTOR.
    
    METHOD PUBLIC VOID setmail(INPUT mailfrom AS CHARACTER,INPUT mailto AS CHARACTER,INPUT subject AS CHARACTER):
        cdoobj:FROM = mailfrom.         /*发件人*/
        cdoobj:TO = mailto.             /*收件人*/
        cdoobj:subject = subject.       /*邮件标题*/
        cdoobj:BodyPart:Charset = "UTF-8".  /*字符集设为UTF-8*/ /*GB2312可选*/
        /*cdoobj:Cc  /*抄送*/
        cdoobj:Bcc  /*密送*/  */
    END METHOD.
    
    METHOD PUBLIC VOID setcc(INPUT mailcc AS CHARACTER):
        cdoobj:Cc = mailcc.
    END METHOD. 
    
    METHOD PUBLIC VOID setBcc(INPUT mailbcc AS CHARACTER):
        cdoobj:Bcc = mailbcc.
    END METHOD. 
    
    METHOD PUBLIC VOID sethtml1(INPUT htmlbody AS LONGCHAR):
        cdoobj:htmlbody = htmlbody.
    END METHOD.    /*直接输入HTML内容*/
    
    METHOD PUBLIC VOID sethtml2(INPUT textpath AS CHARACTER):
        CREATE "Scripting.FileSystemObject" fso NO-ERROR.
        myfile = fso:OpenTextFile(textpath,1,1,).
        cdoobj:htmlbody = myfile:readall.
        myfile:CLOSE.
        RELEASE OBJECT fso NO-ERROR.
        RELEASE OBJECT myfile NO-ERROR.
        ASSIGN fso = ? myfile = ?.
    END METHOD.            /*读文件HTML内容*/
    
    METHOD PUBLIC VOID setbody1(INPUT textbody AS CHARACTER):
        cdoobj:textbody = textbody.
    END METHOD.    /*直接输入内容*/
    
    METHOD PUBLIC VOID setbody2(INPUT textpath AS CHARACTER):
        CREATE "Scripting.FileSystemObject" fso NO-ERROR.
        myfile = fso:OpenTextFile(textpath,1,1,).
        cdoobj:textbody = myfile:readall.
        myfile:CLOSE.
        RELEASE OBJECT fso NO-ERROR.
        RELEASE OBJECT myfile NO-ERROR.
        ASSIGN fso = ? myfile = ?.
    END METHOD.            /*读文件内容*/
    
    METHOD PUBLIC VOID setath(INPUT athfile AS CHARACTER):
        cdoobj:addattachment(athfile,,).
    END METHOD.        /*附件*/
    
    METHOD PUBLIC VOID setserver(INPUT smtpserver AS CHARACTER,INPUT senduser AS CHARACTER,INPUT sendpsw AS CHARACTER):
        cdocfg:FIELDS(namespace + "sendusing") = 2.
        cdocfg:FIELDS(namespace + "smtpserver") = smtpserver.
        cdocfg:FIELDS(namespace + "smtpserverport") = 25.  /*默认端口25 若不是 则修改成自定义的端口*/
        cdocfg:FIELDS(namespace + "smtpauthenticate") = 1.
        cdocfg:FIELDS(namespace + "sendusername") = senduser.
        cdocfg:FIELDS(namespace + "sendpassword") = sendpsw.
        cdocfg:FIELDS:UPDATE.
    END METHOD.
    
    METHOD PUBLIC VOID sendmail():
        cdoobj:SEND.
    END METHOD.
    
    DESTRUCTOR PUBLIC cdoemail():
        RELEASE OBJECT cdocfg NO-ERROR.
        RELEASE OBJECT cdoobj NO-ERROR.
        ASSIGN cdocfg = ? cdoobj = ?.
    END DESTRUCTOR.
END CLASS.

2.在Procedure Editor里测试发送邮件：

DEFINE VARIABLE e AS cdoemail NO-UNDO.
e = NEW cdoemail().
e:setmail("admin@xx163xx.com","receiver@xx163xx.com","JUST A TEST MAIL").  /*sender,receiver,title*/
/*
e:setcc("").  //设置抄送人
e:setbcc("").  //设置密送人
*/
e:setbody1("Just a Test").  /*直接文本做内容*/
/*
e:setbody2("d:\file.txt").  //读文本内容
e:sethtml1("").   //HTML格式内容
e:sethtml2("d:\file.txt").  //读文本内容
e:setath("d:\file.xlsx")   //附件
*/
e:setserver("smtp.xx163xx.com","admin@xx163xx.com","123456789").  /*smtp server,sender name,sender password*/
e:sendmail().
DELETE OBJECT e.
e = ?.

 3.在GUI里做个测试菜单：

/*Author: TERRENCE ZHANG*/
/*Date: 2017-01-10*/
/*For Cimload-Chui Or Gui Use*/

/* ********************  Preprocessor Definitions  ******************** */
&SCOPED-DEFINE SDCLS cdoemail  /*CDO.Message*/
&SCOPED-DEFINE SMTPSV 'smtp@12345.com'  /*邮箱SMTP地址*/
&SCOPED-DEFINE SENDER 'xxxab@12345.com'  /*发件邮箱*/
&SCOPED-DEFINE NAME 'username'  /*发件名*/
&SCOPED-DEFINE PSWD 'password'  /*邮箱密码*/

/* ***************************  Definitions  ************************** */

DEFINE VARIABLE mailto AS CHARACTER FORMAT "x(56)" NO-UNDO.
DEFINE VARIABLE ccto AS CHARACTER FORMAT "x(56)" NO-UNDO.
DEFINE VARIABLE bccto AS CHARACTER FORMAT "x(56)" NO-UNDO.
DEFINE VARIABLE filepath AS CHARACTER FORMAT "x(48)" NO-UNDO.
DEFINE VARIABLE mailtitle AS CHARACTER FORMAT "x(56)" NO-UNDO.
DEFINE VARIABLE content AS CHARACTER 
VIEW-AS EDITOR SIZE 56 BY 5 SCROLLBAR-VERTICAL NO-UNDO.
DEFINE VARIABLE cetpath AS CHARACTER FORMAT "x(48)" NO-UNDO.
DEFINE VARIABLE nddel AS LOGICAL NO-UNDO.

DEFINE BUTTON btnfilepath LABEL "File".
DEFINE BUTTON btncetpath LABEL "File".

DEFINE VARIABLE choice AS LOGICAL INITIAL YES NO-UNDO.

FORM
SKIP(.2)
mailto LABEL "收件人" COLON 15 SKIP(.2)
ccto LABEL "抄送给" COLON 15 SKIP(.2)
bccto LABEL "密送给" COLON 15 SKIP(.2)
filepath LABEL "附件路径" COLON 15 btnfilepath COLON 66
SKIP(.2)
mailtitle LABEL "邮件标题" COLON 15 SKIP(.2)
content LABEL "邮件内容" COLON 15 SKIP(.2)
cetpath LABEL "正文路径" COLON 15 btncetpath COLON 66
SKIP(.2)
nddel LABEL "删除附件" COLON 15 SKIP(.2)
WITH FRAME a 
TITLE COLOR normal ("SEND MAIL FUNCTION")
SIDE-LABELS WIDTH 80 THREE-D.

ON CHOOSE OF btnfilepath IN FRAME a
DO:
    SYSTEM-DIALOG GET-FILE filepath FILTERS "Files" "*" MUST-EXIST
    USE-FILENAME.
    ASSIGN filepath = filepath.
    DISPLAY filepath WITH FRAME a.
END.

ON CHOOSE OF btncetpath IN FRAME a
DO:
    SYSTEM-DIALOG GET-FILE cetpath FILTERS "Text Files (*.txt)" "*.txt" MUST-EXIST
    USE-FILENAME.
    ASSIGN cetpath = cetpath.
    DISPLAY cetpath WITH FRAME a.
END.

/* ***************************  Main Block  *************************** */

REPEAT:
    ENABLE btnfilepath WITH FRAME a.
    ENABLE btncetpath WITH FRAME a.
    UPDATE 
    mailto 
    ccto
    bccto
    filepath
    mailtitle
    content 
    cetpath 
    nddel
    WITH FRAME a.
    
    DISABLE btnfilepath WITH FRAME a.
    DISABLE btncetpath WITH FRAME a.
    
    IF mailto EQ "" THEN
    DO:
        MESSAGE "收件人地址不能为空！" VIEW-AS ALERT-BOX WARNING.
        UNDO,RETRY.
    END.
   
    MESSAGE "确认发送邮件？" VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE choice.
    IF NOT choice THEN UNDO,RETRY.

    DEFINE VARIABLE sd AS CLASS {&SDCLS} NO-UNDO.
    sd = NEW {&SDCLS}().
    sd:setcc(ccto).
    sd:setBcc(bccto).
    sd:setserver({&SMTPSV},{&NAME},{&PSWD}).
    sd:setmail({&SENDER},mailto,mailtitle).
    sd:setbody1(content).
    sd:setbody2(cetpath).
    IF SEARCH(filepath) NE ? THEN sd:setath(filepath).
    sd:sendmail() NO-ERROR.
    IF ERROR-STATUS:ERROR THEN MESSAGE "发送邮件发生错误，请检查相关参数并重试！" VIEW-AS ALERT-BOX ERROR.
    ELSE MESSAGE "邮件已发送".
    DELETE OBJECT sd.
    sd = ?.
    IF nddel AND SEARCH(filepath) NE ? THEN OS-DELETE VALUE(filepath).

END.
                                                                        

运行：