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