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 <daviddingus@att.net>
    '       strTo     : Full email address of who to send the email to. ie, "Bubba Dingus" <bob.dingus@cox.com>
    '       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 <daviddingus@att.net>
    '       strTo     : Full email address of who to send the email to. ie, "Bubba Dingus" <bob.dingus@cox.com>
    '       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 <daviddingus@att.net>
    '       strTo     : Full email address of who to send the email to. ie, "Bubba Dingus" <bob.dingus@cox.com>
    '                 : 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
