vfp 接收邮件

xuewuhen001 2012-05-18 08:41:39
MAPI 控件,可以接收电子邮件中的附件,并保存到指定目录吗?接收邮件的内容,我做出来了,接收附件没成功,请指点迷津?
...全文
417 10 打赏 收藏 转发到动态 举报
写回复
用AI写文章
10 条回复
切换为时间正序
请发表友善的回复…
发表回复
xuewuhen001 2012-05-21
  • 打赏
  • 举报
回复
这样是可以把整个邮件都下载下来,但是可不可以光把邮件中的附件下载到本机指定的目录下呢?
xuewuhen001 2012-05-21
  • 打赏
  • 举报
回复
嗯,好的谢谢啊
敦厚的曹操 2012-05-19
  • 打赏
  • 举报
回复
可能是他看到帮助文件里写的这个,才以为版本是1.179.9.811吧
今后,应该写清楚,再次谢谢提醒!
敦厚的曹操 2012-05-19
  • 打赏
  • 举报
回复
我的版本是最新的,
因为在帮助文件中有一句话,写的是这个:
【版本信息:由于不定期更新,请及时核对版本(右键属性),版本为X.X.X.X,第一位为主版本号,第二位为函数个数,第三位为发布的年份,第四位为日期。当前版本为:1.179.9.811】
而.fll的版本是1.182.10.526
我下了你的文件,帮助文件里也是写着
【版本信息:由于不定期更新,请及时核对版本(右键属性),版本为X.X.X.X,第一位为主版本号,第二位为函数个数,第三位为发布的年份,第四位为日期。当前版本为:1.179.9.811】

敦厚的曹操 2012-05-19
  • 打赏
  • 举报
回复
谢谢大版主提醒呀!今后注意!
十豆三 2012-05-19
  • 打赏
  • 举报
回复
[Quote=引用 1 楼 的回复:]
你看一下木瓜的MyFll.fll下面有下载地址:MyFll.Fll最新文件和帮助和focus文件及中文帮助(合集)
http://download.csdn.net/detail/dxnn520/3649468
[/Quote]你的 MyFll.fll 版本好像是1.179.9.811(一个网友评论中说的),下次上传资源建议把版本写上。
<木瓜的MyFll.fll(1.182.10.526)及说明>
http://download.csdn.net/source/2505656
敦厚的曹操 2012-05-19
  • 打赏
  • 举报
回复
木瓜老师的代码!看对你是否有用?

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
*----------------------------------------
敦厚的曹操 2012-05-19
  • 打赏
  • 举报
回复
邮件函数:

SmtpCreate          创建一个SMTP发送邮件的句柄
SmtpNewMail         在内存中创建邮件内容,等待发送
SmtpSend           发送邮件
SmtpGetLastError       检测邮件最后的错误
Pop3Create          创建一个POP3接收邮件的句柄
Pop3Close          关闭句柄
Pop3AMailList        枚举POP3服务器上的邮件数量
Pop3DeleteMail        删除POP3邮件服务器上的邮件
Pop3GetMail         下载一封邮件
Pop3GetMailHeader      下载邮件头
Pop3DeleteMail        删除服务器上的邮件
敦厚的曹操 2012-05-19
  • 打赏
  • 举报
回复
你看一下木瓜的MyFll.fll下面有下载地址:MyFll.Fll最新文件和帮助和focus文件及中文帮助(合集)
http://download.csdn.net/detail/dxnn520/3649468
十豆三 2012-05-19
  • 打赏
  • 举报
回复
[Quote=引用 7 楼 的回复:]
可能是他看到帮助文件里写的这个,才以为版本是1.179.9.811吧
今后,应该写清楚,再次谢谢提醒!
[/Quote]有这个可能。客气了。

2,718

社区成员

发帖
与我相关
我的任务
社区描述
VFP,是Microsoft公司推出的数据库开发软件,用它来开发数据库,既简单又方便。
社区管理员
  • VFP社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧