MAILER ENVOI DE MAILS EN RAFFALE (ANONYMES OU PAS) STABLE ET RAPIDE (PARAMÉTRABLE)

Public Class Principal
    Inherits System.Windows.Forms.Form
#Region " Code généré par le Concepteur Windows Form "

    Public Sub New()
        MyBase.New()

        'Cet appel est requis par le Concepteur Windows Form.
        InitializeComponent()

        'Ajoutez une initialisation quelconque après l'appel InitializeComponent()

    End Sub

    'La méthode substituée Dispose du formulaire pour nettoyer la liste des composants.
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub

    'Requis par le Concepteur Windows Form
    Private components As System.ComponentModel.IContainer

    'REMARQUE : la procédure suivante est requise par le Concepteur Windows Form
    'Elle peut être modifiée en utilisant le Concepteur Windows Form.  
    'Ne la modifiez pas en utilisant l'éditeur de code.
    Friend WithEvents TbAdresseDest As System.Windows.Forms.TextBox
    Friend WithEvents TbAdresseExp As System.Windows.Forms.TextBox
    Friend WithEvents TbSujet As System.Windows.Forms.TextBox
    Friend WithEvents RtbMessage As System.Windows.Forms.RichTextBox
    Friend WithEvents BtEnvoyer As System.Windows.Forms.Button
    Friend WithEvents LbDest As System.Windows.Forms.Label
    Friend WithEvents LbExp As System.Windows.Forms.Label
    Friend WithEvents LbSujet As System.Windows.Forms.Label
    Friend WithEvents GrConfiguration As System.Windows.Forms.GroupBox
    Friend WithEvents LbServeurSMTP As System.Windows.Forms.Label
    Friend WithEvents TbServeurSMTP As System.Windows.Forms.TextBox
    Friend WithEvents LbNbEnvois As System.Windows.Forms.Label
    Friend WithEvents VsNbEnvois As System.Windows.Forms.VScrollBar
    Friend WithEvents TxNbEnvois As System.Windows.Forms.TextBox
    Friend WithEvents Pbar As System.Windows.Forms.ProgressBar
    Friend WithEvents Winsock As AxMSWinsockLib.AxWinsock
    Friend WithEvents Timer As System.Timers.Timer
    Friend WithEvents LbStatut As System.Windows.Forms.Label
    Friend WithEvents LbDelai As System.Windows.Forms.Label
    Friend WithEvents TxtDelai As System.Windows.Forms.TextBox
    Friend WithEvents VsDelai As System.Windows.Forms.VScrollBar
    Friend WithEvents LbS As System.Windows.Forms.Label
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(Principal))
        Me.TbAdresseDest = New System.Windows.Forms.TextBox()
        Me.LbDest = New System.Windows.Forms.Label()
        Me.LbExp = New System.Windows.Forms.Label()
        Me.TbAdresseExp = New System.Windows.Forms.TextBox()
        Me.LbSujet = New System.Windows.Forms.Label()
        Me.TbSujet = New System.Windows.Forms.TextBox()
        Me.RtbMessage = New System.Windows.Forms.RichTextBox()
        Me.BtEnvoyer = New System.Windows.Forms.Button()
        Me.GrConfiguration = New System.Windows.Forms.GroupBox()
        Me.Winsock = New AxMSWinsockLib.AxWinsock()
        Me.TxNbEnvois = New System.Windows.Forms.TextBox()
        Me.VsNbEnvois = New System.Windows.Forms.VScrollBar()
        Me.LbNbEnvois = New System.Windows.Forms.Label()
        Me.LbServeurSMTP = New System.Windows.Forms.Label()
        Me.TbServeurSMTP = New System.Windows.Forms.TextBox()
        Me.Pbar = New System.Windows.Forms.ProgressBar()
        Me.LbStatut = New System.Windows.Forms.Label()
        Me.Timer = New System.Timers.Timer()
        Me.LbDelai = New System.Windows.Forms.Label()
        Me.TxtDelai = New System.Windows.Forms.TextBox()
        Me.VsDelai = New System.Windows.Forms.VScrollBar()
        Me.LbS = New System.Windows.Forms.Label()
        Me.GrConfiguration.SuspendLayout()
        CType(Me.Winsock, System.ComponentModel.ISupportInitialize).BeginInit()
        CType(Me.Timer, System.ComponentModel.ISupportInitialize).BeginInit()
        Me.SuspendLayout()
        '
        'TbAdresseDest
        '
        Me.TbAdresseDest.BorderStyle = System.Windows.Forms.BorderStyle.FixedSingle
        Me.TbAdresseDest.Location = New System.Drawing.Point(160, 140)
        Me.TbAdresseDest.Name = "TbAdresseDest"
        Me.TbAdresseDest.Size = New System.Drawing.Size(184, 20)
        Me.TbAdresseDest.TabIndex = 4
        Me.TbAdresseDest.Text = ""
        '
        'LbDest
        '
        Me.LbDest.Location = New System.Drawing.Point(18, 141)
        Me.LbDest.Name = "LbDest"
        Me.LbDest.Size = New System.Drawing.Size(133, 16)
        Me.LbDest.TabIndex = 1
        Me.LbDest.Text = "Adresse du destinataire :"
        '
        'LbExp
        '
        Me.LbExp.Location = New System.Drawing.Point(18, 108)
        Me.LbExp.Name = "LbExp"
        Me.LbExp.Size = New System.Drawing.Size(133, 16)
        Me.LbExp.TabIndex = 3
        Me.LbExp.Text = "Adresse de l'expéditeur :"
        '
        'TbAdresseExp
        '
        Me.TbAdresseExp.BorderStyle = System.Windows.Forms.BorderStyle.FixedSingle
        Me.TbAdresseExp.Location = New System.Drawing.Point(160, 108)
        Me.TbAdresseExp.Name = "TbAdresseExp"
        Me.TbAdresseExp.Size = New System.Drawing.Size(184, 20)
        Me.TbAdresseExp.TabIndex = 3
        Me.TbAdresseExp.Text = ""
        '
        'LbSujet
        '
        Me.LbSujet.Location = New System.Drawing.Point(16, 176)
        Me.LbSujet.Name = "LbSujet"
        Me.LbSujet.Size = New System.Drawing.Size(32, 16)
        Me.LbSujet.TabIndex = 5
        Me.LbSujet.Text = "Sujet :"
        '
        'TbSujet
        '
        Me.TbSujet.BorderStyle = System.Windows.Forms.BorderStyle.FixedSingle
        Me.TbSujet.Location = New System.Drawing.Point(54, 176)
        Me.TbSujet.Name = "TbSujet"
        Me.TbSujet.Size = New System.Drawing.Size(290, 20)
        Me.TbSujet.TabIndex = 5
        Me.TbSujet.Text = ""
        '
        'RtbMessage
        '
        Me.RtbMessage.Location = New System.Drawing.Point(16, 211)
        Me.RtbMessage.Name = "RtbMessage"
        Me.RtbMessage.ScrollBars = System.Windows.Forms.RichTextBoxScrollBars.ForcedVertical
        Me.RtbMessage.Size = New System.Drawing.Size(328, 232)
        Me.RtbMessage.TabIndex = 6
        Me.RtbMessage.Text = ""
        '
        'BtEnvoyer
        '
        Me.BtEnvoyer.FlatStyle = System.Windows.Forms.FlatStyle.Flat
        Me.BtEnvoyer.Location = New System.Drawing.Point(136, 484)
        Me.BtEnvoyer.Name = "BtEnvoyer"
        Me.BtEnvoyer.Size = New System.Drawing.Size(80, 24)
        Me.BtEnvoyer.TabIndex = 7
        Me.BtEnvoyer.Text = "Envoyer"
        '
        'GrConfiguration
        '
        Me.GrConfiguration.Controls.AddRange(New System.Windows.Forms.Control() {Me.LbS, Me.TxtDelai, Me.VsDelai, Me.LbDelai, Me.TxNbEnvois, Me.VsNbEnvois, Me.LbNbEnvois, Me.LbServeurSMTP, Me.TbServeurSMTP})
        Me.GrConfiguration.Location = New System.Drawing.Point(16, 8)
        Me.GrConfiguration.Name = "GrConfiguration"
        Me.GrConfiguration.Size = New System.Drawing.Size(328, 80)
        Me.GrConfiguration.TabIndex = 1
        Me.GrConfiguration.TabStop = False
        Me.GrConfiguration.Text = "Configuration"
        '
        'Winsock
        '
        Me.Winsock.Enabled = True
        Me.Winsock.Location = New System.Drawing.Point(16, 482)
        Me.Winsock.Name = "Winsock"
        Me.Winsock.OcxState = CType(resources.GetObject("Winsock.OcxState"), System.Windows.Forms.AxHost.State)
        Me.Winsock.Size = New System.Drawing.Size(28, 28)
        Me.Winsock.TabIndex = 16
        '
        'TxNbEnvois
        '
        Me.TxNbEnvois.BackColor = System.Drawing.Color.AntiqueWhite
        Me.TxNbEnvois.BorderStyle = System.Windows.Forms.BorderStyle.FixedSingle
        Me.TxNbEnvois.Enabled = False
        Me.TxNbEnvois.Location = New System.Drawing.Point(127, 53)
        Me.TxNbEnvois.Name = "TxNbEnvois"
        Me.TxNbEnvois.ReadOnly = True
        Me.TxNbEnvois.Size = New System.Drawing.Size(41, 20)
        Me.TxNbEnvois.TabIndex = 15
        Me.TxNbEnvois.Text = "1"
        Me.TxNbEnvois.TextAlign = System.Windows.Forms.HorizontalAlignment.Right
        '
        'VsNbEnvois
        '
        Me.VsNbEnvois.Location = New System.Drawing.Point(106, 52)
        Me.VsNbEnvois.Maximum = 10000
        Me.VsNbEnvois.Name = "VsNbEnvois"
        Me.VsNbEnvois.Size = New System.Drawing.Size(14, 22)
        Me.VsNbEnvois.TabIndex = 2
        Me.VsNbEnvois.Value = 1
        '
        'LbNbEnvois
        '
        Me.LbNbEnvois.Location = New System.Drawing.Point(8, 56)
        Me.LbNbEnvois.Name = "LbNbEnvois"
        Me.LbNbEnvois.Size = New System.Drawing.Size(96, 16)
        Me.LbNbEnvois.TabIndex = 13
        Me.LbNbEnvois.Text = "Nombre d'envois : "
        '
        'LbServeurSMTP
        '
        Me.LbServeurSMTP.Location = New System.Drawing.Point(8, 23)
        Me.LbServeurSMTP.Name = "LbServeurSMTP"
        Me.LbServeurSMTP.Size = New System.Drawing.Size(88, 16)
        Me.LbServeurSMTP.TabIndex = 12
        Me.LbServeurSMTP.Text = "Serveur SMTP :"
        '
        'TbServeurSMTP
        '
        Me.TbServeurSMTP.BorderStyle = System.Windows.Forms.BorderStyle.FixedSingle
        Me.TbServeurSMTP.Location = New System.Drawing.Point(97, 20)
        Me.TbServeurSMTP.Name = "TbServeurSMTP"
        Me.TbServeurSMTP.Size = New System.Drawing.Size(221, 20)
        Me.TbServeurSMTP.TabIndex = 1
        Me.TbServeurSMTP.Text = ""
        '
        'Pbar
        '
        Me.Pbar.Location = New System.Drawing.Point(17, 455)
        Me.Pbar.Name = "Pbar"
        Me.Pbar.Size = New System.Drawing.Size(327, 20)
        Me.Pbar.Step = 1
        Me.Pbar.TabIndex = 12
        Me.Pbar.Value = 100
        Me.Pbar.Visible = False
        '
        'LbStatut
        '
        Me.LbStatut.BackColor = System.Drawing.Color.PeachPuff
        Me.LbStatut.Location = New System.Drawing.Point(7, 520)
        Me.LbStatut.Name = "LbStatut"
        Me.LbStatut.Size = New System.Drawing.Size(345, 16)
        Me.LbStatut.TabIndex = 13
        Me.LbStatut.Text = "état : en attente..."
        '
        'Timer
        '
        Me.Timer.Enabled = True
        Me.Timer.Interval = 1000
        Me.Timer.SynchronizingObject = Me
        '
        'LbDelai
        '
        Me.LbDelai.AutoSize = True
        Me.LbDelai.Font = New System.Drawing.Font("Microsoft Sans Serif", 6.75!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.LbDelai.Location = New System.Drawing.Point(177, 57)
        Me.LbDelai.Name = "LbDelai"
        Me.LbDelai.Size = New System.Drawing.Size(78, 11)
        Me.LbDelai.TabIndex = 16
        Me.LbDelai.Text = "Délai de réponse :"
        '
        'TxtDelai
        '
        Me.TxtDelai.BackColor = System.Drawing.Color.AntiqueWhite
        Me.TxtDelai.BorderStyle = System.Windows.Forms.BorderStyle.FixedSingle
        Me.TxtDelai.Enabled = False
        Me.TxtDelai.Location = New System.Drawing.Point(271, 54)
        Me.TxtDelai.Name = "TxtDelai"
        Me.TxtDelai.ReadOnly = True
        Me.TxtDelai.Size = New System.Drawing.Size(28, 20)
        Me.TxtDelai.TabIndex = 18
        Me.TxtDelai.Text = "30"
        Me.TxtDelai.TextAlign = System.Windows.Forms.HorizontalAlignment.Right
        '
        'VsDelai
        '
        Me.VsDelai.Location = New System.Drawing.Point(254, 55)
        Me.VsDelai.Maximum = 10000
        Me.VsDelai.Minimum = 1
        Me.VsDelai.Name = "VsDelai"
        Me.VsDelai.Size = New System.Drawing.Size(12, 17)
        Me.VsDelai.TabIndex = 17
        Me.VsDelai.Value = 30
        '
        'LbS
        '
        Me.LbS.AutoSize = True
        Me.LbS.Font = New System.Drawing.Font("Microsoft Sans Serif", 6.75!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.LbS.Location = New System.Drawing.Point(304, 57)
        Me.LbS.Name = "LbS"
        Me.LbS.Size = New System.Drawing.Size(18, 11)
        Me.LbS.TabIndex = 19
        Me.LbS.Text = "sec"
        '
        'Principal
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
        Me.BackColor = System.Drawing.Color.AntiqueWhite
        Me.ClientSize = New System.Drawing.Size(358, 540)
        Me.Controls.AddRange(New System.Windows.Forms.Control() {Me.LbStatut, Me.Pbar, Me.GrConfiguration, Me.BtEnvoyer, Me.RtbMessage, Me.LbSujet, Me.TbSujet, Me.LbExp, Me.TbAdresseExp, Me.LbDest, Me.TbAdresseDest, Me.Winsock})
        Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.Fixed3D
        Me.MaximizeBox = False
        Me.Name = "Principal"
        Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen
        Me.Text = "Douby's mailer"
        Me.GrConfiguration.ResumeLayout(False)
        CType(Me.Winsock, System.ComponentModel.ISupportInitialize).EndInit()
        CType(Me.Timer, System.ComponentModel.ISupportInitialize).EndInit()
        Me.ResumeLayout(False)

    End Sub

#End Region
    Dim nNbSecAttente As Integer
    Dim sRepServeur As String
    Dim bSTOP As Boolean

    Private Sub BtEnvoyer_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtEnvoyer.Click
        Dim nI As Integer
        If BtEnvoyer.Text = "Envoyer" Then
            BtEnvoyer.Text = "STOP"
            sRepServeur = ""
            bSTOP = False
            Pbar.Value = 0
            Pbar.Maximum = VsNbEnvois.Value
            Pbar.Visible = True
            Winsock.LocalPort = 0
            Winsock.Protocol = MSWinsockLib.ProtocolConstants.sckTCPProtocol
            Winsock.RemoteHost = Trim(TbServeurSMTP.Text)
            Winsock.RemotePort = 25
            If Winsock.CtlState = 0 Then
                LbStatut.Text = "état: Tentative de connexion..."
                Winsock.Connect()
                AttenteReponseServeur("220")
                If Not bSTOP Then
                    Winsock.SendData("HELO DouByWorD.com" + vbCrLf)
                    LbStatut.Text = "état: Authentification sur le serveur"
                    AttenteReponseServeur("250")
                    For nI = 1 To VsNbEnvois.Value
                        If Not bSTOP Then
                            EnvoiEmail(Trim(TbAdresseExp.Text), Trim(TbAdresseDest.Text), Trim(TbSujet.Text), Trim(RtbMessage.Text))
                            Pbar.Value = nI
                        End If
                    Next nI
                    Winsock.SendData("quit" + vbCrLf)
                    LbStatut.Text = "état: Déconnexion en cours..."
                    AttenteReponseServeur("221")
                End If
                Winsock.Close()
                LbStatut.Text = "Opération terminée"
            Else
                MsgBox("Impossible d'initialiser la connexion", MsgBoxStyle.Critical, "Erreur Winsock")
                bSTOP = True
            End If
            Winsock.Close()
            If Not bSTOP Then
                MsgBox("Opération terminée", MsgBoxStyle.Information, "information")
            Else
                MsgBox("Opération annulée", MsgBoxStyle.Critical)
            End If
            Pbar.Visible = False
            BtEnvoyer.Text = "Envoyer"
        Else
            bSTOP = True
        End If
    End Sub

    Private Sub BtEnvoyer_MouseEnter(ByVal sender As Object, ByVal e As System.EventArgs) Handles BtEnvoyer.MouseEnter
        BtEnvoyer.FlatStyle = FlatStyle.Standard
    End Sub

    Private Sub BtEnvoyer_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles BtEnvoyer.MouseLeave
        BtEnvoyer.FlatStyle = FlatStyle.Flat
    End Sub


    Private Sub VsNbEnvois_Scroll(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ScrollEventArgs) Handles VsNbEnvois.Scroll
        TxNbEnvois.Text = Trim(Str(VsNbEnvois.Value))
    End Sub


    Sub EnvoiEmail(ByVal sAdresseExp As String, ByVal sAdresseDest As String, ByVal sSujet As String, ByVal sMessage As String)
        Dim sEtapeCom(8, 3) As String
        Dim nCpt As Integer

        sEtapeCom(1, 1) = "mail from:" + Chr(32) + sAdresseExp + vbCrLf
        sEtapeCom(1, 2) = "250"
        sEtapeCom(1, 3) = "Déclaration de l'expéditeur"
        sEtapeCom(2, 1) = "rcpt to:" + Chr(32) + sAdresseDest + vbCrLf
        sEtapeCom(2, 2) = "250"
        sEtapeCom(2, 3) = "Déclaration du destinataire"
        sEtapeCom(3, 1) = "data" + vbCrLf
        sEtapeCom(3, 2) = "354"
        sEtapeCom(3, 3) = "Transmission de la commande data"
        sEtapeCom(4, 1) = "subject:" + sSujet + vbCrLf
        sEtapeCom(4, 2) = ""
        sEtapeCom(4, 3) = "Transmission du sujet du message"
        sEtapeCom(5, 1) = sMessage + vbCrLf
        sEtapeCom(5, 2) = ""
        sEtapeCom(5, 3) = "Transmission du corps du message"
        sEtapeCom(6, 1) = vbCrLf + "." + vbCrLf
        sEtapeCom(6, 2) = "250"
        sEtapeCom(6, 3) = "Trasmission de la requête de fin de transmission"

        For nCpt = 1 To 6
            If Not bSTOP Then
                LbStatut.Text = "état: " + sEtapeCom(nCpt, 3)
                Winsock.SendData(sEtapeCom(nCpt, 1))
                If Len(Trim(sEtapeCom(nCpt, 2))) <> 0 Then
                    AttenteReponseServeur(sEtapeCom(nCpt, 2))
                End If
            End If
        Next nCpt
        LbStatut.Text = "Opération terminée"
    End Sub


    Sub AttenteReponseServeur(ByVal sCodeReponseAttendu As String)
        Dim nNbSecMaxReponse As Integer

        nNbSecMaxReponse = VsDelai.Value
        nNbSecAttente = 0

        While Len(sRepServeur) = 0 And Not bSTOP
            Application.DoEvents()
            If nNbSecAttente > nNbSecMaxReponse Then
                MsgBox("Le serveur SMTP ne répond pas - délai de réponse imparti dépassé", 64, "erreur")
                bSTOP = True
                Exit Sub
            End If
        End While
        While Mid(sRepServeur, 1, 3) <> sCodeReponseAttendu And Not bSTOP
            Application.DoEvents()
            If nNbSecAttente > nNbSecMaxReponse Then
                MsgBox("Code de retour attendu du serveur SMTP incorrect, attendu : " + sCodeReponseAttendu + " reçu : " + sRepServeur, 64, "erreur")
                bSTOP = True
                Exit Sub
            End If
        End While
        sRepServeur = ""
    End Sub


    Private Sub Timer_Elapsed(ByVal sender As System.Object, ByVal e As System.Timers.ElapsedEventArgs) Handles Timer.Elapsed
        nNbSecAttente = nNbSecAttente + 1
    End Sub


    Private Sub Winsock_DataArrival(ByVal sender As Object, ByVal e As AxMSWinsockLib.DMSWinsockControlEvents_DataArrivalEvent) Handles Winsock.DataArrival
        Winsock.GetData(sRepServeur)
    End Sub

    Private Sub VsDelai_Scroll(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ScrollEventArgs) Handles VsDelai.Scroll
        TxtDelai.Text = Trim(Str(VsDelai.Value))
    End Sub
End Class