Bonjour,

J'ai trouvé dans divers messages du forum et bouts de code pour écrire un programme VB6 afin d'envoyer des emails avec WinSock, mais ça ne fonctionne pas très bien, si je lance la procédure email_Winsock (ci-joint), rien n'est envoyé au serveur de messagerie (même en mettant des pauses jusqu'à 30s entre chaque commande !), si je lance le prgramme en pas à pas toutes les commandes Winsock sont exécutée correctement et j'envoi de temps en temps un email que j'ai pu vérifier sur ma messagerie.
J'ai fait une trace des échanges quand ça fonctionne, j'ai l'impression que les réponses du serveur sont décalées !
Merci de m'aider et de m'expliquer ce qui ne marche pas, je n'ai pas trouvé de fonction d'attente de résolution d'un senddata de winsock, ou i l me manque des commandes de contrôle, de validation ou d'attente.

Merci d'avance
Alain

Programme VB6:

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Sub email_winsock()

' les noms sont bidon pour la diffusion pour l'adresse du serveur SMTP, l'adresse emmétrice et l'adresse destinataire

    ' Initialisation
    ' Connection au serveur sur le port 25
    Winsock1.RemoteHost = "smtp.fr.serveurmail.com"     Winsock1.RemotePort = 25
    Winsock1.Close
    Winsock1.Connect
    ' Verifie si la connection est effectué
attente:
    DoEvents
    Refresh
    If Winsock1.State <> 7 Then GoTo attente ' attente de validation de la connection
    Call AttCmd("220") ' attente réponse code 220 du serveur SMTP
    serveur = Mid(DataStr, 5, InStr(DataStr, "SMTP") - 7)
    Winsock1.SendData "EHLO " & serveur & vbCrLf
    DoEvents
    'Call AttRCV 'suppression de l'attente de réponse du serveur sinon rien ne se passe
    ' Source Mail
    Winsock1.SendData "MAIL FROM:" & "<emmeteur@serveur2.fr>" & vbCrLf
    DoEvents
    Call AttRCV 'attente de réponse du serveur
    ' Destinataire Email
    Winsock1.SendData "RCPT TO:" & "<destinataire@serveur.fr>" & vbCrLf
    DoEvents
    Call AttRCV 'attente de réponse du serveur
    ' Fichier à envoyer
    Winsock1.SendData "DATA" & vbCrLf & "" ' pas de pièce jointe
    DoEvents
    ' Sujet du message
    Winsock1.SendData "Subject:" & Chr(32) & "Test d'email par WinSock" & vbCrLf
    DoEvents
    Call AttRCV 'attente de réponse du serveur
    ' corps du message
    Winsock1.SendData "BONJOUR," & vbCrLf
    DoEvents
    Winsock1.SendData vbCrLf
    DoEvents
    Winsock1.SendData vbCrLf
    DoEvents
    Winsock1.SendData "Test d'envoi d'email automatique sans outlook" & vbCrLf
    DoEvents
    Winsock1.SendData vbCrLf
    DoEvents
    Winsock1.SendData vbCrLf
    DoEvents
    Winsock1.SendData "ACT" & vbCrLf
    DoEvents
    Winsock1.SendData "." & vbCrLf  ' fin du corps du message
    DoEvents
    ' Quitte le protocole
    Winsock1.SendData "QUIT" & vbCrLf
    DoEvents
    Winsock1.Close
    ' Message Envoyé
    MsgBox "Message et Fichier Posté !!", vbExclamation, "Bravo !!"
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Open "D:\SourceVb\email_winsock\reponse.txt" For Append As #1
    'MsgBox "il y a des data à reevoir : " + Format(bytesTotal, "0")
    Winsock1.GetData DataStr, vbString, bytesTotal
    'MsgBox DataStr
    Print #1, DataStr
    Close #1
    f_dataRCV = True
End Sub

Public Sub AttCmd(cod As String)
    f_dataRCV = False
attente:
    If Left(DataStr, 3) <> cod Then
        pause (1)
        GoTo attente
    End If
End Sub


Public Sub pause(seconde As Long)
        Sleep (seconde * 1000)
End Sub

Trace de l'exécution correct en pas à pas
(en rouge les commandes envoyées via VB & WinSock) :

    Winsock1.RemoteHost = "smtp.fr.serveurmail.com"     
    Winsock1.RemotePort = 25
    Winsock1.Close
    Winsock1.Connect
220 smtp9.clb.oleane.net ESMTP France-Telecom Oleane; Thu, 21 Jul 2005 17:24:34 +0200

    Winsock1.SendData "EHLO " & serveur & vbCrLf
    Winsock1.SendData "MAIL FROM:" & "<emmeteur@serveur2.fr>" & vbCrLf
250-smtp9.clb.oleane.net Hello [81.80.189.94], pleased to meet you
250-ENHANCEDSTATUSCODES
250-PIPELINING
250-8BITMIME
250-SIZE 21000000
250-DSN
250-AUTH PLAIN LOGIN
250-DELIVERBY
250 HELP

    Winsock1.SendData "RCPT TO:" & "<destinataire@serveur.fr>" & vbCrLf
 250 2.1.0 <emmeteur@serveur2.fr>... Sender ok

    Winsock1.SendData "DATA" & vbCrLf & "" ' pas de pièce jointe
250 2.1.5 <destinataire@serveur.fr>... Recipient ok

    Winsock1.SendData "Subject:" & Chr(32) & "Test d'email par WinSock" & vbCrLf
354 Enter mail, end with "." on a line by itself

    Winsock1.SendData "BONJOUR," & vbCrLf
    Winsock1.SendData vbCrLf
    Winsock1.SendData vbCrLf
    Winsock1.SendData "Test d'envoi d'email automatique sans outlook" & vbCrLf
    Winsock1.SendData vbCrLf
    Winsock1.SendData vbCrLf
    Winsock1.SendData "ACT" & vbCrLf
    Winsock1.SendData "." & vbCrLf  ' fin du corps du message
    Winsock1.SendData "QUIT" & vbCrLf
250 2.0.0 j6LFOYH7012801 Message accepted for delivery

ACT