用VB.Net接收邮件并解码-WBWY
来源:互联网 发布:手机什么软件看片好 编辑:程序博客网 时间:2024/06/06 08:54
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 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
本文来自CSDN博客,转载请标明出处:http://blog.csdn.net/wbwy/archive/2005/06/23/401507.aspx
- 用VB.Net接收邮件并解码-WBWY
- 用VB.Net接收邮件并解码-WBWY
- VB.NET 接收邮件并编码
- VB自动接收邮件
- vb.net Base64解码
- [VB.NET]接收电子邮件
- .net发送接收邮件
- asp.net接收邮件
- Asp.net接收邮件
- vb.net发送邮件
- vb.net编解码url
- JavaMail 接收邮件(解码技术和附件接收)
- Java 接收邮件(解码技术和附件接收)
- ASP.NET 2.0 接收邮件
- 在.net中接收邮件
- .NET发送邮件和接收邮件
- ffmpeg 接收h264+aac并解码
- FFmpeg接收H.264解码并播放
- Item3: Use const whenever possible
- 关于使用表接收存储过程返回结果集的问题
- 御旗之下
- Android 2.2将发
- SQL Server数据库常用的T-SQL命令
- 用VB.Net接收邮件并解码-WBWY
- love 引擎源码开源 适合想学lua 的朋友参考
- 解决ads工程转到MDK(keil)可能出现的error
- 带你深入了解"T-SQL"的十一种设计模式
- Linux 下 Oracle 用户的密码包含特殊字符时给 sqlplus 和 imp/exp 传递密码参数的处理
- Google正式采用全新设计
- 视频歌曲集
- SQL SERVER性能优化--Tempdb相关问题
- (转)利用 Sql 中查看表结构信息