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

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

以后我会整理成一个完整的.

'-------------------------------------------------

'生成基本邮件格式（包括附件），发送邮件到SMTP服务器，

'只能发送到发件人SMTP服务器（需验证），直接投递功能正在编写。

'声明:本段代码中,有一部份借签了网上一位大侠的C#代码.由于找不到原文,无法写出原作者名字

'代码编写:头太晕

'QQ:2538288

'MSN:qq2538288@hotmail.com

'BLOG: http://spaces.msn.com/members/headfaint http://blog.csdn.net/super852

'-------------------------------------------------

Imports System

Imports System.Text

Imports System.IO

Imports System.Net

Imports System.Net.Sockets

Imports System.Collections

Namespace eWebMail

Public Class Mail

'邮件类，生成基本的邮件格式。访问作者BLOG: http://spaces.msn.com/members/headfaint

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 '最大收件人数访问作者BLOG: http://spaces.msn.com/members/headfaint

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

Shared Sub New()

'添加一些常见的文件格式访问作者BLOG: http://spaces.msn.com/members/headfaint

fileHT = New Hashtable

fileHT.Add('.323', 'text/h323')

fileHT.Add('.3g2', 'video/3gpp2')

fileHT.Add('.3gp', 'video/3gpp')

fileHT.Add('.act', 'text/xml')

fileHT.Add('.actproj', 'text/plain')

fileHT.Add('.ai', 'application/postscript')

fileHT.Add('.aif', 'audio/aiff')

fileHT.Add('.aifc', 'audio/aiff')

fileHT.Add('.aiff', 'audio/aiff')

fileHT.Add('.asa', 'text/asa')

fileHT.Add('.asf', 'video/x-ms-asf')

fileHT.Add('.asm', 'text/plain')

fileHT.Add('.asp', 'text/asp')

fileHT.Add('.asx', 'video/x-ms-asf')

fileHT.Add('.au', 'audio/basic')

fileHT.Add('.avi', 'video/avi')

fileHT.Add('.bmp', 'image/bmp')

fileHT.Add('.c', 'text/plain')

fileHT.Add('.cat', 'application/vnd.ms-pki.seccat')

fileHT.Add('.cc', 'text/plain')

fileHT.Add('.cdf', 'application/x-netcdf')

fileHT.Add('.cer', 'application/x-x509-ca-cert')

fileHT.Add('.class', 'java/*')

fileHT.Add('.cod', 'text/plain')

fileHT.Add('.cpp', 'text/plain')

fileHT.Add('.crl', 'application/pkix-crl')

fileHT.Add('.crt', 'application/x-x509-ca-cert')

fileHT.Add('.cs', 'text/plain')

fileHT.Add('.css', 'text/css')

fileHT.Add('.cxx', 'text/plain')

fileHT.Add('.dbs', 'text/plain')

fileHT.Add('.def', 'text/plain')

fileHT.Add('.der', 'application/x-x509-ca-cert')

fileHT.Add('.dib', 'image/bmp')

fileHT.Add('.dll', 'application/x-msdownload')

fileHT.Add('.doc', 'application/msword')

fileHT.Add('.dot', 'application/msword')

fileHT.Add('.dps', 'interface/vnd.divx-skin')

fileHT.Add('.dsp', 'text/plain')

fileHT.Add('.dsw', 'text/plain')

fileHT.Add('.dxu', 'video/vnd.divx-playlist')

fileHT.Add('.edn', 'application/vnd.adobe.edn')

fileHT.Add('.eml', 'message/rfc822')

fileHT.Add('.eps', 'application/postscript')

fileHT.Add('.etd', 'application/x-ebx')

fileHT.Add('.etp', 'text/plain')

fileHT.Add('.exe', 'application/x-msdownload')

fileHT.Add('.ext', 'text/plain')

fileHT.Add('.fdf', 'application/vnd.fdf')

fileHT.Add('.fif', 'application/fractals')

fileHT.Add('.fky', 'text/plain')

fileHT.Add('.gif', 'image/gif')

fileHT.Add('.h', 'text/plain')

fileHT.Add('.hpp', 'text/plain')

fileHT.Add('.hqx', 'application/mac-binhex40')

fileHT.Add('.hta', 'application/hta')

fileHT.Add('.htc', 'text/x-component')

fileHT.Add('.htm', 'text/html')

fileHT.Add('.html', 'text/html')

fileHT.Add('.htt', 'text/webviewhtml')

fileHT.Add('.htx', 'text/html')

fileHT.Add('.hxx', 'text/plain')

fileHT.Add('.i', 'text/plain')

fileHT.Add('.ico', 'image/x-icon')

fileHT.Add('.idl', 'text/plain')

fileHT.Add('.iii', 'application/x-iphone')

fileHT.Add('.inc', 'text/plain')

fileHT.Add('.inl', 'text/plain')

fileHT.Add('.ins', 'application/x-internet-signup')

fileHT.Add('.isp', 'application/x-internet-signup')

fileHT.Add('.java', 'java/*')

fileHT.Add('.jfif', 'image/jpeg')

fileHT.Add('.jpe', 'image/jpeg')

fileHT.Add('.jpeg', 'image/jpeg')

fileHT.Add('.jpg', 'image/jpeg')

fileHT.Add('.js', 'application/x-javascript')

fileHT.Add('.kci', 'text/plain')

fileHT.Add('.latex', 'application/x-latex')

fileHT.Add('.lgn', 'text/plain')

fileHT.Add('.ls', 'application/x-javascript')

fileHT.Add('.lst', 'text/plain')

fileHT.Add('.m1v', 'video/mpeg')

fileHT.Add('.m3u', 'audio/x-mpegurl')

fileHT.Add('.mak', 'text/plain')

fileHT.Add('.man', 'application/x-troff-man')

fileHT.Add('.map', 'text/plain')

fileHT.Add('.mdb', 'application/msaccess')

fileHT.Add('.mfp', 'application/x-shockwave-flash')

fileHT.Add('.mht', 'message/rfc822')

fileHT.Add('.mhtml', 'message/rfc822')

fileHT.Add('.mid', 'audio/mid')

fileHT.Add('.midi', 'audio/mid')

fileHT.Add('.mk', 'text/plain')

fileHT.Add('.mocha', 'application/x-javascript')

fileHT.Add('.movie', 'video/x-sgi-movie')

fileHT.Add('.mp2', 'video/mpeg')

fileHT.Add('.mp2v', 'video/mpeg')

fileHT.Add('.mp3', 'audio/mpeg')

fileHT.Add('.mpa', 'video/mpeg')

fileHT.Add('.mpe', 'video/mpeg')

fileHT.Add('.mpeg', 'video/mpeg')

fileHT.Add('.mpg', 'video/mpeg')

fileHT.Add('.mpv2', 'video/mpeg')

fileHT.Add('.nmw', 'application/nmwb')

fileHT.Add('.nws', 'message/rfc822')

fileHT.Add('.odh', 'text/plain')

fileHT.Add('.odl', 'text/plain')

fileHT.Add('.p10', 'application/pkcs10')

fileHT.Add('.p12', 'application/x-pkcs12')

fileHT.Add('.p7b', 'application/x-pkcs7-certificates')

fileHT.Add('.p7c', 'application/pkcs7-mime')

fileHT.Add('.p7m', 'application/pkcs7-mime')

fileHT.Add('.p7r', 'application/x-pkcs7-certreqresp')

fileHT.Add('.p7s', 'application/pkcs7-signature')

fileHT.Add('.pdf', 'application/pdf')

fileHT.Add('.pdx', 'application/vnd.adobe.pdx')

fileHT.Add('.pfx', 'application/x-pkcs12')

fileHT.Add('.pko', 'application/vnd.ms-pki.pko')

fileHT.Add('.pl', 'application/x-perl')

fileHT.Add('.plg', 'text/html')

fileHT.Add('.png', 'image/png')

fileHT.Add('.prc', 'text/plain')

fileHT.Add('.prf', 'application/pics-rules')

fileHT.Add('.ps', 'application/postscript')

fileHT.Add('.py', 'text/plain')

fileHT.Add('.pys', 'text/plain')

fileHT.Add('.pyw', 'text/plain')

fileHT.Add('.ra', 'audio/vnd.rn-realaudio')

fileHT.Add('.ram', 'audio/x-pn-realaudio')

fileHT.Add('.rat', 'application/rat-file')

fileHT.Add('.rc', 'text/plain')

fileHT.Add('.rc2', 'text/plain')

fileHT.Add('.rct', 'text/plain')

fileHT.Add('.rgs', 'text/plain')

fileHT.Add('.rjs', 'application/vnd.rn-realsystem-rjs')

fileHT.Add('.rjt', 'application/vnd.rn-realsystem-rjt')

fileHT.Add('.rm', 'application/vnd.rn-realmedia')

fileHT.Add('.rmf', 'application/vnd.adobe.rmf')

fileHT.Add('.rmi', 'audio/mid')

fileHT.Add('.rmj', 'application/vnd.rn-realsystem-rmj')

fileHT.Add('.rmm', 'audio/x-pn-realaudio')

fileHT.Add('.rmp', 'application/vnd.rn-rn_music_package')

fileHT.Add('.rms', 'application/vnd.rn-realmedia-secure')

fileHT.Add('.rmvb', 'application/vnd.rn-realmedia-vbr')

fileHT.Add('.rmx', 'application/vnd.rn-realsystem-rmx')

fileHT.Add('.rnx', 'application/vnd.rn-realplayer')

fileHT.Add('.rp', 'image/vnd.rn-realpix')

fileHT.Add('.rpm', 'audio/x-pn-realaudio-plugin')

fileHT.Add('.rsml', 'application/vnd.rn-rsml')

fileHT.Add('.rt', 'text/vnd.rn-realtext')

fileHT.Add('.rtf', 'application/msword')

fileHT.Add('.rul', 'text/plain')

fileHT.Add('.rv', 'video/vnd.rn-realvideo')

fileHT.Add('.s', 'text/plain')

fileHT.Add('.sct', 'text/scriptlet')

fileHT.Add('.sit', 'application/x-stuffit')

fileHT.Add('.sln', 'application/octet-stream')

fileHT.Add('.smi', 'application/smil')

fileHT.Add('.smil', 'application/smil')

fileHT.Add('.snd', 'audio/basic')

fileHT.Add('.sol', 'text/plain')

fileHT.Add('.sor', 'text/plain')

fileHT.Add('.spc', 'application/x-pkcs7-certificates')

fileHT.Add('.spl', 'application/futuresplash')

fileHT.Add('.sql', 'text/plain')

fileHT.Add('.srf', 'text/plain')

fileHT.Add('.sst', 'application/vnd.ms-pki.certstore')

fileHT.Add('.stl', 'application/vnd.ms-pki.stl')

fileHT.Add('.stm', 'text/html')

fileHT.Add('.swf', 'application/x-shockwave-flash')

fileHT.Add('.tab', 'text/plain')

fileHT.Add('.tdl', 'text/xml')

fileHT.Add('.tif', 'image/tiff')

fileHT.Add('.tiff', 'image/tiff')

fileHT.Add('.tlh', 'text/plain')

fileHT.Add('.tli', 'text/plain')

fileHT.Add('.torrent', 'application/x-bittorrent')

fileHT.Add('.trg', 'text/plain')

fileHT.Add('.txt', 'text/plain')

fileHT.Add('.udf', 'text/plain')

fileHT.Add('.udt', 'text/plain')

fileHT.Add('.uls', 'text/iuls')

fileHT.Add('.user', 'text/plain')

fileHT.Add('.usr', 'text/plain')

fileHT.Add('.vb', 'text/plain')

fileHT.Add('.vcf', 'text/x-vcard')

fileHT.Add('.vcproj', 'text/plain')

fileHT.Add('.viw', 'text/plain')

fileHT.Add('.vspscc', 'text/plain')

fileHT.Add('.vsscc', 'text/plain')

fileHT.Add('.vssscc', 'text/plain')

fileHT.Add('.wav', 'audio/x-wav')

fileHT.Add('.wax', 'audio/x-ms-wax')

fileHT.Add('.wiz', 'application/msword')

fileHT.Add('.wm', 'video/x-ms-wm')

fileHT.Add('.wma', 'audio/x-ms-wma')

fileHT.Add('.wmd', 'application/x-ms-wmd')

fileHT.Add('.wmv', 'video/x-ms-wmv')

fileHT.Add('.wmx', 'video/x-ms-wmx')

fileHT.Add('.wmz', 'application/x-ms-wmz')

fileHT.Add('.wpl', 'application/vnd.ms-wpl')

fileHT.Add('.wsc', 'text/scriptlet')

fileHT.Add('.wvx', 'video/x-ms-wvx')

fileHT.Add('.xbm', 'image/x-xbitmap')

fileHT.Add('.xdp', 'application/vnd.adobe.xdp+xml')

fileHT.Add('.xfd', 'application/vnd.adobe.xfd+xml')

fileHT.Add('.xfdf', 'application/vnd.adobe.xfdf')

fileHT.Add('.xls', 'application/vnd.ms-excel')

fileHT.Add('.xml', 'text/xml')

fileHT.Add('.xsl', 'text/xml')

fileHT.Add('.ymg', 'application/ymsgr')

fileHT.Add('.yps', 'application/ymsgr')

fileHT.Add('.z', 'application/x-compress')

End Sub

Public Shared Function GetMime(ByVal strFileName As String) As String

'根据文件扩展名获取文件的格式访问作者BLOG: http://spaces.msn.com/members/headfaint

If fileHT(strFileName) <> Nothing Then Return fileHT(strFileName) Else Return '*/*'

End Function

Public Property RcpName() As String

'收件人名称访问作者BLOG: http://spaces.msn.com/members/headfaint

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

'添加一个收件人地址访问作者BLOG: http://spaces.msn.com/members/headfaint

Return addRs(str, Recipient)

End Function

Public Function AddRecipient(ByVal str() As String) As Boolean

'添加一组收件人地址访问作者BLOG: http://spaces.msn.com/members/headfaint

Return addRs(str, Recipient)

End Function

Public Function AddRecipientCC(ByVal str() As String) As Boolean

'添加一组抄送地址访问作者BLOG: http://spaces.msn.com/members/headfaint

Return addRs(str, RecipientCC)

End Function

Public Function AddRecipientBCC(ByVal str() As String) As Boolean

'添加一组暗送地址访问作者BLOG: http://spaces.msn.com/members/headfaint

Return addRs(str, RecipientBCC)

End Function

Public Function AddRecipientCC(ByVal str As String) As Boolean

'添加一个抄送地址访问作者BLOG: http://spaces.msn.com/members/headfaint

Return addRs(str, RecipientCC)

End Function

Public Function AddRecipientBCC(ByVal str As String) As Boolean

'添加一个暗送地址访问作者BLOG: http://spaces.msn.com/members/headfaint

Return addRs(str, RecipientBCC)

End Function

Protected Function addRs(ByVal str As String, ByRef ra As ArrayList) As Boolean

'添加一个邮件地址到一个列表中访问作者BLOG: http://spaces.msn.com/members/headfaint

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

'添加一组邮件地址到一个列表中访问作者BLOG: http://spaces.msn.com/members/headfaint

Dim i As Integer

For i = 0 To str.Length - 1

If Not addRs(str(i), ra) Then

Return False

End If

End Function

Public Function AddAttachment(ByVal path As String, Optional ByVal strCID As String = '') As String

'添加一个文件到附件中，并设置一个ID，用来在HTML格式邮件正文中调用访问作者BLOG: http://spaces.msn.com/members/headfaint

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。访问作者BLOG: http://spaces.msn.com/members/headfaint

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

Private Function getrndstr() As String

'当没有为附件设置ID时，自动随机生成一个ID 访问作者BLOG: http://spaces.msn.com/members/headfaint

Dim strTemp As String = ''

Do While strTemp.Length < 6

Randomize()

strTemp += Chr(Int(26 * Rnd() + 65))

Loop

Return strTemp

End Function

Protected Function AttachmentNameStr(ByVal fn As String) As String

'生成邮件标题访问作者BLOG: http://spaces.msn.com/members/headfaint

If Encoding.Default.GetByteCount(fn) > fn.Length Then

Return '=?' & Charset.ToUpper() & '?B?' & Base64.Encode(fn) + '?='

Else

Return fn

End If

End Function

Public Property Priority() As String

'设置邮件的优先级访问作者BLOG: http://spaces.msn.com/members/headfaint

Get

Return mPriority

End Get

Set(ByVal Value As String)

Select Case Value

Case '1', 'high'

mPriority = 'High'

Case '3', 'normal'

mPriority = 'Normal'

Case '5', 'low'

mPriority = 'Low'

End Select

End Set

End Property

Public Overrides Function ToString() As String

'重新编写ToString方法，用于输出整体的邮件格式文本。

'这是一个十分关键的函数访问作者BLOG: http://spaces.msn.com/members/headfaint

Dim SendBufferstr As String

Dim strItem As String

If Charset = '' Then

SendBufferstr = 'From:''' & FromName & ''' <' & From & '>' & vbNewLine

Else

SendBufferstr = 'From:''=?' & Charset.ToUpper() & '?B?' & Base64.Encode(FromName) & '?='' <' & From & '>' & vbNewLine

End If

If ReplyTo <> '' Then SendBufferstr += 'Reply-To: ' & ReplyTo & vbNewLine

If Recipient.Count > 0 Then

SendBufferstr += 'TO:'

For Each strItem In Recipient

SendBufferstr += strItem & '<' & strItem & '>,' & vbNewLine

SendBufferstr = SendBufferstr.Substring(0, SendBufferstr.Length - 3) & vbNewLine

End If

If RecipientCC.Count > 0 Then

SendBufferstr += 'CC:'

For Each strItem In RecipientCC

SendBufferstr += strItem & '<' & strItem & '>,' & vbNewLine

SendBufferstr = SendBufferstr.Substring(0, SendBufferstr.Length - 3) & vbNewLine

End If

If RecipientBCC.Count > 0 Then

SendBufferstr += 'BCC:'

For Each strItem In RecipientBCC

SendBufferstr += strItem & '<' & strItem & '>,' & vbNewLine

SendBufferstr = SendBufferstr.Substring(0, SendBufferstr.Length - 3) & vbNewLine

End If

If Charset = '' Then

SendBufferstr += 'Subject:' & Subject & vbNewLine

Else

SendBufferstr += 'Subject:' & '=?' & Charset.ToUpper() & '?B?' & Base64.Encode(Subject) & '?=' & vbNewLine

End If

SendBufferstr += 'X-Priority:' & Priority & vbNewLine

SendBufferstr += 'X-MSMail-Priority:' & Priority & vbNewLine

SendBufferstr += 'Importance:' & Priority & vbNewLine

SendBufferstr += 'X-Mailer: eWebMail' & vbNewLine

SendBufferstr += 'MIME-Version: 1.0' & vbNewLine

If Attachments.Count > 0 Then

SendBufferstr += 'Content-Type: multipart/related;' & vbNewLine & ' boundary=''' & boundary & ''';' & vbNewLine & ' type=''multipart/alternative''' & vbNewLine & vbNewLine

SendBufferstr += 'This is a multi-part message in MIME format.' & vbNewLine & vbNewLine

SendBufferstr += '--' & boundary & vbNewLine

End If

If isHtml Then

SendBufferstr += 'Content-Type: multipart/alternative;' & vbNewLine & ' boundary=''' & boundary1 & '''' & vbNewLine & vbNewLine & vbNewLine

SendBufferstr += 'This is a multi-part message in MIME format.' & vbNewLine & vbNewLine

SendBufferstr += '--' & boundary1 & vbNewLine

SendBufferstr += 'Content-Type: text/plain;' & vbNewLine

If Charset = '' Then

SendBufferstr += ' charset=''iso-8859-1''' & vbNewLine

Else

SendBufferstr += ' charset=''' & Charset.ToLower() & '''' & vbNewLine

End If

SendBufferstr += 'Content-Transfer-Encoding: base64' & vbNewLine & vbNewLine

SendBufferstr += Base64.strLine(Base64.Encode(TextBody)) & vbNewLine & vbNewLine & '--' & boundary1 & vbNewLine & 'Content-Type: text/html;' & vbNewLine

Else

SendBufferstr += 'Content-Type: text/plain;' & vbNewLine

End If

If Charset = '' Then

SendBufferstr += ' charset=''iso-8859-1''' & vbNewLine

Else

SendBufferstr += ' charset=''' & Charset.ToLower() & '''' & vbNewLine

End If

SendBufferstr += 'Content-Transfer-Encoding: base64' & vbNewLine & vbNewLine

SendBufferstr += Base64.strLine(Base64.Encode(Body)) & vbNewLine

If isHtml Then SendBufferstr += vbNewLine & '--' & boundary1 & '--' & vbNewLine

If Attachments.Count > 0 Then

SendBufferstr += vbNewLine & AttachmentsSB.ToString()

SendBufferstr += '--' & boundary & '--' & vbNewLine & vbNewLine

End If

Return SendBufferstr

End Function

End Class

Class Base64

'用BASE64编码访问作者BLOG: http://spaces.msn.com/members/headfaint

Public Shared Function Encode(ByVal str As String) As String

'将字符串编码访问作者BLOG: http://spaces.msn.com/members/headfaint

Return Convert.ToBase64String(Encoding.Default.GetBytes(str))

End Function

Public Shared Function Decode(ByVal str As String) As String

'将字符串解码访问作者BLOG: http://spaces.msn.com/members/headfaint

Return Encoding.Default.GetString(Convert.FromBase64String(str))

End Function

Public Shared Function strLine(ByVal str As String) As String

'将长的字符串内容按邮件格式进行BASE64编码访问作者BLOG: http://spaces.msn.com/members/headfaint

Dim B64sb As New StringBuilder

Dim sl As Integer = str.Length - 76

Dim i As Integer = 0

Do While i < sl

B64sb.Append(str.Substring(i, 76))

B64sb.Append(vbNewLine)

i += 76

Loop

B64sb.Append(str.Substring(i, str.Length - i))

Return B64sb.ToString()

End Function

End Class

Public Class SmtpMail

'用SMTP协议发送邮件访问作者BLOG: http://spaces.msn.com/members/headfaint

Public SmtpServer As String = ''

Public SmtpPort As Integer = 25

Public chkSmtp As Boolean = False

Public smtpUserName As String = ''

Public smtpPassWord As String = ''

Protected Shared ErrCodeHT As New Hashtable

Protected Shared RghCodeHT As New Hashtable

Public Function send(ByVal strMailTo As String, ByVal MailFrom As String, ByVal strMail As String) As Boolean

'发送邮件访问作者BLOG: http://spaces.msn.com/members/headfaint

Dim SendBuffer As New ArrayList

Dim SendBufferstr As String

For Each SendBufferstr In strMailTo.Split(',')

If Not SendBufferstr = '' Then SendBuffer.Add(SendBufferstr)

If SendBuffer.Count = 0 Then Return False

Return send(SendBuffer, MailFrom, strMail)

End Function

Public Function send(ByVal strMailTo As ArrayList, ByVal MailFrom As String, ByVal strMail As String) As Boolean

'发送邮件访问作者BLOG: http://spaces.msn.com/members/headfaint

If strMailTo.Count = 0 Then Return False

Dim tc As TcpClient

Try

tc = New TcpClient(SmtpServer, SmtpPort)

Catch ex As Exception

Return False

End Try

Dim ns As NetworkStream = tc.GetStream()

Try '与服务器建立链接访问作者BLOG: http://spaces.msn.com/members/headfaint

If RghCodeHT(RecvResponse(ns).Substring(0, 3)) = Nothing Then Return False

Catch ex As Exception

Return False

End Try

Dim SendBuffer As New ArrayList

Dim SendBufferstr As String

If chkSmtp Then '验证用户名密码访问作者BLOG: http://spaces.msn.com/members/headfaint

If Not SmtpAuth(ns) Then Return False

Else

SendBufferstr = 'HELO ' & SmtpServer & vbNewLine

If Not Dialog(SendBufferstr, ns) Then Return False

End If

SendBufferstr = 'MAIL FROM:<' & MailFrom & '>' & vbNewLine '发送'MAIL FROM' 访问作者BLOG: http://spaces.msn.com/members/headfaint

If Not Dialog(SendBufferstr, ns) Then Return False

SendBuffer.Clear()

For Each SendBufferstr In strMailTo '发送收件人地址访问作者BLOG: http://spaces.msn.com/members/headfaint

If Not SendBufferstr = '' Then SendBuffer.Add('RCPT TO:<' & SendBufferstr & '>' & vbNewLine)

If Not Dialog(SendBuffer, ns) Then Return False

SendBufferstr = 'DATA' & vbNewLine '发送正文和附件访问作者BLOG: http://spaces.msn.com/members/headfaint

If Not Dialog(SendBufferstr, ns) Then Return False

SendBufferstr = strMail & vbNewLine & '.' & vbNewLine

If Not Dialog(SendBufferstr, ns) Then Return False

SendBufferstr += 'QUIT' & vbNewLine '完成发送，断开连接访问作者BLOG: http://spaces.msn.com/members/headfaint

If Not SendCommand(SendBufferstr, ns) Then Return False

ns.Close()

tc.Close()

Return True

End Function

Public Function Send(ByVal eMail As Mail) As Boolean

'发送邮件访问作者BLOG: http://spaces.msn.com/members/headfaint

Dim SendBuffer As New ArrayList

Dim SendBufferstr As String

For Each SendBufferstr In eMail.Recipient

SendBuffer.Add(SendBufferstr)

For Each SendBufferstr In eMail.RecipientCC

SendBuffer.Add(SendBufferstr)

For Each SendBufferstr In eMail.RecipientBCC

SendBuffer.Add(SendBufferstr)

Return Send(SendBuffer, eMail.From, eMail.ToString())

End Function

Protected Function SendCommand(ByVal Command As String, ByRef ns As NetworkStream) As Boolean

'向SMTP服务器发送一行命令访问作者BLOG: http://spaces.msn.com/members/headfaint

Dim WriteBuffer() As Byte

If Command.Trim() = '' Then Return True

WriteBuffer = Encoding.Default.GetBytes(Command)

Try

ns.Write(WriteBuffer, 0, WriteBuffer.Length)

Catch ex As Exception

Return False

End Try

Return True

End Function

Protected Function Dialog(ByVal Command As String, ByRef ns As NetworkStream) As Boolean

'向SMTP服务器发送一行命令，并等待服务器回应访问作者BLOG: http://spaces.msn.com/members/headfaint

If Command.Trim() = '' Then Return True

If SendCommand(Command, ns) Then

Dim RR As String = RecvResponse(ns)

If RR = 'false' Then Return False

Try

Dim RRCode As String = RR.Substring(0, 3)

If RghCodeHT(RRCode) <> Nothing Then Return True

Catch ex As Exception

Return False

End Try

Return False

Else

Return False

End If

End Function

Protected Function Dialog(ByVal Command As ArrayList, ByRef ns As NetworkStream) As Boolean

'向SMTP服务器发送一行命令,关等待服务器回应访问作者BLOG: http://spaces.msn.com/members/headfaint

Dim strCmd As String

For Each strCmd In Command

If Not Dialog(strCmd, ns) Then Return False

Return True

End Function

Protected Function SmtpAuth(ByRef ns As NetworkStream) As Boolean

'向服务器发送用户名密码验证信息访问作者BLOG: http://spaces.msn.com/members/headfaint

Dim SendBuffer As New ArrayList

Dim SendBufferstr As String

SendBufferstr = 'EHLO ' & SmtpServer & vbNewLine '发送EHLO命令访问作者BLOG: http://spaces.msn.com/members/headfaint

If SendCommand(SendBufferstr, ns) Then

Dim i As Integer = 0

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

Loop

Else

Return False

End If

SendBuffer.Add('AUTH LOGIN' & vbNewLine) '发送用户名密码访问作者BLOG: http://spaces.msn.com/members/headfaint

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服务器接收一个回应访问作者BLOG: http://spaces.msn.com/members/headfaint

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反回信息的对照哈希表访问作者BLOG: http://spaces.msn.com/members/headfaint

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