Vmail x - client smtp pour l'envoi de mail + exe/activex !

Soyez le premier à donner votre avis sur cette source.

Vue 9 139 fois - Téléchargée 1 596 fois

Description

C'est une de mes grosses réalisations que je vous présente ici...
Tout est y est : Design, code bien gras, fonctionel, etc...

Ce programme est un client SMTP qui permet d'envoyer des mails, comme un tout bête anonymiseur en utilisant Winsock.

Mais il est joli (l'interface est adaptée de celle du site vbfrance, merci Nix, même si je ne t'ai pas demandé ton autorisation)... Et en plus, ce programme est UN EXECUTABLE ACTIVE X !

Un EXE/ActiveX ??? Pourquoi faire ? Et bien, en l'incluant dans les références de vos programmes VB/Access ou autre, vous pourrez utiliser les méthodes/propriétés du programme pour envoyer un mail, créer/lire un fichier ini, crypter/décrypter des fichiers, etc...

Il reste quelques bugs, comme la définition du type MIME d'un fichier... Qui sous NT, par exemple, renvoie toujours "Application Octet/Stream"... L'utilisation de l'ajout de destinataire sous forme de collection (bien que la collection existe, elle ne fonctionne pas encore !!!), le codage au format MIME qui est très lent (evitez les pieces jointes de plus de 500 Ko) et bien sur les bugs qui restent à éliminer...

Pour l'utilisation sous forme d'ActiveX, je joint le code ci dessous :

Source / Exemple :


' Après avoir ajouté la référence à vmailx.exe dans votre programme
' Voici le code à ajouter, par exemple sur clic d'un bouton

Sub cmdMail_OnClick()
    ' Utilisation de l'envoi de mail
    
    Dim MyMail As vMailX.SendMail
    Set MyMail = New vMailX.SendMail
    
    ' On vérifie la connection à Internet
    If MyMail.EstConnecte = True Then
    
        With MyMail
            .AdresseFrom = "monadresse@moncompte.fr" ' Nom du destinataire
            .AdresseFromName = "Mon Nom" ' Nom de l'emmeteur
            
            ' Ancienne méthode d'ajout de destinataire
            '.AdresseTo = "destinataire1@compte.fr;destinataire2@compte.fr" ' Destinataire
            ' Nouvelle méthode sous forme de collection
            .Destinataire.Add "d1", "destinataire1@compte.fr", MailTo
            .Destinataire.Add "d2", "destinataire2@compte.fr", MailCc
            
            .AttacherFichier.Add , "C:\autoexec.bat", "Fichier Autoexec" ' Ajout d'un fichier
            .DomainSource = "mon.ordinateur.fr" ' Nom du PC pour le HELO au serveur SMTP
            .MailObjet = "Objet du mail" ' Objet du mail
            .MailFormat = eTEXT ' Format du mail
            .MailContenu = "Corps du mail au format texte" ' Corps du mail
            .MailPriorite = eNormalPriority ' Priorité du Mail
            .MailServeur = "mail.serveursmtp.fr" ' Serveur de mail SMTP
            .TimeOut = 30 ' en secondes
            .xMailer = "MyMail Mailer" ' Nom du Mailer qui a envoyé le mail
            ' Si le time out est dépassé, on retente l'envoi
            .RéessayerEnvoi = True
            ' On affiche la fenêtre de progression
            .AfficherEnvoi = True
        End With
    
        MyMail.MailSend
        
        If MyMail.ErreurNumber = 0 Then
            MsgBox "Message correctement envoyé !"
        Else
            MsgBox MyMail.ErreurDescription
        End If
        
    End If
End Sub

Sub cmdSaveValue_Click()
    ' Utilisation des fichiers INI
    
    Dim MyIni As vMailX.Ini
    Set MyIni = New vMailX.Ini
    
    With MyIni
        .IniFile = "C:\myinifile.ini"
        .WriteIni "TEST", "CONFIG", "ceci est un test"
    End With
    
    MsgBox MyIni.ReadIni("TEST", "CONFIG", "Je sais pas ?")
End Sub

Sub cmdGetInfo_Click()
    ' Utilisation des infos systèmes
    
    Dim MyInfo As vMailX.LocalInfo
    Set MyInfo = New vMailX.LocalInfo
    
    With MyInfo
        MsgBox "Nom de l'ordinateur : " & .CurrentComputer
        MsgBox "Nom de l'utilisateur : " & .CurrentUser
        MsgBox "Version de Windows : " & .WindowsVersion
        ' etc...
    End With
End Sub

' Ne sont pas présent les démonstrations pour Cryptage et Codage...
' (c) Cyril PORTET, Janvier 2002 - Avril 2002
' vMail X version 0.1.60

Conclusion :


Note du 23/05/2002 :
Merci de me remonter les bugs, les problemes, les ameliorations a apporter... Et n'hesitez pas à vous en servir, pour l'instant, c'est du tout FREE !

Note du 27/05/2002 :
J'ai fait une mise à jour partielle du code.
Maintenant le destinataire du message se renseigne sous forme d'une collection comme pour les pieces jointes, j'ai corrigé 2 ou 3 petits bugs mineurs, et là j'attaque le format MIME et l'encodage en version plus rapide...

A+
Cyrilp

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

cs_seboss
Messages postés
39
Date d'inscription
dimanche 13 janvier 2002
Statut
Membre
Dernière intervention
26 avril 2006
-
plutot po mal :-)
cs_Jack
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
61 -
Tu rigoles, c'est excellent :
- Très belle présentation
- Des méthodes sures (vb5 d'accord)
Pour le faire fonctionner, il faut juste aller dans le fichier INI et modifier le serveur par le vôtre (pop.free.fr par exemple) au lieu de l'adresse IP bizarre (10.1.0.1) qu'il met.
Si tu allais farfouinner dans la base de registre, tu trouverais tout ce genre de renseignements qui ne s'initialisent pas ici.
Bravo, bravo, ça me plais beaucoup (10)
cs_MarcoPaulo
Messages postés
3
Date d'inscription
vendredi 5 juillet 2002
Statut
Membre
Dernière intervention
18 décembre 2005
-
Ta source m'a ete tres utile pour construire mon redirecteur de fax. Merci beaucoup.
Si cela t'interese, j'ai modifie 2 choses.
1) un coup de pop quand je me fais jeter par 500(lock by pop)
2) le system d'encodage

Private Const base64_alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="

Public Function b64EncodeFile(strFilePath As String) As String
On Error GoTo ErrEdit
Dim lFileSize
Dim nbligne
Dim temp As String
Dim bStr As String * 1
Dim rStr As String * 3
Dim inFile As Long
Dim nPos As Long
Dim tPos As Long
Dim pour As String
b64EncodeFile = ""
inFile = FreeFile
rStr = ""
bStr = 0
nPos = 0
tPos = 0


If Dir(strFilePath) = "" Then GoTo ErrEdit
lFileSize = FileLen(strFilePath)
nbligne = Int(lFileSize / 3)
Open strFilePath For Binary Access Read As inFile
Do While nPos < nbligne
tPos = tPos + 1
nPos = nPos + 1
DoEvents
Get #inFile, , rStr
temp = temp & base64_enc_buffer(rStr)
If Len(temp) = 76 Then
b64EncodeFile = b64EncodeFile & temp & vbCrLf
temp = ""
End If
rStr = ""
Loop
If Len(temp) > 0 Then
b64EncodeFile = b64EncodeFile & temp
End If
If lFileSize - (nbligne * 3) > 0 Then
temp = ""
For tPos = 1 To lFileSize - (nbligne * 3)
Get #inFile, , bStr
temp = temp & bStr
Next
b64EncodeFile = b64EncodeFile & base64_enc_buffer(temp) & vbCrLf
End If
Close inFile
b64EncodeFile = b64EncodeFile & vbCrLf
Exit Function

ErrEdit:
b64EncodeFile = ""
Exit Function
End Function
Private Function base64_enc_buffer(str As String) As String

Dim r1 As String
Dim r2 As String
Dim r3 As String
Dim r4 As String

Select Case Len(str)
Case 0
r1 = ""
r2 = ""
r3 = ""
r4 = ""
Case 1
r1 = base64(Int((Asc(Mid(str, 1, 1))) / 4))
r2 = base64((Asc(Mid(str, 1, 1)) Mod 4) * 16)
r3 = base64(64)
r4 = base64(64)
Case 2
r1 = base64(Int((Asc(Mid(str, 1, 1))) / 4))
r2 = base64((Int((Asc(Mid(str, 2, 1))) / 16)) + ((Asc(Mid(str, 1, 1)) Mod 4) * 16))
r3 = base64((Asc(Mid(str, 2, 1)) Mod 16) * 4)
r4 = base64(64)
Case 3
r1 = base64(Int((Asc(Mid(str, 1, 1))) / 4))
r2 = base64((Int((Asc(Mid(str, 2, 1))) / 16)) + ((Asc(Mid(str, 1, 1)) Mod 4) * 16))
r3 = base64((Int((Asc(Mid(str, 3, 1))) / 64)) + ((Asc(Mid(str, 2, 1)) Mod 16) * 4))
r4 = base64(Asc(Mid(str, 3, 1)) Mod 64)
End Select

base64_enc_buffer = r1 & r2 & r3 & r4
End Function
Private Function base64(num As Byte) As String
If (num < 65 And num > -1) Then
base64 = Mid(base64_alphabet, num + 1, 1)
Else
base64 = ""
End If
End Function
fofodavid
Messages postés
47
Date d'inscription
mardi 18 mars 2003
Statut
Membre
Dernière intervention
29 août 2004
-
ouiias bof bof
cs_jbel
Messages postés
5
Date d'inscription
mercredi 30 avril 2003
Statut
Membre
Dernière intervention
11 avril 2006
-
Pas mal ce prog... même très bien je dois dire! C'est mieux que ce que je cherchais.
J'ai juste un petite question quand même:

en utilisant un serveur "Microsoft Exchange Server" j'arrive à envoyer des mails en interne en mettant le nom de mon serveur, mais comment faire pour envoyer des mails en externe???

Merci ++

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.