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