VMAIL X - CLIENT SMTP POUR L'ENVOI DE MAIL + EXE/ACTIVEX !

Commentaire de seboss le 25/05/2002 13:32:14

plutot po mal :-)

Commentaire de MarcoPaulo le 19/07/2002 14:28:22

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

Commentaire de jbel le 09/12/2003 15:27:09

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 ++

Commentaire de pledoux le 12/01/2005 09:37:42

Vraiment bien mais, pour être vraiment complet, il manque deux choses :
1 - le principe de transparence (cas d'une ligne avec uniquement un point) ex :
       debut message
       .
       fin message
dans ce cas la fin du message n'est pas transmise. Il faut que tu double le point (toute séquence <CRLF>.<CRLF> doit être remplacée par <CRLF>..<CRLF>. Le serveur SMTP interprête pour supprimer le second point.
2 - La gestion du destinataire en copie cachée n'est pas complétement implémentée. Comme pour "to :" et "cc :" il faut envoyer "bcc :" dans la section data