可以生成邮件,可以发送邮件,稍做修改就可以写成一个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 
|