User Friendly ASP.NET Exception Handling

Imports System.Net
Imports System.Net.Sockets
Imports System.Threading
Imports System.Text
Imports System.Diagnostics

''' <summary>
''' a simple class for trivial SMTP mail support, with no COM dependencies.
''' </summary>
''' <remarks>
'''   - plain text or HTML body
'''   - one optional file attachment
'''   - basic retry mechanism
''' 
'''  Jeff Atwood
'''  http://www.codinghorror.com/
''' </remarks>
Friend Class SimpleMail

    ''' <summary>
    ''' A mail message to be sent. The only required properties are To, and Body.
    ''' </summary>
    Public Class SmtpMailMessage
        ''' <summary>
        ''' Address this email came from. Optional.
        ''' If not provided, an email address will be automatically generated based on the machine name. 
        ''' </summary>
        Public From As String
        ''' <summary>
        ''' Address(es) to send email to. Semicolon delimited. Required.
        ''' </summary>
        Public [To] As String
        ''' <summary>
        ''' Subject text for the email. Optional, but recommended.
        ''' </summary>
        Public Subject As String
        ''' <summary>
        ''' Plain text body. Required.
        ''' </summary>
        Public Body As String
        ''' <summary>
        ''' HTML text body. Optional.
        ''' </summary>
        Public BodyHTML As String
        ''' <summary>
        ''' Fully qualified path of the file you want to attach to the email. Optional.
        ''' </summary>
        Public AttachmentPath As String
        ''' <summary>
        ''' String you wish to attach to the email. Intended for large strings. Optional.
        ''' </summary>
        Public AttachmentText As String
        ''' <summary>
        ''' Name of the attachment as shown in the email. Optional.
        ''' </summary>
        Public AttachmentFilename As String
    End Class

    ''' <summary>
    ''' SMTP client used to submit SMTPMailMessage(s)
    ''' </summary>
    Public Class SmtpClient

        Private Const _intBufferSize As Integer = 1024
        Private Const _intResponseTimeExpected As Integer = 10
        Private Const _intResponseTimeMax As Integer = 750
        Private Const _strAddressSeperator As String = ";"
        Private Const _intMaxRetries As Integer = 3
        Private Const _blnPlainTextOnly As Boolean = False

        Private _strDefaultDomain As String = Config.GetString("SmtpDefaultDomain", "")
        Private _strServer As String = Config.GetString("SmtpServer", "")
        Private _intPort As Integer = Config.GetInteger("SmtpPort", 25)
        Private _strUserName As String = Config.GetString("SmtpAuthUser", "")
        Private _strUserPassword As String = Config.GetString("SmtpAuthPassword", "")
        Private _blnDebugMode As Boolean

        Private _intRetries As Integer = 1

        Private _strLastResponse As String

        Public Sub New()
            _blnDebugMode = System.Diagnostics.Debugger.IsAttached
        End Sub

        ''' <summary>
        ''' Authenticating username, if your mail server requires outgoing authentication.
        ''' Leave blank otherwise.
        ''' </summary>
        Public Property AuthUser() As String
            Get
                Return _strUserName
            End Get
            Set(ByVal Value As String)
                _strUserName = Value
            End Set
        End Property

        ''' <summary>
        ''' Authenticating password, if your mail server requires outgoing authentication.
        ''' Leave blank otherwise.
        ''' </summary>
        Public Property AuthPassword() As String
            Get
                Return _strUserPassword
            End Get
            Set(ByVal Value As String)
                _strUserPassword = Value
            End Set
        End Property

        ''' <summary>
        ''' TCP/IP port to use during SMTP communications.
        ''' </summary>
        ''' <remarks>
        ''' Defaults to 25, the standard SMTP port.
        ''' </remarks>
        Public Property Port() As Integer
            Get
                Return _intPort
            End Get
            Set(ByVal Value As Integer)
                _intPort = Value
            End Set
        End Property

        ''' <summary>
        ''' SMTP server name to connect to when sending mail.
        ''' </summary>
        Public Property Server() As String
            Get
                Return _strServer
            End Get
            Set(ByVal Value As String)
                _strServer = Value
            End Set
        End Property

        ''' <summary>
        ''' Default email domain, eg, 'mycompany.com'
        ''' </summary>
        Public Property DefaultDomain() As String
            Get
                Return _strDefaultDomain
            End Get
            Set(ByVal Value As String)
                _strDefaultDomain = Value
            End Set
        End Property

        ''' <summary>
        ''' Returns true if this class is running in a web context
        ''' </summary>
        Private Function IsWebHosted() As Boolean
            Return Not System.Web.HttpContext.Current Is Nothing
        End Function

        ''' <summary>
        ''' send data over the current network connection
        ''' </summary>
        Private Sub SendData(ByVal tcp As TcpClient, ByVal strData As String)
            Dim ns As NetworkStream = tcp.GetStream()
            Dim b(strData.Length) As Byte
            Dim en As New System.Text.UTF8Encoding

            b = en.GetBytes(strData)
            ns.Write(b, 0, b.Length)
        End Sub

        ''' <summary>
        ''' get data from the current network connection
        ''' </summary>
        Private Function GetData(ByVal tcp As TcpClient) As String
            Dim ns As System.Net.Sockets.NetworkStream = tcp.GetStream()

            If ns.DataAvailable Then
                Dim b() As Byte
                Dim intStreamSize As Integer
                b = New Byte(_intBufferSize) {}
                intStreamSize = ns.Read(b, 0, b.Length)
                Dim en As New System.Text.UTF8Encoding
                Return en.GetString(b)
            Else
                Return ""
            End If
        End Function

        ''' <summary>
        ''' issue a required SMTP command
        ''' </summary>
        Private Sub Command(ByVal tcp As TcpClient, ByVal strCommand As String, _
            Optional ByVal strExpectedResponse As String = "250")

            If Not CommandInternal(tcp, strCommand, strExpectedResponse) Then
                tcp.Close()
                Throw New Exception("SMTP server at " & _strServer.ToString & ":" & _intPort.ToString + _
                    " was provided command '" & strCommand & _
                    "', but did not return the expected response '" & strExpectedResponse & "':" _
                    + Environment.NewLine + _strLastResponse)
            End If

        End Sub

        ''' <summary>
        ''' issue a SMTP command
        ''' </summary>
        Private Function CommandInternal(ByVal tcp As TcpClient, ByVal strCommand As String, _
            Optional ByVal strExpectedResponse As String = "250") As Boolean

            Dim intResponseTime As Integer

            '-- send the command over the socket with a trailing cr/lf
            If strCommand.Length > 0 Then
                SendData(tcp, strCommand & Environment.NewLine)
            End If

            '-- wait until we get a response, or time out
            _strLastResponse = ""
            intResponseTime = 0
            Do While (_strLastResponse = "") And (intResponseTime <= _intResponseTimeMax)
                intResponseTime += _intResponseTimeExpected
                _strLastResponse = GetData(tcp)
                Thread.CurrentThread.Sleep(_intResponseTimeExpected)
            Loop

            '-- this is helpful for debugging SMTP problems
            If _blnDebugMode Then
                Debug.WriteLine("SMTP >> " & strCommand & " (after " & intResponseTime.ToString & "ms)")
                Debug.WriteLine("SMTP << " & _strLastResponse)
            End If

            '-- if we have a response, check the first 10 characters for the expected response code
            If _strLastResponse = "" Then
                If _blnDebugMode Then
                    Debug.WriteLine("** EXPECTED RESPONSE " & strExpectedResponse & " NOT RETURNED **")
                End If
                Return False
            Else
                Return (_strLastResponse.IndexOf(strExpectedResponse, 0, 10) <> -1)
            End If
        End Function

        ''' <summary>
        ''' send mail with integrated retry mechanism
        ''' </summary>
        Public Function SendMail(ByVal mail As SmtpMailMessage) As Boolean
            Dim intRetryInterval As Integer = 333
            Try
                SendMailInternal(mail)
            Catch ex As Exception
                _intRetries += 1
                If _blnDebugMode Then
                    Debug.WriteLine("--> SendMail Exception Caught")
                    Debug.WriteLine(ex.Message)
                End If
                If _intRetries <= _intMaxRetries Then
                    Thread.CurrentThread.Sleep(intRetryInterval)
                    SendMail(mail)
                Else
                    Throw
                End If
            End Try
            If _blnDebugMode Then
                Debug.WriteLine("sent after " & _intRetries.ToString)
            End If
            _intRetries = 1
            Return True
        End Function

        ''' <summary>
        ''' send an email via trivial SMTP implementation
        ''' </summary>
        Private Sub SendMailInternal(ByVal mail As SmtpMailMessage)
            Dim iphost As IPHostEntry
            Dim tcp As New TcpClient

            '-- resolve server text name to an IP address
            Try
                iphost = Dns.GetHostByName(_strServer)
            Catch e As Exception
                Throw New Exception("Unable to resolve server name " & _strServer, e)
            End Try

            '-- attempt to connect to the server by IP address and port number
            Try
                tcp.Connect(iphost.AddressList(0), _intPort)
            Catch e As Exception
                Throw New Exception("Unable to connect to SMTP server at " & _strServer.ToString & ":" & _intPort.ToString, e)
            End Try

            '-- make sure we get the SMTP welcome message
            Command(tcp, "", "220")
            Command(tcp, "HELO " & Environment.MachineName)

            '--
            '-- authenticate if we have username and password
            '-- http://www.ietf.org/rfc/rfc2554.txt
            '--
            If Len(_strUserName & _strUserPassword) > 0 Then
                Command(tcp, "auth login", "334 VXNlcm5hbWU6") 'VXNlcm5hbWU6=base64'Username:'
                Command(tcp, ToBase64(_strUserName), "334 UGFzc3dvcmQ6") 'UGFzc3dvcmQ6=base64'Password:'
                Command(tcp, ToBase64(_strUserPassword), "235")
            End If

            If mail.From = "" Then
                If IsWebHosted() Then
                    mail.From = System.Web.HttpContext.Current.Request.ServerVariables("server_name") & _
                        "@" & _strDefaultDomain
                Else
                    mail.From = System.AppDomain.CurrentDomain.FriendlyName.ToLower & "." & _
                        Environment.MachineName.ToLower & "@" & _strDefaultDomain
                End If
            End If
            Command(tcp, "MAIL FROM: <" & mail.From & ">")

            '-- send email to more than one recipient
            Dim strRecipients() As String = mail.To.Split(_strAddressSeperator.ToCharArray)
            For Each strRecipient As String In strRecipients
                Command(tcp, "RCPT TO: <" & strRecipient & ">")
            Next

            Command(tcp, "DATA", "354")

            Dim sb As New StringBuilder
            With sb
                '-- write common email headers
                .Append("To: " & mail.To + Environment.NewLine)
                .Append("From: " & mail.From + Environment.NewLine)
                .Append("Subject: " & mail.Subject + Environment.NewLine)

                If _blnPlainTextOnly Then
                    '-- write plain text body
                    .Append(Environment.NewLine + mail.Body + Environment.NewLine)
                Else
                    Dim strContentType As String
                    '-- typical case; mixed content will be displayed side-by-side
                    strContentType = "multipart/mixed"
                    '-- unusual case; text and HTML body are both included, let the reader determine which it can handle
                    If mail.Body <> "" And mail.BodyHTML <> "" Then
                        strContentType = "multipart/alternative"
                    End If

                    .Append("MIME-Version: 1.0" & Environment.NewLine)
                    .Append("Content-Type: " & strContentType & "; boundary=""NextMimePart""" & Environment.NewLine)
                    .Append("Content-Transfer-Encoding: 7bit" & Environment.NewLine)
                    ' -- default content (for non-MIME compliant email clients, should be extremely rare)
                    .Append("This message is in MIME format. Since your mail reader does not understand " & Environment.NewLine)
                    .Append("this format, some or all of this message may not be legible." & Environment.NewLine)
                    '-- handle text body (if any)
                    If mail.Body <> "" Then
                        .Append(Environment.NewLine & "--NextMimePart" & Environment.NewLine)
                        .Append("Content-Type: text/plain;" & Environment.NewLine)
                        .Append(Environment.NewLine + mail.Body + Environment.NewLine)
                    End If
                    ' -- handle HTML body (if any)
                    If mail.BodyHTML <> "" Then
                        .Append(Environment.NewLine & "--NextMimePart" & Environment.NewLine)
                        .Append("Content-Type: text/html; charset=iso-8859-1" & Environment.NewLine)
                        .Append(Environment.NewLine + mail.BodyHTML + Environment.NewLine)
                    End If
                    '-- handle attachment (if any)
                    If mail.AttachmentPath <> "" Then
                        .Append(FileToMimeString(mail.AttachmentPath, mail.AttachmentFilename))
                    End If
                    If mail.AttachmentText <> "" Then
                        .Append(ToMimeString(mail.AttachmentText, mail.AttachmentFilename))
                    End If
                End If
                '-- <crlf>.<crlf> marks end of message content
                .Append(Environment.NewLine & "." & Environment.NewLine)
            End With

            Command(tcp, sb.ToString)
            Command(tcp, "QUIT", "")
            tcp.Close()
        End Sub

        ''' <summary>
        ''' returns MIME header section string
        ''' </summary>
        Private Function MimeHeaderString(ByVal strFilename As String) As String
            Dim sb As New StringBuilder
            If strFilename Is Nothing Or strFilename = "" Then strFilename = "attachment.txt"
            With sb
                .Append(Environment.NewLine & "--NextMimePart" & Environment.NewLine)
                .Append("Content-Type: application/octet-stream; name=""" & strFilename & """" & Environment.NewLine)
                .Append("Content-Transfer-Encoding: base64" & Environment.NewLine)
                .Append("Content-Disposition: attachment; filename=""" & strFilename & """" & Environment.NewLine)
                .Append(Environment.NewLine)
            End With
            Return sb.ToString
        End Function

        ''' <summary>
        ''' turn string into a MIME attachment string
        ''' </summary>
        Private Function ToMimeString(ByVal strAny As String, Optional ByVal strFilename As String = "Attachment.txt") As String
            Dim sb As New StringBuilder
            Const intLineWidth As Integer = 75

            strAny = Convert.ToBase64String(System.Text.Encoding.Default.GetBytes(strAny))

            sb.Append(MimeHeaderString(strFilename))
            Dim i As Integer
            Dim c As Integer
            For i = 0 To strAny.Length - 1
                c += 1
                sb.Append(strAny.Substring(i, 1))
                If c = intLineWidth - 1 Then
                    c = 0
                    sb.Append(Environment.NewLine)
                End If
            Next
            Return sb.ToString
        End Function

        ''' <summary>
        ''' turn a file into a MIME attachment string
        ''' </summary>
        Private Function FileToMimeString(ByVal strFilepath As String, Optional ByVal strFileName As String = "") As String

            Dim fs As System.IO.FileStream
            Dim sb As New StringBuilder
            '-- note that chunk size is equal to maximum line width
            Const intChunkSize As Integer = 75
            Dim bytRead(intChunkSize) As Byte
            Dim intRead As Integer

            If strFileName Is Nothing Or strFileName = "" Then
                '-- get just the filename out of the path
                strFileName = System.IO.Path.GetFileName(strFilepath)
            End If

            sb.Append(MimeHeaderString(strFileName))

            fs = New System.IO.FileStream(strFilepath, System.IO.FileMode.Open, System.IO.FileAccess.Read)
            intRead = fs.Read(bytRead, 0, intChunkSize)
            Do While intRead > 0
                sb.Append(System.Convert.ToBase64String(bytRead, 0, intRead))
                sb.Append(Environment.NewLine)
                intRead = fs.Read(bytRead, 0, intChunkSize)
            Loop
            fs.Close()

            Return sb.ToString
        End Function

        ''' <summary>
        ''' Encodes a string as Base64
        ''' </summary>
        Private Function ToBase64(ByVal data As String) As String
            Dim Encoder As System.Text.UTF8Encoding = New System.Text.UTF8Encoding
            Return Convert.ToBase64String(Encoder.GetBytes(data))
        End Function

    End Class

End Class