一段VB.NET代码,生成邮件,发送邮件,支持SMTP验证用户名密码

可以生成邮件,可以发送邮件,稍做修改就可以写成一个com组件,在ASP里调用.

--------------------------------------------------------------------------------


'-------------------------------------------------
'生成基本邮件格式（包括附件），发送邮件到SMTP服务器，
'只能发送到发件人SMTP服务器（需验证），直接投递功能正在编写。
'
'声明:本段代码中,有一部份借签了网上一位大侠的C#代码.由于找不到原文,无法写出原作者名字
'-------------------------------------------------
Imports System
Imports System.Text
Imports System.IO
Imports System.Net
Imports System.Net.Sockets
Imports System.Collections
Namespace eWebMail
Public Class Mail
'邮件类，生成基本的邮件格式。Public Charset As String = "GB2312"
Public From As String
Public FromName As String
Public ReplyTo As String
Public Subject As String = ""
Public isHtml As Boolean = False
Public Body As String = ""
Public TextBody As String = "This is a HTML mail."
Public RecipientMaxNum As Integer = 15 '最大收件人数Public Recipient As New ArrayList
Public RecipientCC As New ArrayList
Public RecipientBCC As New ArrayList
Protected mPriority As String = "Normal"
Protected boundary As String = "=====000_eWebMail0099887766554433_====="
Protected boundary1 As String = "=====001_eWebMail0099887766554433_====="
Protected Attachments As New ArrayList
Protected AttachmentsSB As New StringBuilder
Protected RecipientName As String = ""
Private Shared fileHT As Hashtable

[ 本帖最后由 lohuan 于 2007-10-25 04:29 AM 编辑 ]

Public Shared Function GetMime(ByVal strFileName As String) As String
'根据文件扩展名获取文件的格式
If fileHT(strFileName) <> Nothing Then Return fileHT(strFileName) Else Return "*/*"
End Function
Public Property RcpName() As String
'收件人名称
Get
If RecipientName <> "" Then Return RecipientName
If Recipient.Count > 0 Then Return Recipient(0)
Return ""
End Get
Set(ByVal Value As String)
RecipientName = Value
End Set
End Property
Public Function AddRecipient(ByVal str As String) As Boolean
'添加一个收件人地址
Return addRs(str, Recipient)
End Function
Public Function AddRecipient(ByVal str() As String) As Boolean
'添加一组收件人地址
Return addRs(str, Recipient)
End Function
Public Function AddRecipientCC(ByVal str() As String) As Boolean
'添加一组抄送地址
Return addRs(str, RecipientCC)
End Function
Public Function AddRecipientBCC(ByVal str() As String) As Boolean
'添加一组暗送地址
Return addRs(str, RecipientBCC)
End Function
Public Function AddRecipientCC(ByVal str As String) As Boolean
'添加一个抄送地址
Return addRs(str, RecipientCC)
End Function
Public Function AddRecipientBCC(ByVal str As String) As Boolean
'添加一个暗送地址
Return addRs(str, RecipientBCC)
End Function
Protected Function addRs(ByVal str As String, ByRef ra As ArrayList) As Boolean
'添加一个邮件地址到一个列表中
str = str.Trim()
If str = "" Or str.IndexOf("@") = -1 Then
Return True
End If
If ra.Count < RecipientMaxNum Then
ra.Add(str)
Return True
Else
ra.Clear()
Return False
End If
End Function
Protected Function addRs(ByVal str() As String, ByRef ra As ArrayList) As Boolean
'添加一组邮件地址到一个列表中
Dim i As Integer
For i = 0 To str.Length - 1
If Not addRs(str(i), ra) Then
Return False
End If
Next
End Function
Public Function AddAttachment(ByVal path As String, Optional ByVal strCID As String = "") As String
'添加一个文件到附件中，并设置一个ID，用来在HTML格式邮件正文中调用
If File.Exists(path) Then
Dim fs As FileStream
Try
fs = New FileStream(path, FileMode.Open)

Catch ex As Exception
Return "error no file!"
End Try
Dim strreturn As String = AddAttachment(fs, path, strCID)
fs.Close()
Return strreturn
Else
Return "error no file!"
End If
End Function
Public Function AddAttachment(ByRef AttachmentStream As Stream, ByVal AttachmentName As String, ByVal strCID As String)
'添加一个数据流，保存到附件中，并设置一个ID。
If AttachmentStream.Length > 0 Then
Attachments.Add(AttachmentName)
Dim sl As Long = AttachmentStream.Length
Dim barray(sl) As Byte
Dim dotidx As Integer = AttachmentName.LastIndexOf(".")
Dim strType As String
If dotidx <> -1 Then strType = GetMime(AttachmentName.Substring(dotidx)) Else strType = "*/*"
AttachmentStream.Read(barray, 0, sl)
AttachmentsSB.Append("--" & boundary & vbNewLine)
AttachmentsSB.Append("Content-Type: " & strType & "; name=""" & AttachmentNameStr(AttachmentName.Substring(AttachmentName.LastIndexOf("\") + 1)) & """" & vbNewLine)
AttachmentsSB.Append("Content-Transfer-Encoding: base64" & vbNewLine)
If strCID = "" Then
strCID = getrndstr()
End If
AttachmentsSB.Append("Content-ID: <" & strCID & ">" & vbNewLine)
AttachmentsSB.Append("Content-Disposition: attachment; filename=""" & AttachmentNameStr(AttachmentName.Substring(AttachmentName.LastIndexOf("\") + 1)) & """" & vbNewLine & vbNewLine)
AttachmentsSB.Append(Base64.strLine(Convert.ToBase64String(barray)) & vbNewLine & vbNewLine)
Return strCID
Else
Return "error no data!"
End If
End Function

[ 本帖最后由 lohuan 于 2007-10-25 04:31 AM 编辑 ]

Protected Function SmtpAuth(ByRef ns As NetworkStream) As Boolean
'向服务器发送用户名密码验证信息Dim SendBuffer As New ArrayList
Dim SendBufferstr As String
SendBufferstr = "EHLO " & SmtpServer & vbNewLine '发送EHLO命令
If SendCommand(SendBufferstr, ns) Then
Dim i As Integer = 0
Do
If ns.DataAvailable Then
Dim RR As String = RecvResponse(ns)
If RR = "false" Then Return False
Dim RRCode As String = RR.Substring(0, 3)
If Not RghCodeHT(RRCode) = Nothing Then
If RR.IndexOf("AUTH") <> -1 Then Exit Do
Else
Return False
End If
Else
System.Threading.Thread.Sleep(50)
i = i + 1
If i > 60 Then
Return False
End If
End If
Loop
Else
Return False
End If
SendBuffer.Add("AUTH LOGIN" & vbNewLine) '发送用户名密码
SendBuffer.Add(Base64.Encode(smtpUserName) & vbNewLine)
SendBuffer.Add(Base64.Encode(smtpPassWord) & vbNewLine)
Return Dialog(SendBuffer, ns)
End Function
Protected Function RecvResponse(ByRef ns As NetworkStream) As String
'从SMTP服务器接收一个回应
Dim StreamSize As Integer
Dim ReturnValue As String = ""
Dim ReadBuffer(1023) As Byte
Try
StreamSize = ns.Read(ReadBuffer, 0, 1024)
Catch ex As Exception
Return "false"
End Try
If StreamSize = 0 Then
Return ""
Else
ReturnValue = Encoding.Default.GetString(ReadBuffer).Substring(0, StreamSize)
Return ReturnValue
End If
End Function
Shared Sub New()
'添加一个SMTP反回信息的对照哈希表
ErrCodeHT.Add("500", "邮箱地址错误")
ErrCodeHT.Add("501", "参数格式错误")
ErrCodeHT.Add("502", "命令不可实现")
ErrCodeHT.Add("503", "服务器需要SMTP验证")
ErrCodeHT.Add("504", "命令参数不可实现")
ErrCodeHT.Add("421", "服务未就绪，关闭传输信道")
ErrCodeHT.Add("450", "要求的邮件操作未完成，邮箱不可用（例如，邮箱忙）")
ErrCodeHT.Add("550", "要求的邮件操作未完成，邮箱不可用（例如，邮箱未找到，或不可访问）")
ErrCodeHT.Add("451", "放弃要求的操作；处理过程中出错")
ErrCodeHT.Add("551", "用户非本地，请尝试<forward-path>")
ErrCodeHT.Add("452", "系统存储不足，要求的操作未执行")
ErrCodeHT.Add("552", "过量的存储分配，要求的操作未执行")
ErrCodeHT.Add("553", "邮箱名不可用，要求的操作未执行（例如邮箱格式错误）")
ErrCodeHT.Add("432", "需要一个密码转换")
ErrCodeHT.Add("534", "认证机制过于简单")
ErrCodeHT.Add("538", "当前请求的认证机制需要加密")
ErrCodeHT.Add("454", "临时认证失败")
ErrCodeHT.Add("530", "需要认证")

RghCodeHT.Add("220", "服务就绪")
RghCodeHT.Add("250", "要求的邮件操作完成")
RghCodeHT.Add("251", "用户非本地，将转发向<forward-path>")
RghCodeHT.Add("354", "开始邮件输入，以<CRLF>.<CRLF>结束")
RghCodeHT.Add("221", "服务关闭传输信道")
RghCodeHT.Add("334", "服务器响应验证Base64字符串")
RghCodeHT.Add("235", "验证成功")
End Sub
End Class
End Namespace