DESCARGAR CORREOS POR POP3

Dim host As String = "pop.gmail.com"
Dim puerto As Double = 995
Dim usuario As String = "masm2000"
Dim pwd As String = "xxx"
Dim ssl As Boolean = True

Dim ruta As String = "x:lista" 'CARPETA DONDE SE ALMACENARAN LOS CORREOS

Private Shared Function ValidarCertificado() As Boolean
Return True
End Function

Private Function ver() As String
Dim enc As New System.Text.ASCIIEncoding
Dim serverbuff() As Byte = New [Byte](1023) {}
Dim count As Integer = 0
While True
Dim buff() As Byte = New [Byte](1) {}
Dim bytes As Integer = Streamer.Read(buff, 0, 1)
If bytes = 1 Then
serverbuff(count) = buff(0)
count += 1
If buff(0) = Asc(vbLf) Then
Exit While
End If
Else
Exit While
End If
End While
Dim retval As String = enc.GetString(serverbuff, 0, count)
'Debug.WriteLine("READ:" + retval)
Return retval
End Function

Private Sub Write(ByVal message As String)
Dim en As New System.Text.ASCIIEncoding
Dim WriteBuffer(1023) As Byte
WriteBuffer = en.GetBytes(message)
Streamer.Write(WriteBuffer, 0, WriteBuffer.Length)
'Debug.WriteLine("WRITE:" + message)
End Sub

Public Sub Desconectar()
Dim mensaje As String = ""
Write("QUIT" & vbNewLine)
mensaje = ver()
If UCase(Mid(mensaje, 1, 3)) > "+OK" Then
MsgBox(mensaje)
Exit Sub
End If
pop3.Close()
End Sub

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim mensaje As String = ""

pop3.Connect(host, puerto)
If ssl = True Then
Streamer = New Net.Security.SslStream(pop3.GetStream, False)
DirectCast(Streamer, Net.Security.SslStream).AuthenticateAsClient(host)
Net.ServicePointManager.ServerCertificateValidationCallback = New Net.Security.RemoteCertificateValidationCallback(AddressOf ValidarCertificado)
Else
Streamer = pop3.GetStream()
End If

mensaje = ver()
If UCase(Mid(mensaje, 1, 3)) > "+OK" Then
MsgBox(mensaje)
Desconectar()
Exit Sub
End If

Write("USER " & usuario & vbNewLine)
mensaje = ver()
If UCase(Mid(mensaje, 1, 3)) > "+OK" Then
MsgBox(mensaje)
Desconectar()
Exit Sub
End If

Write("PASS " & pwd & vbNewLine)
mensaje = ver()
If UCase(Mid(mensaje, 1, 3)) > "+OK" Then
MsgBox(mensaje)
Desconectar()
Exit Sub
End If

Write("LIST" & vbNewLine)
mensaje = ver()
If UCase(Mid(mensaje, 1, 3)) > "+OK" Then
MsgBox(mensaje)
Desconectar()
Exit Sub
Else
Dim lista_mensajes As New ArrayList
Dim lista_bytes As New ArrayList
While True
mensaje = ver()
If mensaje = "." & vbNewLine Then
Exit While
Else
Dim correo() As String
correo = Split(mensaje, " ")
lista_mensajes.Add(correo(0))
lista_bytes.Add(correo(1))
End If
End While

Dim suma_bytes As Double = 0

Dim CONTAR As Double
For CONTAR = 0 To lista_mensajes.Count - 1
suma_bytes += lista_bytes(CONTAR)

'tamaño de cada correo
Dim tamaño As String = FormatNumber(CDbl(lista_bytes(CONTAR)), 2) & " Bytes"
If Len(lista_bytes(CONTAR)) > 6 Then
tamaño = FormatNumber(CDbl(lista_bytes(CONTAR)) / (1024 * 1024), 2) & " MB"
Else
If Len(lista_bytes(CONTAR)) > 3 Then
tamaño = FormatNumber(CDbl(lista_bytes(CONTAR)) / 1024, 2) & " KB"
End If
End If
'fin
MsgBox(tamaño)

Write("UIDL " & lista_mensajes(CONTAR) & vbNewLine) 'DEVUELVE UN VALOR UNICO PARA CADA CORREO, UTIL PARA BUSCAR O BORRAR UN CORREO
mensaje = ver()
If UCase(Mid(mensaje, 1, 3)) > "+OK" Then
MsgBox(mensaje)
Else
Dim uid As String = Mid(mensaje, 5 + CDbl(Len(lista_mensajes(CONTAR))))

If uid > "" Then 'BASE DE DATOS
Write("RETR " & lista_mensajes(CONTAR) & vbNewLine)
mensaje = ver()
If UCase(Mid(mensaje, 1, 3)) > "+OK" Then
MsgBox(mensaje)
Else
Try
Dim strm As ADODB.Stream
Dim myMail As New CDO.Message
strm = myMail.GetStream()
strm.Type = ADODB.StreamTypeEnum.adTypeText

'ALMACENA LOS CORREOS ELECTRONICOS EN UN DIRECTORIO
Dim FICHA As New System.IO.StreamWriter(ruta & "" & lista_mensajes(CONTAR) & Now.Ticks & ".eml", True, System.Text.Encoding.GetEncoding(1252))

While True
mensaje = ver()
If mensaje = "." & vbNewLine Then
Exit While
Else
FICHA.Write(mensaje)
strm.WriteText(mensaje, ADODB.StreamWriteEnum.adWriteChar)
End If
End While

strm.Flush()

Try
MsgBox(myMail.From & vbNewLine & myMail.To & vbNewLine & myMail.ReceivedTime & vbNewLine)
Catch
End Try

FICHA.Close()

Catch EX As Exception
MsgBox(EX.Message)
End Try
End If
End If
End If
Next

'tamaño de todos los correos
Dim total_bytes As String = FormatNumber(suma_bytes, 2) & " Bytes"
If Len(suma_bytes) > 6 Then
total_bytes = FormatNumber(suma_bytes / (1024 * 1024), 2) & " MB"
Else
If Len(suma_bytes) > 3 Then
total_bytes = FormatNumber(suma_bytes / 1024, 2) & " KB"
End If
End If
'fin

MsgBox(total_bytes)

End If

'Write("DELE 1") 'BORRA EL MENSAJE 1 DE LA LISTA
'mensaje = ver()
'If UCase(Mid(mensaje, 1, 3)) > "+OK" Then
'MsgBox(mensaje)
'Desconectar()
'Exit Sub
'End If

End Sub

Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
Try
Desconectar()
Catch
End Try
End Sub

End Class