用VB.Net接收邮件并解码-WBWY

本文链接：https://blog.youkuaiyun.com/qianjiu/article/details/5561974

Imports System.Net.Sockets
Imports System.Text
Imports System.IO
Public Class pop
    Dim ns As NetworkStream
    Dim sr As StreamReader
    Dim _server As String
    Dim _port As String
    Dim _user As String
    Dim _pwd As String
    Dim _SaveMailPath As String

'----http://blog.youkuaiyun.com/wbwy----

    Public Sub New(ByVal server As String, ByVal port As String, ByVal user As String, ByVal pwd As String, ByVal SaveMailPath As String)
        _server = server
        _port = port
        _user = user
        _pwd = pwd
        _SaveMailPath = SaveMailPath
    End Sub

    Private Sub Connect()
        Dim sender As New TcpClient(_server, _port)
        Dim outbytes() As Byte
        Dim input As String
        Try
            ns = sender.GetStream()
            sr = New StreamReader(ns)
            sr.ReadLine()
            sendCommand("user " + _user)
            sendCommand("pass " + _pwd)
        Catch ex As Exception
            Console.WriteLine("Could not connect to mail server")
        End Try

    End Sub
    Private Function sendCommand(ByVal command As String) As String
        Dim s, line As String
        Dim input As String = command + vbNewLine
        Dim outbytes() As Byte = System.Text.Encoding.ASCII.GetBytes(input.ToCharArray())
        ns.Write(outbytes, 0, outbytes.Length)
        s = sr.ReadLine
        Return s
    End Function
    Private Function sendCommand1(ByVal command As String) As String
        Dim s, line As String
        Dim input As String = command + vbNewLine
        Dim outbytes() As Byte = System.Text.Encoding.ASCII.GetBytes(input.ToCharArray())
        ns.Write(outbytes, 0, outbytes.Length)

        Do
            line = sr.ReadLine()
            s &= line & vbNewLine
        Loop While Not line = "."
        Dim encoding As System.Text.Encoding = System.Text.Encoding.Default
        Dim b() As Byte = encoding.GetBytes(s)
        b = encoding.Convert(sr.CurrentEncoding, encoding, b)
        s = encoding.GetString(b)
        Return s
    End Function
    Private Function sendCommand2(ByVal command As String) As String
        Dim s, line As String
        Dim input As String = command + vbNewLine
        Dim outbytes() As Byte = System.Text.Encoding.ASCII.GetBytes(input.ToCharArray())
        ns.Write(outbytes, 0, outbytes.Length)

        Dim sOutput As String = ""
        Dim str(4096) As Byte
        Dim startTime As Date = Now
        Dim endCondition As String = vbCrLf & vbCrLf & "."
        Do
            While ns.DataAvailable()
                startTime = Now
                input = ns.Read(str, 0, 4096)
                sOutput &= System.Text.Encoding.Default.GetString(str, 0, input)
            End While
        Loop Until sOutput.IndexOf(endCondition) >= 0 Or Now.Subtract(startTime).TotalMilliseconds > 10000
        If sOutput.IndexOf(endCondition) < 0 Then
            Return "ERR +d 2134 "
        Else
            Return sOutput
        End If
    End Function
    Private Sub Disconnect()
        sendCommand("quit")
        ns.Close()
    End Sub
    Function getAllMeaasage() As String
        Connect()
        Dim s As String = sendCommand1("list")
        Dim ss() As String = s.Split(vbNewLine)
        Dim n As Integer = ss.Length - 2
        For i As Integer = 1 To n
            Dim sss() = ss(i).Split(" ")
            s = sendCommand2("RETR " + CStr(i))
            If s.Substring(0, 3) <> "+OK" Then
                Throw New Exception("接收第" & CStr(i) & "出错")
            Else
                Dim endCondition As String = vbCrLf & vbCrLf & "."
                Dim j As Integer = s.IndexOf(vbNewLine)
                Dim k As Integer = s.IndexOf(endCondition)
                s = s.Substring(j + 2, k - j)
                savemail(s)
            End If
        Next
        Disconnect()
    End Function
    Public Function delAllMessage() As String
        Dim s As String = sendCommand("list")
        Dim ss() As String = s.Split(vbNewLine)
        Dim n As Integer = ss.Length - 2
        For i As Integer = 1 To n
            s = sendCommand1("DELE " + i)
            If s.Substring(0, 3) <> "+OK" Then
                Throw New Exception("删除第" + i + "出错")
            End If
        Next
    End Function
    Private Sub saveMail(ByVal s As String)

        Dim sw As Stream = File.OpenWrite(_SaveMailPath & "/" & Rnd() & ".eml")
        Dim b() As Byte = System.Text.Encoding.Default.GetBytes(s.ToCharArray())
        sw.Write(b, 0, b.Length)
        sw.Close()
    End Sub
    Public Sub decodeMail(ByVal EmailFile As String)
        Dim email As New System.Web.Mail.MailMessage
        Dim sw As FileStream = File.OpenRead(EmailFile)
        Dim b(sw.Length) As Byte
        sw.Read(b, 0, sw.Length)
        Dim s As String = System.Text.Encoding.Default.GetString(b)
        sw.Close()
        Dim from As String = getSubstring(s, "From: ", vbNewLine)
        Dim myTo As String = getSubstring(s, "To: ", vbNewLine)
        Dim cc As String = getSubstring(s, "Cc: ", vbNewLine)
        Dim subject As String = getSubstring(s, "Subject: ", vbNewLine)
    End Sub
    Private Function getSubstring(ByVal s As String, ByVal s1 As String, ByVal s2 As String) As String
        Dim i As Integer = s.IndexOf(s1) + s1.Length
        Dim j As Integer = s.IndexOf(s2, i)
        Dim st As String = s.Substring(i, j - i)
        If decodeGB2312(st) = 0 Then
        End If
        Return st
    End Function
    Private Function decodeGB2312(ByRef s As String) As Integer
        Dim s1 As String = "=?gb2312?B?"
        Dim s2 As String = "?="
        Dim l As Integer = s1.Length
        Dim i, j, n As Integer
        i = s.IndexOf(s1)
        While i <> -1
            i += l
            j = s.IndexOf(s2, i)
            Dim st As String = s.Substring(i, j - i)
            Dim sd As String = decodeBase64(st, "gb2312")
            s = s.Replace(s1 + st + s2, sd)
            i = s.IndexOf(s1)
            n += 1
        End While
        Return n
    End Function
    Private Function decodeBase64(ByVal s As String, ByVal CodeName As String) As String
        Dim b() As Byte = Convert.FromBase64String(s)
        Dim rs As String = System.Text.Encoding.GetEncoding(CodeName).GetString(b)
        Return rs
    End Function
End Class