Newsgroup: it.comp.lang.visual-basic
Titolo: e-mail,posta elettronica

ciao a tutti vi volevo chiedere se mi potevate dare una mano nel creare
un'applicazione
allora l'applicazione che voglio creare come potete leggere nell'oggetto è
un client di posta elettronica vi premetto che voglio creare un programmino
semplice semplice che invia posta e che la legge.
sapete dove posso trovare delle demo gia fatte in vb per vedere il
codice,oppure del materiale in generale grazie mille vi ringrazio siete
grandi continuate cosi...

 legge.
mailoe, sul sito comune, utilizza gli oggetti mapi.
se vuoi fare qualcosa a livello un po' piů basso, passo la mano.
-- 
Salutoni
Sergio
per rispondere... togli il group dall'indirizzo

se vuoi fare qualcosa a livello un po' piů basso, passo la mano.
POP3 s SMTP sempre sul sito comune :-)
-- 
ciao,
hal

Oggi sono gentile e ti do una classe che ho fatto io:
Questa ha bisogno di una form che contenga un controllo winsock e quando fai
la INIT gli passi il controllo e addirittura se vuoi un controllo text.
Occhio che ho provato con smpt pubblici tipo tiscalinet e tin, ma non
funzionano, mentre con il mio aziendale , tutto ok!
'---------------------------------------------------------------------------
------------
' Module    : cSystSMTP
' DateTime  : 11/02/2004 16:34
' Author    : Pivanti Marco
' Purpose   : Classe per l'invio di mail tramite protocollo SMTP
'---------------------------------------------------------------------------
------------
Option Explicit
' Ad ogni classe bisogna passare un controllo winsock
Const c_TimeOut As Long = 30 'secondi
Private m_sender As String
Private m_to As Collection    ' collection di Stringhe
Private m_RemoteHost As String
Private m_RemotePort As String
Private m_wsk_Buffer As String   ' Buffer dei dati arrivati dalla
connessione socket
Public WithEvents wskTcp As Winsock
Public m_txtLog As Object
   ' Oggetto text per Log interno
'---------------------------------------------------------------------------
------------
' Procedure : INIT
' DateTime  : 11/02/2004 16:44
' Author    : Pivanti Marco
' Purpose   : Inizializza la classe passandogli un controllo winsock
'---------------------------------------------------------------------------
------------
'
Public Function INIT(ByRef refwskTcp As Object, Optional refTxtLog As Object
= Nothing) As Boolean
   On Error Resume Next
   Set m_to = New Collection
   Set m_txtLog = refTxtLog
   Set wskTcp = refwskTcp
   wskTcp.Close
   wskTcp.Protocol = 0 'sckTCPProtocol
   m_RemotePort = 25  ' Di default
   INIT = True
End Function
'---------------------------------------------------------------------------
------------
' Procedure : SendMail
' DateTime  : 11/02/2004 17:06
' Author    : Pivanti Marco
' Purpose   : Invia una mail a tutti i TO
' Codici di ritorno:
' 0 - OK
' 1 - Server non risponde
' 2 - il Server non manda la presentazione
' 3 - HELO rejected
' 4 - Start Mail Transaction failed
'---------------------------------------------------------------------------
------------
'
Public Function SendMail(ByVal Subject As String, _
                         ByVal Data As String, ByVal mFrom As String, ByVal
mTo As String) As Integer
   Dim bCode As Byte     ' Codice SMTP
   Dim message As String
   Dim k As Long
   On Error Resume Next
   ' Pulisco la finestra
   If Me.m_txtLog Is Nothing Then
   Else
      Me.m_txtLog.Text = ""
   End If
   ' Cerco la connessione con il server SMPT
   wskTcp.RemoteHost = m_RemoteHost
   wskTcp.RemotePort = m_RemotePort
   wskTcp.Connect
   Do
      DoEvents
   Loop Until wskTcp.State <> 6
   If wskTcp.State = 7 Then
      ' Se si connette attendo che arrivino i primi dati di presentazione
      bCode = WaitFor(message)
      If bCode <> 220 Then
         Logga ("Nessuna presentazione da parte del server")
         BreakComunications
         SendMail = 2
         Exit Function
      End If
      Logga bCode & message
      ' Faccio CIAU
      wskTcp.SendData "HELO 1" & vbCrLf
      bCode = WaitFor()
      If bCode <> 250 Then
         Logga ("Non gli piace il nostro saluto!!!!")
         BreakComunications
         SendMail = 3
         Exit Function
      End If
      Logga bCode & message
      ' Inizio la transazione MAIL
      wskTcp.SendData "MAIL FROM:" & m_sender & vbCrLf
      bCode = WaitFor(message)
      If bCode <> 250 Then
         Logga (message)
         BreakComunications
         SendMail = 4
         Exit Function
      End If
      Logga bCode & message
      ' Aggiungo i destinatari
      For k = 1 To m_to.Count
         wskTcp.SendData "RCPT TO:" & m_to.Item(k) & vbCrLf
         bCode = WaitFor(message)
         Logga ("TO: " & m_to.Item(k) & vbCrLf & bCode & message)
      Next k
      ' inizio i dati
      wskTcp.SendData "DATA" & vbCrLf
      bCode = WaitFor(message)
      Logga bCode & message
      wskTcp.SendData "Subject: " & Subject & vbCrLf
      wskTcp.SendData "From: " & mFrom & vbCrLf
      wskTcp.SendData "To: " & mTo & vbCrLf
      wskTcp.SendData vbCrLf & Data & vbCrLf & "." & vbCrLf
      bCode = WaitFor(message)
      Logga bCode & message
      BreakComunications
   Else
      SendMail = 1
   End If
   On Error Resume Next
End Function
'---------------------------------------------------------------------------
------------
' Procedure : BreakComunications
' DateTime  : 11/02/2004 18:49
' Author    : Pivanti Marco
' Purpose   : Chiude il socket
'---------------------------------------------------------------------------
------------
'
Private Function BreakComunications() As Boolean
   On Error Resume Next
   wskTcp.SendData "QUIT" & vbCrLf
      ' Il quit per finire la transazione della mail
   wskTcp.Close
End Function
'---------------------------------------------------------------------------
------------
' Procedure : WaitFor
' DateTime  : 11/02/2004 18:16
' Author    : Pivanti Marco
' Purpose   : Attende la risposte del server e prende il codice della
risposta
'---------------------------------------------------------------------------
------------
'
Private Function WaitFor(Optional ByRef message As String) As Byte
   Dim dT As Date
   Dim buf As String
   Dim tempCode As String
   On Error Resume Next
   buf = ""
   dT = DateAdd("s", c_TimeOut, Now)
   While Now < dT
      ' Attendo l'arrivo dei dati
      DoEvents
      If m_wsk_Buffer <> "" Then
         ' è arrivato qualcosa
         buf = buf & m_wsk_Buffer
         ' mi salvo il buffer
         m_wsk_Buffer = ""
         ' attendo ancora un secondo
         dT = DateAdd("s", 1, Now)
      End If
   Wend
   If buf = "" Then
      ' sono andato in timeout
      WaitFor = ""
   Else
      ' Mi è arrivato qulcosa, estraggo il codice
      ' che sono le prime 3 cifre
      tempCode = Left(buf, 3)
      If IsNumeric(tempCode) Then
         ' Ok è un codice SMTP
         WaitFor = CByte(tempCode)
         message = Mid(buf, 4, Len(buf))
      Else
         ' Cacchio mi è arrivato?
         WaitFor = ""
      End If
   End If
   'Svuoto il buffer di winsock
   wskTcp.GetData buf, vbString
End Function
Private Sub wskTcp_DataArrival(ByVal bytesTotal As Long)
   Dim buf As String
   On Error Resume Next
   wskTcp.PeekData buf, vbString
   m_wsk_Buffer = m_wsk_Buffer & buf
End Sub
'---------------------------------------------------------------------------
------------
' Procedure : ClearAllTo
' DateTime  : 11/02/2004 17:02
' Author    : Pivanti Marco
' Purpose   : Pulisce tutti i destinatari
'---------------------------------------------------------------------------
------------
'
Public Sub ClearAllTo()
   On Error Resume Next
   Set m_to = New Collection
End Sub
Public Sub AddTo(ByVal Sender As String)
   On Error Resume Next
   If InStr(1, Sender, "<", vbBinaryCompare) = 0 Then
      Sender = "<" & Sender & ">"
   End If
   m_to.Add Sender
End Sub
'---------------------------------------------------------------------------
------------
' Procedure : Logga
' DateTime  : 11/02/2004 18:47
' Author    : Pivanti Marco
' Purpose   : Manda i dati alla finestra di log interno (se c'è)
'---------------------------------------------------------------------------
------------
'
Private Sub Logga(ByVal Text As String)
   On Error Resume Next
   If m_txtLog Is Nothing Then
   Else
      m_txtLog.SelStart = Len(m_txtLog.Text)
      m_txtLog.SelText = Text
   End If
End Sub
'******************* Properties
Public Property Get Sender() As String
   On Error Resume Next
   Sender = m_sender
End Property
Public Property Let Sender(ByVal vNewValue As String)
   On Error Resume Next
   If InStr(1, vNewValue, "<", vbBinaryCompare) = 0 Then
      vNewValue = "<" & vNewValue & ">"
   End If
   m_sender = vNewValue
End Property
Public Property Get RemoteHost() As Variant
   On Error Resume Next
   RemoteHost = m_RemoteHost
End Property
Public Property Let RemoteHost(ByVal vNewValue As Variant)
   On Error Resume Next
   m_RemoteHost = vNewValue
End Property
Public Property Get RemotePort() As Long
   On Error Resume Next
   RemotePort = m_RemotePort
End Property
Public Property Let RemotePort(ByVal vNewValue As Long)
   On Error Resume Next
   m_RemotePort = vNewValue
End Property