vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
SEPA-Dateien erstellen inkl. IBAN-, BLZ-/Kontonummernprüfung  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik:    |   VB-Versionen: VB4, VB5, VB601.09.01
EMails mit dem Winsock-Control abrufen

Ein Beispiel, wie sich EMails unter Verwendung des Winsock-Controls von einem Mailserver abrufen lassen.

Autor:  Dieter OtterBewertung:     [ Jetzt bewerten ]Views:  1.948 
http://www.tools4vb.de/System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt 

"Wie lassen sich EMail-Nachrichten von einem POP3-Server abrufen?"
Diese Frage wurde in der letzten Zeit sehr häufig gestellt.

Die wohl gängigste Methode ist das Verwenden des Winsock-Controls - und das ist gar nicht mal so kompliziert. Es gibt lediglich ein paar Grundvoraussetzungen, welche man beachten muss:
Befehl absenden - auf Antwort warten - Antwort auswerten

Die Reihenfolge hierbei ist folgende:

  1. Anmelden am Server
  2. LIST senden - Warten auf Antwort OK+
  3. Empfange Daten auswerten (Anzahl neuer Nachrichten, Größe der Nachrichten)
  4. RETR x (x = Nachrichtennummer) und Daten empfangen
  5. DELE x (falls die Nachricht nach dem Empfang vom Mailserver gelöscht werden soll)

Was viele jetzt vielleicht falsch machen würden, ist das Verwenden einer String-Variable, in der die Nachricht gespeichert werden soll. Das geht aber nur gut, solange es sich um kleine bis mittelgrosse Nachrichten handelt. Bei Nachrichten über 1 MByte kommt es dann schnell zu einem Laufzeitfehler (Fehler 7). Deshalb sollte man die Nachrichten am besten sofort in eine temporäre Datei speichern...

Folgende Variablen werden für den Nachrichten-Abruf innerhalb der Form benötigt:

' Variablen für den Mail-Empfang
Dim strMail As String
Dim strResponse As String
Dim strLastResponse As String
 
' Datei, in der die Nachricht gespeichert wird
Dim popTempFile As String
Dim BytesRead As Long

1. Anmelden am Mailserver
Um Nachrichten von einem POP3-Mailserver abzurufen, benötigen Sie folgende Informationen:

  • Name des Servers
  • Ihr Benutzername
  • Ihr Kennwort
Ohne diese Daten können keine Mails abgerufen werden!

' Verbindung zum Mailserver herstellen
Public Function MailConnectToServer(ByVal ServerName As _
  String, ByVal UserName As String, ByVal Password As _
  String) As Boolean
 
  ' Status-Fenster "leeren"
  frmStatus.txtStatus.Text = ""
  If Not frmStatus.Visible Then frmStatus.Show , Me
 
  lblStatus.Visible = True
  Status.Value = 0
  MailConnectToServer = False
  popTempFile = ""
 
  With Winsock1
    ' Ggf. vorher schliessen
    On Local Error Resume Next
    .Close
    On Local Error GoTo 0
 
    ' Anmelden am Mailserver
    lblStatus.Caption = "Verbinden mit: " + _
      ServerName + "..."
    DoEvents
    .Protocol = sckTCPProtocol
    .LocalPort = 0
    .Connect ServerName, 110
 
    ' Warten, bis die Verbindung hergestellt ist
    Do While .State < sckConnected
      DoEvents
    Loop
 
    ' Verbindung OK?
    If Not .State > sckConnected Then
      lblStatus.Caption = "Anmelden am Server..."
      DoEvents
 
      ' Auf Antwort warten...
      strResponse = ""
      If WaitForResponse() Then
 
        ' Benutzernamen prüfen
        lblStatus.Caption = "Prüfe Benutzernamen..."
        DoEvents
        strResponse = ""
        .SendData "USER " & UserName & vbNewLine
        If WaitForResponse() Then
 
          ' Kennwort prüfen
          lblStatus.Caption = "Prüfe Kennwort..."
          DoEvents
          strResponse = ""
          .SendData "PASS " & Password & vbNewLine
 
          If WaitForResponse() Then
            MailConnectToServer = True
          Else
            MsgBox "Falsches oder ungültiges Kennwort!", _
              16, "Nachrichten abrufen"
          End If
        Else
          MsgBox "Falscher oder ungültiger Benutzername!", _
            16, "Nachrichten abrufen"
        End If
      Else
        MsgBox "Verbindung zum Mailserver fehlgeschlagen!", _
          16, "Nachrichten abrufen"
      End If
    End If
  End With
End Function

2. Prüfen, ob Nachrichten vorhanden sind
Die nachfolgende Funktion prüft, ob auf dem Mailserver überhaupt Nachrichten vorhanden sind und zeigt die einzelnen Nachrichtennummern (MsgID), sowie die Nachrichtengrößen in einem ListView-Steuerelement an. Die Nachrichten selbst werden jetzt noch nicht abgerufen!

' Prüft auf neue Nachrichten
Public Function MailGetListe() As Boolean
  Dim strMails() As String
  Dim mData() As String
  Dim i As Integer
  Dim itemX As ListItem
 
  ' ListView löschen
  ListView1.ListItems.Clear
 
  ' Liste aller Nacchrichten
  With Winsock1
    strResponse = ""
    .SendData "LIST" & vbNewLine
    frmStatus.txtStatus = frmStatus.txtStatus & _
      "LIST" & vbNewLine
 
    If WaitForResponse() Then
      ' Nachrichten-Auflistung
      strMails = Split(strResponse, vbNewLine)
 
      For i = 1 To UBound(strMails) - 2
        mData = Split(strMails(i), " ")
 
        ' MsgID und Größe in Liste speichern
        Set itemX = ListView1.ListItems.Add(, , mData(0))
        itemX.SubItems(1) = mData(1)
        itemX.SubItems(2) = ""
      Next i
    End If
  End With
 
  MailGetListe = (ListView1.ListItems.Count > 0)
End Function

3. Nachricht abrufen
Um nun eine bestimmte Nachricht abzurufen, wird der Befehl RETR x gesandt. Das "x" steht hierbei für die Nachrichtennummer (siehe LIST - Function MailGetListe). Wie bereits eingangs erwähnt soll die Nachricht selbst in eine temporäre Datei gespeichert werden. Den Dateinamen bilden wir aus dem Tagesdatum und der aktuellen Uhrzeit, so dass nicht aus Versehen eine bereits existierende Datei überschrieben wird. Der Dateiname wird dann von der Funktion als Rückgabewert zurückgegeben.

Ach ja: Soll die Mail nach dem Empfang vom Server gelöscht werden, so muss für den zweiten Parameter True angegeben werden.

' Nachricht abrufen
Public Function MailRecieve(ByVal MsgId As String, _
  Optional ByVal MsgDelete As Boolean = False) As String
 
  Screen.MousePointer = 11
  BytesRead = 0
  With Winsock1
    strResponse = ""
 
    ' Datei, in welcher die aktuelle Nachricht
    ' gespeichert werden soll
    popTempFile = App.Path & "\MAIL_" & MsgId & " " & _
      Format$(Now, "yymmdd_hhnnss") & ".txt"
    DoEvents
 
    .SendData "RETR " & MsgId & vbNewLine
    frmStatus.txtStatus = frmStatus.txtStatus & _
      "RETR " & MsgId & vbNewLine
 
    ' Solange empfangen, bis mit . abgeschlossen ist
    Do While InStr(strResponse, _
      vbNewLine & "." & vbNewLine) = 0
      DoEvents
    Loop
    MailRecieve = popTempFile
    popTempFile = ""
 
    ' GGf. Nachricht vom Server löschen
    If MsgDelete Then
      strResponse = ""
      .SendData "DELE " & MsgId & vbNewLine
      WaitForResponse
    End If
  End With
 
  Screen.MousePointer = 0
End Function

Jetzt fehlt eigentlich nur noch die Funktion, welche die einzelnen Datenpakete vom Mailserver empfängt...

' Daten werden empfangen
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
  Dim F As Integer
  Dim strData As String
 
  Winsock1.GetData strData, vbString
 
  If Not Left$(strData, 3) Like "+OK" Then
    ' Daten-Block in Datei schreiben
    If popTempFile <> "" Then
      F = FreeFile
      Open popTempFile For Append As #F
      Print #F, Replace(strData, vbNewLine & ".", vbNewLine);
      Close #F
 
      ' Fortschritt
      BytesRead = BytesRead + Len(strData)
      If BytesRead > Status.Max Then BytesRead = Status.Max
      Status.Value = BytesRead
    End If
    strMail = strMail & strData
  End If
 
  If popTempFile <> "" Then
    strResponse = strLastResponse & strData
    strLastResponse = strData
  Else
    strResponse = strResponse & strData
    frmStatus.txtStatus = frmStatus.txtStatus + strData
  End If
End Sub
 
' Auf Antwort warten!
Public Function WaitForResponse() As Boolean
 
  ' spätestens nach 45 Sekunden abbrechen
  Const TimeOut = 45
  Dim iStart As Long
 
  iStart = Timer
  WaitForResponse = False
  With Winsock1
    While strResponse = ""
      ' Bei unvorhergesehenem Verbindungsabbruch
      If .State > sckConnected Then
        MsgBox "Verbindungsabbruch!", 16, "Error"
        Exit Function
      End If
 
      ' Wenn TimeOut überschritten, Meldung und abbrechen
      If Timer - iStart > TimeOut Then
        MsgBox "TimeOut!" & vbCrLf & _
          "Der Server antwortet nicht...", 16, "TimerOut"
        Exit Function
      End If
      DoEvents
    Wend
  End With
 
  If Left(strResponse, 3) Like "+OK" Then
    WaitForResponse = True
  End If
End Function

Beispiel:
Das Download-Beispiel beinhaltet ein Formular mit allen benötigten Eingabefeldern, wie ServerName, Benutzername und Kennwort. Per Knopfdruck werden alle Nachrichten mit MsgID und Nachrichtengröße in einem ListView-Steuerelement aufgelistet. Nun können die einzelnen Nachrichten der Reihe nach abgerufen werden. Nach dem Abruf der Nachricht wird automatisch der Windows-Editor gestartet, in welchem die Nachricht selbst angezeigt wird.

Zusätzlich wird während des Empfangvorgangs der Status in Form eines Fortschrittbalkens angezeigt, sowie die einzelnen Antworten vom Mailserver in einem Art Debug-Fenster aufgezeichnet.

Das Beispielsprojekt wurde so gehalten, daß vor dem Abrufen neuer Nachrichten geprüft wird, ob eine Internet-Verbindung besteht - und falls nicht, erscheint der Standard-Verbinden-Dialog...
 

Tipp: sevMail ActiveX mit ZIP-Funktionalität

Mails senden, abrufen und decodieren - ganz easy
Das SMTP Control sendet, das POP3 Control empfängt und der Mail-Parser decodiert empfangene Mails im Handumdrehen - natürlich unter Berücksichtigung von Multi-Part MIME Nachrichten, Anlagen u.v.m. Auf Wunsch zippt die Komponente Dateianlagen, um die Mail zu klein wie möglich zu halten. Auch werden SMTP-AUTH Server unterstütz, bei denen der Versand von Nachrichten nur mit korrekter Authentifizierung erfolgt.

Weiter Infos im Downloadbereich...