Option Strict On
Option Explicit On
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' POP3 - Copyright 2011 © by David Ross Goben.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'This VB.NET Code was inspired by C# code originally written Randy Charles Morin,
'author of KBCafe.com.
'
' I have optimized the heck out of the code to speed I/O and program execution,
' forcing a complete rewrite, I have added MANY language and POP3 enhancements,
' cleaned up a lot of clutter, and added Port and SSL support.
' Oh! And I include REAL comments.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Imports System.Net, System.Text
'-------------------------------------------------------------------------------
' Class Name   : POP3
' Purpose      : POP3 Interface Class
'-------------------------------------------------------------------------------
Public Class POP3
    Inherits Sockets.TcpClient                      'this class shall inherit all the functionality of a TC/IP Client

    Dim Stream As Sockets.NetworkStream             'non-SSL stream object
    Dim UsesSSL As Boolean = False                  'True if SLL authentication required
    Dim SslStream As Security.SslStream             'set to SSL stream supporting SSL authentication if UsesSSL is True
    Dim SslStreamDisposed As Boolean = False        'true if we disposed of SSL Stream object
    Public LastLineRead As String = vbNullString    'copy of the last response line read from the TCP server

    '*******************************************************************************
    ' Sub Name   : Connect          (This is the first the we do with a POP3 object)
    ' Purpose    : Connect to the server using the Server, User Name, Password,
    '            : and a flag indicating if SSL authentication is required
    '            :
    ' Returns    : Nothing
    '            :
    ' Typical TelNet I/O:
    'telnet mail.domain.net 110                     (submit)
    '+OK POP3 mail.domain.net v2011.83 server ready
    'USER myusername                                (submit)
    '+OK User name accepted, password please
    'PASS mysecretpassword                          (submit)
    '+OK Mailbox open, 3 messages                   (the server locks and opens the appropriate maildrop)
    '*******************************************************************************
    Public Overloads Sub Connect(ByVal Server As String, _
                                 ByVal Username As String, _
                                 ByVal Password As String, _
                                 Optional ByVal InPort As Integer = 110, _
                                 Optional ByVal UseSSL As Boolean = False)

        If Connected Then Disconnect() 'check underlying boolean flag to see if we are presently connected, and if so, disconnect that session
        UsesSSL = UseSSL                            'set flag True or False for SSL authentication
        MyBase.Connect(Server, InPort)              'now connect to the server via our base class
        Stream = MyBase.GetStream                   'before we can check for a response, we first have to set up a non-SSL stream
        If UsesSSL Then                             'do we also need to use SSL authentication?
            SslStream = _
            New Security.SslStream(Stream)          'yes, so build an SSL stream object on top of the Network Stream
            SslStream.AuthenticateAsClient(Server)  'add authentication as a client to the server
        End If

        If Not CheckResponse() Then Exit Sub 'exit if an error was encountered

        If CBool(Len(Username)) Then                'if the username is defined (some servers will reject submissions)
            Me.Submit("USER " & Username & vbCrLf)  'submit user name
            If Not CheckResponse() Then Exit Sub 'exit if an error was encountered
        End If

        If CBool(Len(Password)) Then                'if the password is defined (some servers will reject submissions)
            Me.Submit("PASS " & Password & vbCrLf)  'submit password
            If Not CheckResponse() Then Exit Sub 'exit if an error was encountered
        End If
    End Sub

    '*******************************************************************************
    ' Function Name : CheckResponse
    ' Purpose       : Check the response to a POP3 command
    '               :
    ' Returns       : Boolean flag. True = Success, False = Failure
    '               :
    ' NOTE          : All status responses from the server begin with:
    '               : +OK                     (OK; Success, or request granted)
    '            or : -ERR                    (NAGATIVE; error)
    '*******************************************************************************
    Public Function CheckResponse() As Boolean
        If Not IsConnected() Then Return False 'exit if not in TRANSACTION mode
        LastLineRead = Me.Response                  'check response (and save response line)
        If (Left(LastLineRead, 3) <> "+OK") Then    'OK?
            Throw New POP3Exception(LastLineRead)   'no, so throw an exception
            Return False                            'return failure flag
        End If
        Return True                                 'else return success flag
    End Function

    '*******************************************************************************
    ' Function Name : IsConnected
    ' Purpose       : Return connected to Server state, throw error if not
    '               :
    ' Returns       : Boolean Flag. True  if connected to server
    '               :
    '*******************************************************************************
    Public Function IsConnected() As Boolean
        If Not Connected Then                   'if not connected, throw an exception
            Throw New POP3Exception("Not Connected to an POP3 Server.")
            Return False                        'return failure flag
        End If
        Return True                             'Indicate that we are in the TRANSACTION state)
    End Function

    '*******************************************************************************
    ' Function Name : Response 
    ' Purpose       : get response from server (read from the mail stream into a buffer)
    '               :
    ' Returns       : string of data from the server
    '               :
    ' NOTE          : If a dataSize value  > 1 is supplied, then those number of bytes will be streamed in.
    '               : Otherwise, the data will be read in a line at a time, and end with the line end code (Linefeed (vbLf) 10 decimal)
    '*******************************************************************************
    Public Function Response(Optional ByVal dataSize As Integer = 1) As String
        Dim enc As New ASCIIEncoding                                'medium for ASCII representation of Unicode characters
        Dim ServerBufr() As Byte                                    'establish buffer
        Dim Index As Integer = 0                                    'init server buffer index and character counter
        If dataSize > 1 Then                                        'did invoker specify a data length to read?
            '-------------------------------------------------------
            ReDim ServerBufr(dataSize - 1)                          'size to dataSize to read as a single stream block (allow for 0 index)
            Dim dtsz As Integer = dataSize
            Dim sz As Integer                                       'variable to store actual number of bytes read from the stream
            Do While Index < dataSize                               'while we have not read the entire message...
                If UsesSSL Then                                     'process through SSL Stream if secure stream
                    sz = SslStream.Read(ServerBufr, Index, dtsz)    'read a server-defined block of data from SSLstream
                Else                                                'else process through general TCP Stream
                    sz = Stream.Read(ServerBufr, Index, dtsz)       'read a server-defined block of data from Network Stream
                End If
                If sz = 0 Then Return vbNullString 'we lost data, so we could not read the string
                Index += sz                                         'bump index for data count actually read
                dtsz -= sz                                          'drop amount left in buffer
            Loop
        Else '------------------------------------------------------
            ReDim ServerBufr(255)                                  'initially dimension buffer to 256 bytes (including 0 offset)
            Do
                If UsesSSL Then                                     'process through SSL Stream if secure stream
                    ServerBufr(Index) = CByte(SslStream.ReadByte)   'read a byte from SSLstream
                Else                                                'else process through general TCP Stream
                    ServerBufr(Index) = CByte(Stream.ReadByte)      'read a byte from Network stream
                End If
                If ServerBufr(Index) = -1 Then Exit Do 'end of stream if -1 encountered
                Index += 1                                          'bump our offset index and counter
                If ServerBufr(Index - 1) = 10 Then Exit Do 'done with line if Newline code (10; Linefeed) read in
                If Index > UBound(ServerBufr) Then                  'if the index points past end of buffer...
                    ReDim Preserve ServerBufr(Index + 255)          'then bump buffer another 256 bytes (Inc Index), but keep existing data
                End If
            Loop                                                    'loop until line read in
        End If
        Return enc.GetString(ServerBufr, 0, Index)                  'decode from a byte array into a string and return the string
    End Function

    '*******************************************************************************
    ' Sub Name : Submit
    ' Purpose  : Submit a request to the server
    '          :
    ' Returns  : Nothing
    '          :
    ' NOTE     : Command name must be in UPPERCASE, such as "PASS pw1Smorf".
    '          : "pass pw1Smorf" would not be acceptable, though some servers do allow for this.
    '*******************************************************************************
    Public Sub Submit(ByVal message As String)
        Dim enc As New ASCIIEncoding                            'medium for ASCII representation of Unicode characters
        Dim WriteBuffer() As Byte = enc.GetBytes(message)       'converts the submitted string into to a sequence of bytes
        If UsesSSL Then                                         'using SSL authentication?
            SslStream.Write(WriteBuffer, 0, WriteBuffer.Length) 'yes, so write SSL buffer
        Else
            Stream.Write(WriteBuffer, 0, WriteBuffer.Length)    'else write to Network buffer
        End If
    End Sub

    '*******************************************************************************
    ' Sub Name : Disconnect          (This is the last the we do with a POP3 object)
    ' Purpose  : Disconnect from the server and have it enter the UPDATE mode
    '          :
    ' Returns  : Nothing
    '          :
    ' Typical telNet I/O:
    'QUIT           (submit)
    '+OK Sayonara
    '
    ' NOTE:  When the client issues the QUIT command from the TRANSACTION state,
    '        the POP3 session enters the UPDATE state. (Note that if the client
    '        issues the QUIT command from the AUTHORIZATION state, the POP3
    '        session terminates but does NOT enter the UPDATE state.)
    '
    '        If a session terminates for some reason other than a client-issued
    '        QUIT command, the POP3 session does NOT enter the UPDATE state and
    '        MUST NOT remove any messages from the maildrop.
    '
    '        The POP3 server removes all messages marked as deleted from the
    '        maildrop and replies as to the status of this operation. If there
    '        is an error, such as a resource shortage, encountered while removing
    '        messages, the maildrop may result in having some or none of the
    '        messages marked as deleted be removed. In no case may the server
    '        remove any messages not marked as deleted.
    '
    '        Whether the removal was successful or not, the server the releases
    '        any exclusive-access lock on the maildrop and closes the TCP connection.
    '*******************************************************************************
    Public Sub Disconnect()
        Me.Submit("QUIT" & vbCrLf)  'submit quit request
        CheckResponse()             'check response
        If UsesSSL Then             'SSL authentication used?
            SslStream.Dispose()     'dispose of created SSL stream object if so
            SslStreamDisposed = True
        End If
    End Sub

    '*******************************************************************************
    ' Function Name : Statistics
    ' Purpose       : Get the number of email messages and the total size as any integer array
    '               :
    ' Returns       : 2-selement interger array.
    '               :   Element(0) is the number of user email messages on the server
    '               :   Element(1) is the total bytes of all messages taken up on the server
    '               :
    ' Typical telNet I/O:
    'STAT               (submit)
    '+OK 3 16487        (3 records (emails/messages) totaling 16487 bytes (octets))
    '*******************************************************************************
    Public Function Statistics() As Integer()
        If Not IsConnected() Then Return Nothing 'exit if not in TRANSACTION mode
        Me.Submit("STAT" & vbCrLf)                          'submit Statistics request
        LastLineRead = Me.Response                          'check response
        If (Left(LastLineRead, 3) <> "+OK") Then            'OK?
            Throw New POP3Exception(LastLineRead)           'no, so throw an exception
            Return Nothing                                  'return failure flag
        End If
        Dim msgInfo() As String = Split(LastLineRead, " "c) 'separate by spaces, which divide its fields
        Dim Result(1) As Integer
        Result(0) = Integer.Parse(msgInfo(1))               'get the number of emails
        Result(1) = Integer.Parse(msgInfo(2))               'get the size of the email messages
        Return Result
    End Function

    '*******************************************************************************
    ' Function Name : List
    ' Purpose       : Get the drop listing from the maildrop
    '               :
    ' Returns       : Any Arraylist of POP3Message objects
    '               :
    ' Typical telNet I/O:
    'LIST            (submit)
    '+OK Mailbox scan listing follows
    '1 2532          (record index and size in bytes)
    '2 1610
    '3 12345
    '.               (end of records terminator)
    '*******************************************************************************
    Public Function List() As ArrayList
        If Not IsConnected() Then Return Nothing 'exit if not in TRANSACTION mode

        Me.Submit("LIST" & vbCrLf)                          'submit List request
        If Not CheckResponse() Then Return Nothing 'check for a response, but if an error, return nothing
        '
        'get a list of emails waiting on the server for the authenticated user
        '
        Dim retval As New ArrayList                         'set aside message list storage
        Do
            Dim response As String = Me.Response            'check response
            If (response = "." & vbCrLf) Then               'done with list?
                Exit Do                                     'yes
            End If
            Dim msg As New POP3Message                      'establish a new message
            Dim msgInfo() As String = Split(response, " "c) 'separate by spaces, which divide its fields
            msg.MailID = Integer.Parse(msgInfo(0))          'get the list item number
            msg.ByteCount = Integer.Parse(msgInfo(1))           'get the size of the email message
            msg.Retrieved = False                           'indicate its message body is not yet retreived
            retval.Add(msg)                                 'add a new entry into the retrieval list
        Loop
        Return retval                                       'return the list
    End Function

    '*******************************************************************************
    ' Function Name : GetHeader
    ' Purpose       : Grab the email header and optionally a number of lines from the body
    '               :
    ' Returns       : Gets the Email header of the selected email. If an integer value is
    '               : provided, that number of body lines will be returned. The returned
    '               : object is the submitted POP3Message.
    '               :
    ' Typical telNet I/O:
    'TOP 1 0            (submit request for record 1's message header only, 0=no lines of body)
    '+OK Top of message follows
    ' xxxxx             (header for current record is transmitted)
    '.                  (end of record terminator)
    '
    'TOP 1 10           (submit request for record 1's message header plus 10 lines of body data)
    '+OK Top of message follows
    ' xxxxx             (header for current record is transmitted)
    ' xxxxx             (first 10 lines of body)
    '.                  (end of record terminator)
    '*******************************************************************************
    Public Function GetHeader(ByRef msg As POP3Message, Optional ByVal BodyLines As Integer = 0) As POP3Message
        If Not IsConnected() Then Return Nothing 'exit if not in TRANSACTION mode
        Me.Submit("TOP " & msg.MailID.ToString & " " & BodyLines.ToString & vbCrLf)
        If Not CheckResponse() Then Return Nothing 'check for a response, but if an error, return nothing
        msg.Message = vbNullString                  'erasde current contents of the message
        '
        'now process message data by binding the lines into a single string
        '
        Do
            Dim response As String = Me.Response    'grab message line
            If response = "." & vbCrLf Then         'end of data?
                Exit Do                             'yes, done with the loop if so
            End If
            msg.Message &= response                 'else build message by appending the new line
        Loop
        Return msg                                  'return new filled Message object
    End Function

    '*******************************************************************************
    ' Function Name : Retrieve
    ' Purpose       : Retrieve email from POP3 server for the provided POP3Message object
    '               :
    ' Returns       : The submitted POP3 Message object with its Message property filled,
    '               : and its ByteCount property properly fitted to the message size.
    '               :
    ' NOTE          : Some email servers are set up to automatically delete an email once
    '               : it is retrieved from the server. Outlook, Outlook Express, and
    '               : Windows Mail do this. It is an option under Juno and Gmail. So, if we
    '               : do not submit a POP3 QUIT (the Disconnect() method), but just close
    '               : out the POP3 object, the message(s) will not be deleted.
    '               : Even so, most Windows-based server-processors will add an additional
    '               : CR for each LF, but the reported email size does not account for them.
    '               : So we must retreive more data to account for this.
    '
    ' Typical telNet I/O:
    'RETR 1             (submit request to retrive record index 1 (cannot be an index marked for deletion))
    '+OK 2532 octets    (an octet is an fancy term for a 8-bit byte)
    ' xxxx              (message header and message are retreived)
    '.                  (end of record terminator)
    '*******************************************************************************
    Public Function Retrieve(ByRef msg As POP3Message) As POP3Message
        If Not IsConnected() Then Return Nothing 'exit if not in TRANSACTION mode
        Me.Submit("RETR " & msg.MailID.ToString & vbCrLf)   'issue request for indicated message number
        If Not CheckResponse() Then Return Nothing 'check for a response, but if an error, return nothing
        msg.Message = Me.Response(msg.ByteCount)                'grab message line
        'the stream reader automatically convers the NewLine code, vbLf, to vbCrLf, so the files is not yet
        'fully read. For example, a files that was 233 lines will therefore have 233 more characters not
        'yet read from the files when it has reached its reported data size. So we will scan these in.
        'But even if this was not the case, the trailing "." & vbCrLf is still pending.
        Do
            Dim S As String = Response()                    'grab more data
            If S = "." & vbCrLf Then                        'end of data?
                Exit Do                                     'If so, then exit app
            End If
            msg.Message &= S                                'else tack data to end of message
        Loop                                                'keep trying
        msg.ByteCount = Len(msg.Message)                        'ensure full size updated
        Return msg                                          'return new message object
    End Function

    '*******************************************************************************
    ' Sub Name : Delete
    ' Purpose  : Delete an email
    '          :
    ' Returns  : Nothing
    '          :
    ' NOTE     : Some email servers are set up to automatically delete an email once
    '          : it is retrieved from the server. Outlook, Outlook Express, and
    '          : Windows Mail do this. It is an option under Juno and Gmail.
    '
    ' Typical telNet I/O:
    'DELE 1             (submit request to delete record index 1)
    '+OK Message deleted
    '*******************************************************************************
    Public Sub Delete(ByVal msgHdr As POP3Message)
        If Not IsConnected() Then Exit Sub 'exit if not in TRANSACTION mode
        Me.Submit("DELE " & msgHdr.MailID.ToString & vbCrLf)    'submit Delete request
        CheckResponse()                                         'check response
    End Sub

    '*******************************************************************************
    ' Sub Name : Reset
    ' Purpose  : Reset any deletion (automatic or manual) of all email from
    '          : the current session.
    '          :
    ' Returns  : Nothing
    '          :
    ' Typical telNet I/O:
    'RSET               (submit)
    '+OK Reset state
    '*******************************************************************************
    Public Sub Reset()
        If Not IsConnected() Then Exit Sub 'exit if not in TRANSACTION mode
        Me.Submit("RSET" & vbCrLf)  'submit Reset request
        CheckResponse()             'check response
    End Sub

    '*******************************************************************************
    ' Function Name : NOOP (No Operation)
    ' Purpose       : Does nothing. Juts gets a position response from the server
    '               :
    ' Returns       : Boolean flag. False if disconnected, else True if connected.
    '               :
    ' NOTE          : This NO OPERATION command is useful when you have a server that
    '               : automatically disconnects after a certain idle period of activity.
    '               : This command can be issued by a timer that also monitors users
    '               : inactivity, and issues a NOOP to reset the server timer.
    '               :
    ' Typical telNet I/O:
    'NOOP               (submit)
    '+OK
    '*******************************************************************************
    Public Function NOOP() As Boolean
        If Not IsConnected() Then Return False 'exit if not in TRANSACTION mode
        Me.Submit("NOOP")
        Return CheckResponse()
    End Function

    '*******************************************************************************
    ' Function Name : Finalize
    ' Purpose       : remove SSL Stream object if not removed
    '*******************************************************************************
    Protected Overrides Sub Finalize()
        If Not SslStreamDisposed Then   'SSL Stream object Disposed?
            SslStream.Dispose()         'no, so do it
        End If
        MyBase.Finalize()               'then do normal finalization
    End Sub
End Class

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

'-------------------------------------------------------------------------------
' Class Name : POP3Message
' Purpose    : POP3 message data
'-------------------------------------------------------------------------------
Public Class POP3Message
    Public MailID As Integer = 0                'message number
    Public ByteCount As Integer = 0             'length of message in bytes
    Public Retrieved As Boolean = False         'flag indicating if the message has be retrieved
    Public Message As String = vbNullString     'the text of the message

    Public Overrides Function ToString() As String
        Return Message
    End Function
End Class

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

'-------------------------------------------------------------------------------
' Class Name : POP3Exception
' Purpose    : process exception
' NOTE       : This is a normal exception, but we wrap it to give it an identy
'            : that can be associated with clsPOP3
'-------------------------------------------------------------------------------
Public Class POP3Exception
    Inherits ApplicationException

    Public Sub New(ByVal str As String)
        MyBase.New(str)
    End Sub
End Class
