Anonyme mailor

Télécharger le projet
Commenter

Description

Oui je sais, vous allez sûrement me dire qu'il existe des centaines de milliers de code source permettant de faire ça...

Mais moi je pense apporter ma petite pierre, puisque mon programme utilise un mélange de code source que j'ai trouvé un peu partout sur le web, et qui envoie un mail anonyme en utilisant le smtp du l'utilisateur qui envoie le message en le cherchant dans la base de registre ( voir capture ! )

EDIT : j'ai mis à jour la source, j'ai rajouter quelques débug !

Source / Exemple : 


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

Conclusion :


Je tiens à remercier Renfield pour son magnifique OCX et vincentescalade pour sa source en VBS qui permet d'envoyer un mail sans problème ;)

J'ai mis à jour le .zip afin d'y incorporer l' ocx de Renfield !
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (ZogStriP)