Sending with VB.NET

Option Explicit On 

Imports System.Net.Sockets

Imports System.IO

Imports System.Text

Public Class ClsSMTP
    Private Enum SMTP_STATE
        MAIL_CONNECT
        MAIL_HELO
        MAIL_FROM
        MAIL_RCPTTO
        MAIL_DATA
        MAIL_DOT
        MAIL_QUIT
    End Enum

    Private Structure EMAIL
        Dim Name As String
        Dim Address As String
    End Structure

    Private Structure SMTP
        Dim HOST As String
        Dim Port As Integer
        Dim Sender As EMAIL
        Dim Recipient As EMAIL
        Dim ReplyTo As EMAIL
        Dim Subject As String
        Dim message As String
        Dim AttachmentFile As String
        Dim AttachmentData As String
        Dim EncodedFile As String
    End Structure

    Private strSMTPError As String

    Private SMTPData As SMTP
    Private SMTPState As SMTP_State

    Public Property HOST() As String
        Get
            Return SMTPData.HOST
        End Get
        Set(ByVal Value As String)
            SMTPData.HOST = Value
        End Set
    End Property

    Public Property Port() As Integer
        Get
            Return SMTPData.Port
        End Get
        Set(ByVal Value As Integer)
            SMTPData.Port = Value
        End Set
    End Property

    Public Property SenderName() As String
        Get
            Return SMTPData.Sender.Name
        End Get
        Set(ByVal Value As String)
            SMTPData.Sender.Name = Value
        End Set
    End Property

    Public Property SenderAddress() As String
        Get
            Return SMTPData.Sender.Address
        End Get
        Set(ByVal Value As String)
            SMTPData.Sender.Address = Value
        End Set
    End Property

    Public Property RecipientName() As String
        Get
            Return SMTPData.Recipient.Name
        End Get
        Set(ByVal Value As String)
            SMTPData.Recipient.Name = Value
        End Set
    End Property

    Public Property RecipientAddress() As String
        Get
            Return SMTPData.Recipient.Address
        End Get
        Set(ByVal Value As String)
            SMTPData.Recipient.Address = Value
        End Set
    End Property

    Public Property ReplyToName() As String
        Get
            Return SMTPData.ReplyTo.Name
        End Get
        Set(ByVal Value As String)
            SMTPData.ReplyTo.Name = Value
        End Set
    End Property

    Public Property ReplyToAddress() As String
        Get
            Return SMTPData.ReplyTo.Address
        End Get
        Set(ByVal Value As String)
            SMTPData.ReplyTo.Address = Value
        End Set
    End Property

    Public Property Subject() As String
        Get
            Return SMTPData.Subject
        End Get
        Set(ByVal Value As String)
            SMTPData.Subject = Value
        End Set
    End Property

    Public Property Message() As String
        Get
            Return SMTPData.message
        End Get
        Set(ByVal Value As String)
            SMTPData.message = Value
        End Set
    End Property

    Public Property AttachmentFile() As String
        Get
            Return SMTPData.AttachmentFile
        End Get
        Set(ByVal Value As String)
            SMTPData.AttachmentFile = Value
            SMTPData.EncodedFile = UUEncodeFile(SMTPData.AttachmentFile)
            SMTPData.AttachmentData = SMTPData.AttachmentData & SMTPData.EncodedFile & vbCrLf
        End Set
    End Property

    Public Property AttachmentData() As String
        Get
            Return SMTPData.AttachmentData
        End Get
        Set(ByVal Value As String)
            SMTPData.AttachmentData = Value
        End Set
    End Property

    Public ReadOnly Property SMTPError() As String
        Get
            Return strSMTPError
        End Get
    End Property

    Public Sub SendMessage()
        On Error GoTo ProcErr
        Dim strServerResponse As String
        Dim strResponseCode As String
        Dim strDataToSend As String

        Dim varLines() As String
        Dim varLine As String
        Dim strMessage As String
        Dim Count As Long
        Dim StartPoint As Long

        Dim ObjTCP As New TcpClient()
        Dim ObjOutboundData As Stream
        Dim ObjInboundData As StreamReader
        Dim DataArray() As Byte
        SMTPState = SMTP_STATE.MAIL_CONNECT

        'check data
        Select Case True
            Case InStr(1, SMTPData.Sender.Address, "@") = 0
                SMTPData.Sender.Address = SMTPData.Sender.Address & "@" & SMTPData.HOST
            Case InStr(1, SMTPData.Recipient.Address, "@") = 0
                SMTPData.Recipient.Address = SMTPData.Recipient.Address & "@" & SMTPData.HOST
        End Select

        'Call CWinSock.Connect(SMTPData.HOST, SMTPData.Port)
        ObjTCP.Connect(SMTPData.HOST, SMTPData.Port)
        ObjInboundData = New StreamReader(ObjTCP.GetStream, Encoding.ASCII)

        Do While (Not SMTPState = SMTP_STATE.MAIL_QUIT)
            strServerResponse = ObjInboundData.ReadLine

            strResponseCode = Left(strServerResponse, 3)
            If strServerResponse <> "" Then
                If strResponseCode = "250" Or strResponseCode = "220" Or strResponseCode = "354" Then
                    Select Case SMTPState
                        Case SMTP_STATE.MAIL_CONNECT
                            SMTPState = SMTP_STATE.MAIL_HELO
                            strDataToSend = Trim$(SMTPData.Sender.Address)
                            strDataToSend = Left$(strDataToSend, InStr(1, strDataToSend, "@") - 1)

                            strDataToSend = "HELO " & strDataToSend & vbCrLf

                            DataArray = Encoding.ASCII.GetBytes(strDataToSend.ToCharArray())
                            ObjOutboundData = ObjTCP.GetStream
                            ObjOutboundData.Write(DataArray, 0, strDataToSend.Length)

                        Case SMTP_STATE.MAIL_HELO
                            SMTPState = SMTP_STATE.MAIL_FROM
                            strDataToSend = "MAIL FROM:" & Trim$(SMTPData.Sender.Address) & vbCrLf

                            DataArray = Encoding.ASCII.GetBytes(strDataToSend.ToCharArray())
                            ObjOutboundData = ObjTCP.GetStream
                            ObjOutboundData.Write(DataArray, 0, strDataToSend.Length)

                        Case SMTP_STATE.MAIL_FROM
                            SMTPState = SMTP_STATE.MAIL_RCPTTO
                            strDataToSend = "RCPT TO:" & Trim$(SMTPData.Recipient.Address) & vbCrLf

                            DataArray = Encoding.ASCII.GetBytes(strDataToSend.ToCharArray())
                            ObjOutboundData = ObjTCP.GetStream
                            ObjOutboundData.Write(DataArray, 0, strDataToSend.Length)

                        Case SMTP_STATE.MAIL_RCPTTO
                            SMTPState = SMTP_STATE.MAIL_DATA
                            strDataToSend = "DATA" & vbCrLf

                            DataArray = Encoding.ASCII.GetBytes(strDataToSend.ToCharArray())
                            ObjOutboundData = ObjTCP.GetStream
                            ObjOutboundData.Write(DataArray, 0, strDataToSend.Length)

                        Case SMTP_STATE.MAIL_DATA
                            SMTPState = SMTP_STATE.MAIL_DOT

                            strDataToSend = "From:" & SMTPData.Sender.Name & " <" & SMTPData.Sender.Address & ">" & vbCrLf

                            DataArray = Encoding.ASCII.GetBytes(strDataToSend.ToCharArray())
                            ObjOutboundData = ObjTCP.GetStream
                            ObjOutboundData.Write(DataArray, 0, strDataToSend.Length)

                            strDataToSend = "To:" & SMTPData.Recipient.Name & " <" & SMTPData.Recipient.Address & ">" & vbCrLf

                            DataArray = Encoding.ASCII.GetBytes(strDataToSend.ToCharArray())
                            ObjOutboundData.Write(DataArray, 0, strDataToSend.Length)


                            If Len(SMTPData.ReplyTo.Address) > 0 Then
                                strDataToSend = "Subject:" & SMTPData.Subject & vbCrLf & vbCrLf

                                DataArray = Encoding.ASCII.GetBytes(strDataToSend.ToCharArray())
                                ObjOutboundData.Write(DataArray, 0, strDataToSend.Length)

                                strDataToSend = "Reply-To:" & SMTPData.ReplyTo.Name & " <" & SMTPData.ReplyTo.Address & ">" & vbCrLf & vbCrLf

                                DataArray = Encoding.ASCII.GetBytes(strDataToSend.ToCharArray())
                                ObjOutboundData.Write(DataArray, 0, strDataToSend.Length)

                            Else
                                strDataToSend = "Subject:" & SMTPData.Subject & vbCrLf & vbCrLf

                                DataArray = Encoding.ASCII.GetBytes(strDataToSend.ToCharArray())
                                ObjOutboundData.Write(DataArray, 0, strDataToSend.Length)
                            End If

                            If Len(SMTPData.AttachmentData) <> 0 Then
                                strMessage = SMTPData.message & vbCrLf & vbCrLf & SMTPData.AttachmentData
                            Else
                                strMessage = SMTPData.message & vbCrLf & vbCrLf
                            End If
                            varLines = Split(strMessage, vbCrLf)
                            strMessage = ""
                            For Each varLine In varLines
                                strDataToSend = varLine & vbCrLf
                                DataArray = Encoding.ASCII.GetBytes(strDataToSend.ToCharArray())
                                ObjOutboundData.Write(DataArray, 0, strDataToSend.Length)
                            Next
                            strDataToSend = "." & vbCrLf
                            DataArray = Encoding.ASCII.GetBytes(strDataToSend.ToCharArray())
                            ObjOutboundData.Write(DataArray, 0, strDataToSend.Length)
                        Case SMTP_STATE.MAIL_DOT
                            SMTPState = SMTP_STATE.MAIL_QUIT
                            strDataToSend = "QUIT" & vbCrLf

                            DataArray = Encoding.ASCII.GetBytes(strDataToSend.ToCharArray())
                            ObjOutboundData = ObjTCP.GetStream
                            ObjOutboundData.Write(DataArray, 0, strDataToSend.Length)

                        Case SMTP_STATE.MAIL_QUIT
                            ObjTCP.Close()
                    End Select
                Else
                    ObjTCP.Close()
                    If Not SMTPState = SMTP_STATE.MAIL_QUIT Then
                        strSMTPError = "SMTP Error: " & strServerResponse
                    End If
                End If
            Else
            End If
        Loop
        ObjTCP.Close()

ProcExit:
        Exit Sub
ProcErr:
        Err.Raise(Err.Number, TypeName(Me) & ".SendMessage", Err.Source & " -> " & vbCrLf & Err.Description & vbCrLf)
        GoTo ProcExit
    End Sub

    Public Function UUEncodeFile(ByVal strFilePath As String) As String
        'On Error GoTo ProcErr

        Dim ObjFile As New StreamReader(strFilePath)
        Dim Buffer() As Char
        Dim FileIndex As Integer

        Dim intFile As Integer 'file handler
        Dim intTempFile As Integer 'temp file
        Dim lFileSize As Long 'size of the file
        Dim strFileName As String 'name of the file
        Dim strFileData As String 'file data chunk
        Dim lEncodedLines As Long 'number of encoded lines
        Dim strTempLine As String 'temporary string
        Dim I As Long 'loop counter
        Dim j As Integer 'loop counter
        Dim strResult As String

        'Get file name
        strFileName = Mid$(strFilePath, InStrRev(strFilePath, "\") + 1)
        'Insert first marker: "begin 664 ..."
        strResult = "begin 664 " + strFileName + vbLf
        'Get file size
        lFileSize = FileLen(strFilePath)
        lEncodedLines = lFileSize \ 45 + 1
        'Prepare buffer to retrieve data from the file by 45 symbols chunks
        strFileData = Space(45)
        intFile = FreeFile()

        ' Open strFilePath For Binary As intFile
        For I = 1 To lEncodedLines
            'Read file data by 45-bytes cnunks
            If I = lEncodedLines Then
                'Last line of encoded data often is not equal to 45, therefore we need to change size of the buffer
                strFileData = Space(lFileSize Mod 45)
            End If
            'Retrieve data chunk from file to the buffer
            ReDim Buffer(strFileData.Length - 1)
            ObjFile.ReadBlock(Buffer, FileIndex, strFileData.Length)
            strFileData = CStr(Buffer)

            'Get intFile, , strFileData

            'Add first symbol to encoded string that informs about quantity of symbols in encoded string.
            'More often "M" symbol is used.
            strTempLine = Chr(Len(strFileData) + 32)
            If I = lEncodedLines And (Len(strFileData) Mod 3) Then
                'If the last line is processed and length of source data is not a number divisible by 3, add one or two blankspace symbols
                strFileData = strFileData + Space(3 - (Len(strFileData) Mod 3))
            End If
            For j = 1 To Len(strFileData) Step 3
                'Breake each 3 (8-bits) bytes to 4 (6-bits) bytes
                '1 byte
                strTempLine = strTempLine + Chr(Asc(Mid(strFileData, j, 1)) \ 4 + 32)
                '2 byte
                strTempLine = strTempLine + Chr((Asc(Mid(strFileData, j, 1)) Mod 4) * 16 + Asc(Mid(strFileData, j + 1, 1)) \ 16 + 32)
                '3 byte
                strTempLine = strTempLine + Chr((Asc(Mid(strFileData, j + 1, 1)) Mod 16) * 4 + Asc(Mid(strFileData, j + 2, 1)) \ 64 + 32)
                '4 byte
                strTempLine = strTempLine + Chr(Asc(Mid(strFileData, j + 2, 1)) Mod 64 + 32)
            Next j
            'replace " " with "`"
            strTempLine = Replace(strTempLine, " ", "`")
            'add encoded line to result buffer
            strResult = strResult + strTempLine + vbLf
            'reset line buffer
            strTempLine = ""
        Next I
        ObjFile.Close()

        'Close(intFile)

        'add the end marker
        strResult = strResult & "`" & vbLf + "end" + vbLf
        'asign return value
        UUEncodeFile = strResult

ProcExit:
        Exit Function
ProcErr:
        Err.Raise(Err.Number, "MUUEncode.UUEncodeFile", Err.Source & " -> " & vbCrLf & Err.Description & vbCrLf)
        GoTo ProcExit

    End Function

End Class