POP3

javromara
16 de Diciembre del 2003
Hola a todos
Estoy realizando una aplicación que debe leer unos mensajes de un servidor POP3 y luego borrarlos del mismo. Lo hace todo bien,pero no llega a eliminar los mensajes cuando abandono el servidor.
El código es el siguiente

unction WaitFor2(ResponseCode As String, Respuesta As String) As Boolean
Dim start As Single, Tmr As Single
Dim i As Integer
On Error GoTo ctrl_error2
Timeout = 20
start = Timer ' Controlar que no sea forever
While Len(Response) = 0 And wsock.State <> 9
Tmr = Timer - start
DoEvents '** IMPORTANTE: Dejar que el sistema siga
If wsock.State = 8 Then
Timeout = 60
End If
If Tmr > Val(Timeout) Then ' Time in seconds to wait

'MsgBox "POP3 service error, timeout esperando respuesta del servidor", vbExclamation
WaitFor2 = False
Cadena = "TIMEOUTXX"
Exit Function

End If
Sleep 200 'espero un 2/10 de segundo
If wsock.State <> 8 Then
wsock.GetData Response
Else

End If
Wend
Respuesta = Response
Response = "" ' **IMPORTANTE: poner en blanco
WaitFor2 = True
Exit Function
ctrl_error2:
WaitFor2 = False
Cadena = "FalloX" + CStr(wsock.State)
wsock.Close
End Function

Public Function CheckCorreo() As String
Set wsock = New Winsock
Dim Respuesta As String
Dim cantmensajes As String
Dim cadenaCabecera As String
Dim poscdIncidencia As Integer
Dim poscdservtec As Integer
Dim poscduser As Integer
Dim CdIncide As String
Dim cdservtec As String
Dim Tecnico As String
Dim fechamensaje As Date
Dim FechaSQL As String
Dim i As Integer
MsgBox "Empezamos "
On Error GoTo ctrl_error
pop3Host = "192.6.1.93"
pop3User = "acuserecibo.cau"
pop3Passwd = "1234"
Cadena = ""
wsock.Close
wsock.RemoteHost = pop3Host
wsock.RemotePort = 110
wsock.LocalPort = 0
'De otra forma no es posible chequear a menos que pasen
'4 minutos entre aperturas y cierres de sockets
'esto es una "caracteristica" de diseño del control
wsock.Connect

If Not WaitFor("+OK", Respuesta) Then
Cadena = Cadena + "El servidor de correo no contesta por ahora" + Respuesta + " VEAMOS"
wsock.Close
CheckCorreo = Cadena
Exit Function
End If
MsgBox "Conectado"
wsock.SendData "USER " & pop3User + vbCrLf
If Not WaitFor2("+OK", Respuesta) Then
Cadena = "El usuario POP3 es inválido"
wsock.Close
CheckCorreo = Cadena
Exit Function
End If
MsgBox "Conectado2"
wsock.SendData "PASS " & pop3Passwd + vbCrLf
If Not WaitFor2("+OK", Respuesta) Then
Cadena = "El password del usuario POP3 es inválido"
wsock.Close
CheckCorreo = Cadena
Exit Function
End If
wsock.SendData "STAT" + vbCrLf
If Not WaitFor2("+OK", Respuesta) Then
Cadena = "El servidor no responde al comando STAT"
wsock.Close
CheckCorreo = Cadena
Exit Function
End If
MsgBox "Conectado3"
cantmensajes = Mid$(Respuesta, 5, InStr(5, Respuesta, " ", vbTextCompare) - 5)
'Cadena = Cadena + "Tiene " + cantmensajes + " mensajes nuevos."
'Cadena = Cadena + Format$(Now, "General Date")
nmensaje = CInt(Trim(cantmensajes))
txtInterv = "No hay mensajes " + CStr(nmensaje)
If nmensaje > 0 Then
txtInterv = ""
For i = 1 To nmensaje
wsock.SendData "TOP " + CStr(i) + " 1 " + vbCrLf
If Not WaitFor2("+OK", Respuesta) Then
Cadena = "El servidor no responde al comando RETR"
wsock.Close
CheckCorreo = Cadena
Exit Function
End If
MsgBox "Conectado4"
Do While (InStr(Respuesta, vbCrLf + "." + vbCrLf) = 0) And (InStr(Respuesta, "-ERR") = 0)
wsock.GetData Response
Respuesta = Respuesta + Response
Response = ""
Loop


cadenaCabecera = Respuesta

' Sacamos informacion de la cabecera
poscdIncidencia = InStr(cadenaCabecera, "cdincide=")
poscdservtec = InStr(cadenaCabecera, "&cdservtec=")
poscduser = InStr(cadenaCabecera, "&cduser=")
CdIncide = Mid(cadenaCabecera, poscdIncidencia + 9, poscdservtec - 9 - poscdIncidencia)
cdservtec = Mid(cadenaCabecera, poscdservtec + 11, poscduser - 11 - poscdservtec)
Tecnico = Mid(cadenaCabecera, poscduser + 8)
fechamensaje = CDate("01/12/2003")
FechaSQL = SQLFecha(fechamensaje)
txtInterv = txtInterv + CStr(i) + " _ " + "Acuse de recibo en el Proveedor " + cdservtec + "<br>"
wsock.SendData "DELE " + CStr(i) + vbCrLf
If Not WaitFor2("+OK", Respuesta) Then
Cadena = "El servidor no responde al comando DELE"
wsock.Close
CheckCorreo = Cadena
Exit Function
End If
txtInterv = txtInterv + "<br>BorradoSP2X " + Respuesta + "<br>"
Next
End If
Respuesta = ""
wsock.SendData "QUIT" + vbCrLf
'Do While (InStr(Respuesta, "+OK") = 0) And (InStr(Respuesta, "-ERR") = 0)
' wsock.GetData Response
' Respuesta = Respuesta + Response
' Response = ""
' Loop

wsock.Close
'Set mrstAdoConsulta = Nothing
'Set mcmdAdoConsulta = Nothing
CheckCorreo = "Fin" + Respuesta + "<br>" + txtInterv
Set wsock = Nothing
Exit Function


ctrl_error:
CheckCorreo = "Error :" + Err.Description
wsock.Close
Set wsock = Nothing
End Function