| 网站首页 | 业界新闻 | 群组 | 人才 | 技术文章 | 下载频道 | 博客 | 代码贴 | 编程论坛
共有 367 人关注过本帖
标题:找不到Collection类定义
只看楼主 收藏
kim_wei
Rank: 1
等 级:新手上路
帖 子:38
专家分:7
注 册:2008-5-5
结帖率:71.43%
  已结贴   问题点数:20  回复次数:14   
找不到Collection类定义
大侠们好,我在做邮件自动接收、下载程序,使用了木瓜的Mytools,调用了流星雨的邮件解码程序,但是在执行    AddProperty(This,"Contents",NewObject("Collection"))语句时报错,请帮忙啊!
2017-09-13 14:21
kim_wei
Rank: 1
等 级:新手上路
帖 子:38
专家分:7
注 册:2008-5-5
  得分:0 
我用的是vfp6.0
再:还有没有其他自动下载邮件的方法?请帮忙!
2017-09-13 14:42
吹水佬
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:117
帖 子:4646
专家分:18748
注 册:2014-5-20
  得分:10 
这句是在当前对象创建或设置Contents属性的值为一个Collection类实例对象。
可能是找不到Collection类的定义,NewObject("Collection")执行失败。
参考VFP帮助 NewObject() 的使用说明。
2017-09-13 14:42
kim_wei
Rank: 1
等 级:新手上路
帖 子:38
专家分:7
注 册:2008-5-5
  得分:0 
谢谢斑竹!

这个类是什么类?用途是什么?怎样建立?

下面是木瓜和流星雨的源码,请您看看,帮忙分析一下:

Set Library To myfll
hPop3=Pop3Create("pop.163.com","帐号","密码")
If hPop3==""
    MessageBox("无法连接服务器")
    Return
EndIf

nCount=Pop3AMailList(hPop3,"aMail")  &&邮件个数

If nCount<0
    ?"无法取得邮件信息"
    Pop3Close(hPop3)
    Return
EndIf

For x=1 to 2  &&把2改成nCount可以下载每一封邮件
   
    cMailBody=Pop3GetMail(hPop3,aMail[x,1])   &&下载邮件

    * StrToFile(cMailBody,"mail"+Transform(x)+".eml")  &&把邮件保存到磁盘
   
    *下面这段代码,使用网友 流星雨 写的解码程序,对邮件进行解码
    oMail =  NEWOBJECT('Mail')
    oMail.LoadEML(cMailBody)   &&这里解析邮件

    ?'发件人:',oMail.Sender
    ?'收件人:',oMail.Recever
    ?'抄送:',oMail.CC
    ?'发件日期:',oMail.SendDateTime
    ?'邮件主题:',oMail.Subject
    ?'附件数量:',oMail.Contents.Count
    *?'邮件正文:',oMail.BodyText
    *?'邮件HTML正文:',oMail.BodyHtml
    FOR i = 1 TO oMail.Contents.Count  &&遍历每一个附件
        ?'第',ALLTRIM(STR(i)),'个附件名称:',oMail.Contents(i).Name
        ?'文件内容在oMail.Contents(',ALLTRIM(STR(i)),').Value中'
    ENDFOR
EndFor

Pop3Close(hPop3)

Set Library To


*-------------------------------------------------------------------------------
*类    名:Mail
*功  能:对邮件进行解码
*作  者:流星雨
*备  注:
*-------------------------------------------------------------------------------


DEFINE CLASS 'Mail' AS Custom
    Mail = ""
    Subject = "" &&主题

    Recever = "" &&收件人

    Cc = "" &&抄送

    Sender = "" &&发件人

    SendDateTime = "" &&发送时间

    BodyText = "" &&文本正文

    BodyHtml = "" &&HTML正文

*----------------------------------------
    PROCEDURE LoadEML    &&加载邮件

    LPARAMETERS cMail,lMailType
    *参数:cMail 字符串形式邮件或文件形式邮件
    *参数:lMailType 0 字符串形式 1文件形式 此参数可省略,默认为0
    IF VARTYPE(lMailType)="L" OR lMailType = 0
        This.Mail = cMail
        RELEASE cMail
    ELSE
        IF FILE(cMail,1) AND JUSTEXT(cMail) = "EML"
            This.Mail = FILETOSTR(cMail)
        ELSE
            MESSAGEBOX('文件不存在或格式不对',48,'错误')
            RETURN
        ENDIF
    ENDIF
    AddProperty(This,"Contents",NewObject("Collection"))
    *--------------发件人
    This.Sender = This.Decode(CHRTRAN(STREXTRACT(This.Mail,CHR(10)+'From:',CHR(13)),'"',''))
    *--------------收件人
    This.Recever = STREXTRACT(This.Mail,CHR(10)+'To:',':')
    This.Recever = SUBSTR(This.Recever,1,RAT(CHR(13),This.Recever)-1)
    This.Recever = This.Decode(This.Recever)
    *--------------抄送
    This.Cc = STREXTRACT(This.Mail,CHR(10)+'Cc:',':')
    This.Cc = SUBSTR(This.Cc ,1,RAT(CHR(13),This.Cc)-1)
    This.Cc = This.Decode(CHRTRAN(This.Cc,CHR(13)+CHR(10),''))
    *--------------发送日期,格式我没有转换,偷个小懒:)
    This.SendDateTime = STREXTRACT(This.Mail,CHR(10)+'Date: ',CHR(13)) &&

    This.SendDateTime = STREXTRACT(This.SendDateTime,', ',' +')
    *--------------邮件主题
    This.Subject = STREXTRACT(This.Mail,CHR(10)+'Subject:',CHR(13))
    DO WHILE .T.    &&防止多行主题,主题明明是一段话却编码成两行,可能是因为有换行符号CHR(10)存在,不知道怎么会允许这种情况存在

        IF SUBSTR(This.Mail,AT(This.Subject+CHR(13),This.Mail)+LEN(This.Subject)+2,1) = "    "
            This.Subject = This.Subject +CHR(13)+CHR(10)+ STREXTRACT(This.Mail,This.Subject+CHR(13),CHR(13))
        ELSE
            EXIT
        ENDIF
    ENDDO
    *lcCharacter = SUBSTR(lcCharacter,1,RAT(CHR(13),lcCharacter)-1)
    This.Subject = This.Decode(This.Subject)
   
    *--------------邮件内容及附件
    LOCAL lcBoundary,lcBoundary1,lcCharacter,i,ii
    lcBoundary = "--"+CHRTRAN(STREXTRACT(This.Mail,'boundary=',CHR(13)),'";','')
    FOR i = 1 TO OCCURS(lcBoundary,This.Mail)-1
        lcCharacter = STREXTRACT(This.Mail,lcBoundary,lcBoundary,i)
        cBoundary = CHRTRAN(STREXTRACT(lcCharacter,'boundary=',CHR(13)),'";','')
        IF !EMPTY(cBoundary)
            cBoundary = '--' + cBoundary
            FOR ii = 1 TO OCCURS(cBoundary,lcCharacter)-1
                This.AddContent(STREXTRACT(This.Mail,cBoundary,cBoundary,ii))
            ENDFOR
        ELSE
            This.AddContent(lcCharacter)
        ENDIF
    ENDFOR
*----------------------------------------
    PROCEDURE Decode &&解码

    LPARAMETERS cText
        LOCAL lcStr,lcCharacter,cSaveText,cTempStr,si
        If not ( "=?"$cText and  "?=" $ cText)
            Return cText  &&这种不带编码的,直接返回

        EndIf
        cSaveTest = cText
        cText = cText + IIF(RIGHT(cText,1) = '=',CHR(13),'')
        FOR si = 1 TO OCCURS('=?',cText)
            lcStr = STREXTRACT(CHR(13)+CHR(10)+cText+CHR(13)+CHR(10),CHR(13)+CHR(10),CHR(13)+CHR(10),si)
            DO CASE
            CASE '?Q?'$lcStr    &"ed-printable编码 例:Re:=B9=D8=D3=DAMYFLL

                lcCharacter = STREXTRACT(lcStr+'?','?Q?','?')
                cSaveTest = STRTRAN(cSaveTest,"=?"+STREXTRACT(lcStr,'=?','?Q')+'?Q?'+lcCharacter+"?=",QPDecode(lcCharacter))
            CASE '?B?'$cText    &&base64编码

                lcCharacter = STREXTRACT(lcStr+'?','?B?','?')
                cSaveTest = STRTRAN(cSaveTest,"=?"+STREXTRACT(lcStr,'=?','?B')+'?B?'+lcCharacter+"?=",STRCONV(lcCharacter,14))
            ENDCASE
        ENDFOR
        *RETURN CHRTRAN(cSaveTest,'    " '+CHR(13)+CHR(10),'')
        RETURN CHRTRAN(cSaveTest,CHR(13)+CHR(10),'')
    ENDPROC
*----------------------------------------
    PROCEDURE AddContent
    LPARAMETERS cContent,cArrayMail
    LOCAL cType
    cType = STREXTRACT(cContent,'Content-Type: ',';')
    DO CASE
    CASE cType = 'text/plain' &&正文

        This.BodyText = SUBSTR(cContent,AT(CHR(13)+CHR(10)+CHR(13)+CHR(10),cContent)+4,LEN(cContent))
        DO CASE
        CASE CHR(10)+'Content-Transfer-Encoding: base64'$cContent
            This.BodyText = STRCONV(This.BodyText,14)
        CASE CHR(10)+'Content-Transfer-Encoding: quoted-printable'$cContent
            This.BodyText = QPDecode(This.BodyText)
        ENDCASE
    CASE cType = 'text/html' &&HTML正文

        This.BodyHtml = SUBSTR(cContent,AT(CHR(13)+CHR(10)+CHR(13)+CHR(10),cContent)+4,LEN(cContent))
        DO CASE
        CASE CHR(10)+'Content-Transfer-Encoding: base64'$cContent
            This.BodyHtml = STRCONV(This.BodyHtml,14)
        CASE CHR(10)+'Content-Transfer-Encoding: quoted-printable'$cContent
            This.BodyHtml = QPDecode(This.BodyHtml)
        ENDCASE
    OTHERWISE    &&附件,其实真正的附件应该为application/格式,这里将非正文的内容都作为附件了,像HTML格式中的图片其实可以过滤,在查看HTML邮件时才有用

        oItem=NewObject("empty")
        AddProperty(oItem,"Name",This.Decode(CHRTRAN(STREXTRACT(cContent,'name=',CHR(13)),'";','')))
        AddProperty(oItem,"Value",STRCONV(SUBSTR(cContent,AT(CHR(13)+CHR(10)+CHR(13)+CHR(10),cContent)+4,LEN(cContent)),14))
        This.Contents.Add(oItem)
    ENDCASE
*----------------------------------------
ENDDEFINE

2017-09-13 14:46
吹水佬
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:117
帖 子:4646
专家分:18748
注 册:2014-5-20
  得分:5 
以下是引用kim_wei在2017-9-13 14:42:15的发言:

我用的是vfp6.0

vfp6好象没有AddProperty()
用AddProperty方法试试:
this.AddProperty("Contents",NewObject("Collection"))
2017-09-13 14:47
kim_wei
Rank: 1
等 级:新手上路
帖 子:38
专家分:7
注 册:2008-5-5
  得分:0 
还是出现同样的错误提示,是不是我现在缺少Collection类啊?
2017-09-13 15:43
吹水佬
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:117
帖 子:4646
专家分:18748
注 册:2014-5-20
  得分:5 
以下是引用kim_wei在2017-9-13 15:43:45的发言:

还是出现同样的错误提示,是不是我现在缺少Collection类啊?

看看 NewObject("Collection") 执行结果,有无载入Collection类的类库?
2017-09-13 16:07
kim_wei
Rank: 1
等 级:新手上路
帖 子:38
专家分:7
注 册:2008-5-5
  得分:0 
执行了一下,还是出现同样的错误提示。
2017-09-13 16:25
kim_wei
Rank: 1
等 级:新手上路
帖 子:38
专家分:7
注 册:2008-5-5
  得分:0 
斑竹,不知道您有没有时间,可以把上面的源代码运行一下吗?
我是这样做的,不知道对不对?

1、新建个表单,建一个命令按钮,在click中输入:

set proc to 程序1

Set Library To myfll
hPop3=Pop3Create("pop.163.com","帐号","密码")        &&密码、帐号都改成我自己的
If hPop3==""
    MessageBox("无法连接服务器")
    Return
EndIf

nCount=Pop3AMailList(hPop3,"aMail")  &&邮件个数

If nCount<0
    ?"无法取得邮件信息"
    Pop3Close(hPop3)
    Return
EndIf

For x=1 to 2  &&把2改成nCount可以下载每一封邮件
   
    cMailBody=Pop3GetMail(hPop3,aMail[x,1])   &&下载邮件

    * StrToFile(cMailBody,"mail"+Transform(x)+".eml")  &&把邮件保存到磁盘
   
    *下面这段代码,使用网友 流星雨 写的解码程序,对邮件进行解码
    oMail =  NEWOBJECT('Mail')
    oMail.LoadEML(cMailBody)   &&这里解析邮件

    ?'发件人:',oMail.Sender
    ?'收件人:',oMail.Recever
    ?'抄送:',oMail.CC
    ?'发件日期:',oMail.SendDateTime
    ?'邮件主题:',oMail.Subject
    ?'附件数量:',oMail.Contents.Count
    *?'邮件正文:',oMail.BodyText
    *?'邮件HTML正文:',oMail.BodyHtml
    FOR i = 1 TO oMail.Contents.Count  &&遍历每一个附件
        ?'第',ALLTRIM(STR(i)),'个附件名称:',oMail.Contents(i).Name
        ?'文件内容在oMail.Contents(',ALLTRIM(STR(i)),').Value中'
    ENDFOR
EndFor

Pop3Close(hPop3)

Set Library To



[此贴子已经被作者于2017-9-13 16:41编辑过]

附件: 您没有浏览附件的权限,请 登录注册
2017-09-13 16:39
kim_wei
Rank: 1
等 级:新手上路
帖 子:38
专家分:7
注 册:2008-5-5
  得分:0 
2、再建一个prg文件,名称为“程序1”,内容为:


*-------------------------------------------------------------------------------
*类    名:Mail
*功  能:对邮件进行解码
*作  者:流星雨
*备  注:
*-------------------------------------------------------------------------------


DEFINE CLASS 'Mail' AS Custom
    Mail = ""
    Subject = "" &&主题

    Recever = "" &&收件人

    Cc = "" &&抄送

    Sender = "" &&发件人

    SendDateTime = "" &&发送时间

    BodyText = "" &&文本正文

    BodyHtml = "" &&HTML正文

*----------------------------------------
    PROCEDURE LoadEML    &&加载邮件

    LPARAMETERS cMail,lMailType
    *参数:cMail 字符串形式邮件或文件形式邮件
    *参数:lMailType 0 字符串形式 1文件形式 此参数可省略,默认为0
    IF VARTYPE(lMailType)="L" OR lMailType = 0
        This.Mail = cMail
        RELEASE cMail
    ELSE
        IF FILE(cMail) AND JUSTEXT(cMail) = "EML"
            This.Mail = FILETOSTR(cMail)
        ELSE
            MESSAGEBOX('文件不存在或格式不对',48,'错误')
            RETURN
        ENDIF
    ENDIF
    AddProperty(This,"Contents",NewObject("Collection"))
    *--------------发件人
    This.Sender = This.Decode(CHRTRAN(STREXTRACT(This.Mail,CHR(10)+'From:',CHR(13)),'"',''))
    *--------------收件人
    This.Recever = STREXTRACT(This.Mail,CHR(10)+'To:',':')
    This.Recever = SUBSTR(This.Recever,1,RAT(CHR(13),This.Recever)-1)
    This.Recever = This.Decode(This.Recever)
    *--------------抄送
    This.Cc = STREXTRACT(This.Mail,CHR(10)+'Cc:',':')
    This.Cc = SUBSTR(This.Cc ,1,RAT(CHR(13),This.Cc)-1)
    This.Cc = This.Decode(CHRTRAN(This.Cc,CHR(13)+CHR(10),''))
    *--------------发送日期,格式我没有转换,偷个小懒:)
    This.SendDateTime = STREXTRACT(This.Mail,CHR(10)+'Date: ',CHR(13)) &&

    This.SendDateTime = STREXTRACT(This.SendDateTime,', ',' +')
    *--------------邮件主题
    This.Subject = STREXTRACT(This.Mail,CHR(10)+'Subject:',CHR(13))
    DO WHILE .T.    &&防止多行主题,主题明明是一段话却编码成两行,可能是因为有换行符号CHR(10)存在,不知道怎么会允许这种情况存在

        IF SUBSTR(This.Mail,AT(This.Subject+CHR(13),This.Mail)+LEN(This.Subject)+2,1) = "    "
            This.Subject = This.Subject +CHR(13)+CHR(10)+ STREXTRACT(This.Mail,This.Subject+CHR(13),CHR(13))
        ELSE
            EXIT
        ENDIF
    ENDDO
    *lcCharacter = SUBSTR(lcCharacter,1,RAT(CHR(13),lcCharacter)-1)
    This.Subject = This.Decode(This.Subject)
   
    *--------------邮件内容及附件
    LOCAL lcBoundary,lcBoundary1,lcCharacter,i,ii
    lcBoundary = "--"+CHRTRAN(STREXTRACT(This.Mail,'boundary=',CHR(13)),'";','')
    FOR i = 1 TO OCCURS(lcBoundary,This.Mail)-1
        lcCharacter = STREXTRACT(This.Mail,lcBoundary,lcBoundary,i)
        cBoundary = CHRTRAN(STREXTRACT(lcCharacter,'boundary=',CHR(13)),'";','')
        IF !EMPTY(cBoundary)
            cBoundary = '--' + cBoundary
            FOR ii = 1 TO OCCURS(cBoundary,lcCharacter)-1
                This.AddContent(STREXTRACT(This.Mail,cBoundary,cBoundary,ii))
            ENDFOR
        ELSE
            This.AddContent(lcCharacter)
        ENDIF
    ENDFOR
*----------------------------------------
    PROCEDURE Decode &&解码

    LPARAMETERS cText
        LOCAL lcStr,lcCharacter,cSaveText,cTempStr,si
        If not ( "=?"$cText and  "?=" $ cText)
            Return cText  &&这种不带编码的,直接返回

        EndIf
        cSaveTest = cText
        cText = cText + IIF(RIGHT(cText,1) = '=',CHR(13),'')
        FOR si = 1 TO OCCURS('=?',cText)
            lcStr = STREXTRACT(CHR(13)+CHR(10)+cText+CHR(13)+CHR(10),CHR(13)+CHR(10),CHR(13)+CHR(10),si)
            DO CASE
            CASE '?Q?'$lcStr    &&"ed-printable编码 例:Re:=B9=D8=D3=DAMYFLL

                lcCharacter = STREXTRACT(lcStr+'?','?Q?','?')
                cSaveTest = STRTRAN(cSaveTest,"=?"+STREXTRACT(lcStr,'=?','?Q')+'?Q?'+lcCharacter+"?=",QPDecode(lcCharacter))
            CASE '?B?'$cText    &&base64编码

                lcCharacter = STREXTRACT(lcStr+'?','?B?','?')
                cSaveTest = STRTRAN(cSaveTest,"=?"+STREXTRACT(lcStr,'=?','?B')+'?B?'+lcCharacter+"?=",STRCONV(lcCharacter,14))
            ENDCASE
        ENDFOR
        *RETURN CHRTRAN(cSaveTest,'    " '+CHR(13)+CHR(10),'')
        RETURN CHRTRAN(cSaveTest,CHR(13)+CHR(10),'')
    ENDPROC
*----------------------------------------
    PROCEDURE AddContent
    LPARAMETERS cContent,cArrayMail
    LOCAL cType
    cType = STREXTRACT(cContent,'Content-Type: ',';')
    DO CASE
    CASE cType = 'text/plain' &&正文

        This.BodyText = SUBSTR(cContent,AT(CHR(13)+CHR(10)+CHR(13)+CHR(10),cContent)+4,LEN(cContent))
        DO CASE
        CASE CHR(10)+'Content-Transfer-Encoding: base64'$cContent
            This.BodyText = STRCONV(This.BodyText,14)
        CASE CHR(10)+'Content-Transfer-Encoding: quoted-printable'$cContent
            This.BodyText = QPDecode(This.BodyText)
        ENDCASE
    CASE cType = 'text/html' &&HTML正文

        This.BodyHtml = SUBSTR(cContent,AT(CHR(13)+CHR(10)+CHR(13)+CHR(10),cContent)+4,LEN(cContent))
        DO CASE
        CASE CHR(10)+'Content-Transfer-Encoding: base64'$cContent
            This.BodyHtml = STRCONV(This.BodyHtml,14)
        CASE CHR(10)+'Content-Transfer-Encoding: quoted-printable'$cContent
            This.BodyHtml = QPDecode(This.BodyHtml)
        ENDCASE
    OTHERWISE    &&附件,其实真正的附件应该为application/格式,这里将非正文的内容都作为附件了,像HTML格式中的图片其实可以过滤,在查看HTML邮件时才有用

        oItem=NewObject("empty")
        AddProperty(oItem,"Name",This.Decode(CHRTRAN(STREXTRACT(cContent,'name=',CHR(13)),'";','')))
        AddProperty(oItem,"Value",STRCONV(SUBSTR(cContent,AT(CHR(13)+CHR(10)+CHR(13)+CHR(10),cContent)+4,LEN(cContent)),14))
        This.Contents.Add(oItem)
    ENDCASE
*----------------------------------------
ENDDEFINE

2017-09-13 16:43







关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.082736 second(s), 8 queries.
Copyright©2004-2017, BCCN.NET, All Rights Reserved