vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Brandneu! sevEingabe v3.0 - Das Eingabecontrol der Superlative!  
 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.07.01
EMails mit dem Winsock-Control versenden

Ein Beispiel, wie sich EMails unter Verwendung des Winsock-Controls an beliebige Empfänger versenden lässt.

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

"Wie kann ich aus meiner Anwendung heraus eine EMail-Nachricht versenden?"
Diese Frage wurde in der letzten Zeit sehr häufig gestellt. Zum Versenden von EMail-Nachrichten bietet Visual-Basic drei Möglichkeiten:

  • Verwenden der Microsoft Outlook Object Library
  • Verwenden des MAPI-Controls
  • Verwenden des Winsock-Controls
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. HELO senden - Warten auf Antwortcode 250
  3. Absender-Daten übermitteln - Warten auf Antwortcode 250
  4. Empfänger-Daten übermitteln - Warten auf Antwortcode 250
  5. Daten senden (Header & Message), mit CR CR . CR beenden
  6. Warten auf Antwortcode 250
  7. QUIT senden - Warten auf Antwortcode 221

Und hier der Code zum Versenden einer Nachricht:

' ServerName: Name des SMTP-Servers
'   bei T-Online z.B. mailto.btx.dtag.de
' 
' EmpfName:   Name des Empfängers
' EmpfEMail:  EMail-Adresse des Empfängers
' AbsName:    Absender-Name (Ihr Name)
' AbsEMail:   Absender-EMail (Ihre EMail-Adresse)
' Betreff:    Nachrichten-Betreff (Subject)
' Nachricht:  Nachrichten-Text
' ======================================================
Public Function MailSend(ServerName As String, EmpfName As _
  String, EmpfEMail As String, AbsName As String, _
  AbsEMail As String, Betreff As String, _
  ByVal Nachricht As String) As Boolean
 
  Dim Header As String
  Dim iPos As Long
  Const CR = vbNewLine
 
  ' Status-Fenster "leeren"
  frmStatus.txtStatus.Text = ""
  If Not frmStatus.Visible Then frmStatus.Show , Me
 
  With Winsock1
    ' Anmelden am Mailserver
    lblStatus.Caption = "Verbinden mit: " + _
      ServerName + "..."
    .Protocol = sckTCPProtocol
    .LocalPort = 0
    .Connect ServerName, 25
 
    ' Warten, bis die Verbindung hergestellt ist
    Do While .State < sckConnected
      DoEvents
    Loop
 
    ' Keine Verbindung möglich?
    If .State > sckConnected Then
      MsgBox "Kein Verbindungsaufbau möglich!"
      MailSend = False
    Else
 
      ' HELO schicken (Begrüssung)
      lblStatus.Caption = "Anmelden am Server..."
      .SendData "HELO " & ServerName & CR
      If Not WaitForResponse("250") Then GoTo Send_End
 
      ' Absender-Daten
      lblStatus.Caption = "Sende Nachricht..."
      .SendData "MAIL FROM: <" & AbsEMail & ">" & CR
      If Not WaitForResponse("250") Then GoTo Send_End
 
      ' Empfänger-Daten
      .SendData "RCPT TO: <" + EmpfEMail + ">" + CR
      If Not WaitForResponse("250") Then GoTo Send_End
 
      ' Server mitteilen, daß jetzt DATEN gesendet werden
      .SendData "DATA" & CR
      If Not WaitForResponse("354") Then GoTo Send_End
 
      ' Nachrichten-Header erstellen
      Header = "From: " & AbsName & _
        " <" & AbsEMail & ">" & CR & _
        "To: " & EmpfName & " <" & EmpfEMail & ">" & CR & _
        "Date: " & Format(Date, "Ddd") & ", " & _
          Format(Date, "dd Mmm YYYY") & " " & _
          Format(Time, "hh:mm:ss") & "" & " +0001" & CR & _
        "Subject: " & Betreff & CR
 
      ' WICHTIG!!!
      ' Prüfen, ob innerhalb des Nachrichtentextes eine
      ' Zeile nur aus einem einzigen Punkt enthält.
      ' Wenn ja, unbedingt einen zweiten Punkt anfügen,
      ' da ein einzelner Punkt das Ende der Nachricht
      ' angibt!!!
      iPos = InStr(Nachricht, vbCrLf & "." & vbCrLf)
      If iPos > 0 Then
        Nachricht = Left$(Nachricht, iPos) & "." & _
          Mid$(Nachricht, iPos + 1)
      End If
 
 
      ' Jetzt Daten senden
      .SendData Header & vbCrLf
      While Nachricht <> ""
        ' Paketweise zu je 1024 Bytes senden
        .SendData Left$(Nachricht, 1024)
        Nachricht = Mid$(Nachricht, 1025)
        DoEvents
      Wend
      .SendData vbCrLf
      .SendData vbCrLf & "." & vbCrLf
 
      If Not WaitForResponse("250") Then GoTo Send_End
 
      ' Abmelden am Server
      lblStatus.Caption = "Abmelden vom Server..."
      .SendData "QUIT" & CR
      If Not WaitForResponse("221") Then GoTo Send_End
      MailSend = True
    End If
  End With
 
Send_End:
  ' Verbindung beenden
  lblStatus.Caption = "Verbindung beenden..."
  Winsock1.Close
 
  lblStatus.Caption = "Bereit..."
End Function
 
' Auf Antwort warten...
Public Function WaitForResponse(ByVal Response As _
 String) As Boolean
 
  ' spätestens nach 45 Sekunden abbrechen
  Const TimeOut = 45
  Dim iStart As Long
 
  iStart = Timer
  WaitForResponse = False
  With Winsock1
    While .Tag <> Response
      ' Bei unvorhergesehenem Verbindungsabbruch
      If .State > sckConnected And Response <> "221" 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 antworte nicht...", 16, "TimerOut"
        Exit Function
      End If
      DoEvents
    Wend
    .Tag = ""
  End With
 
  WaitForResponse = True
End Function
 
' Empfangen von Daten vom Server
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
  Dim strDaten As String
 
  Winsock1.GetData strDaten
  frmStatus.txtStatus = frmStatus.txtStatus + strDaten
 
  ' Wird für die Sub "WaitForResponse" benötigt
  Winsock1.Tag = Left$(strDaten, 3)
End Sub

Beispiel:
Das Beispiel zum Downloaden beinhaltet ein Formular mit allen benötigten Eingabefeldern, wie ServerName, Absender- und Empfängerangaben, Nachrichtenbetreff und die Nachricht selbst. Zusätzlich wird während des Sendevorgang der Status angezeigt, sowie alle Antworten vom Mailserver in einem Art Debug-Fenster aufgezeichnet.

Das Beispielsprojekt wurde so gehalten, daß vor dem Versenden geprüft wird, ob eine Internet-Verbindung besteht - und falls nicht, erscheint der Standard-Verbinden-Dialog... Nach dem Sendevorgang lässt sich die Online-Verbindung auch automatisch wieder trennen.

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