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

类别:.NET开发 点击:0 评论:0 推荐:

可以生成邮件,可以发送邮件,稍做修改就可以写成一个com组件,在ASP里调用.
以后我会整理成一个完整的.

'-------------------------------------------------
'生成基本邮件格式(包括附件),发送邮件到SMTP服务器,
'只能发送到发件人SMTP服务器(需验证),直接投递功能正在编写。
'
'声明:本段代码中,有一部份借签了网上一位大侠的C#代码.由于找不到原文,无法写出原作者名字
'
'代码编写:头太晕
'QQ:2538288
'MSN:[email protected]
'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
            Next
        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
                Next
                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
                Next
                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
                Next
                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)
            Next
            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)
            Next
            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)
            Next
            For Each SendBufferstr In eMail.RecipientCC
                SendBuffer.Add(SendBufferstr)
            Next
            For Each SendBufferstr In eMail.RecipientBCC
                SendBuffer.Add(SendBufferstr)
            Next
            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
            Next
            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
                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) '发送用户名密码 访问作者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

本文地址:http://com.8s8s.com/it/it41510.htm