462 lines
26 KiB
VB.net
462 lines
26 KiB
VB.net
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
|