1. Accueil
  2. Visual Basic / VB.NET
  3. Sources Visual Basic / VB.NET
  4. Sources Réseau & Internet
  5. Anonym mail simple et expliqué (winsock + progressbar)

Anonym mail simple et expliqué (winsock + progressbar)

0/5 (26 avis)

Vue 15 085 fois - Téléchargée 1 614 fois

Télécharger le projet
Commenter

Description

Si vous voulez un example regarder la capture d'écran
Le code est pas compliké, y a aussi une bonne gestion de la barre de progression(lettres apres lettres)
Pour l'instant on peut envoyer qu'à une personne

Source / Exemple : 


dans le module
------------------

Option Explicit

Public Type Retour
    valeur As Boolean
    libelle As String
End Type

Public Function Vérification_Champs() As Retour
    Dim temp As Retour
    temp.valeur = False
    If F.Text_Serveur.Text = "" Then temp.libelle = "Vous devez remplir le champ [Serveur]": Vérification_Champs = temp: Exit Function
    If F.Text_Mail_Dest.Text = "" Then temp.libelle = "Vous devez remplir le champ du [Mail Destinataire]": Vérification_Champs = temp: Exit Function
    temp.valeur = True
    Vérification_Champs = temp
End Function

Public Function Recup(ByVal temp As String, code As Integer) As Boolean
    If Val(Mid(temp, 1, 3)) = code Then
        Recup = True
    Else
        Recup = False
    End If
End Function

Dans la frame
-----------------

Dim Etape As Integer
Dim Erreur As Boolean

Private Sub Command1_Click()
    Dim ret
    Dim temp As Retour
    Erreur = False
    MousePointer = fmMousePointerAppStarting
    temp = Vérification_Champs
    If temp.valeur = False Then     'Erreur
        ret = MsgBox(temp.libelle, vbCritical, "Erreur")
        MousePointer = fmMousePointerDefault
    Else                            'On met en forme les données
        Etape = 0
        If Not W.State = 0 Then W.Close
        DoEvents
        W.RemoteHost = Text_Serveur.Text
        W.Connect
    End If
End Sub

Private Sub Form_Load()
    W.RemotePort = 25
    W.LocalPort = 1003
    Bar.max = 60
End Sub

Private Sub W_DataArrival(ByVal bytesTotal As Long)
    Dim Temp_Recep, Temp_Envoi As String
    Dim ret
    
    W.GetData Temp_Recep, vbString
    Select Case Etape
    Case 0
        If Recup(Temp_Recep, 220) Then
            '''''''''''' Recup du nom du serveur pour la commande "HELO {Nom du serveur}"
            Temp_Envoi = "HELO " & Text_Serveur
            Envoyer (Temp_Envoi)
        Else
            MsgBox ("Problème lors de la Connexion" & vbCrLf & Temp_Recep)
            MousePointer = fmMousePointerDefault
        End If
    Case 1          'On est connecté et on a envoyer "HELO {Nom du serveur}"
        If Recup(Temp_Recep, 250) Then
            '''''''''''' Le Helo est bien pris en compte et on peux commencer à envoyer...
            Temp_Envoi = "MAIL FROM: " & "<" & Text_Mail_Emet & ">"
            Envoyer (Temp_Envoi)
        Else
            '''''''''''' Le HELO est rejeté
            MsgBox ("Problème lors de la réponse au HELO" & vbCrLf & Temp_Recep)
            MousePointer = fmMousePointerDefault
        End If
    Case 2
        If Recup(Temp_Recep, 250) Then
            '''''''''''' Le MAIL FROM: est accepté
            Temp_Envoi = "RCPT TO: " & "<" & Text_Mail_Dest & ">"
            Envoyer (Temp_Envoi)
        Else
            '''''''''''' Le MAIL FROM: n'est pas accepté
            MsgBox ("Problème lors de la réponse au MAIL FROM" & vbCrLf & Temp_Recep)
            MousePointer = fmMousePointerDefault
        End If
    Case 3
        If Recup(Temp_Recep, 250) Then
            '''''''''''' Le RCPT est accepté, on a fait le plus dur ;)
            Temp_Envoi = "DATA"
            Envoyer (Temp_Envoi)
        Else
            '''''''''''' Le serveur n'est pas open relay ou alors le destinataire est inconnu
            MsgBox ("Problème lors de la réponse au RCPT TO" & vbCrLf & Temp_Recep)
            MousePointer = fmMousePointerDefault
        End If
    Case 4
        If Recup(Temp_Recep, 354) Then
            Temp_Envoi = ""
            '''''''''''' Remplir les champs correspondant à l'emetteur
            If Not Text_Nom_Emet = "" Or Not Text_Mail_Emet = "" Then
                Temp_Envoi = "From: "
                If Not Text_Nom_Emet = "" Then Temp_Envoi = Temp_Envoi & Chr(34) & Text_Nom_Emet & Chr(34) & " "
                If Not Text_Mail_Emet = "" Then Temp_Envoi = Temp_Envoi & "<" & Text_Mail_Emet & ">"
                Temp_Envoi = Temp_Envoi & vbCrLf
            End If
            
            ''''''''''' Remplir les champs correspondant au destinataire
            Temp_Envoi = Temp_Envoi & "To: "
            If Not Text_Nom_Dest = "" Then Temp_Envoi = Temp_Envoi & Chr(34) & Text_Nom_Dest & Chr(34) & " "
            Temp_Envoi = Temp_Envoi & "<" & Text_Mail_Dest & ">" & vbCrLf
            
            ''''''''''' Ajouter le sujet du mail
            Temp_Envoi = Temp_Envoi & "Subject: " & Text_Sujet & vbCrLf & vbCrLf '2 sauts de lignes pour dire que l'on passe au corps du msg
            
            ''''''''''' Ajouter le corps du message
            Temp_Envoi = Temp_Envoi & Text_Msg & vbCrLf & "."
            ''''''''''' On Envoie tout
            Envoyer (Temp_Envoi)
        Else
            MsgBox ("Problème lors de la réponse au DATA" & vbCrLf & Temp_Recep)
            MousePointer = fmMousePointerDefault
        End If
        Case 5
                
            If Not Recup(Temp_Recep, 250) Then
                ''''''' Si pb lors de la fin du message
                MsgBox ("Problème lors de la fin du corps du message" & vbCrLf & Temp_Recep)
                MousePointer = fmMousePointerDefault
            Else
                ''''''' Le message a bien été envoyé ;) C po cool ca?
            End If
                Envoyer ("QUIT")
        Case 6
            If Recup(Temp_Recep, 221) Then
                If Not Erreur Then ret = MsgBox("Merci pour ce gentil programme" & vbCrLf & "qui m'a permis d'envoyer un" & vbCrLf & "E-mail @nonyme ;)", vbInformation, "Fin")
            Else
                MsgBox ("Problème lors de la déconnexion du serveur" & vbCrLf & Temp_Recep)
            End If
            Etape = -1
            W.Close
            MousePointer = fmMousePointerDefault
    End Select
    Etape = Etape + 1
End Sub

Private Sub W_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 (Description)
    If W.State = 7 Then
        ''''''' Pour pas avoir le message MErci pour ce gentil prog....
        Erreur = True
        Envoyer ("quit")
        DoEvents
        Etape = 6
    Else
        W.Close
    End If
    MousePointer = fmMousePointerDefault
End Sub

Public Function Envoyer(temp As String)
Dim i, max, max_bar, comp_bar, delta_bar
''''''''''' on envoi les lettres une à une et en mm temps on fait progresser la barre1
max = Len(temp)
Bar.Value = Etape * 10
delta_bar = 10 / Len(temp)
For i = 1 To max Step 1
    W.SendData (Mid(temp, i, 1))
    Bar.Value = Bar.Value + delta_bar
Next i
W.SendData (vbCrLf)
End Function

Conclusion :


pour envoyer un mail:
-vous devez au moins remplir le champ serveur et l'adresse du destinataire
-le serveur SMTP doit etre celui qu'utilise le destinataire (pour bidule@wandoo.fr utiliser le serveur de wanadoo: mail.wanadoo.fr) ou alors un serveur "open relay" (c'est deja plus dur à trouver)

Je me suis pas renseigné assez mais pour ma part le serveur SMTP de monfournisseur me permet d'envoyer des mails à n'importe quels e-mail... Testez avec le votre...
Si vous avez d'autres questions ou peut etre des suggestions envoyer moi un message
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
olivierXIII
Messages postés
50
Date d'inscription
lundi 21 avril 2003
Statut
Membre
Dernière intervention
4 août 2005
6 févr. 2005 à 10:53
J'avais déja eu ce probleme, qui est 'fixé'
Pour ma part j'envoi "QUIT" au serveur, j'attend qu'il me déconnecte, PUIS dans sck_OnClose il faut faire sck.CloseSocket (ou .Close avec winsock).
Sinon la connexion reste dans l'état sckClosing.

Et la plus de problème.
tbbuim1
Messages postés
940
Date d'inscription
jeudi 20 février 2003
Statut
Membre
Dernière intervention
3 février 2011
 9
6 févr. 2005 à 10:45
Effectivement j'ai mis un w.close un peu partout mais rien n'y fait. j'ai toujours address in use pendant 10min lorsque j'envoi un mail avec une adresse bidon n'ont pris en compte par le serveur. Genre Moi@toi.com
Connais-tu un moyen pour éviter ce probleme de "address in use"? C'est chiant, j'essaye de mettre un mail anonyme mais le temps que j'en trouve une qui est acceptée par le serveur, une lettre de la poste à le temps d'arriver...
SkyRocKo
Messages postés
174
Date d'inscription
samedi 10 mai 2003
Statut
Membre
Dernière intervention
18 février 2006
5 févr. 2005 à 22:05
Excellent !!! 10/10

Dommage qu'on doive spécifier le serveur smtp mais bon, c'est la vie !

Bonne continuation

++
cs_Repie
Messages postés
103
Date d'inscription
mardi 10 octobre 2000
Statut
Membre
Dernière intervention
5 mars 2006
5 juin 2004 à 00:40
c bizare dans la logique si l'appelé (le serveur) clos la connexion le port est de nouveau utilisable (le serveur clos la connexion au moment ou l'on envoie "QUIT" il me semble) mais c'est vrai que cela fait lgt que j'ai posté... par contre si un w.close doit etre placé ce n'est pas au form_load etant donné qu'il est appelé qu'une fois au lancement, je le verrai mieux au moment ou on appuie sur le boutton envoyer
(et en regardant mon code g l'impression d'avoir pris en compte cette erreur puisque j'ai mis
If Not W.State = 0 Then W.Close)
tbbuim1
Messages postés
940
Date d'inscription
jeudi 20 février 2003
Statut
Membre
Dernière intervention
3 février 2011
 9
4 juin 2004 à 10:35
Pas mal, mais il manque quelque chose d'essentiel!!!!!!!!!!!!!!!!!!!!
Dans le form_load
il faut mettre en premier
W.Close
Et oui, autrement si ya le moindre problème
La barre de progressement s'arrête en plein milieu et il est impossible d'envoyer un mail pendant plus de 10min selon le serveur utilisé...
Il affiche l'erreur: "address in use"
(Cf cours Winsock étape1 sur http://grafikm.developpez.com/vbreseau/ )
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 (cs_Repie)