Option Strict On
Option Explicit On
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Utilities - Copyright 2011 © by David Ross Goben.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Imports System.Text, VB = Microsoft.VisualBasic

Public Class Utilities

    '*******************************************************************************
    ' Function Name : DecodeBase64ToStr
    ' Purpose       : Decode a provided raw email message string that is encoded to Base64.
    '               :
    ' Returns       : Decoded String
    '               : 
    ' NOTES         : note that the lone vbCrLf at the end of lines is filtered out.
    '*******************************************************************************
    Public Shared Function DecodeBase64ToStr(ByVal strData As String) As String
        Return Encoding.UTF8.GetChars(DecodeBase64ToBytes(strData))
    End Function

    '*******************************************************************************
    ' Function Name : DecodeBase64ToBytes
    ' Purpose       : Decode a provided raw email message string that is encoded to Base64.
    '               :
    ' Returns       : Decoded binary Byte Array
    '               : 
    ' NOTES         : note that the lone vbCrLf at the end of lines is filtered out.
    '*******************************************************************************
    'this modification returns a Byte Array of the Base64 encoded source data
    Public Shared Function DecodeBase64ToBytes(ByVal strData As String) As Byte()
        Return System.Convert.FromBase64String(strData.Replace(vbCrLf, vbNullString))
    End Function

    '==========================================================================
    '==========================================================================

    '*******************************************************************************
    ' Function Name : DecodeQuotedPrintable
    ' Purpose       : Method to clean typical control translations, or all of them.
    '               : This should be invoked for all data coded Quoted-Printable.
    '               :
    ' Returns       : Provided a raw message string block, it returns a decoded string.
    '               : 
    ' NOTES         : Typical cleaning involves changing "=0D" to vbCr, "=0A" to vbLf,
    '               : "=20" to a space, and "=3D" to "=", plus any line wrap
    '               : terminators at the end of lines to vbNullstring.
    '               :
    '               : A StringBuilder object will be used, which will very quickly 
    '               : do a replacement of all control code translations using fewer
    '               : resources, and what resources that are used will be instantly
    '               : flushed when the method exits.
    '*******************************************************************************
    Public Shared Function DecodeQuotedPrintable(ByVal Message As String, Optional ByVal QuickClean As Boolean = False) As String
        'set up StringBuilder object with data stripped of any line continuation tags
        Dim Msg As New StringBuilder(Message.Replace("=" & vbCrLf, vbNullString))

        If QuickClean Then                                                  'perform a quick clean (clean up common basics)
            Return Msg.Replace("=" & vbCrLf, vbNullString).Replace("=0D", vbCr).Replace("=0A", _
                                   vbLf).Replace("=20", " ").Replace("=3D", "=").ToString
        Else                                                                'perform total cleaning
            'store 2-character hex values that require a leading "0"
            Dim HxData As String = "X0102030405060708090A0B0C0D0E0F"
            For Idx As Integer = 1 To &HF                                   'initially process codes 1-15, which require a leading zero
                Msg.Replace("=" & Mid(HxData, Idx << 1, 2), Chr(Idx))       'replace hex data with single character code (SHIFT is faster)
            Next
            For idx As Integer = &H10 To &HFF                               'process the whole 8-bit extended ASCII gambit
                Msg.Replace("=" & Hex(idx), Chr(idx))                       'replace hex data with single character code
            Next
            Return Msg.ToString                                             'return result string
        End If
    End Function

    '==========================================================================
    '==========================================================================

    '*******************************************************************************
    ' Function Name : DecodeBinHex
    ' Purpose       : Decode a provided raw email message string that is encoded to BinHex.
    '               :
    ' Returns       : Decoded String
    '               : 
    ' NOTES         : note that the lone vbCrLf at the end of lines is filtered out.
    '*******************************************************************************
    Public Shared Function DecodeBinHex(ByVal StrData As String) As Byte()
        Dim Src() As Byte = Encoding.UTF8.GetBytes(StrData.Replace(vbCrLf, vbNullString).ToUpper)
        Dim Result() As Byte                            'init output buffer
        ReDim Result(UBound(Src) \ 2)                   'set initial dimension to 1024 bytes (includes offset 0)
        Dim Index As Integer = 0                        'init index for Result() array

        For Idx As Integer = 0 To UBound(Src) Step 2    'scan the string, 2 hex characters at a time
            Dim CL As Integer = Src(Idx) - 48           'Convert "0" - "F" to 0-F
            If CL > 10 Then CL -= 7
            Dim CR As Integer = Src(Idx + 1) - 48       'do the same for the right hex digit
            If CR > 10 Then CR -= 7
            If Index > UBound(Result) Then
                ReDim Preserve Result(Index + 255)      'bump by 256 (allow for Index offset)
            End If
            Result(Index) = CByte(CL * 16 + CR)         'stuff byte value
            Index += 1                                  'bump index
        Next
        ReDim Preserve Result(Index - 1)                'set array to final size
        Return Result                                   'return the final result
    End Function

    '==========================================================================
    '==========================================================================

    '*******************************************************************************
    ' Function Name : TextNeedsEncoding
    ' Purpose       : Determine if HTML text, Rich Text, or Plain Text requires
    '               : 8-bit code translation to 7-bit Quoted-Printable tags.
    '               :
    ' Returns       : Provided a source string, it returns a boolena flag.
    '               : If the returned value is true, the source contains 8-bit data
    '               : and will be encoded by server.
    '               :
    ' NOTES         : If text data contains 8-bit values, the default .NET
    '               : SMTP processor will force this code to be encoded to Base64,
    '               : even if only a single byte is 8-bit.
    '               :
    '               : To avoid this, the Force7BitHtml() method can be invoked on
    '               : HTML text to ensure that it is 7-bit encoded so that it can
    '               : be processed as Quoted-Printable or as 7Bit. The ForceQuotedPrintable()
    '               : method performs essential conversions for non-HTML text, but this
    '               : would be best served in Attachments and Alternate Views.
    '*******************************************************************************
    Public Shared Function TextNeedsEncoding(ByVal Message As String) As Boolean
        Dim Byt() As Byte = Encoding.UTF8.GetBytes(Message) 'convert message to byte array
        For Each B As Byte In Byt
            If CBool(B And &H80) Then Return True
        Next
        Return False
    End Function

    '==========================================================================
    '==========================================================================

    '*******************************************************************************
    ' Function Name : Force7BitHtml
    ' Purpose       : Method to convert 8-bit code in an HTML message to 7-bit.
    '               :
    ' Returns       : Provided a string containing HTML code, it will return a string
    '               : containing HTML code that does not have any 8-bit data embedded.
    '               :
    ' NOTES         : If any characters in an HTML text string are 8-bit (values
    '               : greater than 127), then they are converted into a special
    '               : 7-bit HTML Entity Number, For Example, code 149 (•) is an 8-bit
    '               : value that can be changed to HTML "&#149;", which will ensure
    '               : that it will still be displayed on the HTML page, but the HTML
    '               : souce code will no longer carry an actual 8-bit value. If such
    '               : code had not been corrected, the encoding of the data would be
    '               : forced to change from quoted-printable to Base64, because that
    '               : would be the only way the email processor could guarantee that
    '               : the email text was fully intact.
    '*******************************************************************************
    Public Shared Function Force7BitHtml(ByVal HtmlSource As String) As String
        Dim Sb As New StringBuilder                             'set up string builder for appending data
        For Idx As Integer = 1 To Len(HtmlSource)
            Dim C As Integer = AscW(Mid(HtmlSource, Idx, 1))    'get a single character from the source
            Select Case C                                       'check each character
                Case Is > &H7F, Is < 0                          'if 8-bit or unicode code
                    Sb.Append("&#" & C.ToString & ";")          'convert to 7-bit HTML ecoder
                Case Else
                    Sb.Append(ChrW(C))                          'else save text regardless
            End Select
        Next
        Return Sb.ToString
    End Function

    '==========================================================================
    '==========================================================================

    '*******************************************************************************
    ' Function Name : ForceQuotedPrintable
    ' Purpose       : Force 8-bit code in a text message to 7-bit, without data loss.
    '               :
    ' Returns       : Provided a source string that contains 8-bit data, the 8-bit
    '               : data is converted to Hex-Tags, and the returned string is 7-bit.
    '               :
    ' NOTES         : if any characters in a text string are 8-bit (values greater
    '               : than 127), then they are converted into special 7-bit tags.
    '               : For Example, code 149 (•) is an 8-bit value that can be changed
    '               : to hex "=95", which will ensure that it will still be displayed
    '               : in the text, but the text data will no longer carry an actual
    '               : of the data would be forced to change from quoted-printable or 7bit
    '               : to Base64, because that would be the only way the email processor
    '               : Base64, because that would be the only way the email processor
    '               : could guarantee that the email text was fully intact. However,
    '               : you will have to use the DecodeQuotedPrintable() method to convert
    '               : it back to its original text form.
    '               :
    '               : The Encoded text will begin with "=00". Because unencoded null codes
    '               : are not permitted in email data, you can use this to instantly
    '               : determine on the receiving end that this code will need to be
    '               : processed by DecodeQuotedPrintable() a second time (if initially
    '               : encoded as Quoted-Printable). A second pass would be required,
    '               : because if this translated code was afterward encoded as Quoted-
    '               : Printable, and all the "=xx" byte-translations, would be
    '               : reinterpreted as "=3Dxx", which DecodeQuotedPrintable() would
    '               : convert back to "=xx", so passing through a second time would
    '               : properly convert the additional encoding. Further, by checking the
    '               : text startiing with "=00", you would know that you would need to
    '               : double-decode the text. Also, you would want to initially skip this
    '               : initial tag when passing it the second time to DecodeQuotedPrintable():
    '               :
    '               : Dim Result As String = DecodeQuotedPrintable(Message)   'initially decode Quoted-Printable text
    '               : If VB.Left(Result, 3) = "=00" Then                      'tagged as pre-encoded?
    '               :     Return DecodeQuotedPrintable(Mid(Result, 4))        'yes, so decode again and return, less initial null byte
    '               : Else
    '               :     Return Result                                       'otherwise, return result of decoding
    '               : End If
    '*******************************************************************************
    Public Shared Function ForceQuotedPrintable(ByVal Message As String) As String
        Dim Byt() As Byte = Encoding.UTF8.GetBytes(Message)    'convert message to byte array
        Dim Sb As New StringBuilder("=00")                     'set up string builder for appending data
        For Each B As Byte In Byt
            Select Case B                                      'check each byte
                Case Is > &H7F                                 'if 8-bit code
                    Sb.Append("=" & Hex(B))                    'convert to 7-bit tag
                Case Else
                    Sb.Append(Chr(B))                          'else save text regardless
            End Select
        Next
        Return Sb.ToString
    End Function

    '==========================================================================
    '==========================================================================

    '*******************************************************************************
    ' Function Name : QConvertHTML2Text
    ' Purpose       : Short-Form Convert HTML formatted text to plain text
    '               :
    ' Returns       : Provided a simple HTML source string, it will return a Plain Text
    '               : string with HTML code  removed.
    '*******************************************************************************
    Public Shared Function QConvertHTML2Text(ByVal HTMLText As String) As String
        Return RegularExpressions.Regex.Replace(HTMLText.Replace("&nbsp;", " ").Replace("&quot;", """").Replace("&apos;", _
                "'"), "<[^>]*>", "").Replace("&lt;", "<").Replace("&gt;", ">").Replace("&amp;", "&").Replace(";;", ";")
    End Function

    '==========================================================================
    '==========================================================================

    '*******************************************************************************
    ' Function Name : ConvertHTML2Text
    ' Purpose       : Convert HTML formatted text to plain text
    '               :
    ' Returns       : Provided a complex HTML string, it will return a Plain Text string
    '               : with all HTML codes and formatting removed from it.
    '               :
    ' NOTE          : Numerous of these conversions will convert the text to 8-bit,
    '               : though most of these sysmbols will not be encountered in most
    '               : HTML documents we produce. But regardless of that, if you wish
    '               : to make this conversion the main body message of an email, you
    '               : may have to further convert this using ForceQuotedPrintable()
    '               : to maintain Quoted-Printable encoding and avoid Base64, even
    '               : though this is typically not an issue. However, some few really
    '               : primitive email readers, typically those that simply allow you
    '               : to preview email messages, without fully loading them, will not
    '               ' know how to support Base64, or will not bother with it, but simply
    '               : display the raw data. RFC 2045 requires email handlers to support it.
    '*******************************************************************************
    Public Shared Function ConvertHTML2Text(ByVal HTMLText As String) As String
        'instantiate an initially blank StringBuilder object
        Dim Sb As New StringBuilder()

        'first remove leading whitespace of each line and append the result to the StringBuilder
        Dim ary() As String = Split(HTMLText, vbCrLf)
        For Each S As String In ary
            Sb.Append(S.TrimStart(Chr(9), " "c))
        Next

        'replace reserved entities (except <, >, and &)
        Sb.Replace("&quot;", """").Replace("&apos;", "'").Replace("&nbsp;", " ")

        'replace HTML paragraph, line breaks, and table entry terminators with vbCrLf
        Sb.Replace("<p>", vbCrLf).Replace("<P>", vbCrLf).Replace("</p>", vbCrLf).Replace("</P>", vbCrLf).Replace("<br>", _
                          vbCrLf).Replace("<BR>", vbCrLf).Replace("</td>", vbCrLf).Replace("</TD>", vbCrLf)

        'replace ISO 8859-1 Symbols (160-255). Note that any matches will make the text 8-bit
        Sb.Replace("&iexcl;", "¡").Replace("&cent;", "¢").Replace("&pound;", "£").Replace("&curren;", _
                             "¤").Replace("&yen;", "¥").Replace("&brvbar;", "¦").Replace("&sect;", "§").Replace("&uml;", _
                             "¨").Replace("&copy;", "©").Replace("&ordf;", "ª").Replace("&laquo;", "«").Replace("&not;", _
                             "¬").Replace("&shy;", "-").Replace("&reg;", "®").Replace("&macr;", "¯").Replace("&deg;", _
                             "°").Replace("&plusmn;", "±").Replace("&sup2;", "²").Replace("&sup3;", "³").Replace("&acute;", _
                             "´").Replace("&micro;", "µ").Replace("&para;", "¶").Replace("&middot;", "•").Replace("&cedil;", _
                             "¸").Replace("&sup1;", "¹").Replace("&ordm;", "º").Replace("&raquo;", "»").Replace("&frac14;", _
                             "¼").Replace("&frac12;", "½").Replace("&frac34;", "¾").Replace("&iquest;", "¿").Replace("&times;", _
                             "×").Replace("&divide;", "÷")

        'replace ISO 8859-1 characters. Note that any matches will make the text 8-bit
        Sb.Replace("&Agrave;", "À").Replace("&Aacute;", "Á").Replace("&Acirc;", "Â").Replace("&Atilde;", "Ã").Replace("&Auml;", _
                               "Ä").Replace("&Aring;", "Å").Replace("&AElig;", "Æ").Replace("&Ccedil;", "Ç").Replace("&Egrave;", _
                               "È").Replace("&Eacute;", "É").Replace("&Ecirc;", "Ê").Replace("&Euml;", "Ë").Replace("&Igrave;", _
                               "Ì").Replace("&Iacute;", "Í").Replace("&Icirc;", "Î").Replace("&Iuml;", "Ï").Replace("&ETH;", _
                               "Ð").Replace("&Ntilde;", "Ñ").Replace("&Ograve;", "Ò").Replace("&Oacute;", "Ó").Replace("&Ocirc;", _
                               "Ô").Replace("&Otilde;", "Õ").Replace("&Ouml;", "Ö").Replace("&Oslash;", "Ø").Replace("&Ugrave;", _
                               "Ù").Replace("&Uacute;", "Ú").Replace("&Ucirc;", "Û").Replace("&Uuml;", "Ü").Replace("&Yacute;", _
                               "Ý").Replace("&THORN;", "Þ").Replace("&szlig;", "ß").Replace("&agrave;", "à").Replace("&aacute;", _
                               "á").Replace("&acirc;", "â").Replace("&atilde;", "ã").Replace("&auml;", "ä").Replace("&aring;", _
                               "å").Replace("&aelig;", "æ").Replace("&ccedil;", "ç").Replace("&egrave;", "è").Replace("&eacute;", _
                               "é").Replace("&ecirc;", "ê").Replace("&euml;", "ë").Replace("&igrave;", "ì").Replace("&iacute;", _
                               "í").Replace("&icirc;", "î").Replace("&iuml;", "ï").Replace("&eth;", "ð").Replace("&ntilde;", _
                               "ñ").Replace("&ograve;", "ò").Replace("&oacute;", "ó").Replace("&ocirc;", "ô").Replace("&otilde;", _
                               "õ").Replace("&ouml;", "ö").Replace("&oslash;", "ø").Replace("&ugrave;", "ù").Replace("&uacute;", _
                               "ú").Replace("&ucirc;", "û").Replace("&uuml;", "ü").Replace("&yacute;", "ý").Replace("&thorn;", _
                               "þ").Replace("&yuml;", "ÿ")

        'replace Math Symbols Supported by HTML. Note that any matches will make the text 8-bit
        Sb.Replace("&forall;", "∀").Replace("&part;", "∂").Replace("&exist;", "∃").Replace("&empty;", "∅").Replace("&nabla;", _
                               "∇").Replace("&isin;", "∈").Replace("&notin;", "∉").Replace("&ni;", "∋").Replace("&prod;", _
                               "∏").Replace("&sum;", "∑").Replace("&minus;", "−").Replace("&lowast;", "∗").Replace("&radic;", _
                               "√").Replace("&prop;", "∝").Replace("&infin;", "∞").Replace("&ang;", "∠").Replace("&and;", _
                               "∧").Replace("&or;", "∨").Replace("&cap;", "∩").Replace("&cup;", "∪").Replace("&int;", _
                               "∫").Replace("&there4;", "∴").Replace("&sim;", "∼").Replace("&cong;", "≅").Replace("&asymp;", _
                               "≈").Replace("&ne;", "≠").Replace("&equiv;", "≡").Replace("&le;", "≤").Replace("&ge;", _
                               "≥").Replace("&sub;", "⊂").Replace("&sup;", "⊃").Replace("&nsub;", "⊄").Replace("&sube;", _
                               "⊆").Replace("&supe;", "⊇").Replace("&oplus;", "⊕").Replace("&otimes;", "⊗").Replace("&perp;", _
                               "⊥").Replace("&sdot;", "⋅")

        'replace Greek Letters Supported by HTML. Note that any matches will make the text 8-bit
        Sb.Replace("&Alpha;", "Α").Replace("&Beta;", "Β").Replace("&Gamma;", "Γ").Replace("&Delta;", "Δ").Replace("&Epsilon;", _
                              "Ε").Replace("&Zeta;", "Ζ").Replace("&Eta;", "Η").Replace("&Theta;", "Θ").Replace("&Iota;", _
                              "Ι").Replace("&Kappa;", "Κ").Replace("&Lambda;", "Λ").Replace("&Mu;", "Μ").Replace("&Nu;", _
                              "Ν").Replace("&Xi;", "Ξ").Replace("&Omicron;", "Ο").Replace("&Pi;", "Π").Replace("&Rho;", _
                              "Ρ").Replace("&Sigma;", "Σ").Replace("&Tau;", "Τ").Replace("&Upsilon;", "Υ").Replace("&Phi;", _
                              "Φ").Replace("&Chi;", "Χ").Replace("&Psi;", "Ψ").Replace("&Omega;", "Ω").Replace("&alpha;", _
                              "α").Replace("&beta;", "β").Replace("&gamma;", "γ").Replace("&delta;", "δ").Replace("&epsilon;", _
                              "ε").Replace("&zeta;", "ζ").Replace("&eta;", "η").Replace("&theta;", "θ").Replace("&iota;", _
                              "ι").Replace("&kappa;", "κ").Replace("&lambda;", "λ").Replace("&mu;", "μ").Replace("&nu;", _
                              "ν").Replace("&xi;", "ξ").Replace("&omicron;", "ο").Replace("&pi;", "π").Replace("&rho;", _
                              "ρ").Replace("&sigmaf;", "ς").Replace("&sigma;", "σ").Replace("&tau;", "τ").Replace("&upsilon;", _
                              "υ").Replace("&phi;", "φ").Replace("&chi;", "χ").Replace("&psi;", "ψ").Replace("&omega;", _
                              "ω").Replace("&thetasym;", "ϑ").Replace("&upsih;", "ϒ").Replace("&piv;", "ϖ")

        'replace Other Entities Supported by HTML. Note that any matches will make the text 8-bit
        Sb.Replace("&OElig;", "Œ").Replace("&oelig;", "œ").Replace("&Scaron;", "Š").Replace("&scaron;", "š").Replace("&Yuml;", _
                              "Ÿ").Replace("&fnof;", "ƒ").Replace("&circ;", "ˆ").Replace("&tilde;", "˜").Replace("&ensp;", _
                              " ").Replace("&emsp;", " ").Replace("&thinsp;", " ").Replace("&ndash;", "–").Replace("&mdash;", _
                              "—").Replace("&lsquo;", "‘").Replace("&rsquo;", "’").Replace("&sbquo;", "‚").Replace("&ldquo;", _
                              " ").Replace("&rdquo;", " ").Replace("&bdquo;", "„").Replace("&dagger;", "†").Replace("&Dagger;", _
                              "‡").Replace("&bull;", "•").Replace("&hellip;", "…").Replace("&permil;", "‰").Replace("&prime;", _
                              "′").Replace("&Prime;", "″").Replace("&lsaquo;", "‹").Replace("&rsaquo;", "›").Replace("&oline;", _
                              "‾").Replace("&euro;", "€").Replace("&trade;", "™").Replace("&larr;", "←").Replace("&uarr;", _
                              "↑").Replace("&rarr;", "→").Replace("&darr;", "↓").Replace("&harr;", "↔").Replace("&crarr;", _
                              "↵").Replace("&lceil;", "⌈").Replace("&rceil;", "⌉").Replace("&lfloor;", "⌊").Replace("&rfloor;", _
                              "⌋").Replace("&loz;", "◊").Replace("&spades;", "♠").Replace("&clubs;", "♣").Replace("&hearts;", _
                              "♥").Replace("&diams;", "♦")

        'replace special ASCII coding entities that were not captured by the above. Note that values > 127 will make the text 8-bit
        For Idx As Integer = 1 To 255                       'See www.w3schools.com/tags/ref_entities.asp
            Sb.Replace("&#" & Idx.ToString & ";", Chr(Idx)) 'replace most common numeric entities
        Next

        'Ensure header definitions are followed by vbCrLf
        Dim NewText As String = RegularExpressions.Regex.Replace(Sb.ToString(), "</H[^>]*>", vbCrLf)

        'Also seek out other Unicode encoded number entities not covered by the above and individually update them
        Dim Idy As Integer = InStr(NewText, "&#")                                           'check for a numeric entity
        Do While Idy <> 0                                                                   'loop as long as we find one
            Dim Idz As Integer = InStr(Idy, NewText, ";")                                   'find terminating semicolon
            Dim S As String = Mid(NewText, Idy, Idz - Idy + 1)                              'grab expression
            RegularExpressions.Regex.Replace(NewText, S, Chr(CInt(Mid(S, 3, Len(S) - 3))))  'replace expression
            InStr(Idy + 1, NewText, "&#")
        Loop

        'strip remaining HTML text tags, replace < and > placeholders, convert ampersand, replace ;; with ;, then return result
        Return RegularExpressions.Regex.Replace(NewText, "<[^>]*>", "").Replace("&lt;", _
                                        "<").Replace("&gt;", ">").Replace("&amp;", "&").Replace(";;", ";")
    End Function

    '==========================================================================
    '==========================================================================

    '*******************************************************************************
    ' Enum MediaTypes: Structure used by GetMediaType
    '*******************************************************************************
    Public Enum MediaTypes As Integer
        ApplicationOctet    ' 0 = Integer Value
        ApplicationPdf      ' 1
        ApplicationRtf      ' 2
        ApplicationSoap     ' 3
        ApplicationZip      ' 4
        ImageGif            ' 5
        ImageJpeg           ' 6
        ImageTiff           ' 7
        TextHtml            ' 8
        TextPlain           ' 9
        TextRich            '10
        TextXml             '11
    End Enum

    '*******************************************************************************
    ' Function Name : GetMediaType
    ' Purpose       : Provide easy access to System.Net.Mime.MediaTypes text
    '               :
    ' Returns       : provided a MediaTypes enumeration value, a string representing
    '               : the selected type will be returned.
    '*******************************************************************************
    Public Shared Function GetMediaType(ByVal MediaType As MediaTypes) As String
        Select Case MediaType
            Case MediaTypes.ApplicationPdf
                Return "application/pdf"
            Case MediaTypes.ApplicationRtf
                Return "application/rtf"
            Case MediaTypes.ApplicationSoap
                Return "application/soap+xml"
            Case MediaTypes.ApplicationZip
                Return "application/zip"
            Case MediaTypes.ImageGif
                Return "image/gif"
            Case MediaTypes.ImageJpeg
                Return "image/jpeg"
            Case MediaTypes.ImageTiff
                Return "image/tiff"
            Case MediaTypes.TextHtml
                Return "text/html"
            Case MediaTypes.TextPlain
                Return "text/plain"
            Case MediaTypes.TextRich
                Return "text/richtext"
            Case MediaTypes.TextXml
                Return "text/xml"
            Case Else
                Return "application/octet-stream"
        End Select
    End Function

    '==========================================================================
    '==========================================================================

    '*******************************************************************************
    ' Enum TransferEncodings: Structure used by GetTransferEncoding
    '*******************************************************************************
    Public Enum TransferEncodings As Integer
        QuotedPrintable ' 0 = Integer value
        Base64          ' 1
        SevenBit        ' 2
    End Enum

    '*******************************************************************************
    ' Function Name : GetTransferEncoding
    ' Purpose       : Provide easy access to System.Net.Mime.TransferEncoding data
    '               :
    ' Returns       : Provided a TransferEncodings value, a TransferEncoding value
    '               : is returned.
    '*******************************************************************************
    Public Shared Function GetTransferEncoding(ByVal TransferEncoding As TransferEncodings) As System.Net.Mime.TransferEncoding
        Return DirectCast(TransferEncoding, System.Net.Mime.TransferEncoding)
    End Function

    '==========================================================================
    '==========================================================================

    '*******************************************************************************
    ' Function Name : GetEmailInfo
    ' Purpose       : Break email down into its component parts.
    '               :
    ' Returns       : EmailInfo object with component parts of email broken down.
    '               :
    ' NOTES         : This method uses classes EmailItems and EmailInfo.
    '               : The Message Body, and each AlternnateView or Attachment are
    '               : contained within EmailItem objects within the EmailIngo object.
    '               :
    '               : An EmailItem contains fields for FROM, TO, SUBJECT, Content-Type,
    '               : a flag indicating if the ContentTypeData is a filename or if it is 
    '               : text formatting, content-transfer-encoding data, and the raw encoded,
    '               : data, whether it is a message or binary information. If the content-
    '               : transfer encoding is set to "base64", the data should be decoded
    '               : using the DecodeBase64() method. If it is "quoted-printable", the
    '               : data should be decoded using DecodeQuotedPrintable(). If it is
    '               : "7bit", it is 7-bit data and does not need to be decoded.
    '*******************************************************************************
    Public Shared Function GetEmailInfo(ByVal MailMessage As String) As EmailInfo
        Dim Info As New EmailInfo                                               'structure to hold breakdown of email
        Dim Ary() As String = Split(MailMessage, vbCrLf)                        'break full email into lines
        Dim Idx As Integer = 0                                                  'index into Ary()
        Dim MX As Integer = UBound(Ary) + 1                                     'find end if list+1
        Dim Boundaries As New Collections.Generic.List(Of String)               'boundary definitions

        Dim IsMultiPart As Boolean = False                                      'true if we have multiple parts
        Dim SeekingEncoding As Boolean = False                                  'true if we are looking for encoding
        Dim BuildingDataBlock As Boolean = False                                'true if we are building a data block
        Dim HaveMessageBody As Boolean = False                                  'true if we have the message body defined

        Dim ContentType As String = vbNullString                                'hold last-defined Content Type
        Dim ContentTypeIsName As Boolean = False                                'true of Content Type specified a file
        Dim ContentTypeData As String = vbNullString                            'if block isan attachment
        Dim ContentEncoding As String = vbNullString                            'hold last-defined Content Transfer Encoding
        Dim ContentBody As String = vbNullString                                'block data accumulator
        '-----------------------------------------------------------
        Dim Inheader As Integer = 4                                             'flag for gathering To, From, Date, Subject
        Do
            Dim S As String = Ary(Idx)                                          'grab a line of data from the email
            '
            ' check for important header items
            '
            If CBool(Len(S)) AndAlso CBool(Inheader) Then                       'if we are currently in the header...
                Dim I As Integer = InStr(S, ":")                                'find field delimiter
                If CBool(I) Then                                                'found one?
                    If VB.Right(S, 1) = ";" Then                                'line continues?
                        Idx += 1                                                'yes, so bump index
                        S &= Ary(Idx).Trim(Chr(9), " "c)                        'append next line next line
                    End If
                    Select Case LCase(VB.Left(S, I))                            'yes, check for one of 4 fields
                        Case "from:"                                            'Found FROM field
                            Info.FromData = Trim(Mid(S, I + 1))                 'stuff to structure
                            Inheader -= 1                                       'drop 1 from flag
                        Case "to:"                                              'Found TO field
                            Info.ToData = Trim(Mid(S, I + 1))                   'stuff to structure
                            Inheader -= 1                                       'drop 1 from flag
                        Case "date:"                                            'Found DATE field
                            Info.DateData = Trim(Mid(S, I + 1))                 'stuff to structure
                            Inheader -= 1                                       'drop 1 from flag
                        Case "subject:"                                         'Found SUBJECT field
                            Info.SubjectData = Trim(Mid(S, I + 1))              'stuff to structure
                            Inheader -= 1                                       'drop 1 from flag
                    End Select
                End If
                If Not CBool(Inheader) Then                                     'if InHeader flag is zero
                    SeekingEncoding = True                                      'start looking for a Content-Transfer-Encoding field
                    S = vbNullString                                            'purge current data
                End If
            End If
            '-------------------------------------------------------
            ' check for boundaries
            '-------------------------------------------------------
            If CBool(Len(S)) AndAlso CBool(Boundaries.Count) Then               'check any defined boundaries
                For Idy As Integer = 0 To Boundaries.Count - 1
                    If CBool(InStr(S, Boundaries.Item(Idy), CompareMethod.Text)) Then
                        If BuildingDataBlock Then
                            Dim Itm As New EmailItem                            'create a new item
                            Itm.ContentType = ContentType                       'store content type
                            Itm.ContentTypeData = ContentTypeData               'save filename or character set
                            Itm.ContentTypeDataIsFilename = ContentTypeIsName   'save flag indicating if Attachment
                            Itm.ContentEncoding = ContentEncoding               'store encoding
                            Itm.ContentBody = ContentBody                       'store data
                            ContentBody = vbNullString                          'reset accumulator
                            If HaveMessageBody Then                             'already have a message body?
                                If ContentTypeIsName Then                       'if an attachment
                                    Info.Attachments.Add(Itm)                   'add an attachment
                                Else                                            'otherwise an alternate view
                                    Info.AlternateViews.Add(Itm)
                                End If
                            Else
                                Info.MessageBody = Itm                          'else stuff new item to message body
                                HaveMessageBody = True                          'indicate we now have a message body
                            End If
                            ContentTypeData = vbNullString                      'reset filename/charset
                            BuildingDataBlock = False                           'turn off building flag
                        End If
                        SeekingEncoding = True                                  'turn block seeing on again
                        S = vbNullString                                        'purge current data
                        Exit For
                    End If
                Next
            End If
            '-------------------------------------------------------
            ' build data block
            '-------------------------------------------------------
            If BuildingDataBlock Then
                ContentBody &= S & vbCrLf                                       'add a line to content data
            End If
            '-------------------------------------------------------
            ' if seeking encoding
            '-------------------------------------------------------
            If CBool(Len(S)) AndAlso SeekingEncoding Then                       'are we seeking TCE?
                Dim I As Integer = InStr(S, ":")                                'yes, check for field delimiter
                If CBool(I) Then                                                'did we find one?
                    Select Case LCase(VB.Left(S, I))                            'yes, check for types
                        '=======================================================
                        Case "content-type:"                                    'Content type?
                            ContentType = Mid(S, I + 1).Trim(Chr(9), " "c)      'yes, so grab data
                            If VB.Right(S, 1) = ";" Then                        'more to add?
                                Idx += 1                                        'yes, so bump index
                                ContentType &= Ary(Idx).Trim(Chr(9), " "c)      'grab next line
                            End If
                            ContentTypeIsName = False                           'init flag specifying a file as false
                            Dim sbAry() As String = Split(ContentType, ";")     'now check the content type data
                            ContentType = sbAry(0)                              'keep first part for ContentType
                            If StrComp(VB.Left(sbAry(0), 10), "multipart/", CompareMethod.Text) = 0 Then
                                'multipart, so grab second parameter (boundary definition), and strip any quotes
                                Dim Bnd As String = Trim(Mid(sbAry(1), InStr(sbAry(1), "=") + 1)).Replace("""", vbNullString)
                                Boundaries.Add(Bnd)                             'and add a boundary
                            ElseIf StrComp(VB.Left(sbAry(1), 5), "name=", CompareMethod.Text) = 0 Then
                                ContentTypeIsName = True                        'attachment if a filename specified (otherwise a view)
                                sbAry = Split(sbAry(1), "=")                    'multipart, so grab second parameter
                                'get second part of second parameter (filename definition)
                                ContentTypeData = sbAry(1).Trim().Replace("""", vbNullString)   'strip any quotes
                            Else
                                ContentTypeData = sbAry(1)                      'AlternateView, so stuff display character set
                            End If
                            '===================================================
                        Case "content-transfer-encoding:"
                            ContentEncoding = Mid(S, I + 1).Trim(Chr(9), " "c)  'yes, so grab data
                            SeekingEncoding = False                             'turn off seeking flag
                            BuildingDataBlock = True                            'turn on building data block flag
                            Idx += 1                                            'bump to skip required following blank line
                    End Select
                End If
            End If
            Idx += 1                                                            'bump array index
        Loop While Idx < MX
        '-----------------------------------------------------------
        Return Info                                                             'return with filled data block
    End Function
End Class

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

'*******************************************************************************
' Class Name : EmailItem (used by EmailInfo class)
' Purpose    : Stores structure of an email block
'*******************************************************************************
Public Class EmailItem
    Public ContentType As String = vbNullString         'CONTENT-TYPE data
    Public ContentTypeData As String = vbNullString     'filename or text encoding
    Public ContentTypeDataIsFilename As Boolean = False 'True if ContentTypeData specifies a filename
    Public ContentEncoding As String = vbNullString     'CONTENT-TRANSFER-ENCODING data
    Public ContentBody As String = vbNullString         'raw data of block
End Class

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

'*******************************************************************************
' Class Name : EmailInfo (used by GetEmailInfo method)
' Purpose    : Store component parts of an Email
'*******************************************************************************
Public Class EmailInfo
    Public FromData As String = vbNullString                            'FROM:
    Public ToData As String = vbNullString                              'TO:
    Public DateData As String = vbNullString                            'DATE:
    Public SubjectData As String = vbNullString                         'SUBJECT:
    Public MessageBody As EmailItem                                     'contents of message body
    Public AlternateViews As New Collections.Generic.List(Of EmailItem) 'list of alternate views
    Public Attachments As New Collections.Generic.List(Of EmailItem)    'list of attachments
End Class