Winsock

Tout d'abord vous devez rajouter à votre projet le composant Microsoft Winsock Control. Pour cela vous allez dans le menu Projet puis Composants. La fenêtre suivante apparaîtra.

S'il n'apparaît pas dans la liste, essayez de récupérer le fichier MSWINSCK.OCX sur autre machine et faites « Parcourir… » afin de le sélectionner.

Ensuite vous devez coller sur votre Form le contrôle lui-même :

Ce form est composé de cinq champs de saisie et un champ d'affichage. Le premier nommé txtFrom permet de saisir l'expéditeur du mail. Le deuxième txtTo permet de saisir le récepteur du mail. Le troisième txtSubject permet de saisir le sujet du message. Le quatrième rtxtMail (de type RichTextBox) permet de saisir le contenu du mail. Le cinquième txtServer permet de saisir le serveur SMTP à partir duquel vous souhaitez envoyer votre mail (généralement les serveurs SMTP n'autorisent que les machines appartenant au même réseau d'émettre des mails). Le sixième rtxtLog permet de voir ce que le serveur nous retourne comme information.

La première chose à faire est de déclarer une variable permettant de capturer les événements d'un contrôle Winsock.

Private WithEvents evt As Winsock

Afin de capturer l'ensemble des événements du contrôle Winsock que vous avez collé sur le Form, il faut que les deux variables pointent sur le même objet.

Set evt = ws

Voici le code complet du Form :

Private WithEvents evt As Winsock
Private nextSend As Boolean

Private Sub btnSend_Click()
Dim tmp As String

Set evt = ws

ws.Connect txtServer, 25
While ws.State <> sckConnected
DoEvents
Wend
nextSend = False
ws.SendData "HELO toto" & vbCrLf
While nextSend = False
DoEvents
Wend
nextSend = False
ws.SendData "MAIL FROM:" & txtFrom.Text & vbCrLf
While nextSend = False
DoEvents
Wend
nextSend = False
ws.SendData "RCPT TO:" & txtTo.Text & vbCrLf
While nextSend = False
DoEvents
Wend
nextSend = False
ws.SendData "DATA" & vbCrLf
While nextSend = False
DoEvents
Wend

ws.SendData "To:" & txtTo.Text & vbCrLf
ws.SendData "From:" & txtFrom.Text & vbCrLf
ws.SendData "Subject:" & txtSubject.Text & vbCrLf
ws.SendData rtxtMail.Text & vbCrLf
nextSend = False
ws.SendData vbCrLf & "." & vbCrLf
While nextSend = False
DoEvents
Wend


nextSend = False
ws.SendData "QUIT" & vbCrLf
While nextSend = False
DoEvents
Wend


ws.Close
End Sub

Private Sub evt_Close()
rtxtLog.Text = rtxtLog.Text & vbCrLf & "Deconnexion réalisée"
End Sub

Private Sub evt_Connect()
rtxtLog.Text = rtxtLog.Text & vbCrLf & "Connexion au serveur réalisée"
End Sub

Private Sub evt_ConnectionRequest(ByVal requestID As Long)
rtxtLog.Text = rtxtLog.Text & vbCrLf & "Demande de connexion au serveur"
End Sub

Private Sub evt_DataArrival(ByVal bytesTotal As Long)
Dim tmp As String

If ws.State = sckClosed Or ws.State = sckClosing Then Exit Sub
ws.GetData tmp, vbString, bytesTotal
rtxtLog.Text = txtLog.Text & Chr(13) & tmp
rtxtLog.Refresh
nextSend = True
End Sub

Private Sub evt_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
MsgBox Number & " : " & Description
End Sub

Le code présent ci-dessus ne gère pas les erreurs.

Comme vous pouvez le constater, plusieurs événements sont gérés dont la connexion, la déconnexion, la réception de messages et la réception d'erreurs. Pour chaque envoi, la variable nextFalse est positionnée à False, car le programme doit attendre que le serveur ait répondu avant d'envoyer la suite. Vous pouvez rencontrer deux types d'erreurs : les erreurs liées à la connexion donc c'est l'événement Error qui vous permettra de les gérer, ou bien les erreurs retournées par le serveur si vous avez envoyé une mauvaise commande. Dans ce dernier cas, c'est dans l'événement DataArrival qu'il faudra regarder la chaîne retournée par le serveur pour savoir si tout c'est bien passé.

Lorsque vous envoyez de grosses données, deux événements supplémentaires peuvent vous permettre de voir l'avancement : SendComplete qui prévient quand le transfert est terminé, et SendProgress qui permet de savoir le nombre d'octets envoyés.

Comme vous avez pu le constater, chaque instruction envoyée se termine par vbCrLf qui permet de dire au serveur que c'est la fin de l'instruction.

Pour la réception nous allons construire un nouveau Form afin de lire les mails.

Ensuite vous devez coller sur votre Form le contrôle lui-même :

Ce form se divise en deux parties. La partie du haut concernant la connexion :

• Le champ login : txtLogin ;
• Le champ mot de passe : txtPassword ;
• Le champ serveur : txtServer ;
• Le bouton de connexion : btnConnect
• Le bouton de déconnexion : btnDisconnect.

La partie du bas compte trois champs :

• Une listbox à droite : lstMessage dans laquelle apparaîtra la liste des messages ;
• Une RichTextBox à droite : rtxtMessage dans laquelle vous verrez le contenu du message ;
• Une RichTextBox en bas : rtxtLog qui correspond à la fenêtre de log comme por l'émission.

Le code que je fournis est des plus basiques. C'est juste pour montrer que l'utilisation des sockets est toujours la même chose. Le tout est de savoir ce que vous recevez et ce que vous devez envoyer. Pour cela je vous renvoie aux différentes RFC ou alors à votre propre cahier des charges si vous développez votre propre protocole de communication.

Voici le code complet du Form :

Private WithEvents evt As Winsock
Private nextSend As Boolean
Private answer As String

Private nbrecept As Long


Private Sub btnConnect_Click()
Dim tmp As String

Set evt = ws

nbrecept = 0

ws.Connect txtServer, 110
While ws.State <> sckConnected
DoEvents
Wend
'Attente du message de bienvenue
nextSend = False
While nextSend = False
DoEvents
Wend



nextSend = False
ws.SendData "USER " & txtLogin.Text & vbCrLf
While nextSend = False
DoEvents
Wend

nextSend = False
ws.SendData "PASS " & txtPassword.Text & vbCrLf While nextSend = False
DoEvents
Wend
If InStr(1, answer, "OK") > 0 Then
lblMessage.Caption = "Vous êtes connecté" RecuperationNbMessage
Else
    lblMessage.Caption = "Login/mot de passe incorrect"
  End If
End Sub


Private Sub evt_ConnectionRequest(ByVal requestID As Long)
  rtxtLog.Text = rtxtLog.Text & vbCrLf & "Demande de connexion au serveur"
End Sub

Private Sub evt_DataArrival(ByVal bytesTotal As Long)
  Dim tmp As String

  If ws.State = sckClosed Or ws.State = sckClosing Then Exit Sub
  ws.GetData tmp, vbString, bytesTotal
  rtxtLog.Text = txtLog.Text & Chr(13) & tmp
  rtxtLog.Refresh
  nextSend = True
End Sub

Private Sub evt_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
  MsgBox Number & " : " & Description
End Sub

Remarque

Il est tout à fait possible qu'il y ait des erreurs dans le document. Si vous en trouvez, ou bien souhaitez un peu plus d'explication sur certains points, veuillez m'envoyer un message privé via le forum afin de mettre à jour l'ensemble de ce document. D'avance merci.