Foxtable(狐表)用户栏目专家坐堂 → 继续探讨lumisoft接收邮件问题


  共有2978人关注过本帖树形打印复制链接

主题:继续探讨lumisoft接收邮件问题

帅哥哟,离线,有人找我吗?
rjh4078
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:狐精 帖子:3358 积分:24758 威望:0 精华:0 注册:2012/3/26 21:47:00
继续探讨lumisoft接收邮件问题  发帖心情 Post By:2016/5/21 21:50:00 [只看该作者]

现在大部分邮件都能收取 也能获取到附件

但是有部分邮件获取附件的时候会出现下图中的错误

 

 


图片点击可在新窗口打开查看此主题相关图片如下:qq截图20160521214708.png
图片点击可在新窗口打开查看

 

 

附上代码

 

 

Dim pop3Server As String = "pop.exmail.qq.com"
Dim pop3Port As Integer = "995"
Dim pop3UseSsl As Boolean = True
Dim username As String = "testid"
Dim password As String = "tespsd"
Using pop3 As New LumiSoft.Net.POP3.Client.POP3_Client()
pop3.Connect(pop3Server, pop3Port, pop3UseSsl)
pop3.Login(username, password )
Dim infos As object = pop3.messages()
''msgbox(Infos.count)

Dim msgs As object = pop3.messages()
Dim i As Integer
'获取某邮件信息
For i=0 To Infos.count-1
    If i<55 Then
        ''output.show(i)
        e.form.Controls("lbyjs").text="正在比对第" & i+1 & "封邮件"
        'try
        Dim dr As DataRow=DataTables("inbox").sqlfind("uid='" & msgs(i).uid & "'")
        If dr Is Nothing Then
            Dim messageBytes = msgs(i).MessageToByte
            Dim mime_message = LumiSoft.Net.Mail.Mail_Message.ParseFromByte(messageBytes)
            If i=Infos.count-1 Then
                e.form.Controls("lbyjs").text="收件完成!本次共接收" & i & "封邮件!"
            End If
            e.form.Controls("lbyjs").text="共有" & Infos.count & "封邮件,正在接收第" & i+1 & "封"
            ''Application.DoEvents()
            ''output.show(i & ":" & mime_message.Subject)
            If mime_message IsNot Nothing  Then
                Dim fjs = mime_message.GetAttachments(True, True)
                Dim r As Row=Tables("inbox").addnew
                r("uid")=msgs(i).uid
                If mime_message.From(0).DisplayName="" Then
                    r("发件人")= mime_message.From(0).Address
                Else
                    r("发件人")=mime_message.From(0).DisplayName
                End If
                r("发件时间")=mime_message.Date
                r("主题")=mime_message.Subject
                r("附件数")=fjs.length
                r("收件人")=_UserName
                r("部门")=_UserGroup
                If mime_message.BodyText IsNot Nothing Then
                    r("正文")=mime_message.BodyHtmlText
                Else
                    r("正文")=mime_message.bodytext
                End If
                r("发件地址")=mime_message.From(0).Address
                'r.locked=True
               ' r.save
                For Each entity As object In fjs
                    ''output.show(entity.Contentid)
                    ''output.show(entity.ContentDisposition.Param_FileName)
                    If entity.ContentType IsNot Nothing Then
                        '' Dim fileName As String = entity.ContentType.Param_Name
                        Dim fileName As String=""
                        If entity.ContentType.Param_Name<>""
                            fileName  =entity.ContentType.Param_Name
                        Else
                            fileName =entity.ContentDescription
                            'MessageBox.show(entity.ContentType.Param_Name)
                            'MessageBox.show(entity.ContentDescription)
                        End If
                        Dim id As String
                        If entity.Contentid<>"" Then
                            id=entity.Contentid
                            id=id.TrimStart("<")
                            id=id.TrimEnd(">")
                            ''MessageBox.show(id)
                        End If
                        If Not String.IsNullOrEmpty(fileName) Then
                            try
                                Dim dir As New io.DirectoryInfo(ProjectPath & "bin\temp\")
                                If Not dir.Exists Then
                                    dir.Create()
                                End If
                                ''filename=filename.Replace(" ","")
                                ''MessageBox.show(filename)
                                Dim path__1 As String = io.Path.Combine(dir.FullName, fileName)
                                Dim byteObj As object= entity.Body
                                Dim decodedDataStream As io.Stream = byteObj.GetDataStream()
                                Using fs As New io.FileStream(path__1, io.FileMode.Create)
                                LumiSoft.Net.Net_Utils.StreamCopy(decodedDataStream, fs, 4000)
                            End Using
                            Dim tr As Row=Tables("附件").addnew
                            tr("uid")=msgs(i).uid
                            tr("cid")=id
                            Dim ifo As new FileInfo(path__1)
                            tr("文件名")=ifo.name.Replace(ifo.Extension,"")
                            tr("格式")=ifo.Extension
                            tr.save
                            tr.DataRow.SQLInsertFile("附件",path__1)
                        catch ex As Exception
                            '''' MessageBox.show(ex.ToString)
                            Dim ttr As Row=Tables("附件").addnew
                            ttr("uid")=msgs(i).uid
                            If ex.ToString.contains("非法字符") Then
                                ttr("文件名")=filename
                                ttr("说明")=ex.ToString
                            Else                               
                                ttr("文件名")=filename
                                ttr("说明")=ex.ToString
                            End If
                        End try
                    End If
                End If
            Next
        End If
    End If
    'Catch ex As Exception
    'End try
End If
Next
pop3.disconnect
End Using


 回到顶部
帅哥哟,离线,有人找我吗?
大红袍
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:贵宾 帖子:39310 积分:196782 威望:0 精华:1 注册:2015/4/25 9:23:00
  发帖心情 Post By:2016/5/22 11:24:00 [只看该作者]

上传实例啊。不然你就用Imap协议去弄啊。

 回到顶部
帅哥哟,离线,有人找我吗?
vkfox
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:幼狐 帖子:73 积分:620 威望:0 精华:0 注册:2018/12/15 21:37:00
  发帖心情 Post By:2019/2/13 0:29:00 [只看该作者]

发现用“sqlfind
Dim dr As DataRow=DataTables("inbox").sqlfind("uid='" & msgs(i).uid & "'")
总是返回True
如果改成“find”
Dim dr As DataRow=DataTables("inbox").find("uid='" & msgs(i).uid & "'")
则是对的
图片点击可在新窗口打开查看

 回到顶部
帅哥哟,离线,有人找我吗?
lhpc120
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:三尾狐 帖子:633 积分:6326 威望:0 精华:0 注册:2011/5/8 13:21:00
  发帖心情 Post By:2019/2/13 1:18:00 [只看该作者]

图片点击可在新窗口打开查看

 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2019/2/13 9:17:00 [只看该作者]

以下是引用vkfox在2019/2/13 0:29:00的发言:
发现用“sqlfind
Dim dr As DataRow=DataTables("inbox").sqlfind("uid='" & msgs(i).uid & "'")
总是返回True
如果改成“find”
Dim dr As DataRow=DataTables("inbox").find("uid='" & msgs(i).uid & "'")
则是对的
 

 

那你试试改成

 

Dim dr As DataRow=DataTables("inbox").sqlfind("uid=" & msgs(i).uid & "")

 


 回到顶部