DESCARGAR CORREOS POR POP3

CODIGO GENERADO CON VISUAL BASIC 2005 (Frame­work 2.0)

Éste códi­go se descar­gará los corre­os elec­tróni­cos de tu servi­dor POP3, el for­ma­to de los corre­os descar­ga­dos es MIME y se gener­arán archivos con la exten­sión ".eml", com­pat­i­ble con muchos clientes de correo como: Out­look Express, Win­dows Live Mail, Thunderbird, …

Para que fun­cione cor­rec­ta­mente, es nece­sario agre­gar la sigu­iente ref­er­en­cia al proyec­to.
"Microsoft CDO for Win­dows 2000 Library"

Para agra­gar la ref­er­en­cia, seguimos estos pasos:
- Abri­mos el proyec­to que vamos a usar, o creamos uno nue­vo.
- Menu "Proyec­to"
- Agre­gar ref­er­en­cia …
- pes­taña "COM"
- selec­cionamos "Microsoft CDO for Win­dows 2000 Library"
- Acep­tar

Éste es el códi­go completo.


Public Class Form1
Dim pop3 As System.Net.Sockets.TcpClient = New System.Net.Sockets.TcpClient()
Dim Streamer As IO.Stream

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

Un pensamiento en “DESCARGAR CORREOS POR POP3

Deja una respuesta

Tu dirección de correo electrónico no será publicada. Los campos obligatorios están marcados con *

+ 37 = 47