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.csdn.net/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.<a href="https://www.jb51.cc/tag/toch/" target="_blank" class="keywords">toch</a>arArray()) ns.Write(outbytes,outbytes.Length) s = sr.ReadLine Return s End Function Private Function sendCommand1(ByVal command As String) As String Dim s,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,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,4096) sOutput &= System.Text.Encoding.Default.GetString(str,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("<a href="https://www.jb51.cc/tag/shanchu/" target="_blank" class="keywords">删除</a>第" + 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.<a href="https://www.jb51.cc/tag/toch/" target="_blank" class="keywords">toch</a>arArray()) sw.Write(b,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,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