"Wie kann ich aus meiner Anwendung heraus eine EMail-Nachricht versenden?"
Befehl absenden - auf Antwort warten - Antwort auswerten Die Reihenfolge hierbei ist folgende:
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 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 Weiter Infos im Downloadbereich... |