用VB.Net接收邮件并解码-WBWY
2005-06-23 20:16
288 查看
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, 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
4000
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
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, 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
4000
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
相关文章推荐
- 用VB.Net接收邮件并解码-WBWY
- Jmail接收邮件及UTF-8解码问题(含VB及C#代码)
- 使用 LumiSoft.Net.POP3.Client 接收邮件
- VB.NET邮件群发纯htlm二维码
- VB.NET验证邮件地址的合法性实现代码
- [VB.NET源码]接收UDP广播
- 桌面邮件飞机源码——VB.NET网络编程简单实例
- vb.net开发邮件客户端程序
- VB.Net实现PDU中的UCS2编码和解码
- VB.NET通过Socket实现字符串发送与接收程序
- .NET C# 使用S22.Imap.dll接收邮件 并且指定收取的文件夹的未读邮件,并且更改未读准态
- [VB.NET]串口接收16进制代码
- [VB.NET]请问,如何暂停socket的异步接收?
- 一段VB.NET代码,生成邮件,发送邮件,支持SMTP验证用户名密码.
- 使用 LumiSoft.Net.POP3.Client 接收邮件心得
- 基于Lumisoft.NET组件的POP3邮件接收和删除操作
- asp.net 2.0发送和接收邮件总结
- VB.NET的一个邮件发送函数
- vb.net 导出为excel及邮件群发
- vb.net实现邮件发送