VB 5/6-Tipp 0071: E-Mails empfangen via Winsock

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
' Die Komponente ' (MSWINSCK.OCX)' wird benötigt.
' Die Komponente 'Microsoft Windows Common Controls 5.0 (SP2) (comctl32.ocx)' wird benötigt.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Fortschrittsanzeige "ProgressBar1"
' Steuerelement: Kontrollkästchen-Steuerelement "Check1"
' Steuerelement: Listen-Steuerelement "List1"
' Steuerelement: Timersteuerelement "Timer1"
' Steuerelement: Windows Socket "Winsock1"
' Steuerelement: Textfeld "Text1"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"

' Dieser Code ist eine Erweiterung der alten Nr. 71 von www.activevb.de
' Ebenso wurden Teile des Tip Nr. 504 verwendet

' Das Projekt empfängt E-Mails via Winsock

' Erweiterungen zu Tip Nr. 71:

' Fehlerkorrektur der Fortschrittsanzeige Fehlerkorrektur des Timeout
' bei langsamen POP3-Servern Speichern der E-Mail in einer .txt Datei
' zur Fehlerkorrektur der Speicherung überlanger E-Mails im Textfeld
' Dekodieren und speichern der auf BASE64 beruhenden Anhänge

' Überarbeitet durch: (c) 02/2003 Hans Henning Klein (hexerei@handshake.de)

Option Explicit

Const Base64 As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" & _
                         "abcdefghijklmnopqrstuvwxyz" & _
                         "0123456789+/"

Private Result As String
Private Corr As Long
Private TOut As Boolean
Private B64() As Byte
Private Rev64() As Byte

Private Const TimeOut As Long = 10
Private Const Port As Long = 110

' Dise Angaben müssen vor dem 1. Start angepasst werden:
Private Const Host As String = "pop3.hs-sb.handshake.de" ' Servername
Private Const Account As String = "fxspooky"             ' Benutzername
Private Const Password As String = "Passwort"            ' Passwort

Private DatopenWins As Integer
Private DatOpen As Boolean
Private InGoingBytes As Long

Private Sub SchreibAnhang(ByRef Datname As String)
    Dim LT As Integer
    Dim LW As Long, t As Long
    Dim Anhang As Boolean
    Dim Wandel As String, Data As String
    Dim Woll As String, Leerzeile As String
    Dim AnhName As String, LastContentName As String
    Dim sourceB() As Byte
    Dim Result(3) As Byte
    Dim w1 As Byte, w2 As Byte
    Dim w3 As Byte, w4 As Byte
   
    ' Dateianhänge aus BASE64 dekodieren und speichern
    Label1.Caption = "Mailanhang schreiben..."
    DoEvents
    AnhName = ""
    Anhang = False
    LT = FreeFile()
    Open App.Path & "\" & (List1.ListIndex + 1) & ".txt" For Input As #LT
    Do
        Line Input #LT, Data
        If Anhang Then
            If Len(Data) > 0 Then
                If Len(Data) > 3 Then
                    If Left(Data, 4) <> "----" Then
                        Woll = Woll & Data
                        Do
                            If Len(Woll) >= 4 Then
                                Wandel = Left$(Woll, 4)
                                Woll = Right$(Woll, Len(Woll) - 4)
                                sourceB() = StrConv(Wandel, vbFromUnicode)
                                w1 = Rev64(sourceB(0))
                                w2 = Rev64(sourceB(1))
                                w3 = Rev64(sourceB(2))
                                w4 = Rev64(sourceB(3))
                                Result(0) = ((w1 * 4 + Int(w2 / 16)) And 255)
                                Result(1) = ((w2 * 16 + Int(w3 / 4)) And 255)
                                Result(2) = ((w3 * 64 + w4) And 255)
                                Put #LW, , Result(0)
                                Put #LW, , Result(1)
                                Put #LW, , Result(2)
                            Else
                                Exit Do
                            End If
                        Loop
                    Else
                        Anhang = False
                    End If
                Else
                    Anhang = False
                End If
            End If
            If Anhang = False Then
                Close #LW
                If Len(Datname) = 0 Then
                    Datname = AnhName
                Else
                    Datname = Datname & " / " & AnhName
                End If
                AnhName = ""
            End If
        End If
        If InStr(1, UCase(Data), "CONTENT-TYPE", vbTextCompare) > 0 Then
        
        ' wurde ein Dateiname für einen Anhang mitgeliefert?
        If InStr(1, UCase(Data), "NAME") Then
                t = InStr(1, Data, "=")
                LastContentName = Mid(Data, t + 1)
                LastContentName = Replace(LastContentName, Chr$(34), "")
                If Dir(App.Path & "\" & LastContentName) > "" Then
                    Kill App.Path & "\" & LastContentName
                End If
            End If
        End If
        
        If InStr(1, UCase(Data), "CONTENT-TRANSFER-ENCODING: BASE64", vbTextCompare) > 0 Then
            Do
                Line Input #LT, Leerzeile
                
                ' wurde ein Dateiname mitgeliefert?
                If InStr(1, UCase(Leerzeile), "NAME") Then
                    t = InStr(1, Leerzeile, "=")
                    LastContentName = Mid$(Leerzeile, t + 1)
                    LastContentName = Replace$(LastContentName, Chr$(34), "")
                    If Len(Dir$(App.Path & "\" & LastContentName)) > 0 Then
                        Kill App.Path & "\" & LastContentName
                    End If
                End If
            Loop Until Leerzeile = ""
            
            Anhang = True
            If LastContentName = "" Then
                AnhName = (List1.ListIndex + 1) & ".anh"
            Else
                AnhName = LastContentName
            End If
            LW = FreeFile()
            Open App.Path & "\" & AnhName For Binary As #LW
        End If
    Loop Until EOF(LT)
    Close #LT
    Label1.Caption = ""
End Sub

Private Sub Command2_Click()
    ' Trennen
    
    If Check1.Value = vbChecked Then
        Label1.Caption = "Trennen und Nachrichten löschen"
    Else
        Label1.Caption = "Trennen"
    End If
    
    ' Ausloggen und event. Löschungen durchführen
    Winsock1.SendData "quit" & vbCrLf
    If Response Then Goto ERRSub
    
    Winsock1.Close
    Label1.Caption = ""
    Label2.Caption = "getrennt"
    Exit Sub
    
ERRSub:
    Call MsgBox("Fehler bei der Übertragung - " & Err.Description, _
        vbOKOnly + vbExclamation, App.Title)
    
    Winsock1.Close
    Label1.Caption = ""
End Sub

Private Sub Form_Load()
    Timer1.Enabled = False
    B64() = StrConv(Base64, vbFromUnicode)
    Call ReverseCode(B64, Rev64)
    Label2.Caption = "getrennt"
End Sub

Sub ReverseCode(Code() As Byte, Rev() As Byte)
    ' Dreht ein Bytearray um
    Dim i As Integer
    
    ReDim Rev(255) ' Ein Byte
    For i = LBound(Code) To UBound(Code)
        Rev(Code(i)) = i
    Next i
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ' Verbindung evtl. schließen
    
    If Winsock1.State <> sckClosed Then
        Call Command2_Click
    End If
End Sub

Private Sub List1_Click()
    Dim AFile As String, Data As String
    Dim LT As Long
    Dim Stime As Long
    Dim Datei As String
    
    ' Mail herunterladen
    
    If Label2.Caption = "Verbunden" Then
        Label1.Caption = "Nachricht " & _
        CStr(List1.ListIndex + 1) & " abrufen"
        
        ' max. Länge der Datei
        Corr = CLng(List1.ItemData(List1.ListIndex)) + 256
        ProgressBar1.Max = Corr
        ProgressBar1.Value = 0
        
        DatOpen = True
        DatopenWins = FreeFile()
        InGoingBytes = 0
        Stime = Timer + TimeOut
        
        ' temp. Dateiname
        AFile = App.Path & "\" & (List1.ListIndex + 1) & ".txt"
        Open AFile For Binary Access Write As #DatopenWins
        
        ' E-Mail abrufen
        Winsock1.SendData "retr " & CStr(List1.ListIndex + 1) & vbCrLf
        Do
            DoEvents
            If ProgressBar1.Max < InGoingBytes Then _
                ProgressBar1.Max = InGoingBytes
                
            ' Wenn Daten eintreffen -> Timeout verlängern
            If ProgressBar1.Value <> InGoingBytes Then
                ProgressBar1.Value = InGoingBytes
                Stime = Timer + TimeOut
            End If
        Loop Until (InGoingBytes >= Corr) Or (Timer > Stime)
        Close #DatopenWins
        DatOpen = False
        ProgressBar1.Value = ProgressBar1.Max
        DoEvents
        
        If Check1.Value = vbChecked Then
        
            ' Mail zum Löschen markieren
            Winsock1.SendData "dele " & CStr(List1.ListIndex + 1) & vbCrLf
            
            Label1.Caption = "Nachricht " & _
                CStr(List1.ListIndex + 1) & " markieren"
            
            If Response Then Goto ERRSub
        End If
        
        ' Dateianhänge im BASE64-Format suchen
        Text1.Text = ""
        LT = FreeFile()
        Open AFile For Input As #LT
        Do
            Line Input #LT, Data
            If InStr(1, UCase(Data), "CONTENT-TRANSFER-ENCODING: BASE64", vbTextCompare) > 0 Then
                Call SchreibAnhang(Datei)
                Text1.Text = Text1.Text & vbCrLf & "Dateianhang: " & Datei
                Exit Do
            End If
            Text1.Text = Text1.Text & Data & vbCrLf
            DoEvents
        Loop Until EOF(LT)
        Close #LT
    Else
        MsgBox "Einlesen von E-Mails ohne Verbindung zum Server nicht " & _
            "möglich!", vbOKOnly + vbCritical, "Hinweis"
         
    End If
    Exit Sub
   
ERRSub:
    MsgBox ("Fehler bei der Übertragung - " & Err.Description)
    Winsock1.Close
    Label1.Caption = ""
End Sub

Private Sub Timer1_Timer()
    TOut = True
End Sub

Private Sub Winsock1_DataArrival(ByVal BytesTotal As Long)
    Dim B() As Byte
    
    If DatOpen Then
        Winsock1.GetData B, vbByte
        Put #DatopenWins, , B()
        
        ' Ende-Kennzeichen der E-Mail?
        If B(BytesTotal - 3) = 46 And B(BytesTotal - 2) = 13 _
            And B(BytesTotal - 1) = 10 Then Corr = InGoingBytes
            
        InGoingBytes = InGoingBytes + BytesTotal
    Else
        Winsock1.GetData Result
    End If
End Sub

Private Function Response() As Boolean
    TOut = False
    Result = ""
    Timer1.Interval = TimeOut * 1000
    Timer1.Enabled = True
    
    Do While Len(Result) = 0
        DoEvents
        If TOut Then Exit Do
    Loop
    Response = TOut
End Function

Private Sub Command1_Click()
    ' E-Mails empfangen
    
    Dim t As Long, No As Long, x As Long
    Dim Bytes As Long
    Dim Dat As String
    Dim Corr As Integer
    Dim Stime As Long
    Dim Von As String, Betreff As String
    Dim Uebertragungsfehler As Byte
    Dim RetVal As Boolean
    
    If Winsock1.State = sckClosed Then
        Label2.Caption = "Verbunden"
        Command1.Enabled = False
        DatOpen = False
        List1.Clear
        Text1.Text = ""
        DoEvents
        
        ' Verbindung mit Server aufnehmen und einloggen
        Label1.Caption = "Suche Host"
        Winsock1.LocalPort = 0
        Winsock1.Connect Host, Port
        If Response Then Goto ERRSub
        
        Label1.Caption = "Suche Account"
        Winsock1.SendData "user " & Account & vbCrLf
        If Response Then Goto ERRSub
        
        Label1.Caption = "Sende Passwort"
        Winsock1.SendData "pass " & Password & vbCrLf
        If Response Then Goto ERRSub
        
        ' Anzahl & Größe der E-Mails abfragen
        Label1.Caption = "Postfach prüfen"
        Winsock1.SendData "stat" & vbCrLf
        If Response Then Goto ERRSub
        
        Call StatData(Result, No, Bytes)
        If No > 0 Then
            ProgressBar1.Value = 0
            ProgressBar1.Max = No
            Dat = CStr(No)
            
            For x = 1 To No
            
                ' Größen der Mail abfragen
                Label1.Caption = "Nachricht " & CStr(x) & _
                    " von " & Dat & " erfassen"
                    
                DoEvents
                Uebertragungsfehler = 0
                Do
                    Winsock1.SendData "list " & CStr(x) & vbCrLf
                    RetVal = Not Response
                    If Not RetVal Then
                        warten 5
                        Uebertragungsfehler = Uebertragungsfehler + 1
                        If Uebertragungsfehler > 4 Then
                            Goto ERRSub
                        End If
                    End If
                    DoEvents
                Loop Until RetVal
                Call StatData(Result, No, Bytes)
                DoEvents
                
                ' Absender und Betreff abfragen
                Uebertragungsfehler = 0
                Do
                    Winsock1.SendData "top " & CStr(x) & " 0" & vbCrLf
                    RetVal = Not Response
                    If Not RetVal Then
                        warten 5
                        Uebertragungsfehler = Uebertragungsfehler + 1
                        If Uebertragungsfehler > 4 Then
                            Goto ERRSub
                        End If
                    End If
                Loop Until RetVal
                
                Von = ""
                Betreff = ""
                t = InStr(1, UCase(Result), "FROM:")
                
                If t > 0 Then Von = Trim(Mid(Result, t + 6, _
                    InStr(t + 6, Result, vbLf) - t - 7))
                    
                t = InStr(1, UCase(Result), "SUBJECT:")
                If t > 0 Then
                    If InStr(t, Result, vbLf) Then
                        Betreff = Mid(Result, t + 9, _
                            InStr(t + 9, Result, vbLf) - t - 10)
                    Else
                        Betreff = Mid(Result, t + 9)
                    End If
                End If
                
                List1.AddItem Von & vbTab & Betreff & vbTab & Bytes
                List1.ItemData(List1.NewIndex) = Bytes
                ProgressBar1.Value = ProgressBar1.Value + 1
            Next x
            
            ProgressBar1.Value = 0
            Label1.Caption = x - 1 & " E-Mails erfasst."
            
        ElseIf No = 0 Then
            Label1.Caption = "Keine E-Mails vorhanden"
            
        Else
            Label1.Caption = "Fehler"
        End If
    End If
    Exit Sub
    
ERRSub:
    Call MsgBox("Fehler bei der Übertragung - " & Err.Description)
    Winsock1.Close
    Label1.Caption = ""
    Command1.Enabled = True
End Sub

Private Sub StatData(Data As String, ByRef No As Long, ByRef Bytes As Long)
    Dim Dat As String
    Dim x As Long
    
    x = InStr(1, Data, "+OK")
    If x <> 0 Then
        Data = Mid$(Data, x, Len(Data))
        Dat = Trim$(Mid$(Data, 4, Len(Data)))
        x = InStr(1, Dat, " ")
        If x <> 0 Then
            No = Val(Left$(Dat, x))
            Bytes = Val(Mid$(Dat, x + 1, Len(Dat)))
        Else
            No = -1
        End If
    End If
End Sub

Public Sub SchreibData(Datei As String, Daten As Variant)
    Dim uz As Long
       
    uz = FreeFile
    Open App.Path & "\" & Datei For Output As #uz
        Print #uz, Daten
    Close #uz
End Sub

Public Sub warten(Spanne As Long)
    Dim aus As Long
    
    aus = Timer
    Do
        DoEvents
    Loop Until Abs(Timer - aus) > Spanne
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Kommentar von Stephan Triesch am 28.04.2008 um 11:44

Hallo Pauli,

das Problem wird leider nicht ganz deutlich.
Von welchem Posteingang / Papierkorb redest Du ?

Sorry, aber Dein Schreibstil und die unvollständige Schilderung lässt mich nur vermuten wo Dein Problem ist.

Ich vermute, dass Du ein anderes Mail-Tool (z.B. Outlook Express oder ähnliches) verwendest und nun Dein Postfach (oder Deine Postfächer) mittels oben niedergeschriebenen Programmzeilen auslesen möchtest.

1. gibt es technisch gesehen bei POP3 Accounts keine Papierkörbe
2. muss einem POP3-Server explizit mitgeteilt werden, dass Mails nach dem Abruf vom Server zu löschen sind.


Kontrolliere mal bitte Deine Konten-Einstellungen in Deinem eMail-Programm. Vermutlich steht dort etwas wie "Kopie aller Nachrichten auf dem Server belassen" UND "Nach dem Löschen vom Server entfernen" ... und diese Punkte sind vermutlich bei Dir angehakt.
... im Klartext bedeutet das, dass Deine eMails erst vom Server gelöscht werden, wenn Du diese in Deinem Mail-Programm löschst (auch aus dem Papierkorb) ODER diesen Löschvorgang mittels der oben beschriebenen Zeilen zu Fuss durchführst.
Bevor Du Dein eigenes Mail-Tools einsetzt solltest Du Dich etwas genauer mit der Arbeitsweise eines Mailservers auseinandersetzen, da ungewollte Nebeneffekte so nicht auszuschliessen sind.

Viel Erfolg !

==============================================
Beratung für Datenlogistik und -verarbeitungen
Stephan Triesch

www.triesch.de
==============================================

Kommentar von Pauli am 25.04.2008 um 17:59

Hollo Leute!

Bei mir funktionierts zwar, dass ich E-Mails abrufen kann, nur is mir nicht ganz klar warum der nicht die Mails aus dem Posteingangsordner ausliest, sonder wild aus den gelöschten und den Eingang?!

Es scheint als ob er alle noch nicht gelesenen aussucht, aber das will ich ja garnet. Ich will doch alle die ich im Posteingang hab sehen und nicht irgendwechen Spam der im Papierkorb liegt. Was muß ich ändern, damit ich die richtigen Mails auslese?

Gruß Pauli

Kommentar von Chris am 29.11.2007 um 10:48

Hallo!
Wenn ich den HTML Teil extrahiere und in einer Datei abspeicher, diese dann anzeigen lasse, dann sieht das Ergebnis jedoch von der Formatierung her ganz anders aus als in meinem Outlook. Woran liegt das??

lg Chris

Kommentar von Stephan Triesch am 15.12.2006 um 12:21

Hallo Kay,

Du kannst die "Microsoft Internet Controls" verwenden, welche als Browser-Anzeigebereich in Deiner Form dargestellt werden.

Sofern Du dieses Control nicht direkt unter den Komponenten findest (Menu: Projekt/Komponenten"), dann suche nach der Datei "shdocvw.dll" (meistens zu finden unter "%windir%\system32\" und binde diese als neue Komponente ein.

Die Verwendung ist nicht ganz einfach und leider nirgendwo dokumentiert.
Am einfachsten speicherst Du Deinen (zuvor extrahierten) HTML-Code in eine Datei und zeigst sie mit dem Befehl ...

tmpBrowser.Navigate "C:\Meine_Seite.htm"

... an.

Anmerkung:
- Betrifft VB5 prof. / Win XP
- Microsoft hat die Methoden und Eigenschaften in den Steuerelementen der Nachfolgegeneration an einigen Stellen verändert !

Viel Erfolg ... Stephan

==============================================
Beratung für Datenlogistik und -verarbeitungen
Stephan Triesch

www.triesch.de
==============================================

Kommentar von Kay am 13.12.2006 um 11:25

hallo. kann mir jemand bitte sagen wie ich die mail nicht als text unten angezeigt bekomme sondern als HTML dokument? das wäre echt nett.

Kommentar von Razorback am 21.10.2006 um 22:36

bitte um Hilfe


Laufzeitfehler 5

ungültiger Prozessaufruf oder ungültiges Argument

Kommentar von Stephan Triesch am 08.07.2006 um 14:12

Hier gibt es eine sehr gute Beschreibung zu SMTP / POP3 Befehlen, welche die meisten Fragen beantworten sollten (nicht von der Telnet-Verwendung irritieren lassen ... Befehle per Winsock sind die gleichen):

SMTP: http://www.it-academy.cc/content/article_browse.php?ID=915

POP3: http://www.it-academy.cc/content/article_browse.php?ID=0000000997

==============================================
Beratung für Datenlogistik und -verarbeitungen
Stephan Triesch

www.triesch.de
==============================================

Kommentar von Miseeg am 21.10.2005 um 21:58

Grüß die Runde,
Weiss einer, wie man sich den Empfänger anzeigen lassen kann ?
zB um bestimmt Emails aus dem CatchAll Pool zu filtern.

Grüße,
Miseeg

Kommentar von Sebo am 24.09.2005 um 09:17

@Andreas

so nen spagetti code kannste immerhin sinnvoll umschreiben mit einer fussgesteuerte schleife...

DO
* Uebertragungsfehler = 0
...
* End If

LOOP WHILE (Len(Von) = 0 Or Len(Betreff) = 0)

Kommentar von Andreas am 23.09.2005 um 16:10

@ Alex:

Das ist richtig. Hatte ich noch gar nicht bedacht. Hab das jetzt um ein Abbruchkriterium erweitert, falls wirklich kein Betreff angegeben wurde.

Bleibt alles gleich bis auf die If-Anweisung mit der Sprungmarke:

If (Len(Von) = 0 Or Len(Betreff) = 0) And RCounter < 20 Then RCounter = RCounter + 1: GoTo RetrieveSubjectNSender


Die Variable RCounter will natürlich definiert werden. As Byte müsste reichen.

Kommentar von Alex am 23.09.2005 um 15:19

@Andreas.

Führt zur Endlosschleife wenn Betreff leer ist.
Ich füge noch folgenden Code ein und frage nur
Datum und Absender ab:

Retry:
.
.
.
MailDate = "" <- Noch zusätzlich deklarieren als String
Von = ""
Betreff = ""

t = InStr(1, UCase(Result), "DELIVERY-DATE:")
If t > 0 Then MailDate = Trim(Mid(Result, t + 14, _
InStr(t + 14, Result, vbLf) - t - 21))
.
.
.
.
End If
End If

If Len(Von) = 0 Or Len(MailDate) = 0 Then GoTo Retry

Kommentar von Andreas am 21.09.2005 um 20:52

Bei mir hats so nicht hingehaun mit der Ermittlung von Absender und Betreff. Erst mit Spaghetti-Code ;-)

RetrieveSubjectNSender:
* Uebertragungsfehler = 0
* Do
...
* Else
* Betreff = Mid(Result, t + 9)
* End If
* End If

If Len(Von) = 0 Or Len(Betreff) = 0 Then GoTo RetrieveSubjectNSender


Zeilen mit einem Stern sind aus dem Code übernommen, die anderen neu.

Hoffe damit bekommts nun auch der letzte hin :-)

Kommentar von MaG am 26.08.2005 um 12:34

Ich hab das jetzt so ergänzt, um Absender und Betreff zu erhalten

Der Teil ab Else ist es - die Do-Loop-Schleife

Do
Winsock1.SendData "top " & CStr(x) & " 0" & vbCrLf
RetVal = Not Response
If Not RetVal Then
warten 5
Uebertragungsfehler = Uebertragungsfehler + 1
If Uebertragungsfehler > 4 Then
GoTo ERRSub
End If
Else
Do
t = InStr(1, UCase(Result), "FROM:")
DoEvents
Loop Until t > 0
End If
Loop Until RetVal

muss noch mit nem TimeOut ergänzt werden

Kommentar von Drago am 29.07.2005 um 21:10

Den Absender erhalte ich jetzt nach dem von Sebo beschriebenem Umbau, aber der Betreff fehlt immernoch.
was muss ich machen um auch noch den Betreff zu erhalten?

Kommentar von Sebo am 04.04.2005 um 10:15

jo, stimmt .. das programm ist zu schnell, und das ergebnis enthaelt nicht den header . deswegen muessen wa da ne kleine verzögerung einbauen....

fueg mal folgendes in zeile 400 (ca) ein .. (also genau VOR den beiden Zeilen mit dem *)

While Left(UCase(Result), 19) = "+OK MESSAGE FOLLOWS"
DoEvents
Wend
* Von = ""
* Betreff = ""

Kommentar von Cloppy am 31.03.2005 um 23:01

Hallo Sebo-Freak,

schaue mir den Source seit 2 Tagen an, um durchzublicken, wie man Timing- u. a. Probleme lösen soll.
Was macht denn bitte diese Programmzeile mit den Variablen Von und Betreff:
List1.AddItem Von & vbTab & Betreff & vbTab & Bytes

Bin für freundliche Hilfe dankbar.

Kommentar von Sebo am 31.03.2005 um 12:48

Moin Freaks !

wenn ich ne mail abgerufen habe, und das prog weiter laufen lasse, kommt irgendwann der timeout, und der winsock.state steht auf 8 (Closing) ..
wenn ich jetzt das prog beenden will, wird nur abgeprueft ob winsock.state auf 0 (Closed) steht ...
aber da 8 <> 0 gehts weiter, und er versucht nun
Zeile 161: Winsock1.SendData "quit" & vbCrLf
und da bekomm ich nen fehler, weil der state der falsche is ...
was nun ? auch die 8 abfangen ? oder wie ?

Kommentar von Sebo am 31.03.2005 um 12:44

Cloppy:
>>Bei mir funktioniert auch die Anzeige von >>Absender "FROM:" und Titel "SUBJECT:" nicht. Dateigrösse >>wird auch falsch angezeigt. Wer hat die Lösung? Timing->>Probleme?

wer sacht denn, dass das ueberhaupt angezeigt werden sollte ?
wenn du dir den source wirklich angeschaut haettest, siehste das selber ...
sprich: es ist nicht implementiert, dass from & subject angezeigt wird..

aber das brauch ich auch, ich werd ma was basteln ...

Kommentar von Cloppy am 30.03.2005 um 23:07

Bei mir funktioniert auch die Anzeige von Absender "FROM:" und Titel "SUBJECT:" nicht. Dateigrösse wird auch falsch angezeigt. Wer hat die Lösung? Timing-Probleme?

Kommentar von Cloppy am 23.03.2005 um 20:07

Ah ja, there's a newer version of comctl32.ocx registered. Do you want to upgrade to Version 2.0 wird beim öffnen des Quellcodes von VB6 gemeldet.

Kommentar von Cloppy am 23.03.2005 um 20:03

WINxp SP1:

Wrong protocol or connection state for the request...

Label1.Caption = "Postfach prüfen"
Winsock1.SendData "stat" & vbCrLf

Bei Freenet funktioniert mit dem POP3-Konto der STAT-Befehl womöglich nicht.
Haben die umgestellt oder liegt der Fehler im Programm
Bitte um Hilfe

Kommentar von Sandra am 06.05.2004 um 09:39

Hallo,
habe zum Test in das Original-Programm meine eMail-Daten geschrieben. Auf dem Rechner auf dem die EXE-Datei kompiliert wurde, funktioniert das Prog. einwandfrei. Bei anderen Rechnern mit gleicher comctl32.ocx und mswinsck.ocx bekomme ich

Fehlermeldung: Run-time error 52: Bad file name or number

Weiß jemand was ich falsch mache ? Bitte schreibt mir !

Kommentar von Christian H. am 04.04.2004 um 15:15

Hi!
Das Programm funktioniert soweit...habe nur in folgender Zeile das Problem "Typen unverträglich":
If InStr(UCase(CStr(Data)), "CONTENT-TRANSFER-ENCODING: BASE64", vbTextCompare) > 0 Then

Woran liegt das? Kann das jemand fixen???

cYa

Wodka2k

Kommentar von kayhan am 06.03.2004 um 17:47

hallo,

par tips für weitere programmierer die dieses tool benutzen ! über t-online habe ich keine probleme gehabt !
laut dencken weil ich auch über T-online im netz bin oder weil t-online schnellere e-Mail server hat.
Als ich aber über 1und1 via pop3 abfragen wollte !
sagen wir 5 mails kam bei der ersten mail nur eine byte zahl ohne Absender,Betreff bei der 2 mail auch das gleiche wie bei der 1 Mail und bei allen anderen kamen 0 byte.
Habe dann das programm im Debuggen-Modus gestartet und das ganze Programm mit F8 durchlaufen lassen. siehe da alle Mails waren eingelesen mit allen Infos. Habe im Programm an einigen Punkten Schleifen eingebaut der das alles langsamer macht und es funktioniert. Mfg Entwickler

Kommentar von FanatiX am 22.02.2004 um 19:37

ich weisses auch ned, hab schon benachrichtigung laufen, falls jmd ne lösung für das header und anzeigeproblem hat ;)

ich habs aufgegeben aber versuch mal alles was ankommt an daten temporär abzuspeichern...

nochwas:
bei meinem gmx account zb gehts ned, bei arcor ja....

Kommentar von Patrick Hegemann am 22.02.2004 um 17:10

Hallo,

Ich blicke nicht ganz durch wie man das behandeln muss.
Und was macht das überhaupt???

mfg
Patrick Hegemann

Kommentar von Andy am 22.08.2003 um 17:08

zum 1. problem:

habe ich nun doch lösen können. Man muß das Result z.B. in einem String sammeln wenn die datenmenge so groß ist (es gibt mehrere Result).

Kommentar von Andy am 21.08.2003 um 20:26

1. Problem:
Ich hab Probleme bei großen Mailheadern weil das "FROM:" bzw. "Subject" im Result nicht mehr gefunden wird. Bei diesen Headern ist die Länge des results immer 4096 und er ist auch nicht vollständig. Ist dies vielleicht eine Beschränkung der Winsock? Wenn ich per Telnet mit dem Mailserver kommuniziere sehe ich den ganzen Header. Hat jemand eine Idee wie man das lösen kann?

2. Problem:
Anhangnamen mit Umlauten können nicht gespeichert werden da meist folgendes im namen steht "?ISO-8859-1?.. und der Umlaut so ähnlich wie "=E8". Kennt jemand eine Umwandlung für das? (ich hab schon gesucht und leider nichts passendes gefunden und bevor ich es komplett selber schreiben muß erstmal fragen)

Ansonsten läuft es bei mir. Habe außerdem noch Sendezeit und Message-ID herausgefiltert, sowie eine Datenbank zum abgleich schon geladener und neuer Mails drangebastelt.

Kommentar von patrick am 16.08.2003 um 17:16

vielleicht bin ich zu blöd, aber wie bekomme ich jetzt den Inhalt (body) der E-Mail zu Gesicht?
In dem Text1 wird immer nur sowas wie

+OK 570 octets follow.

angezeigt, aber kein Inhalt? Auch das runterladbare Bsp-Programm macht dasselbe.

Danke

Kommentar von am 11.07.2003 um 21:52

$$
$$
$$
$$
wegen so2 falls ihr pc in dos unter qbasic jede zeile mit diesen beiden symbolen startet ist alles okay
dies ist der traeer fuer email
mittels editor eine e-mail maske erstellen wegen leuten sehe irq ist oder sind die ersten beiden lines verdeckt
als rand aber normaler weise wuerde es zur lerndemo umgang mit dem pc gehören dass der user am homepc diese seite unter qc selbst programmiert weiters ist der sendebuchstabe p und für empfang w

Kommentar von realares am 13.05.2003 um 12:47

Kann ich dir sagen, weil die länge ebend nicht stimmt, nicht aufs Byte Genau. Die Bedingung zum Erkennen vom Ende des Atchment ist nicht OK

Kommentar von Gamewalker am 27.04.2003 um 03:18

Meine Files haben Alle CRC Errors, eine ner Idee/Lösung ? Haben die richtige grösse aber crc

Kommentar von Hans H. Klein am 17.03.2003 um 10:31

Für Jonathan:
Der Mailheader hat keine feste Endemarkierung in einer Email.
Am einfachsten suchst Du die 1. Zeile, die mit "Content-Type: text*" beginnt.
In den nächsten Zeilen können noch Angaben zum Transfer-Encoding oder verwendeten Zeichensatz stehen, aber
nach der nächsten leeren Zeile beginnt die eigentliche Mail.

Kommentar von Jonathan am 15.03.2003 um 21:18

Wie werde ich den Mail-Header los???

Kommentar von FanatiX am 17.02.2003 um 12:00

bei mir bekommt das programm auch noch nach 1 minute timeout zeit(laut konstante) nicht mehr als 2 balken auf der progressbar geladen...rekord waren 4 balken!!!
schätze ma es wäre besser wenn die empfangenen dtaen in eine datei gespeichert werden da der buffer für große mails nicht ausreicht...nur WIE macht man das?

Kommentar von McChef am 14.02.2003 um 09:03

Zur Progressbar:
Die Anweisung:
ProgressBar1.Max = Bytes
in
ProgressBar1.Max = Bytes + 5
ändern und es läuft. Eigentlich genügt hier auch + 2, da am Ende der Mail zweimal Chr$(0) gesendet wird, was bei der Längenangabe im Header auf dem Mailserver aber nicht berücksichtigt wird.

Kommentar von Bene am 12.01.2003 um 16:15

LÖSUNG für "Fehler bei der Übertragung"!

Setzt einfach mal den
Const TimeOut = 10
auf 30 oder mehr sekunden!!! nicht jeder server ist ein super-sprinter!

Kommentar von Jordl am 25.11.2002 um 22:32

Jo, ich bekomm auch immer "Fehler bei Übertragung". Aber nur wenn die größe der Mail über 75 kb beträgt (z.B. wenn Attachments mitgesendet werden). Hab den Fehler aber noch nicht gefunden. Hat jemand ne Idee oder nen Lösungsvorschlag?

Kommentar von Frager am 11.08.2002 um 18:47

Wo bekomme ich den diese OCXs... her?

Kommentar von Andreas am 09.06.2002 um 16:29

zu 2: es gibt so eine Funktion - fast jedenfalls. Sie heisst "TOP x y". Sie gibt y Zeilen der Mail x an.
Dies funktioniert zumindest mit sendmail auf Linux (SuSE 7.0)

Kommentar von One-Way am 18.03.2002 um 20:42

ja gibt es kannst du ProgressBar rausnehemen dann geht es bei mir anders weiss ich auch nicht

Kommentar von dabeck am 16.02.2002 um 19:35

Ich habe genau das selbe Problem wie 4.) und 15.) also bei:
Laufzeitfehler 380 , Ungültiger Eigenschaftwert
bei der Zeile 103 und folgenden Code
ProgressBar1.Value = Abs(RecBytes + Len(Mail(X)) - Corr - 1)
------
Gibt es eine Lösung für das Problem???
Cu
dabeck

Kommentar von Hauke am 16.02.2002 um 14:55

Es Tritt bei mir dieser Fehler auf
Fehler bei der Übertragungs Rate und woher weis das Programm den Meine E-Mail Adresse? Kann bzw. nichts eingeben.

Kommentar von Frank am 10.02.2002 um 19:28

Bei mir tritt folgender Fehler auf
Laufzeitfehler '5'
Ungültiger Prozeduraufruf oder ungültiges Argument
Mail(X) = Left$(Mail(X), Len(Mail(X)) - 2)
was kann das sein????
Danke für jeden Tip

Kommentar von Hamir am 19.01.2002 um 15:43

Wie kann ich E-Mails Attachments empfangen??

Kommentar von Yves Rösener am 28.12.2001 um 14:41

Tolle Sache ist das schon mit dem abrufen, nur habe ich da folgende Frage zu.
Dieses Tool moechte ich auch in einem Netzwerk einsetzen, wo der Internetzugang über einen Proxy besteht, kann mit jemand erklären wo ich beim Winsock einstell, welche Adresse und welchen Port der Proxy besitzt, sofern dies überhaupt möglich ist???
Vielen Dank im voraus.

Kommentar von Dani am 19.12.2001 um 10:47

Hallo ,
Betrift : Tip 071: Emails empfangen via Winsock
bei mir tretet folgender Fehler auf
Laufzeitfehler 380 , Ungültiger Eigenschaftwert
bei der Zeile 103 und folgenden Code
ProgressBar1.Value = Abs(RecBytes + Len(Mail(X)) - Corr - 1)
Mit freundlichen Gruß

Kommentar von Daniel am 11.11.2001 um 00:37

Bei mir tritt immer bei der Verwendung der Winsock der Fehler auf, daß diese nicht die erforderliche Lizenz ausweist. Hat jemand dazu eine Idee?

Kommentar von Denny am 10.10.2001 um 03:45

Bei mir tritt folgender Fehler auf
Betrift : Tip 071: Emails empfangen via Winsock
bei mir tretet folgender Fehler auf
Laufzeitfehler 380 , Ungültiger Eigenschaftwert
bei der Zeile 103 und folgenden Code
ProgressBar1.Value = Abs(RecBytes + Len(Mail(X)) - Corr - 1)
Was kann man da machen?
besten Dank,
Denny

Kommentar von Turbo24prg am 12.07.2001 um 15:02

Ich möchte genau wie
Michael nur E-Mails mit bestimmtem Betreff abholen.
Wie geht das?
Dringend ! Danke

Kommentar von Michael Lorenz am 13.06.2001 um 16:08

Wie ist es denn möglich angehängte Dateien aus den Mails zu extrahieren?
Ich habe das Progamm so umgeschrieben das der E-mailtext anstelle der Textbox in einer Datei (c:\test.txt) ausgegeben wird.. aber so bekomme ich auch kein Atachment!
Weis jemand wie?

Kommentar von Heinz-Mario Fruehbeis am 04.06.2001 um 23:55

Leider kann ich nicht "Return-path:" und "From:" auslesen.
Ist das bei jedem so?
Wenn nicht, wo könnte mein Fehler liegen.
Den gesamten Downlaod als *.nws gespeichert
liefert beim öffnen OL-Express sehr wohl die obigen Punkte.
Gruß Mario

Kommentar von Heinz-Mario Fruehbeis am 04.06.2001 um 23:54

Leider kann ich nicht "Return-path:" und "From:" auslesen.
Ist das bei jedem so?
Wenn nicht, wo könnte mein Fehler liegen.
Den gesamten Downlaod als *.nws gespeichert
liefert beim öffnen OL-Express sehr wohl die obigen Punkte.
Gruß Mario

Kommentar von Mario am 04.05.2001 um 19:14

Ich habe das gleiche Problem wie Andreas Klein. Leider hab ich keine Antwort dazu gefunden.

Kommentar von Karl Groß am 18.04.2001 um 06:36

Hallo.
Bei mir läuft das Programm auch wunderbar.
Mich würde interessieren, ob es eine Möglichkeit gibt über das Winsock Steuerelement Emails mit der MIME Kodierung zu empfangen, da bei mir sonst immer das Attachment kaputt geht.
Gruß, Karl

Kommentar von Michael am 03.04.2001 um 00:05

Hallo,
Das Programm läuft bei mir wunderbar.
Jetzt habe ich aber noch das Problem das ich nur E-Mail´s mit einem ganz bestimmten Betreff herunterladen möchte. gibt´s da eine Möglichkeit, und wenn ja wie ??
Gruß
Michael

Kommentar von Anton am 19.03.2001 um 22:43

Gibt es irgendwo eine Anleitung wie mann das Abrufen der Mails besser über Winsock kontrolieren kann bei mir bricht er nach mehreren abrufen immer mit Fehlermeldung ab der Abruf der Mails bleibt dan einfach stehen

Kommentar von Markusle am 28.02.2001 um 09:34

Wie kan ich E-mails mit Anhang abfragen und in Datei schreiben???

Kommentar von n.ebert am 30.01.2001 um 14:51

Bei mir tritt der gleiche Fehler auf wie bei Andreas Klein.
MfG Norbert

Kommentar von Andreas Klein am 11.01.2001 um 15:22

Hallo ,
Betrift : Tip 071: Emails empfangen via Winsock
bei mir tretet folgender Fehler auf
Laufzeitfehler 380 , Ungültiger Eigenschaftwert
bei der Zeile 103 und folgenden Code
ProgressBar1.Value = Abs(RecBytes + Len(Mail(X)) - Corr - 1)
Mit freundlichen Gruß
Andreas Klein

Kommentar von Hartmut am 20.12.2000 um 15:53

Hallo Mathias!
Du musst zuerst die DFÜ-Verbindung zu T-Online erstellen und nachdem die Verbindung hergestellt ist das VB-Programm starten.
In den Programm-Konstanten sollten folgende Werte stehen:
Const Host$ = "pop.t-online.de"
Const Account$ = "schnarrenberger"
Const Password$ = "." ' Punkt genügt, da das echte Passw. bei der Einwahl zu T-Online angegeben wurde.
MfG.
Hartmut Bartsch

Kommentar von Andreas am 27.11.2000 um 11:57

Ich habe das Beispiel so umgeschrieben, dass ich erst die Liste der mails lese und dann auf Click die mail hole. Was für Komandos sind zum mail-server gültig?
(ich kenne: user, pass, stat, list, retr)
gibt es auch eines, um nur dir Kopfinfos zu lesen?

Kommentar von Mathias am 31.10.2000 um 15:34

Ich habe T-Online und wenn ich versuche mit dem TIP 71 E-mails abzuholen kommt immer bei Suche Host "Fehler bei der Übertragung". Mache ich etwas falsch? Bitte schreibt mir.
Gruß Mathias