ENVOYER UN MAIL EN SE FAISANT PASSER POUR QUELQU'UN D'AUTRE AVEC PIECE JOINTE CE

konyaliseref Messages postés 35 Date d'inscription mercredi 12 mars 2003 Statut Membre Dernière intervention 20 juillet 2005 - 17 avril 2003 à 16:13
hwoarangbe04 Messages postés 3 Date d'inscription mardi 17 mai 2005 Statut Membre Dernière intervention 26 juin 2008 - 4 juil. 2012 à 10:20
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.

https://codes-sources.commentcamarche.net/source/6768-envoyer-un-mail-en-se-faisant-passer-pour-quelqu-un-d-autre-avec-piece-jointe-certifie-sans-bug

hwoarangbe04 Messages postés 3 Date d'inscription mardi 17 mai 2005 Statut Membre Dernière intervention 26 juin 2008
4 juil. 2012 à 10:20
J'aimerais teste ce petit outil mais avec quel programme je peux l'executer?

Merci d'avance
cs_PaTaTe Messages postés 2126 Date d'inscription mercredi 21 août 2002 Statut Contributeur Dernière intervention 19 février 2021 2
5 juin 2005 à 13:25
ca marche si on connais un serveur mail nous refusant pas .... ca c une autre histoire !

Pas de note parce ke je peux pas tester objectivement la chose.
pcpunch Messages postés 1243 Date d'inscription mardi 7 mai 2002 Statut Membre Dernière intervention 18 février 2019 5
28 janv. 2004 à 18:36
Y a des erreurs domage!!! Bug
flejeune Messages postés 1 Date d'inscription jeudi 27 février 2003 Statut Membre Dernière intervention 25 juin 2003
25 juin 2003 à 09:59
Voici la source à utiliser pour envoyer une pièce jointe. Je ne l'ai testée qu'une fois mais ça marche.

C'est la source ci-dessus mais j'ai rajouté une fonction "UUENCODE" trouvée sur une autre source de ce site. Un nouveau paramètre "FileToSend" est à fournir à la fonction "envoyer": le path du fichier à joindre.

Bon amusement. A+


Option Explicit
Dim Sock As Winsock

Function Envoyer(Socket As Winsock, Nom_Exped As String, Mail_Exped As String, Nom_Destin As String, Mail_Destin As String, Objet As String, Optional Sujet As String "", Optional Serveur As String "Serveur Par Defaut", Optional FileToSend As String) As Boolean

Envoyer = False
Set Sock = Socket
Sock.Close
Sock.RemotePort = 25
Sock.RemoteHost = Serveur

Dim T(6) As String
Dim mFrom As String
Dim mTo As String
Dim mMess As String

mFrom = Nom_Exped & " " & "<" & Mail_Exped & ">"
mTo = Nom_Destin & " " & "<" & Mail_Destin & ">"
mMess = ""
mMess = "FROM: " & mFrom & vbCrLf & "TO: " & mTo & vbCrLf

If Sujet <> "" Then mMess = mMess & "SUBJECT:" & Sujet & vbCrLf & vbCrLf

mMess = mMess & Objet & vbCrLf
T(0) = "HELO " & Serveur & vbCrLf
T(1) = "MAIL FROM: " & "<" & Mail_Exped & ">" & vbCrLf
T(2) = "RCPT TO: " & "<" & Mail_Destin & ">" & vbCrLf
T(3) = "DATA" & vbCrLf
T(4) = mMess & vbCrLf & UUEncodeFile(FileToSend)
T(5) = vbCrLf & "." & vbCrLf
T(6) = "QUIT" & vbCrLf

Dim i As Integer, c As Integer

Sock.Close

Sock.Connect

For c = 1 To 10
For i = 1 To 5000
DoEvents
Next i
DoEvents
If Sock.State = sckConnected Then Exit For
Next c

If Sock.State <> sckConnected Then Envoyer = False: Exit Function

For i = 0 To 6
DoEvents

If Not SdTxt(T(i)) Then
Exit For
Err.Number = 1
End If

Next i

If Err.Number 0 Then Envoyer True

End Function

Function SdTxt(txt As String) As Boolean

SdTxt = False

Dim i As Integer
Dim tmp As String * 1

For i = 1 To Len(txt)
tmp = Mid$(txt, i, 1)
Sock.SendData tmp
Next i

If Err.Number 0 Then SdTxt True

End Function




Public Function UUEncodeFile(strFilePath As String) As String

Dim intFile As Integer
Dim intTempFile As Integer
Dim lFileSize As Long
Dim strFileName As String
Dim strFileData As String
Dim lEncodedLines As Long
Dim strTempLine As String
Dim i As Long
Dim j As Integer

Dim strResult As String

strFileName = Mid$(strFilePath, InStrRev(strFilePath, "") + 1)

strResult = "begin 664 " + strFileName + vbLf

lFileSize = FileLen(strFilePath)
lEncodedLines = lFileSize 45 + 1

strFileData = Space(45)

intFile = FreeFile

Open strFilePath For Binary As intFile

For i = 1 To lEncodedLines
DoEvents
If i = lEncodedLines Then

strFileData = Space(lFileSize Mod 45)
End If

Get intFile, , strFileData

strTempLine = Chr(Len(strFileData) + 32)

If i = lEncodedLines And (Len(strFileData) Mod 3) Then


strFileData = strFileData + Space(3 - (Len(strFileData) Mod 3))
End If

For j = 1 To Len(strFileData) Step 3
DoEvents
strTempLine = strTempLine + Chr(Asc(Mid(strFileData, j, 1)) 4 + 32)

strTempLine = strTempLine + Chr((Asc(Mid(strFileData, j, 1)) Mod 4) * 16 _
+ Asc(Mid(strFileData, j + 1, 1)) 16 + 32)

strTempLine = strTempLine + Chr((Asc(Mid(strFileData, j + 1, 1)) Mod 16) * 4 _
+ Asc(Mid(strFileData, j + 2, 1)) 64 + 32)

strTempLine = strTempLine + Chr(Asc(Mid(strFileData, j + 2, 1)) Mod 64 + 32)
Next j

strTempLine = Replace(strTempLine, " ", "`")

strResult = strResult + strTempLine + vbLf

strTempLine = ""
Next i

Close intFile


strResult = strResult & "`" & vbLf + "end" + vbLf

UUEncodeFile = strResult
End Function
cs_Douns Messages postés 100 Date d'inscription lundi 16 septembre 2002 Statut Membre Dernière intervention 19 septembre 2005 1
25 avril 2003 à 15:51
Ouah! Le Kardesh y prog en VB, hallucinant!
Par contre, tu es toujours aussi mauvais en orthographe...
" toutefois si des bug apparaisse faites "
T'as pas l'impression qui manque quelque chose...
konyaliseref Messages postés 35 Date d'inscription mercredi 12 mars 2003 Statut Membre Dernière intervention 20 juillet 2005
24 avril 2003 à 17:47
ca y est g rajouter un systeme pour joindre des pieces et aussi un autre pour sauvegarder les parametres dans le registre
super!!!!!!!!!
konyaliseref Messages postés 35 Date d'inscription mercredi 12 mars 2003 Statut Membre Dernière intervention 20 juillet 2005
24 avril 2003 à 16:09
test
ICIoBRa Messages postés 368 Date d'inscription dimanche 24 juin 2001 Statut Membre Dernière intervention 7 décembre 2015
18 avril 2003 à 15:36
En effet cher Clem, je suis très partiellement d'accord avec vous ;p
konyaliseref Messages postés 35 Date d'inscription mercredi 12 mars 2003 Statut Membre Dernière intervention 20 juillet 2005
18 avril 2003 à 15:23
YAHOO CA Y EST JAI REUSSI A METTRE MA SOURCE DONC VOILA VOUS POUVEZ DELIRER TRANQUILLE AMUSEZ VOUS BIEN !!!
CIAO TOUS
$EREF
cs_Clem Messages postés 282 Date d'inscription dimanche 1 avril 2001 Statut Membre Dernière intervention 12 février 2007
18 avril 2003 à 15:22
ICIoBRa, oui je connaissais, mais je trouve que c'est tjs intéréssant de voir comment les autres l'on fait, ils peuvent avoir fait un meilleur code que moi (c'est d'ailleurs probable...)
ICIoBRa Messages postés 368 Date d'inscription dimanche 24 juin 2001 Statut Membre Dernière intervention 7 décembre 2015
18 avril 2003 à 13:54
le tYpe pas ventar' (meme si je connais deja) LOL !!
miko500 Messages postés 188 Date d'inscription dimanche 29 octobre 2000 Statut Membre Dernière intervention 18 août 2005
17 avril 2003 à 19:05
moi aussi j'aimerais bien ta source stp mon mail c : MICKSASNE0@aol.com
cs_Clem Messages postés 282 Date d'inscription dimanche 1 avril 2001 Statut Membre Dernière intervention 12 février 2007
17 avril 2003 à 17:38
il fait combien en taille ton zip ?
je veux bien avoir ta source (meme si je connais deja) : clem@progfr.com
konyaliseref Messages postés 35 Date d'inscription mercredi 12 mars 2003 Statut Membre Dernière intervention 20 juillet 2005
17 avril 2003 à 16:13
desole je narrive pas à envoyer la source zipper il me sort une erreur si qqun sait le probleme quil menvoit un mail ou alors si vous voulez la source demander la je vous lenverrai. merci seref.balci@orange.fr