This code demonstrates how to send and receive email from a POP3 server using the WinSock control.
Receiving Email
You will need: cmdCheckMail (a button), Winsock1 and List1.
In Command1_Click() you need t change the username and password and the smtp server. Although some servers allow you to send messages thru them even if the from email account doesnt really exist.
The messages will be downloaded to the C:\Windows\Temp
folder. It will download attachments.
It saves them as *.eml, which is the default extension for email. When you open the files, they'll open in the default email client, Outlook Express, or something.
This example will leave a copy of the message still on the server.. If you want to delete the message simply add sendMsg "DELE " & a
after the RETR
command in cmdCheckMail_Click()
. ' In general Declarations
Dim received As Boolean
Dim Message$
Dim sckError
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData Message$
Select Case Winsock1.Tag
Case "RETR"
Put #1, , Message$
If InStr(Message$, vbLf + "." + vbCrLf) Then
Close 1
received = True
End If
Case Else
sckError = (Left$(Message$, 3) = "-ER")
received = True
End Select
End Sub
Private Sub Winsock1_Close()
Winsock1.Close
End Sub
Private Sub cmdCheckMail_Click()
' LogIn to the server ~ get settings from outlook express
Winsock1.Connect "pop.freeserve.net", 110
Do Until received: DoEvents: Loop
if sckError then msgbox "An error occured trying to connect to server" : Exit sub
sendMsg "USER username" ' Send UserName
if sckError then Msgbox "Error with username" : Exit sub
sendMsg "PASS password" ' Send Password
if sckError then Msgbox "Error with password" : Exit sub
' Get Number of Messages and total size in bytes
sendMsg "STAT"
x = InStr(Message$, " "): b = InStrRev(Message$, " ")
Messages = Val(Mid$(Message$, x + 1, b - x))
Size = Val(Mid$(Message$, b + 1))
MsgBox "Number of messages to download " & Messages
' Download all messages
For a = 1 To Messages
' Winsock1_DataArrival will save message as "Email-1.eml", "Email-2.eml" etc
Winsock1.Tag = "RETR"
Open "C:\Windows\Temp\eMail-" & a & ".eml" For Binary Access Write As #1
sendMsg "RETR " & a
List1.AddItem "eMail " & a & ": Downloaded"
Next
Winsock1.Tag = ""
End Sub
Sub sendMsg(m$)
Winsock1.SendData m$ + vbCrLf
received = False
Do Until received
DoEvents
Loop
End Sub
Sending mail
This is the code I use to send emails using Winsock.
You need these two controls: Winsock1 and Command1.' In general Declarations
Dim received As Boolean
Private Sub Command1_Click()
sFrom$ = "[email protected]"
sTo$ = "[email protected]"
sSubject$ = "Hello Mary"
sMessage$ = "This is a simple Message"
' need SMTP server to route message thru, 25 (SMTP)
Winsock1.Connect "smtp.freeserve.net", 25
Do While Winsock1.State <> sckConnected: DoEvents: Loop
sendMsg "HELO " & "Peaches"
sendMsg "MAIL FROM: <" & sFrom & ">"
sendMsg "RCPT TO: <" & sTo & ">"
sendMsg "DATA"
m$ = m$ + "From: <" + sFrom + ">" + vbCrLf
m$ = m$ + "To: <" + sTo + ">" + vbCrLf
m$ = m$ + "Subject: " + sSubject$ + vbCrLf
m$ = m$ + "Date: " + Format$(Now, "h:mm:ss") + vbCrLf
m$ = m$ + "MIME-Version: 1.0" + vbCrLf
m$ = m$ + "Content-Type: text/plain; charset=us-ascii" + vbCrLf + vbCrLf
m$ = m$ + sMessage$ + vbCrLf + vbCrLf + "." + vbCrLf
sendMsg m$ + "QUIT"
Winsock1.Close
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
received = True
End Sub
Sub sendMsg(m$)
Winsock1.SendData m$ + vbCrLf
received = False
Do Until received
DoEvents
Loop
End Sub
Comments