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 !
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.