Seite 1 von 2

POP3_MailCheck

Verfasst: 25.07.2010 07:48
von rolaf
Hi Leute.

hier ein Code von mir (den ich in einem neuen Tool brauchte) der die vorhandenen Mails auf dem Server checkt und deren Größe, Absender sowie Betreff ausgibt, ohne die komplettem Mails herunterladen zu müßen.

Vielleicht kann es jemand brauchen. :)

Neue 7. Version:

Code: Alles auswählen

;POP3_MailCheck (PB 4.41)
;von DrFalo, X360 Andy, STARGÅTE, ...

EnableExplicit

Structure Header
  Size.s
  From.s 
  Subject.s
  Date.s 
EndStructure
  
Global Dim Mail.Header(1)

Define Message.i

InitNetwork()

Procedure.s POP3_ReceiveNetworkData(ConnectID.i, Separator.s)

  Protected BufferLength.i = 1024
  Protected Buffer.s = Space(BufferLength)
  Protected Length.i, Result.s
  Protected Timeout.i = ElapsedMilliseconds() + 15000 ;15 Sekunden

  Repeat
    Select NetworkClientEvent(ConnectID)
      Case #PB_NetworkEvent_Data
        Repeat
          Length = ReceiveNetworkData(ConnectID, @Buffer, BufferLength)
          If Length = - 1
            ProcedureReturn ""
          EndIf
          Result + Left(Buffer, Length)
        Until Right(Result, Len(Separator)) = Separator
        Break
      Default
        Delay(1)
        If ElapsedMilliseconds() > Timeout
          ProcedureReturn ""
        EndIf
    EndSelect
  ForEver

  Debug Result

  ProcedureReturn ReplaceString(Result, #CRLF$, #LF$)

EndProcedure

Procedure POP3_MailCheck(Server.s, Port.i, User.s, Pass.s)

  Protected Message.i, MessagePart.i, Messages.i
  Protected ReceiveString.s, ReceiveStringPart.s
  Protected ConnectID.i = OpenNetworkConnection(Server, Port)

  If Not ConnectID
    ProcedureReturn
  EndIf

  If Left(POP3_ReceiveNetworkData(ConnectID, #CRLF$), 3) = "+OK"
    SendNetworkString(ConnectID, "USER " + User + #CRLF$)
    If Left(POP3_ReceiveNetworkData(ConnectID, #CRLF$), 3) = "+OK"
      SendNetworkString(ConnectID, "PASS " + Pass + #CRLF$)
      If Left(POP3_ReceiveNetworkData(ConnectID, #CRLF$), 3) = "+OK"
        SendNetworkString(ConnectID, "LIST" + #CRLF$)
        ReceiveString = POP3_ReceiveNetworkData(ConnectID, #CRLF$ + "." +  #CRLF$)
        If Left(ReceiveString, 3) = "+OK"
          Messages = CountString(ReceiveString, #LF$) - 2
          ReDim Mail(Messages)
          For Message = 1 To Messages
            Mail(Message)\Size = "Size: " + StringField(StringField(ReceiveString, Message + 1, #LF$), 2, " ") + " Byte"
          Next Message
          For Message = 1 To Messages
            SendNetworkString(ConnectID, "TOP " + Str(Message) + " 0" + #CRLF$)
            ReceiveString = POP3_ReceiveNetworkData(ConnectID, #CRLF$ + "." +  #CRLF$)
             If Left(ReceiveString, 3) = "+OK"
               For MessagePart = 1 To CountString(ReceiveString, #LF$) - 2
                 ReceiveStringPart = StringField(ReceiveString, MessagePart + 1, #LF$)
                 If FindString(LCase(ReceiveStringPart), "from:", 1)
                   Mail(Message)\From = Trim(ReceiveStringPart)
                 ElseIf FindString(LCase(ReceiveStringPart), "subject:", 1)
                   Mail(Message)\Subject = Trim(ReceiveStringPart)
                 ElseIf FindString(LCase(ReceiveStringPart), "date:", 1)
                   Mail(Message)\Date = StringField(Trim(ReceiveStringPart), 1, "+")
                 EndIf
               Next MessagePart
             EndIf
          Next Message
        EndIf
      EndIf
    EndIf
    CloseNetworkConnection(ConnectID)
  EndIf

EndProcedure

POP3_MailCheck("server", 110, "user", "pass")

For Message = 1 To ArraySize(Mail())
  Debug ""
  Debug "Message: " + Str(Message)
  Debug Mail(Message)\Size
  Debug Mail(Message)\From
  Debug Mail(Message)\Subject
  Debug Mail(Message)\Date
Next Message
Funktioniert bei mir in zwei versch. Postfächern einwandfrei.

Re: MailCheck

Verfasst: 25.07.2010 08:58
von STARGÅTE
Funktioniert hier ebenfalls:
- GMX
- sysproserver

Aber bitte änder noch folgenden Sache:
- Prüfe erst ob es eine gültige ConnectID gibt, sonst kackt ReceiveNetworkData ab.

Desweiteren bin ich kein Freund davon, ReceiveNetworkData() auszurufen, ohne das NetworkClientEvent() #PB_NetworkEvent_Data zurück gegeben hat.

Zwar funktioniert das rein praktisch, da ja ReceiveNetworkData solange wartet bis Daten im Buffer sind. Wenn dann aber doch die Verbindung abbricht, dann bleibt das Programm genau dort stehen -> friert ein.

Vllt konnte man/du/ich das ganze noch PB-Typisch machen:

Code: Alles auswählen

If ExamineMails(Server, Username, Password)
  While NextMail()
    Debug MailSize()
    Debug MailSender()
    Debug MailSubject()
  Wend
EndIf

Re: MailCheck

Verfasst: 26.07.2010 07:56
von rolaf
Hallo!

> Funktioniert hier ebenfalls:
> - GMX
> - sysproserver

Das ist gut (GMX), sysproserver hatte ich auch getestet, zudem speicheranbieter.de.

> Aber bitte änder noch folgenden Sache:
> - Prüfe erst ob es eine gültige ConnectID gibt, sonst kackt ReceiveNetworkData ab.

Gültige ConnectID, wie prüfe ich das?

> Desweiteren bin ich kein Freund davon, ReceiveNetworkData() auszurufen, ohne das NetworkClientEvent()
> #PB_NetworkEvent_Data zurück gegeben hat.

Da muß ich mal sehen wie ich das am besten einbaue, ich denke die Proc Mail_ReceiveData wäre der richtige Ort um es nur einmal einfügen zu müssen.

> Vllt konnte man/du/ich das ganze noch PB-Typisch machen:

Code: Alles auswählen

If ExamineMails(Server, Username, Password)
  While NextMail()
    Debug MailSize()
    Debug MailSender()
    Debug MailSubject()
  Wend
EndIf
Gerne, nur hab ich da noch keinen Plan. :wink:

Re: MailCheck

Verfasst: 26.07.2010 09:33
von Kiffi
DrFalo hat geschrieben:Gültige ConnectID, wie prüfe ich das?

Code: Alles auswählen

Protected ConnectID.i = OpenNetworkConnection(Server, 110)
If ConnectID
  [...]
Grüße ... Kiffi

Re: MailCheck

Verfasst: 26.07.2010 10:32
von STARGÅTE
>> Gerne, nur hab ich da noch keinen Plan. :wink:

Gut, ich selber habe n Plan ^^

Ich würde das ganze jedoch gleich noch erweitern.
Soll heißen, dass ganze so weit wie möglich mit der Mail-Lib von PB in einklang bringen.
Dass heißt, nachdem die Mails geladen sind kann man "normal" mit z.B. GetMailAttribute(#Mail, Attribut)
die Kopfdaten auslesen.
Auch den MailBody würde ich runterladen lassen, wenn es der benutzer wünscht.
Dafür gebe es dann die Funktion: ReceiveMailBody() und für den Anhang: ReceiveMailAttachment()
das eine Lädt den Body in die Mail, zum auslesen dann GetMailBody(),
das andere downloaded den Anhang irgendwo hin ^^

Re: MailCheck

Verfasst: 26.07.2010 11:15
von X360 Andy
Mit Google klappt das ganze zwar nicht, aber sonst mit jedem anderen Anbieter.

Hier noch die Möglichkeit das Datum der Email abzufragen

Code: Alles auswählen

;MailCheck (PB 4.41)
;von DrFalo, ...

EnableExplicit

Global Server.s = ""
Global User.s = ""
Global Pass.s = ""

Global Dim Email.s(3, 1)
Define A.i

InitNetwork()

Procedure.s Mail_ReceiveData(ConnectID.i)

  Protected Result.s = Space(9999)
  ReceiveNetworkData(ConnectID, @Result, 9999)
  ProcedureReturn ReplaceString(RTrim(Result), #CRLF$, #LF$)

EndProcedure

Procedure Mail_SendData(ConnectID.i, StringToSend.s)

  StringToSend + #CRLF$
  SendNetworkData(ConnectID, @StringToSend, Len(StringToSend))

EndProcedure

Procedure Mail_Check()

  Protected A.i, B.i, Messages.i
  Protected ReceiveString.s, ReceiveStringPart.s
  Protected ConnectID.i = OpenNetworkConnection(Server, 110)

  If Left(Mail_ReceiveData(ConnectID), 3) = "+OK"
    Mail_SendData(ConnectID, "USER " + User)
    If Left(Mail_ReceiveData(ConnectID), 3) = "+OK"
      Mail_SendData(ConnectID, "PASS " + Pass)
      If Left(Mail_ReceiveData(ConnectID), 3) = "+OK"
        Mail_SendData(ConnectID, "LIST")
        ReceiveString = Mail_ReceiveData(ConnectID)
        If Left(ReceiveString, 3) = "+OK"
          Messages = CountString(ReceiveString, #LF$) - 2
          ReDim Email(3, Messages)
          For A = 1 To Messages
            Email(0, A) = "Size: " + StringField(StringField(ReceiveString, A + 1, #LF$), 2, " ") + " Byte"
          Next A
          For A = 1 To Messages
            Mail_SendData(ConnectID, "TOP " + Str(A) + " 0")
            ReceiveString = Mail_ReceiveData(ConnectID)
             If Left(ReceiveString, 3) = "+OK"
               For B = 1 To CountString(ReceiveString, #LF$) - 2
                 ReceiveStringPart = StringField(ReceiveString, B + 1, #LF$)
                 If FindString(LCase(ReceiveStringPart), "from:", 1)
                   Email(1, A) = Trim(ReceiveStringPart)
                 ElseIf FindString(LCase(ReceiveStringPart), "subject:", 1)
                   Email(2, A) = Trim(ReceiveStringPart)
                 ElseIf FindString(LCase(ReceiveStringPart), "date:", 1)
                   Email(3, A) = StringField(Trim(ReceiveStringPart),0,"+")
                 EndIf
               Next B
             EndIf
          Next A
        EndIf
      EndIf
    EndIf
    CloseNetworkConnection(ConnectID)
  EndIf

EndProcedure

Mail_Check()

For A = 1 To ArraySize(Email(), 2)
  Debug Email(0, A) + " | " + Email(1, A) + " | " + Email(2, A) +" | " + Email(3, A)
Next A

Gruß Andreas

Re: MailCheck

Verfasst: 26.07.2010 14:57
von rolaf
Kiffi hat geschrieben:
DrFalo hat geschrieben:Gültige ConnectID, wie prüfe ich das?

Code: Alles auswählen

Protected ConnectID.i = OpenNetworkConnection(Server, 110)
If ConnectID
  [...]
Grüße ... Kiffi
Oh man, wie peinlich. Danke. :oops:
Manchmal muß eben erst die Sonne scheinen damit man im Wald die Bäume sieht. :mrgreen:
X360 Andy hat geschrieben:Mit Google klappt das ganze zwar nicht, aber sonst mit jedem anderen Anbieter.
Hier noch die Möglichkeit das Datum der Email abzufragen
Google schau ich mir mal an. Ja gute Idee, Datum ist ja auch noch interessant. Und wenns schon mal da ist, kann man es auch mitnehmen.
STARGÅTE hat geschrieben:Gut, ich selber habe n Plan ^^
Ich würde das ganze jedoch gleich noch erweitern.
Ah, gut - nen Plan haben ist schon mal nicht schlecht. :) Erweitern ist auch nicht zu verachten, man kann sich ja dann raussuchen was man im Einzellfall braucht.

Ich werde heute mal noch versuchen die bisherige Version zu verbessern, das es kein Einfrieren geben kann. Mal schauen...

Re: MailCheck

Verfasst: 26.07.2010 15:03
von STARGÅTE
Hier kannst daran arbeiten, kann garde nicht weiter schreiben ^^

Code: Alles auswählen

Procedure.i ExamineMails(Server$, Username$, Password$)
 ;Mail = CreateMail(Mail, "", "")
 Protected Quit, BufferLength = 1024, Buffer$ = Space(BufferLength), Result$, State
 Protected Messages, Message
 Protected ConnectID.i = OpenNetworkConnection(Server$, 110)
 If Not ConnectID : ProcedureReturn #False : EndIf
 Repeat
  Select NetworkClientEvent(ConnectID)  
   Case #PB_NetworkEvent_Data
    Result$ = ""
    Repeat
     Length = ReceiveNetworkData(ConnectID, @Buffer$, BufferLength)
     Result$ + Left(Buffer$, Length)
    Until Length <> BufferLength
    Debug Result$
    If Left(Result$, 3) = "+OK"
     Select State
      Case 0 ; USER
       SendNetworkString(ConnectID, "USER "+Username$+#CRLF$) : State = 1
      Case 1
       SendNetworkString(ConnectID, "PASS "+Password$+#CRLF$) : State = 2
      Case 2
       SendNetworkString(ConnectID, "LIST"+#CRLF$) : State = 3
      Case 3
       Result$ = ReplaceString(Result$, #CRLF$, #LF$)
       Messages = CountString(Result$, #LF$)-2
       For Message = 1 To Messages
        Size$ = StringField(StringField(Result$, Message+1, #LF$), 2, " ") + " Byte"
        Debug "Size: " + Size$
       Next
     EndSelect
    Else
     Break
    EndIf
   Default
    Delay(1)
  EndSelect
 ForEver
EndProcedure
Da siehst du gleich, wie ich das zB mit den empfangen lösen würde

Re: MailCheck

Verfasst: 26.07.2010 15:52
von rolaf
Sieht elegant aus. :allright: Ich mach mich mal dran...

Edit: Au, da haste gerade an ner verzwickten Stelle aufgehört :wink: wo man die bisherige Eleganz vermutlich verlassen muss. Mein Kopf raucht, ich glaub da brauch ich länger für. Außerdem ist mir noch nicht klar wie man die ermittelten Daten nach auserhalb der Prozedur bringt?

Re: MailCheck

Verfasst: 26.07.2010 15:57
von ts-soft
Optionalen Parameter für den Port nicht vergessen, 110 ist zwar schön und trifft es recht oft, aber nicht immer.

Gruß
Thomas