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.tocharArray())
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("删除第" + 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,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,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
本文来自CSDN博客,转载请标明出处:http://blog.csdn.net/wbwy/archive/2005/06/23/401507.aspx