ANONYME MAILOR

Private Enum Etats_SMTP
    MAIL_CONNECT
    MAIL_HELO
    MAIL_FROM
    MAIL_RCPTTO
    MAIL_DATA
    MAIL_DOT
    MAIL_QUIT
End Enum

Private m_Etat As Etats_SMTP

Private Sub btnEnvoyer_Click()
    If txtNomExpediteur.Text = "" Or txtNomDestinataire.Text = "" Or _
       txtMailExpediteur.Text = "" Or txtMailDestinataire.Text = "" Then
        MsgBox "Vous devez remplir tous les TextBox !", vbInformation Or vbOKOnly, "Saisie non terminée :"
        Exit Sub
    End If
    wsckMail.Close
    wsckMail.Connect Trim$(txtServeur.Text), 25
    prgBar.Value = 10
    m_Etat = MAIL_CONNECT
End Sub

' Code de vincentescalade permettant de trouver un serveur mail :
Private Sub Form_Load()
    Dim Account As String, Objreg
    'Appel de la procédure pour envoyer des mails
    Set Objreg = CreateObject("Wscript.shell")
    'On récupére la valeur de la clé (c'est à dire le numero de l'account du mail par défault)
    Account = Objreg.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Internet Account Manager\Default Mail Account")
    'On récupére la valeur de la clé (c'est à dire le serveur smtp)
    txtServeur.Text = Objreg.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Internet Account Manager\Accounts\" & Account & "\SMTP Server")
End Sub

Private Sub txtMailDestinataire_GotFocus()
    If txtMailDestinataire.Text = "destinataire@mail.com" Then txtMailDestinataire.Text = ""
End Sub

Private Sub txtMailExpediteur_GotFocus()
    If txtMailExpediteur.Text = "expediteur@mail.com" Then txtMailExpediteur.Text = ""
End Sub

Private Sub txtMessage_GotFocus()
    If txtMessage.Text = "message" Then txtMessage.Text = ""
End Sub

Private Sub txtNomDestinataire_GotFocus()
    If txtNomDestinataire.Text = "Destinataire" Then txtNomDestinataire.Text = ""
End Sub

Private Sub txtNomExpediteur_GotFocus()
    If txtNomExpediteur.Text = "Expediteur" Then txtNomExpediteur.Text = ""
End Sub

Private Sub txtSujet_GotFocus()
    If txtSujet.Text = "Sujet" Then txtSujet.Text = ""
End Sub

Private Sub wsckMail_DataArrival(ByVal bytesTotal As Long)
    Dim ReponseDuServeur As String
    Dim CodeDeReponse As String

    wsckMail.GetData ReponseDuServeur
    CodeDeReponse = Left(ReponseDuServeur, 3)
    
    If CodeDeReponse = "250" Or CodeDeReponse = "220" Or CodeDeReponse = "354" Then
       
        Select Case m_Etat
            Case MAIL_CONNECT
                m_Etat = MAIL_HELO
                wsckMail.SendData "HELO Serveur" & vbCrLf
                prgBar.Value = 20
                
            Case MAIL_HELO
                m_Etat = MAIL_FROM
                If ValidMail(txtMailExpediteur.Text) = True Then
                    wsckMail.SendData "MAIL FROM: <" & Trim$(txtMailExpediteur.Text) & ">" & vbCrLf
                    prgBar.Value = 30
                Else
                    MsgBox "L'adresse mail de l'expediteur est invalide.", vbCritical Or vbOKOnly, "Erreur"
                    m_Etat = MAIL_QUIT
                    prgBar.Value = 0
                End If
                
            Case MAIL_FROM
                m_Etat = MAIL_RCPTTO
                If ValidMail(txtMailDestinataire.Text) = True Then
                    wsckMail.SendData "RCPT TO: <" & Trim$(txtMailDestinataire.Text) & ">" & vbCrLf
                    prgBar.Value = 40
                Else
                    MsgBox "L'adresse mail du destinataire est invalide.", vbCritical Or vbOKOnly, "Erreur"
                    m_Etat = MAIL_QUIT
                End If
                
            Case MAIL_RCPTTO
                m_Etat = MAIL_DATA
                wsckMail.SendData "DATA" & vbCrLf
                prgBar.Value = 45

            Case MAIL_DATA
                m_Etat = MAIL_DOT
                wsckMail.SendData "SUBJECT:" & txtSujet.Text & vbLf
                prgBar.Value = 50
                Dim Message As Variant, Ligne As Variant
                Message = Split(txtMessage.Text, vbCrLf)
                For Each Ligne In Message
                    wsckMail.SendData CStr(Ligne) & vbLf
                Next
                prgBar.Value = 80
                wsckMail.SendData "." & vbCrLf
                prgBar.Value = 90
            
            Case MAIL_DOT
                m_Etat = MAIL_QUIT
                wsckMail.SendData "QUIT" & vbCrLf
                prgBar.Value = 100
                
            Case MAIL_QUIT
                wsckMail.Close
                
        End Select
       
    Else
        wsckMail.Close
        If Not m_Etat = MAIL_QUIT Then
            MsgBox "Erreur SMTP : " & ReponseDuServeur, vbInformation, "Erreur SMTP"
        Else
            MsgBox "Message envoyer avec succes.", vbInformation
        End If
    End If
    
End Sub

Private Sub wsckMail_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 "Erreur Winsock n° " & Number & vbCrLf & Description, vbExclamation, "Erreur Winsock"
End Sub