Newsgroup: it.comp.lang.visual-basic
Titolo: aiuto pop3 e smtp

ciao a tutti
qualcuno ha un link di un programma(ovviamente voglio vedere i
sorgenti) che invia e scarica la posta????

 sorgenti) che invia e scarica la posta????
Ci sono TERABYTE di materiale nel Web sia sui protocolli, che sarebbero
da conoscere,
che su sorgenti in VB per invio/ricezione...!
Nel mio sito trovi un Demo per VBA(Access) che sfrutta WinSock, ma usa
classi ricavate
da VB6 per la Decodifica MIME:
http://www.alessandrobaraldi.it/DettaglioFaq.asp?IdFAQ=72
vedi se può esserti utile.
@Alex

grazie
Alessandro Baraldi ha scritto:



Certo che si!
Sul mio sito trovi un esempio fatto in .net: 
www.thetotalsite.it
.
In particolare lo trovi in questa sezione: 
http://www.thetotalsite.it/programmazione/esempi.aspx?c=2
Bye,
-- 
Carmine ( 
pikachu...@gmail.com
 (Togli la scritta NOSPAM) )
Webmaster di The Total Site 4 : 
http://www.thetotalsite.it
My Blog: 
http://blog.thetotalsite.it
MariokartDS Codice Amico: 532639027909 - CarmineC in MarioKartDS
Se un circuito funziona al primo tentativo è perchè il problema è molto
più nascosto e subdolo di quanto tu possa pensare...
E apparirà nel momento in cui farà il massimo danno 

anche io sarei molto interessato, ma all'indirizzo indicato non sono
stato capace di trovare il codice sorgente.
Dove sbaglio (se sbaglio)?
Grazie.
Alessandro Baraldi ha scritto:



Quanto segue e' una routine di invio posta scritta da me l'anno
passato. Funziona, mai dato problemi particolari. Ovviamente ho rimosso
i pezzi di codice piu' sensibili (password, strutture del db) e c'e' un
po' di roba che non ti servira', cmq come base di partenza dovrebbe
andare benissimo.
Private Sub cmdSpedisci_Click()
    Dim intCiclo As Long
    Dim strContatto As String
    Dim lngErr As Long
    Dim strErr As String
    Dim lngNewID As Long
    Dim rngAllegati() As String
    Dim udtWSAD As WSADATA
    Dim hndSocket As Long
    Dim udtIndirizzo As SOCKADDR
    Dim lngError As Long
    Dim strBuffer As String
    Dim strRet As String
    Dim lngRet As String
    Dim strBody As String
    Dim strMittente As String
    Dim strDestinatario As String
    Dim lngContAllegati As Long
    Dim blnProsegui As Boolean
    Dim lngNumIndirizzi As Long
    Dim lngDimensioneFile As Long
    On Error GoTo errEmail
    'Controllo le dimensioni degli allegati
    lngDimensioneFile = 0
    rngAllegati = Split(mstrAllegati, Chr$(0))
    For lngContAllegati = 1 To UBound(rngAllegati)
            lngDimensioneFile = lngDimensioneFile + FileLen("" &
rngAllegati(0) & "\" & rngAllegati(lngContAllegati))
    Next
    'Se la dimensione degli allegati supera 5 mega mando un messaggio
d'avviso
    If lngDimensioneFile > 3000000 Then
        strBuffer = "Gli allegati che si sta per inviare hanno una
dimensione elevata. "
        strBuffer = strBuffer & "Il loro invio puo' occupare molto
tempo e la loro ricezione non è garantita." & Chr$(13) & Chr$(10)
        strBuffer = strBuffer & "Questo perchè le caselle e-mail degli
utenti hanno in genere una dimensione massima." & Chr$(13) & Chr$(10)
        strBuffer = strBuffer & "Si vuole proseguire comunque?"
        If MyMsgBox(strBuffer, vbYesNo) = vbNo Then
            Exit Sub
        End If
    End If
    'Controllo la dimensione totale dell' e-mail se è maggiore di 20
mega visualizzo avvertimento
    On Error Resume Next
    lngDimensioneFile = (lngDimensioneFile * (UBound(mrngIndirizzi) +
1))
    If Err.Number <> 0 Then
        lngDimensioneFile = 100000000
    End If
    On Error GoTo 0
    If lngDimensioneFile > 20000000 Then
        strBuffer = "La dimensione totale dell'e-mail che si sta per
inviare è eccessiva." & Chr$(13) & Chr$(10)
        strBuffer = strBuffer & "L'invio di queste e-mail può
richiedere molto tempo." & Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10)
        strBuffer = strBuffer & "Si vuole proseguire comunque?"
        If MyMsgBox(strBuffer, vbYesNo) = vbNo Then
            Exit Sub
        End If
    End If
    strBuffer = ""
    Screen.MousePointer = vbHourglass
    ' Mittente della mail
    strMittente = Trim$(gudtAgenzia.EMail)
    ' Connette il winsock
    ' Prima inizializza la libreria
    If WSAStartup(&H101, udtWSAD) <> 0 Then
        lngError = Err.LastDllError
        Err.Raise vbObjectError + lngError, , "Impossibile
inizializzare la versione socket richiesta. Errore " & lngError
    End If
    ' Poi crea il socket
    hndSocket = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
    lngError = Err.LastDllError
    If hndSocket <= 0 Then
        Err.Raise vbObjectError + lngError, , "Impossibile creare il
socket per la connessione. Errore " & lngError
    End If
    ' Valorizzo la struttura che indica al socket a cosa deve
connettersi
    udtIndirizzo.sin_family = AF_INET
    udtIndirizzo.sin_addr = inet_addr("IP DEL SERVER")
    udtIndirizzo.sin_port = htons(25)
    ' Eseguo la connessione vera e propria
    lngNewID = connect(hndSocket, udtIndirizzo, LenB(udtIndirizzo))
    lngError = Err.LastDllError
    If (lngNewID <> 0) And (lngError <> 0) Then
        Err.Raise vbObjectError + lngError, , "Impossibile effettuare
la connessione al server di posta. Errore " & lngError
    End If
    DoEvents
    DoEvents
    ' Imposto il timeout della connessione a 10 secondi
    'strRet = Space$(1500)
    'getsockopt hndSocket, &HFFFF&, &H1006, strRet, 1000
    strRet = "10"
    setsockopt hndSocket, &HFFFF&, &H1006, strRet, Len(strRet)
    strRet = Space$(500)
    lngRet = recv(hndSocket, strRet, 499, 0)
    lngError = Err.LastDllError
    If lngRet <= 0 Then
        Err.Raise vbObjectError + lngError, , "Non e' stata ricevuta
nessuna risposta dal server dopo la connessione. Errore " & lngError
    End If
    DoEvents
    DoEvents
    ' Comando di inizio procedura
    strBuffer = "helo" & Chr$(13) & Chr$(10)
    lngNewID = send(hndSocket, strBuffer, Len(strBuffer), 0)
    lngError = Err.LastDllError
    If lngNewID <= 0 Then
        Err.Raise vbObjectError + lngError, , "Impossibile inviare
HELO. Errore " & lngError
    End If
    strRet = Space$(300)
    lngRet = recv(hndSocket, strRet, 300, 0)
    lngError = Err.LastDllError
    If lngRet <= 0 Then
        Err.Raise vbObjectError + lngError, , "Il server non ha
risposto alla richiesta di protocollo. Errore " & lngError
    End If
    DoEvents
    DoEvents
    ' Comando di richiesta Login
    strBuffer = "AUTH LOGIN" & Chr$(13) & Chr$(10)
    lngNewID = send(hndSocket, strBuffer, Len(strBuffer), 0)
    lngError = Err.LastDllError
    If lngNewID <= 0 Then
        Err.Raise vbObjectError + lngError, , "Impossibile iniziare
l'autenticazione. Errore " & lngError
    End If
    strRet = Space$(1400)
    lngRet = recv(hndSocket, strRet, 1400, 0)
    lngError = Err.LastDllError
    If lngRet <= 0 Then
        Err.Raise vbObjectError + lngError, , "Non e' stata ricevuta
nessuna risposta dal server alla richiesta di autenticazione. Errore "
& lngError
    Else
        If Left$(strRet, 3) <> "334" Then
            Err.Raise vbObjectError + lngError, , "Impossibile iniziare
l'autenticazione. " & Chr$(13) & "Messaggio del server: '" &
Left$(strRet, lngRet) & Chr$(13) & "Errore " & lngError
        End If
    End If
    DoEvents
    DoEvents
    ' Nome utente
    strBuffer = "QUI CI VA IL NOME UTENTE CODIFICATO" & Chr$(13) &
Chr$(10)
    lngNewID = send(hndSocket, strBuffer, Len(strBuffer), 0)
    lngError = Err.LastDllError
    If lngNewID <= 0 Then
        Err.Raise vbObjectError + lngError, , "Impossibile inviare il
nome utente. Errore " & lngError
    End If
    strRet = Space$(1400)
    lngRet = recv(hndSocket, strRet, 1400, 0)
    lngError = Err.LastDllError
    If lngRet <= 0 Then
        Err.Raise vbObjectError + lngError, , "Mancata richiesta di
password da parte del server. Errore " & lngError
    Else
        If Left$(strRet, 3) <> "334" Then
            Err.Raise vbObjectError + lngError, , "Nome utente errato.
" & Chr$(13) & "Messaggio del server: '" & Left$(strRet, lngRet) &
Chr$(13) & "Errore " & lngError
        End If
    End If
    DoEvents
    DoEvents
    ' Password
    strBuffer = "QUI CI VA LA PASSWORD CODIFICATA" & Chr$(13) &
Chr$(10)
    lngNewID = send(hndSocket, strBuffer, Len(strBuffer), 0)
    lngError = Err.LastDllError
    lngError = Err.LastDllError
    If lngNewID <= 0 Then
        Err.Raise vbObjectError + lngError, , "Impossibile inviare la
password. Errore " & lngError
    End If
    strRet = Space$(1400)
    lngRet = recv(hndSocket, strRet, 1400, 0)
    lngError = Err.LastDllError
    If lngRet <= 0 Then
        Err.Raise vbObjectError + lngError, , "Mancata risposta del
server dopo invio password. Errore " & lngError
    Else
        If Left$(strRet, 3) <> "235" Then
            Err.Raise vbObjectError + lngError, , "Password errata. " &
Chr$(13) & "Messaggio del server: " & Left$(strRet, lngRet) & Chr$(13)
& "Errore " & lngError
        End If
    End If
    DoEvents
    DoEvents
    lngNumIndirizzi = UBound(mrngIndirizzi) + 1
    For intCiclo = 0 To UBound(mrngIndirizzi)
        strDestinatario = mrngIndirizzi(intCiclo)
        'Aumento la progressbar
        If intCiclo <> 0 Then
            frmSpedisciEMail.swfProgBar.FrameNum = CInt(intCiclo /
lngNumIndirizzi * 100)
        End If
        lblCountMail.Caption = intCiclo + 1
        ' Mittente (quello vero. Quello negli header lo inserisco dopo)
        strBuffer = "mail from: " & strMittente & Chr$(13) & Chr$(10)
        lngNewID = send(hndSocket, strBuffer, Len(strBuffer), 0)
        lngError = Err.LastDllError
        If lngNewID <= 0 Then
            Err.Raise vbObjectError + lngError, , "Impossibile inviare
il mittente. Errore " & lngError
        End If
        strRet = Space$(1400)
        lngRet = recv(hndSocket, strRet, 1400, 0)
        lngError = Err.LastDllError
        If lngRet <= 0 Then
            Err.Raise vbObjectError + lngError, , "Mancata risposta del
server dopo invio mittente. Errore " & lngError
            If Left$(strRet, 3) <> "250" Then
                Err.Raise vbObjectError + lngError, , "Mittente errato.
" & Chr$(13) & "Messaggio del server: '" & Left$(strRet, lngRet) &
Chr$(13) & "Errore " & lngError
            End If
        End If
        DoEvents
        DoEvents
        ' Destinatario (quello vero. Quello negli header lo inserisco
dopo)
        strBuffer = "rcpt to: " & strDestinatario & Chr$(13) & Chr$(10)
        lngNewID = send(hndSocket, strBuffer, Len(strBuffer), 0)
        lngError = Err.LastDllError
        If lngNewID <= 0 Then
            Err.Raise vbObjectError + lngError, , "Impossibile inviare
il destinatario. Errore " & lngError
        End If
        strRet = Space$(1400)
        lngRet = recv(hndSocket, strRet, 1400, 0)
        lngError = Err.LastDllError
        If lngRet <= 0 Then
            Err.Raise vbObjectError + lngError, , "Mancata risposta del
server dopo invio destinatario. Errore " & lngError
        Else
            If Left$(strRet, 3) <> "250" Then
                blnProsegui = False
                strBuffer = "RSET" & Chr$(13) & Chr$(10)
                lngNewID = send(hndSocket, strBuffer, Len(strBuffer),
0)
                'Err.Raise vbObjectError + lngError, ,"Mittente errato.
" & Chr$(13) & "Messaggio del server: '" & Left$(strRet, lngRet) &
Chr$(13) & "Errore " & lngError
            Else
                blnProsegui = True
            End If
        End If
        DoEvents
        DoEvents
        If blnProsegui Then
            ' Comando che attiva l'inserimento della mail vera e
propria
            strBuffer = "DATA" & Chr$(13) & Chr$(10)
            lngNewID = send(hndSocket, strBuffer, Len(strBuffer), 0)
            lngError = Err.LastDllError
            If lngNewID <= 0 Then
                Err.Raise vbObjectError + lngError, , "Impossibile
inviare il comando di creazione della mail. Errore " & lngError
            End If
            strRet = Space$(1400)
            lngRet = recv(hndSocket, strRet, 1400, 0)
            lngError = Err.LastDllError
            If lngRet <= 0 Then
                Err.Raise vbObjectError + lngError, , "Mancata risposta
del server durante la creazione della mail. Errore " & lngError
                If Left$(strRet, 3) <> "354" Then
                    Err.Raise vbObjectError + lngError, , "Comando DATA
errato. " & Chr$(13) & "Messaggio del server: '" & Left$(strRet,
lngRet) & Chr$(13) & "Errore " & lngError
                End If
            End If
            DoEvents
            DoEvents
            ' Header della mail
            strBody = "From: " & gudtAgenzia.Nome & "<" & strMittente &
">" & Chr$(13) & Chr$(10)
            strBody = strBody & "Reply-To: " & strMittente & Chr$(13) &
Chr$(10)
            strBody = strBody & "To: " & strDestinatario & Chr$(13) &
Chr$(10)
            strBody = strBody & "Subject: " & txtOggetto.Text &
Chr$(13) & Chr$(10)
            strBody = strBody & "Return-Path: " & strMittente &
Chr$(13) & Chr$(10)
            strBody = strBody & "Mime-Version: 1.0" & Chr$(13) &
Chr$(10)
            ' Verifico se ci sono allegati
            If Len(mstrAllegati) > 0 Then
                ' Se ce ne sono dichiaro la mail come tipo
multipart/mixed, che indica al client di posta
                ' che la mail e' composta da piu' parti
                strBody = strBody & "Content-Type: multipart/mixed; "
                ' Dichiaro il boundary (RFC 2045/46/47/48)
                strBody = strBody & "boundary=" & Chr$(34) &
"--=Part_Bound_SUPERCALIFRAGILISTICHESPIRALIDOSO" & Chr$(34) & Chr$(13)
& Chr$(10)
                ' Invio di separazione tra l'header ed il corpo della
mail
                strBody = strBody & Chr$(13) & Chr$(10)
                strBody = strBody & "--" &
"--=Part_Bound_SUPERCALIFRAGILISTICHESPIRALIDOSO" & Chr$(13) & Chr$(10)
                strBody = strBody & "Content-Type: text/plain;
charset=""iso-8859-1""" & Chr$(13) & Chr$(10)
                strBody = strBody & "Content-Transfer-Encoding:
quoted-printable" & Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10)
            End If
            ' Aggiungo il testo del messaggio
            strBody = strBody & txtMessaggio.Text & Chr$(13) & Chr$(10)
            ' Se ci sono allegati
            If Len(mstrAllegati) > 0 Then
                strBody = strBody & Chr$(13) & Chr$(10)
                ' Divido la stringa nei singoli allegati
                rngAllegati = Split(mstrAllegati, Chr$(0))
                ' Ciclo gli allegati (parto da 1 perche' l'elemento 0
contiene
                ' il percorso, gli altri il nome del file)
                For lngContAllegati = 1 To UBound(rngAllegati)
                    ' Scrivo il boundary
                    strBody = strBody & "--" &
"--=Part_Bound_SUPERCALIFRAGILISTICHESPIRALIDOSO" & Chr$(13) & Chr$(10)
                    strBody = strBody & PreparaAllegato("" &
rngAllegati(0) & "\" & rngAllegati(lngContAllegati)) & Chr$(13) &
Chr$(10)
                    DoEvents
                    DoEvents
                    DoEvents
                    DoEvents
                Next lngContAllegati
                ' Scrivo il boundary di chiusura
                strBody = strBody & Chr$(13) & Chr$(10)
                strBody = strBody & "--" &
"--=Part_Bound_SUPERCALIFRAGILISTICHESPIRALIDOSO--" & Chr$(13) &
Chr$(10)
            End If
            DoEvents
            DoEvents
            ' Aumento il timeout della connessione (devo mandare su la
mail completa)
            strRet = "60"
            setsockopt hndSocket, &HFFFF&, &H1006, strRet, Len(strRet)
            ' Creo la stringa di chiusura
            strBody = strBody & Chr$(13) & Chr$(10) & "." & Chr$(13) &
Chr$(10)
            lngNewID = send(hndSocket, strBody, Len(strBody), 0)
            lngError = Err.LastDllError
            If lngNewID <= 0 Then
                Err.Raise vbObjectError + lngError, , "Impossibile
inviare l'email. Errore " & lngError
            End If
            strRet = Space$(1400)
            lngRet = recv(hndSocket, strRet, 1400, 0)
            If lngRet <= 0 Then
                Err.Raise vbObjectError + lngError, , "Mancata risposta
del server durante l'invio della mail. Errore " & lngError
                If Left$(strRet, 3) <> "250" Then
                    Err.Raise vbObjectError + lngError, , "Il server ha
rifiutato l'invio della mail. " & Chr$(13) & "Messaggio del server: '"
& Left$(strRet, lngRet) & Chr$(13) & "Errore " & lngError
                Else
                    ' Se sono qui, e' andato tutto bene. Segno
l'avvenuto invio della mail
                    DoEvents
                    DoEvents
                    Sleep 100
                End If
            End If
        End If
    Next intCiclo
    'Sposto la progressbar fino infondo
    frmSpedisciEMail.swfProgBar.FrameNum = 100
    ' Log off dal server
    strBuffer = "quit" & Chr$(13) & Chr$(10)
    lngNewID = send(hndSocket, strBuffer, Len(strBuffer), 0)
    ' Pulisco il water
    closesocket hndSocket
    WSACleanup
    ' Segnalo che le mail sono state inviate
    MyMsgBox Messaggio(24)
    Me.Hide
    Screen.MousePointer = vbDefault
    Exit Sub
errEmail:
    strErr = Err.Description
    MyMsgBox Err.Description, vbExclamation + vbOKOnly, App.Title
    strRet = "10"
    Resume
    setsockopt hndSocket, &HFFFF&, &H1006, strRet, Len(strRet)
    strBuffer = "RSET" & Chr$(13) & Chr$(10)
    lngNewID = send(hndSocket, strBuffer, Len(strBuffer), 0)
    strBuffer = "quit" & Chr$(13) & Chr$(10)
    lngNewID = send(hndSocket, strBuffer, Len(strBuffer), 0)
    closesocket hndSocket
    WSACleanup
 
    Screen.MousePointer = vbDefault
 
End Sub

ypsylon ha scritto:

Il Link ti fa accedere ad una pagina dalla quale puoi scaricare il
Demo(è un Setup)
poi è possibile sproteggerlo inserendo la PWD=sitocomune .
Ripeto però che è un Demo in Access2002, ma che il codice è
decisamente compatibile
con VB6.
E' solo un Server di posta, ma invia anche i formato Html...., per la
parte Client invece
non l'ho mai pubblicato, ma ci sono demo validi per VB6 completi di
Parser per la parte
MIME...!
@Alex

Grazie mille.
Molto prezioso.
Ci do un'occhiata.

Scusa il disturbo.
Non riesco ad aprire il .mdb, perchè di una versione successiva alla
mia
io utilizzo Ms-Access 2000 SR1
Non è che gentilmente, magari, potresti renderla disponibile anche per
questa versione?
se no, non importa, lo installo su un'altra macchina con Office XP
(credo vada bene?)
e lo converto.
O combinerei casini?
grazie ancora per l'attenzione.

il tuo codice mi interessa. grazie.
però incollandolo in un progetto VB mi dice
'tipo non definito'
per lo statement
Dim udtWSAD As WSADATA
scusa l'ignoranza, ma non sono in grado di andare avanti.
devo indicare qualcosa nei riferimenti del progetto?
grazie per l'attenzione

ypsylon ha scritto:

Non posso convertirla in versioni precedenti in quanto non compatibile.
Ricorda però che il Pacchetto non distribuisce il componente
WinSock.Ocx
pertanto se non possiedi la licenza non funziona.
Winsock.Ocx è distribuito con VB o con VisualStudio se non ricordo
male...
@Alex

 ha scritto nel messaggio 
news:1157028312.3...@i3g2000cwc.googlegroups.com...

Ne troverai parecchi di punti in cui non sarai in grado di andare avanti, in 
quel codice ;-)
Nel senso: tutto il codice che ho postato si appoggia alla API Winsock. Ora, 
come per tutte le API, VB non le gestisce direttamente ma vanno -DICHIARATE- 
all'interno del progetto. Occhio, non parlo di riferimenti, parlo di 
dichiarare le funzioni a cui vuoi accedere: la differenza e' nel fatto che 
il riferimento punta ad una libreria ad oggetti, mentre la dichiarazione 
delle funzioni punta ad una DLL di funzioni non OOP.
Detto questo: hai bisogno di inserire, nel modulo in cui dichiari quella 
funzione o, ancora meglio, in un modulo dedicato alla dichiarazione delle 
API, tutti gli elementi extra-vb di cui faccio uso.
Per cui, in sintesi:
1) Cerca su internet qualche tutorial su VB6 + API + Declare, almeno hai 
idea di cosa si stia parlando
2) Sul sito 
allapi.net
 trovi tutte le declare di cui hai bisogno. Lanci 
programma, segni errore, cerchi su allapi, copincolli, lanci programma, 
segni errore, etc. etc...

 sorgenti) che invia e scarica la posta????
Vediamo se ci sono anche i sorgenti ... pare di si , ed in diversi linguaggi :
http://www.ostrosoft.com/smtp_component.asp
http://www.ostrosoft.com/smtp_component/smtp_vb.zip
Licensing
Non-commercial license free
Unlimited usage for developing non-commercial applications.
http://www.ostrosoft.com/vb/rfc/rfc821.html
 ecc
--
Fosco

grazie
Fosco ha scritto:
