Option Strict On Option Explicit On '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' SMTP - Copyright 2011 © by David Ross Goben. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Imports System.Net, VB = Microsoft.VisualBasic '------------------------------------------------------------------------------- ' Class Name : SMTP ' Purpose : SMTP Interface Class '------------------------------------------------------------------------------- Public Class SMTP '******************************************************************************* ' Function Name : BrainDeadSimpleEmailSend ' Purpose : Send super simple email message (works with most SMTP servers) '=============================================================================== 'NOTES: strFrom : Full email address of who is sending the email. ie, David Dingus ' strTo : Full email address of who to send the email to. ie, "Bubba Dingus" ' strSubject: Brief text regarding what the email concerns. ' strBody : text that comprises the message body of the email. ' smtpHost : This is the email host you are using for sending emails, such ' : as "smtp.comcast.net", "authsmtp.juno.com", etc. '******************************************************************************* Public Shared Sub BrainDeadSimpleEmailSend(ByVal strFrom As String, _ ByVal strTo As String, _ ByVal strSubject As String, _ ByVal strBody As String, _ ByVal smtpHost As String) Dim smtpEmail As New Mail.SmtpClient(smtpHost) 'create new SMTP client using TCP Port 25 smtpEmail.Send(strFrom, strTo, strSubject, strBody) 'send email End Sub '******************************************************************************* ' Function Name : QuickiEMail ' Purpose : Send a simple email message (but packed with a lot of muscle) '=============================================================================== 'NOTES: strFrom : Full email address of who is sending the email. ie, David Dingus ' strTo : Full email address of who to send the email to. ie, "Bubba Dingus" ' strSubject: Brief text regarding what the email concerns. ' strBody : text that comprises the message body of the email. ' smtpHost : This is the email host you are using for sending emails, such ' : as "smtp.gmail.com", "smtp.comcast.net", "authsmtp.juno.com", etc. ' smtpPort : TCP Communications Port to use. Most servers default to 25. ' usesSLL : If this value is TRUE, then use SSL Authentication protocol for secure communications. ' SSLUsername: If usesSLL is True, this is the username to use for creating a credential. Leave blank if the same as strFrom. ' SSLPassword: If usesSLL is True, this is the password to use for creating a credential. If this field and SSLUsername ' : are blank, then default credentials will be used (only works on local, intranet servers). ' SSLDomain : If creating a credential when a specific domain is required, set this parameter, otherwise, leave it blank. '******************************************************************************* Public Shared Function QuickiEMail(ByVal strFrom As String, _ ByVal strTo As String, _ ByVal strSubject As String, _ ByVal strBody As String, _ ByVal smtpHost As String, _ Optional ByVal smtpPort As Integer = 25, _ Optional ByVal usesSSL As Boolean = False, _ Optional ByVal SSLUsername As String = vbNullString, _ Optional ByVal SSLPassword As String = vbNullString, _ Optional ByVal SSLDomain As String = vbNullString) As Boolean Try Dim smtpEmail As New Mail.SmtpClient(smtpHost, smtpPort) 'create new SMTP client smtpEmail.EnableSsl = usesSSL 'true if SSL Authentication required If usesSSL Then 'SSL authentication required? If Len(SSLUsername) = 0 AndAlso Len(SSLPassword) = 0 Then 'if both SSLUsername and SSLPassword are blank... smtpEmail.UseDefaultCredentials = True 'use default credentials Else 'otherwise, we must create a new credential If Not CBool(Len(SSLUsername)) Then 'if SSLUsername is blank, use strFrom smtpEmail.Credentials = New NetworkCredential(strFrom, SSLPassword, SSLDomain) Else smtpEmail.Credentials = New NetworkCredential(SSLUsername, SSLPassword, SSLDomain) End If End If End If smtpEmail.Send(strFrom, strTo, strSubject, strBody) 'send email using text/plain content type and QuotedPrintable encoding Catch e As Exception 'if error, report it MsgBox(e.Message, MsgBoxStyle.OkOnly Or MsgBoxStyle.Exclamation, "Mail Send Error") Return False 'return a failure flag End Try Return True 'if no error, then return a success flag End Function '******************************************************************************* ' Function Name : SendEMail ' Purpose : Send a more complex email message '=============================================================================== 'NOTES: strFrom : Full email address of who is sending the email. ie, David Dingus ' strTo : Full email address of who to send the email to. ie, "Bubba Dingus" ' : If multiple recipients, separate each full email address using a semicolon (;) ' strSubject: Brief text regarding what the email concerns. ' strBody : text that comprises the message body of the email. May be raw text or HTML code. ' IsHTML : True if the strBody data is HTML, or the type of data that would be contained within an HTML Body block. ' smtpHost : This is the email host you are using for sending emails, such ' : as "smtp.gmail.com", "smtp.comcast.net", "authsmtp.juno.com", etc. ' AltView : A System.Net.Mail.AlternateView object, such as Rich Text or HTML. ' : If need be, set AltView.ContentType.MediaType and AltView.TransferEncoding to properly format the AlternateView. ' : For example: AltView.ContentType.MediaType = Mime.MediaTypeNames.Text.Rtf ' : AltView.TransferEncoding = Mime.TransferEncoding.SevenBit ' StrCC : Send "carbon copies" of email to this or these recipients. ' : If multiple recipients, separate each full email address using a semicolon (;) ' strBcc : Blind Carbon Copy. Hide this or these recipients from view by others. ' : If multiple recipients, separate each full email address using a semicolon (;) ' strAttachments: A single filepath, or a list of filepaths to send to the recipient. ' : If multiple attachments, separate each filepath using a semicolon (;) (C:\my data\win32.txt; c:\jokes.rtf) ' : The contents of the attachments will be encoded and sent. ' : If you wish to send the attachment by specifying content type (MediaType) and content transfer encoding ' : (Encoding), then follow the attachment name with the MediaType and optional encoding (default is ' : application/octet-stream,Base64) by placing them within parentheses, and separated by a comma. For example: ' : C:\My Files\API32.txt (text/plain, SevenBit); C:\telnet.exe (application/octet-stream, Base64) ' : Where: The MediaType is determined from the System.Net.Mime.MediaTypeNames class, which ' : can specify Application, Image, or Text lists. For example, the above content type, ' : "text\plain", was defined by acquiring System.Net.Mime.MediaTypeNames.Text.Plain. ' : The second parameter, Encoding, is determined by the following the values specified by the ' : System.Net.Mime.TrasperEncoding enumeration: ' : QuotedPrintable (acquired by System.Net.Mime.TransferEncoding.QuotedPrintable.ToString) ' : Base64 (acquired by System.Net.Mime.TransferEncoding.Base64.ToString) ' : SevenBit (acquired by System.Net.Mime.TransferEncoding.SevenBit.ToString) ' smtpPort : TCP Communications Port to use. Most servers default to 25. ' usesSLL : If this value is TRUE, then use SSL Authentication protocol for secure communications. ' SSLUsername: If usesSLL is True, this is the username to use for creating a credential. Leave blank if the same as strFrom. ' SSLPassword: If usesSLL is True, this is the password to use for creating a credential. If this field and SSLUsername ' : are blank, then default credentials will be used (only works on local, intranet servers). ' SSLDomain : If creating a credential when a specific domain is required, set this parameter, otherwise, leave it blank. '******************************************************************************* Public Shared Function SendEMail(ByVal strFrom As String, _ ByVal strTo As String, _ ByVal strSubject As String, _ ByVal strBody As String, _ ByVal IsHTML As Boolean, _ ByVal smtpHost As String, _ Optional ByVal AltView As Mail.AlternateView = Nothing, _ Optional ByVal strCC As String = vbNullString, _ Optional ByVal strBcc As String = vbNullString, _ Optional ByVal strAttachments As String = vbNullString, _ Optional ByVal smtpPort As Integer = 25, _ Optional ByVal usesSSL As Boolean = False, _ Optional ByVal SSLUsername As String = vbNullString, _ Optional ByVal SSLPassword As String = vbNullString, _ Optional ByVal SSLDomain As String = vbNullString) As Boolean Dim Email As New Mail.MailMessage 'create a new mail message With Email .From = New Mail.MailAddress(strFrom) 'add FROM to mail message (must be a Mail Address object) '------------------------------------------- Dim Ary() As String = Split(strTo, ";") 'add TO to mail message (possible list of email addresses; separated each with ";") For Idx As Integer = 0 To UBound(Ary) If Len(Trim(Ary(Idx))) <> 0 Then .To.Add(Trim(Ary(Idx))) 'add each TO recipent (primary recipients) Next '------------------------------------------- .Subject = strSubject 'add SUBJECT text line to mail message '------------------------------------------- .Body = strBody 'add BODY text of email to mail message. .IsBodyHtml = IsHTML 'indicate if the message body is actually HTML text. .IsBodyHtml = True '------------------------------------------- If AltView IsNot Nothing Then 'if an alternate view of plaint text message is defined... .AlternateViews.Add(AltView) 'add the alternate view End If '------------------------------------------- If CBool(Len(strCC)) Then 'add CC (Carbon Copy) email addresses to mail message Ary = Split(strCC, ";") '(possible list of email addresses, separated each with ";") For Idx As Integer = 0 To UBound(Ary) If Len(Trim(Ary(Idx))) <> 0 Then .CC.Add(Trim(Ary(Idx))) 'add each recipent Next End If '------------------------------------------- If CBool(Len(strBcc)) Then 'add Bcc (Blind Carbon Copy) email addresses to mail message Ary = Split(strBcc, ";") '(possible list of email addresses; separated each with ";") For Idx As Integer = 0 To UBound(Ary) If Len(Trim(Ary(Idx))) <> 0 Then .Bcc.Add(Trim(Ary(Idx))) 'add each recipent (hidden recipents) Next End If '------------------------------------------- If CBool(Len(strAttachments)) Then 'add any attachments to mail message Ary = Split(strAttachments, ";") '(possible list of file paths, separated each with ";") For Idx As Integer = 0 To UBound(Ary) 'process each attachment Dim attach As String = Trim(Ary(Idx)) 'get attachment data If Len(attach) <> 0 Then 'if an attachment present... Dim I As Integer = InStr(attach, "(") 'check for formatting instructions If CBool(I) Then 'formatting present? Dim Fmt As String 'yes, so set up format cache Fmt = Mid(attach, I + 1, Len(attach) - I - 1) 'get format data attach = Trim(VB.Left(attach, I - 1)) 'strip format data from the attachment path Dim Atch As New Mail.Attachment(attach) 'create a new attachment Dim fmts() As String = Split(Fmt, ",") 'break formatting up For I = 0 To UBound(fmts) 'process each format specification Fmt = Trim(fmts(I)) 'grab a format instruction If CBool(Len(Fmt)) Then 'data defined? Select Case I 'yes, so determine which type of instruction to process Case 0 'index 0 specified MediaType Atch.ContentType.MediaType = Fmt 'set media type to attachment Case 1 'index 1 specifes Encoding Select Case LCase(Fmt) 'check the encoding types and process accordingly Case "quotedprintable", "quoted-printable" Atch.TransferEncoding = Mime.TransferEncoding.QuotedPrintable Case "sevenbit", "7bit" Atch.TransferEncoding = Mime.TransferEncoding.SevenBit Case Else Atch.TransferEncoding = Mime.TransferEncoding.Base64 End Select End Select End If Next .Attachments.Add(Atch) 'add attachment to email Else .Attachments.Add(New Mail.Attachment(attach)) 'add filepath (if no format specified, encoded in effiecient Base64) End If End If Next End If End With '----------------------------------------------------------------------- 'now open the email server... Try Dim SmtpEmail As New Mail.SmtpClient(smtpHost, smtpPort) 'create new SMTP client on the SMTP server SmtpEmail.EnableSsl = usesSSL 'true if SSL Authentication required If usesSSL Then 'SSL authentication required? If Len(SSLUsername) = 0 AndAlso Len(SSLPassword) = 0 Then 'if both SSLUsername and SSLPassword are blank... SmtpEmail.UseDefaultCredentials = True 'use default credentials Else 'otherwise, we must create a new credential If Not CBool(Len(SSLUsername)) Then 'if SSLUsername is blank, use strFrom SmtpEmail.Credentials = New NetworkCredential(strFrom, SSLPassword, SSLDomain) Else SmtpEmail.Credentials = New NetworkCredential(SSLUsername, SSLPassword, SSLDomain) End If End If End If SmtpEmail.Send(Email) 'finally, send the email... Catch e As Exception 'if error, report it MsgBox(e.Message, MsgBoxStyle.OkOnly Or MsgBoxStyle.Exclamation, "Mail Error") Return False 'return failure flag End Try Return True 'return success flag End Function End Class