Envoyer un mail en se faisant passer pour quelqu'un d'autre avec piece jointe certifie sans bug

Soyez le premier à donner votre avis sur cette source.

Vue 12 412 fois - Téléchargée 1 455 fois

Description

C'est assez simple, ils'agit d'un petit programme pour envoyer un mail classique seulement il est possible de changer d'identiter pour faire une blague à un ami ou un parent ;) ca marche d'enfer.
INVRAISEMBLABLE !!!! Regardez la capture et jugez vous-meme!!!
Pour les aides, j'ai mis une rubrique "aide".

Source / Exemple :


voir le zip

Conclusion :


ceci est la version finale... sans bug, avec l'option "joindre un ficher"...
toutefois si des bug apparaisse faites moi signe!!! seref.balci@orange.fr
merci!!! :)

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
3
Date d'inscription
mardi 17 mai 2005
Statut
Membre
Dernière intervention
26 juin 2008

J'aimerais teste ce petit outil mais avec quel programme je peux l'executer?

Merci d'avance
Messages postés
2081
Date d'inscription
mercredi 21 août 2002
Statut
Contributeur
Dernière intervention
16 mars 2020
2
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.
Messages postés
1247
Date d'inscription
mardi 7 mai 2002
Statut
Membre
Dernière intervention
18 février 2019
3
Y a des erreurs domage!!! Bug
Messages postés
1
Date d'inscription
jeudi 27 février 2003
Statut
Membre
Dernière intervention
25 juin 2003

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
Messages postés
100
Date d'inscription
lundi 16 septembre 2002
Statut
Membre
Dernière intervention
19 septembre 2005

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...
Afficher les 14 commentaires

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.