Visual Basic Forum

meteor45_ · Tutorial Leser Anmeldedatum: 04.11.2007 Beiträge: 29

also ich will (wie bei manchen steahlern) in meinen lottozahlen generator
eine e-mail funktion einabauen..

die e-mail versaand soll über meinen v server laufen!

es sollen die generierten zahlen verschickt werden
einer ne idee?

killer110_ · Poster Anmeldedatum: 16.04.2007 Beiträge: 165

So könnte man an die Sache rangehen!

1.

<--- hier draufklicken!
2. "Email php" eingeben
3. Auf "Suchen" klicken!
4. Auf den 7 Thread von oben auf die 3. Seite gehen und ersten post angucken!
5. Sich freuen...

King of Chaos_ · Coder Anmeldedatum: 26.09.2007 Beiträge: 235

ist das aber dann ned per php script (kann hier ned suchen wegen der schutzsoftware die hier läuft)

das will er ja glaub ich ned er wills ja über seinen server ...

Hamtaro_ · Verfasst am: 05.12.2007, 15:11

http://vbforums.com/showthread.php?t=374892 vllt?
oder sieh mal auf pscode.com nach

Wie findet ihr meine Sig?

meteor45_ · Tutorial Leser Anmeldedatum: 04.11.2007 Beiträge: 29

@King of Chaos genua!^^

ehm ich komm mit der anleitung nicht klar

edit:// ich finde nur anleitungen mit vb.net und smtp versand-.-

help

meteor45_ · Tutorial Leser Anmeldedatum: 04.11.2007 Beiträge: 29

need help büdde

King of Chaos_ · Coder Anmeldedatum: 26.09.2007 Beiträge: 235

Aus der Extra Tipp Area von vb@rchiv
das dürfte dir helfen!!!

---Empfangen-*-----

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

---Versenden------

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

meteor45_ · Tutorial Leser Anmeldedatum: 04.11.2007 Beiträge: 29

wärst du noch so nett mir den link dazu zu schicken .. (von der seite )

ich will mir datt mal da ansehn

King of Chaos_ · Coder Anmeldedatum: 26.09.2007 Beiträge: 235

http://www.vbarchiv.net

meteor45_ · Tutorial Leser Anmeldedatum: 04.11.2007 Beiträge: 29

meteor45_ · Tutorial Leser Anmeldedatum: 04.11.2007 Beiträge: 29

ich komm damit nicht klar..

_code__ · Verfasst am: 05.12.2007, 20:17

jetzt mah doch nicht einen doppelpost nach dem andern Evil or Very Mad

"EDIT" button gibts auch

und auf der seite kannste auch suchen...

EDIT://
oder man nimmt sich 2 min & guckt da mal nach

King of Chaos_ · Coder Anmeldedatum: 26.09.2007 Beiträge: 235

lOl irgendwann reichts schau selber mFg