It is currently Thu Dec 12, 2019 8:12 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 39 posts ]  Go to page Previous  1, 2, 3
Author Message
 Post subject: Re: POP3 Include (crossplatform)
PostPosted: Fri Mar 07, 2014 7:15 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Mon Jun 09, 2003 8:30 am
Posts: 196
noon gates :mrgreen:

well done my friend

_________________
사십 둘 .


Top
 Profile  
Reply with quote  
 Post subject: Re: POP3 Include (crossplatform)
PostPosted: Wed Oct 10, 2018 12:42 pm 
Online
Enthusiast
Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 559
Location: Almaty (Kazakhstan)
my free web hosting is going to shutdown soon. it works probably 10 years. i am love my website, but he is dead. and them i am see at my mail box. it exists 16 years. so idea is make mail box and client read mail from that box - it will be like server. offcouse password will be unsafe and clients can hack it. but it is ok. main idea - that "hosting" will work long time, i am sure :)

i am read manuals, how to setup outlook for that my mail server. it says: you need to check SSL checkbox for getting mail. this example no have that SSL. can it have some solution? i am no need send mail, only read one letter.


Top
 Profile  
Reply with quote  
 Post subject: Re: POP3 Include (crossplatform)
PostPosted: Sat Feb 09, 2019 1:46 pm 
Offline
User
User
User avatar

Joined: Tue Oct 06, 2009 9:11 pm
Posts: 87
does anybody have an updated version of this include for newer PB-Versions?

_________________
Repeat
PureBasic
ForEver


Top
 Profile  
Reply with quote  
 Post subject: Re: POP3 Include (crossplatform)
PostPosted: Sat Feb 09, 2019 7:10 pm 
Offline
Enthusiast
Enthusiast

Joined: Tue Jul 26, 2005 12:02 pm
Posts: 211
Location: Lieusaint (77), France
+1

_________________
Purebasic 5.71 64 bits - Windows 10 Pro 64 bits 1903


Top
 Profile  
Reply with quote  
 Post subject: Re: POP3 Include (crossplatform)
PostPosted: Sat Feb 09, 2019 8:11 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Wed Feb 01, 2012 3:30 pm
Posts: 753
Location: Nottinghamshire UK
Hi Updated to 5.70 but not tested

Code:
;+-------------------------+
;|
;| pop3.pbi
;|
;| V01.007 ©HeX0R
;| 06.03.2014
;|
;| Include to read mails
;| from a pop3 server
;| No SSL/TLS Supported!
;|
;| [x] windows
;| [x] linux
;| [x] mac
;| [x] x86
;| [x] x64
;| [x] unicode
;| [ ] SSL/TLS
;| [ ] make lunch
;|
;+-------------------------+
UseMD5Fingerprint()
;PB removed #PB_Sort_Integer, so I'll put it back in for backwards compatibility
CompilerIf Defined(PB_Sort_Integer, #PB_Constant) = 0
   #PB_Sort_Integer = #PB_Integer
CompilerEndIf

Interface _POP3_
   GetLastError.i()
   GetLastResponse.s()
   Connect.i(Pop3Server.s, Pop3Port.i, Username.s, Password.s, TimeOUT.i = 10000)
   Disconnect.i()
   CountMails.i()
   GetHeader.s(Index.i)
   GetHeaderField.s(Header.s, Field.s)
   LoadMail.i(Index.i)
   CountAttachments.i()
   GetAttachmentName.s(Index.i)
   SaveAttachment.i(Index.i, Path.s, FileName.s = "")
   CountMailParts.i()
   GetMailPartHeader.s(Index.i)
   GetMailPartBody.s(Index.i)
   SaveMailPartBody.i(Index.i, Path.s, FileName.s = "")
   CheckHTMLFormat.s(Header.s, Body.s)
   DeleteMail.i(Index.i)
   ResetDelete.i()
   AbortReceiving()
EndInterface

Structure _POP3_MAIL_PARTS_
   Index.i
   Boundary.s
   Header.s
   Body.s
EndStructure

Structure _POP3_MAIN_STRUCTURE_
   VTable.i
   ConnectionID.i
   LastError.i
   MailLoaded.i
   TimeOUT.i
   StopReceiving.i
   *Buffer
   MessageCount.i
   LastResponse.s
   Capability.s
   Internal.i
   List MailParts._POP3_MAIL_PARTS_()
EndStructure

Enumeration
   #POP3_ERROR_NONE
   #POP3_ERROR_NO_CONNECTION
   #POP3_ERROR_NO_RESPONSE
   #POP3_ERROR_SERVER_DIED
   #POP3_ERROR_WRONG_USERNAME
   #POP3_ERROR_WRONG_PASSWORD
   #POP3_ERROR_NOT_ENOUGH_MEMORY
   #POP3_ERROR_COMMAND_NOT_ACCEPTED
   #POP3_ERROR_INDEX_OUT_OF_BOUNDS
   #POP3_ERROR_NO_HEADER
   #POP3_ERROR_NO_MAIL_LOADED
   #POP3_ERROR_ALLREADY_DISCONNECTED
   #POP3_ERROR_UNABLE_TO_DELETE_MAIL
   #POP3_ERROR_SENDING
   #POP3_ERROR_TIMED_OUT
   #POP3_ERROR_USER_ABORTED
   #POP3_ERROR_NO_FILENAME_FOUND
EndEnumeration

Declare.i __POP3_Disconnect(*THIS._POP3_MAIN_STRUCTURE_)

Procedure.i __POP3_GetLastError(*THIS._POP3_MAIN_STRUCTURE_)
   ProcedureReturn *THIS\LastError
EndProcedure

Procedure.s __POP3_GetLastResponse(*THIS._POP3_MAIN_STRUCTURE_)
   
   ;Get the last Response from the server

   ProcedureReturn *THIS\LastResponse
EndProcedure

Procedure.i __POP3_Internal_CheckResponse(*THIS._POP3_MAIN_STRUCTURE_, Response.s)
   Protected Result
   
   ;Just fot checking, what the server really responded.
   
   If Left(LCase(Response), 3) = "+ok"
      *THIS\LastResponse = Mid(Response, 4)
      Result             = #True
   ElseIf Left(LCase(Response), 4) = "-err"
      *THIS\LastResponse = Mid(Response, 5)
   Else
      *THIS\LastResponse = Response
   EndIf
   
   ProcedureReturn Result
EndProcedure

Procedure.s __POP3_Internal_DecodeText_QuotedPrintable(Text.s, CS.i)
   Protected Result.s, *Buff1, Value, a$, i, Pos
   
   ;Restore the quoted-printable text
   *Buff1 = AllocateMemory(Len(Text) * 2)
   If *Buff1
      For i = 1 To Len(Text)
         If Mid(Text, i, 1) <> "="
            PokeB(*Buff1 + Pos, Asc(Mid(Text, i, 1)))
            Pos + 1
         ElseIf Mid(Text, i + 1, 2) = #CRLF$
            ;ignore the #crlf$
            i + 2
         Else
            a$    = Mid(LCase(Text), i + 1, 2)
            Value = Val("$" + a$)
            PokeB(*Buff1 + Pos, Value)
            Pos + 1
            i + 2
         EndIf
      Next i
      Result = PeekS(*Buff1, -1, CS)
      FreeMemory(*Buff1)
   EndIf

   ProcedureReturn Result
EndProcedure
         
Procedure.s __POP3_Internal_DecodeText(Text.s)
   Protected Result.s, Codec.s, Charset.s, CS, f1, f2, f3, f4, fold, Pattern.s
   Protected i, j, Buff1.s, Buff2.s, *Buff2
   
   ;Decodes the very strange encodings in the header.
   ;Looks complicated, which it isn't really.
   ;Maybe it's just my coding style which makes it look so ugly...
   
   Result = ""
   f1     = 1
   fold   = 0
   Repeat
      f1 = FindString(Text, "=?", f1)
      f2 = FindString(Text, "?", f1 + 2)
      f3 = FindString(Text, "?", f2 + 1)
      f4 = FindString(Text, "?=", f3 + 1)
      If f1 And f2 > f1 And f3 > f2 And f4 > f3
         Charset = Mid(Text, f1 + 2, f2 - f1 - 2)
         Codec   = Mid(Text, f2 + 1, f3 - f2 - 1)
         Pattern = Mid(Text, f3 + 1, f4 - f3 - 1)
         If LCase(Charset) = "utf-8"
            CS = #PB_UTF8
         Else
            CS = #PB_Ascii
         EndIf
         If fold
            Result + Mid(Text, fold, f1 - fold); - 1)
         Else
            Result + Left(Text, f1 - 1)
         EndIf
         Select LCase(Codec)
            Case "b"
               ;base64
               CompilerIf #PB_Compiler_Unicode
                  j     = StringByteLength(Pattern, #PB_Ascii)
                  Buff1 = Space(j)
                  PokeS(@Buff1, Pattern, -1, #PB_Ascii)
                  Buff2 = Space(j * 2)
                  i     = Base64DecoderBuffer(@Buff1, j, @Buff2, j * 2)
               CompilerElse
                  j     = Len(Pattern)
                  Buff2 = Space(j * 2)
                  i     = Base64DecoderBuffer(@Pattern, j, @Buff2, j * 2)
               CompilerEndIf
               Result + PeekS(@Buff2, i, CS)
            Case "q"
               ;Quoted Printable
               Result + __POP3_Internal_DecodeText_QuotedPrintable(Pattern, CS)
         EndSelect
         fold = f4 + 2
         f1   = fold
      EndIf
   Until f1 = 0
   
   Result + Mid(Text, fold)
   
   ProcedureReturn Result
EndProcedure

Procedure.i __POP3_Internal_SendString(*THIS._POP3_MAIN_STRUCTURE_, Send.s)
   Protected *Buffer, Result
   
   ;SendNetworkString also for unicode.
   
   While NetworkClientEvent(*THIS\ConnectionID) = #PB_NetworkEvent_Data
      ;oh, oh, still old data available?
      ReceiveNetworkData(*THIS\ConnectionID, *THIS\Buffer, MemorySize(*THIS\Buffer))
      Delay(10)
   Wend
   
   CompilerIf #PB_Compiler_Unicode
      *Buffer = AllocateMemory(StringByteLength(Send, #PB_Ascii) + 1)
      If *Buffer
         PokeS(*Buffer, Send, -1, #PB_Ascii)
         Result = SendNetworkData(*THIS\ConnectionID, *Buffer, MemorySize(*Buffer) - 1)
         FreeMemory(*Buffer)
      EndIf
   CompilerElse
      Result = SendNetworkString(*THIS\ConnectionID, Send)
   CompilerEndIf
   
   ProcedureReturn Result
EndProcedure

Procedure.s __POP3_Internal_WaitForResponse(*THIS._POP3_MAIN_STRUCTURE_, CheckEnd = #False)
   Protected Result.s, MainTimeOUT, InternalWait, Size
   
   ;Internal Procedure.
   ;Will try to read anything coming from the pop3-server.
   ;If CheckEnd is #True it will load till the string ends in #CRLF$ + "." + #CRLF$
   ;which is the case in header and body callings.
   ;If CheckEnd is 2, it will do the same, but quicker (mail bodys can also contain #CRLF$ . #CRLF$, so CheckEnd = 2 should only be used in Header Requests).
   ;If CheckEnd is 3, it will look for #CRLF$ + "." + #CRLF$ AND also for just a #CRLF$ (if -err will be returned)
   
   MainTimeOUT         = ElapsedMilliseconds() + *THIS\TimeOUT
   InternalWait        = ElapsedMilliseconds() + 200
   Result              = ""
   *THIS\StopReceiving = #False
   
   Repeat
     
      If MainTimeOUT < ElapsedMilliseconds()
         *THIS\LastResponse = Result
         Result             = ""
         *THIS\LastError    = #POP3_ERROR_TIMED_OUT
         Break
      EndIf
      If *THIS\StopReceiving
         Result              = ""
         *THIS\LastResponse  = ""
         *THIS\LastError     = #POP3_ERROR_USER_ABORTED
         *THIS\StopReceiving = #False
         Break
      EndIf
     
      Select NetworkClientEvent(*THIS\ConnectionID)
         Case #PB_NetworkEvent_Data
            Size = ReceiveNetworkData(*THIS\ConnectionID, *THIS\Buffer, MemorySize(*THIS\Buffer))
            If Size > 0
               Result + PeekS(*THIS\Buffer, Size, #PB_Ascii)
               MainTimeOUT  = ElapsedMilliseconds() + *THIS\TimeOUT
               InternalWait = ElapsedMilliseconds() + 200
               If CheckEnd = 2 And Right(Result, 5) = #CRLF$ + "." + #CRLF$
                  Break
               EndIf
            ElseIf Size = -1
               __POP3_Disconnect(*THIS)
               *THIS\LastError = #POP3_ERROR_SERVER_DIED
               Result = ""
               Break
            EndIf
         Case #PB_NetworkEvent_Disconnect
            Break
         Case 0
            If InternalWait < ElapsedMilliseconds()
               If CheckEnd
                  If Right(Result, 5) = #CRLF$ + "." + #CRLF$
                     Break
                  ElseIf CheckEnd = 3 And Right(Result, 2) = #CRLF$
                     Break
                  EndIf
               ElseIf Right(Result, 2) = #CRLF$
                  Break
               EndIf
               InternalWait = ElapsedMilliseconds() + 200
            EndIf
      EndSelect
      Delay(15)
   ForEver

   ProcedureReturn Result
EndProcedure

Procedure.i __POP3_Disconnect(*THIS._POP3_MAIN_STRUCTURE_)
   Protected a$, Result
   
   ;Well, what could this be for?...
   
   If *THIS\ConnectionID
      If __POP3_Internal_SendString(*THIS, "QUIT" + #CRLF$) > 0
         a$ = __POP3_Internal_WaitForResponse(*THIS)
         If LCase(Left(a$, 3)) = "+ok"
            Result = #True
         EndIf
      EndIf
      CloseNetworkConnection(*THIS\ConnectionID)
      *THIS\ConnectionID = #False
      *THIS\Capability   = ""
      *THIS\MailLoaded   = #False
      *THIS\LastError    = #POP3_ERROR_NONE
      ClearList(*THIS\MailParts())
      FreeMemory(*THIS\Buffer)
      *THIS\Buffer = #Null
   Else
      *THIS\LastError = #POP3_ERROR_ALLREADY_DISCONNECTED
   EndIf
   
   ProcedureReturn Result
EndProcedure

Procedure.i __POP3_Internal_DecodeBinaryBase64(Body.s)
   Protected Buff1.s
   Protected *Buffer, i, j, L
   
   ;Decode a Base64 string into binary data (also works in unicode)

   Body = Trim(RemoveString(Body, #CRLF$))
   j    = StringByteLength(Body, #PB_Ascii)
   L    = j << 1
   CompilerIf #PB_Compiler_Unicode
   Buff1 = Space(j)
   PokeS(@Buff1, Body, -1, #PB_Ascii)
   *Buffer = AllocateMemory(L)
   i       = Base64DecoderBuffer(@Buff1, j, *Buffer, L)
   *Buffer = ReAllocateMemory(*Buffer, i)
   CompilerElse
   *Buffer = AllocateMemory(L)
   i       = Base64Decoder(@Body, j, *Buffer, L)
   *Buffer = ReAllocateMemory(*Buffer, i)
   CompilerEndIf
   
   ProcedureReturn *Buffer
EndProcedure


Procedure.s __POP3_Internal_MD5StringFingerprint(String.s)
   Protected Result.s, *Buffer
   
   ;create MD5Fingerprint of a string... works also in unicode
   
   CompilerIf #PB_Compiler_Unicode
      *Buffer = AllocateMemory(StringByteLength(String, #PB_Ascii) + 1)
      If *Buffer
         PokeS(*Buffer, String, -1, #PB_Ascii)
         Result = Fingerprint(*Buffer, Len(String), #PB_Cipher_MD5)
         FreeMemory(*Buffer)
      EndIf
   CompilerElse
      Result = MD5Fingerprint(@String, Len(String))
   CompilerEndIf
   
   ProcedureReturn Result
EndProcedure
     
Procedure.s __POP3_GetHeaderField(*THIS._POP3_MAIN_STRUCTURE_, Header.s, Field.s)
   Protected Result.s, i, j
   
   ;Get special fields of Header.
   ;e.g. "subject" or "Content-Type"
   
   If *THIS\ConnectionID = #Null
      *THIS\LastError = #POP3_ERROR_NO_CONNECTION
      ProcedureReturn ""
   EndIf
   
   Field + ":"
   i     = FindString(Header, #CRLF$ + Field, 1, #PB_String_NoCase)
   If i
      i + Len(Field) + 2
      j = i - 1
      Repeat
         j = FindString(Header, #CRLF$, j + 1)
         If j And Mid(Header, j + 2, 1) <> " " And Mid(Header, j + 2, 1) <> #TAB$ And Mid(Header, j + 2, 1) <> Chr(160)
            Break
         EndIf
      Until j = 0
      If j > 0
         Result = LTrim(Mid(Header, i, j - i))
      Else
         Result = LTrim(Mid(Header, i))
      EndIf
      If LTrim(Field) = "subject:"
         Result = ReplaceString(Result, #CRLF$ + "  ", #CRLF$)
         Result = RemoveString(Result, #CRLF$)
      EndIf
   EndIf
   
   ProcedureReturn Result
EndProcedure

Procedure.i __POP3_CountAttachments(*THIS._POP3_MAIN_STRUCTURE_)
   Protected Result, a$
   
   ;Count Attachments of loaded mail
     
   If *THIS\ConnectionID = #Null
      *THIS\LastError = #POP3_ERROR_NO_CONNECTION
      ProcedureReturn 0
   ElseIf *THIS\MailLoaded = #False
      *THIS\LastError = #POP3_ERROR_NO_MAIL_LOADED
      ProcedureReturn 0
   EndIf
   
   ForEach *THIS\MailParts()
      a$ = __POP3_GetHeaderField(*THIS, *THIS\MailParts()\Header, "Content-Disposition")
      If FindString(LCase(a$), "attachment;", 1)
         Result + 1
      EndIf
   Next
   
   ProcedureReturn Result
EndProcedure

Procedure.s __POP3_Internal_LoadMailParts(*THIS._POP3_MAIN_STRUCTURE_, Part.s, Boundary.s = "")
   Protected i, k, l, a$, b$, CB
   
   ;Load the different parts of a mail
   
   i = FindString(Part, #CRLF$ + #CRLF$, 1)
   If i
      b$   = Left(Part, i - 1)
      Part = Mid(Part, i + 4)
      a$   = __POP3_GetHeaderField(*THIS, b$, "Content-Type")
      ;Check if any Boundary in Header
      i    = FindString(LCase(a$), "boundary", 1)
      If i = 0
         ;no? save part
         AddElement(*THIS\MailParts())
         *THIS\MailParts()\Index    = ListIndex(*THIS\MailParts())
         *THIS\MailParts()\Header   = __POP3_Internal_DecodeText(b$)
         If Trim(RemoveString(Part, #CRLF$)) <> ""
            *THIS\MailParts()\Body = Part
         Else
            *THIS\MailParts()\Body = ""
         EndIf
         *THIS\MailParts()\Boundary = Boundary
      Else
         ;Yes? Get Boundaries Name
         k            = FindString(a$, "=", i) + 1
         l            = FindString(a$, #CRLF$, k)
         If l = 0
            Boundary = Mid(a$, k)
         Else
            Boundary = Mid(a$, k, l - k)
         EndIf
         If Left(Boundary, 1) = #DQUOTE$
            Boundary = Mid(Boundary, 2)
         EndIf
         If Right(Boundary, 1) = ";"
            Boundary = Left(Boundary, Len(Boundary) - 1)
         EndIf
         l = FindString(Boundary, #DQUOTE$)
         If l > 0
            Boundary = Left(Boundary, l - 1)
         EndIf
         CB = CountString(Part, "--" + Boundary + #CRLF$)
         Dim Boundaries.i(CB)
         k = 1
         For i = 0 To CB - 1
            Boundaries(i) = FindString(Part, "--" + Boundary + #CRLF$, k)
            k = Boundaries(i) + Len(Boundary) + 4
         Next i
         Boundaries(CB) = FindString(Part, #CRLF$ + "--" + Boundary + "--", 1)
         For i = 0 To CB - 1
            __POP3_Internal_LoadMailParts(*THIS, Mid(Part, Boundaries(i), Boundaries(i + 1) - Boundaries(i)), Boundary)
         Next i
         Part = Left(Part, Boundaries(0) - 1) + Mid(Part, Boundaries(CB) + Len(Boundary) + 8)
         AddElement(*THIS\MailParts())
         *THIS\MailParts()\Index    = ListIndex(*THIS\MailParts())
         *THIS\MailParts()\Header   = __POP3_Internal_DecodeText(b$)
         If Trim(RemoveString(Part, #CRLF$)) <> ""
            *THIS\MailParts()\Body = Part
         Else
            *THIS\MailParts()\Body = ""
         EndIf
         *THIS\MailParts()\Boundary = ""
      EndIf
   EndIf
   
EndProcedure

Procedure.s __POP3_GetAttachmentName(*THIS._POP3_MAIN_STRUCTURE_, Index.i)
   Protected Result.s, i, j, a$
   
   ;Get the name of the Attachment No. Index
   
   If *THIS\ConnectionID = #Null
      *THIS\LastError = #POP3_ERROR_NO_CONNECTION
      ProcedureReturn ""
   ElseIf *THIS\MailLoaded = #False
      *THIS\LastError = #POP3_ERROR_NO_MAIL_LOADED
      ProcedureReturn ""
   ElseIf __POP3_CountAttachments(*THIS) < Index Or Index < 1
      *THIS\LastError = #POP3_ERROR_INDEX_OUT_OF_BOUNDS
      ProcedureReturn ""
   EndIf
   
   ForEach *THIS\MailParts()
      a$ = __POP3_GetHeaderField(*THIS, *THIS\MailParts()\Header, "Content-Disposition")
      If FindString(LCase(a$), "attachment;", 1)
         i + 1
      EndIf
      If i = Index
         j = FindString(LCase(a$), "filename=", 1)
         If j
            a$ = Mid(a$, j + 9)
            ;lazy opera doesn't use Dquotes for filename
            If FindString(a$, #DQUOTE$, 1)
               a$ = StringField(a$, 2, #DQUOTE$)
            Else
               a$ = Trim(a$)
            EndIf
            Result = ReplaceString(a$, "/", "_")
            Result = ReplaceString(ReplaceString(Result, ":", "_"), "\", "_")
         EndIf
         *THIS\LastError = #POP3_ERROR_NONE
         Break
      EndIf
   Next
           
   ProcedureReturn Result   
EndProcedure

Procedure.i __POP3_LoadMail(*THIS._POP3_MAIN_STRUCTURE_, Index.i)
   Protected Result, a$
   
   ;This procedure will load the Mail No. Index.
   ;Call this before you can use
   ;  CountAttachments()
   ;  SaveAttachment()
   ;  CountMailParts()
   ;  GetAttachmentName()
   ;  GetMailPartHeader()
   ;  GetMailPartBody()
   
   If *THIS\ConnectionID = #Null
      *THIS\LastError = #POP3_ERROR_NO_CONNECTION
      ProcedureReturn 0
   ElseIf *THIS\MessageCount < Index Or Index < 1
      *THIS\LastError = #POP3_ERROR_INDEX_OUT_OF_BOUNDS
      ProcedureReturn 0
   EndIf
   
   ClearList(*THIS\MailParts())
   *THIS\LastResponse = ""
   *THIS\MailLoaded   = #False
   
   If __POP3_Internal_SendString(*THIS, "RETR " + Str(Index) + #CRLF$) > 0
      a$ = __POP3_Internal_WaitForResponse(*THIS, #True)
      If a$
         If __POP3_Internal_CheckResponse(*THIS, a$)
            ;remove the "." + #CRLF$ from the end of the mail
            *THIS\LastResponse = Left(*THIS\LastResponse, Len(*THIS\LastResponse) - 3)
            If Left(*THIS\LastResponse, 2) = #CRLF$
               *THIS\LastResponse = Mid(*THIS\LastResponse, 3)
            EndIf
            __POP3_Internal_LoadMailParts(*THIS, *THIS\LastResponse)
            Result           = #True
            *THIS\MailLoaded = #True
            SortStructuredList(*THIS\MailParts(), #PB_Sort_Descending, OffsetOf(_POP3_MAIL_PARTS_\Index), #PB_Sort_Integer)
         Else
            *THIS\LastError = #POP3_ERROR_NO_MAIL_LOADED
         EndIf
      EndIf
   Else
      *THIS\LastError = #POP3_ERROR_SENDING
   EndIf
   
   ProcedureReturn Result
EndProcedure

Procedure.i __POP3_DeleteMail(*THIS._POP3_MAIN_STRUCTURE_, Index.i)
   Protected Result, a$
   
   ;Mails will not get deleted immediately!
   ;They will be deleted, when sending a "QUIT" to the server.
   ;That means you could undo all of your DELE-Messages
   ;when sending a RSET before QUIT
   ;(See below procedure)
   
   If *THIS\ConnectionID = #Null
      *THIS\LastError = #POP3_ERROR_NO_CONNECTION
      ProcedureReturn 0
   ElseIf *THIS\MessageCount < Index Or Index < 1
      *THIS\LastError = #POP3_ERROR_INDEX_OUT_OF_BOUNDS
      ProcedureReturn 0
   EndIf
   
   If __POP3_Internal_SendString(*THIS, "DELE " + Str(Index) + #CRLF$) > 0
      a$ = __POP3_Internal_WaitForResponse(*THIS)
      If __POP3_Internal_CheckResponse(*THIS, a$)
         *THIS\LastResponse = Left(*THIS\LastResponse, Len(*THIS\LastResponse) - 3)
         Result             = #True
         *THIS\LastError    = #POP3_ERROR_NONE
      Else
         *THIS\LastError = #POP3_ERROR_UNABLE_TO_DELETE_MAIL
      EndIf
   Else
      *THIS\LastError = #POP3_ERROR_SENDING
   EndIf
   
   ProcedureReturn Result
EndProcedure

Procedure.i __POP3_ResetDelete(*THIS._POP3_MAIN_STRUCTURE_)
   Protected Result, a$
   
   ;Undo all of your DELE-Messages you've sent
   
   If *THIS\ConnectionID = #Null
      *THIS\LastError = #POP3_ERROR_NO_CONNECTION
      ProcedureReturn 0
   EndIf
   
   If __POP3_Internal_SendString(*THIS, "RSET" + #CRLF$) > 0
      a$ = __POP3_Internal_WaitForResponse(*THIS)
      If __POP3_Internal_CheckResponse(*THIS, a$)
         *THIS\LastResponse = Left(*THIS\LastResponse, Len(*THIS\LastResponse) - 3)
         Result             = #True
         *THIS\LastError    = #POP3_ERROR_NONE
      Else
         *THIS\LastError = #POP3_ERROR_UNABLE_TO_DELETE_MAIL
      EndIf
   Else
      *THIS\LastError = #POP3_ERROR_SENDING
   EndIf
   
   ProcedureReturn Result
EndProcedure
   

Procedure.s __POP3_GetHeader(*THIS._POP3_MAIN_STRUCTURE_, Index.i)
   Protected Result.s, i, a$, b$, CS
   
   ;Just load the Header of a Mail
   ;(Not supported by all mail-servers)

   If *THIS\ConnectionID = #Null
      *THIS\LastError = #POP3_ERROR_NO_CONNECTION
      ProcedureReturn ""
   ElseIf *THIS\MessageCount < Index Or Index < 1
      *THIS\LastError = #POP3_ERROR_INDEX_OUT_OF_BOUNDS
      ProcedureReturn ""
   ElseIf (*THIS\Capability <> "" And FindString(*THIS\Capability, ";TOP;") = 0)
      *THIS\LastError = #POP3_ERROR_COMMAND_NOT_ACCEPTED
      ProcedureReturn ""
   EndIf

   If __POP3_Internal_SendString(*THIS, "TOP " + Str(Index) + " 0" + #CRLF$) > 0
      Result = __POP3_Internal_WaitForResponse(*THIS, 2)
      Result = __POP3_Internal_DecodeText(Result)
      __POP3_Internal_CheckResponse(*THIS, Result)
      Result = *THIS\LastResponse
      a$     = __POP3_GetHeaderField(*THIS, Result, "Content-Transfer-Encoding")
      b$     = __POP3_GetHeaderField(*THIS, Result, "Content-Type")
      If FindString(b$, "utf-8", 1, #PB_String_NoCase) And FindString(a$, "8bit", 1, #PB_String_NoCase) = 0 And FindString(b$, "multipart/alternative", 1, #PB_String_NoCase) = 0
         CS = #PB_UTF8
         CompilerIf #PB_Compiler_Unicode
         a$ = Space(StringByteLength(Result, #PB_Ascii))
         PokeS(@a$, Result, -1, #PB_Ascii)
         Result = a$
         CompilerEndIf
         Result = PeekS(@Result, -1, CS)
      EndIf
   Else
      *THIS\LastError = #POP3_ERROR_SENDING
   EndIf
   
   ProcedureReturn Result
EndProcedure

Procedure.i __POP3_Connect(*THIS._POP3_MAIN_STRUCTURE_, Pop3Server.s, Pop3Port.i, Username.s, Password.s, TimeOUT.i)
   Protected a$, b$, CAPA.s, ok, Result, TimeStamp.s
   Protected i, j
   
   ;Connect to the pop3-Server.
   
   ClearList(*THIS\MailParts())
   *THIS\Buffer = AllocateMemory(8 * 1024 * 1024) ;8MB
   If *THIS\Buffer = 0
      *THIS\LastError = #POP3_ERROR_NOT_ENOUGH_MEMORY
      ProcedureReturn 0
   EndIf
   *THIS\LastError     = #POP3_ERROR_NONE
   *THIS\TimeOUT       = TimeOUT
   *THIS\LastResponse  = ""
   *THIS\Capability    = ""
   *THIS\MailLoaded    = #False
   *THIS\StopReceiving = #False
   *THIS\ConnectionID  = OpenNetworkConnection(Pop3Server, Pop3Port)
   If *THIS\ConnectionID = 0
      *THIS\LastError = #POP3_ERROR_NO_CONNECTION
      FreeMemory(*THIS\Buffer)
      *THIS\Buffer = #Null
   Else
      ;Wait for Response
      a$ = __POP3_Internal_WaitForResponse(*THIS)
      If LCase(Left(a$, 4)) = "-err"
         *THIS\LastError = #POP3_ERROR_NO_RESPONSE
      ElseIf __POP3_Internal_CheckResponse(*THIS, a$)
         ;o.k., go on
         ;Check what options this server offers (not all will answer this call)
         If __POP3_Internal_SendString(*THIS, "CAPA" + #CRLF$) <= 0
            *THIS\LastError = #POP3_ERROR_SENDING
         Else
            ;we don't know, if this server accepts CAPA, to make it faster, we lower the timeout
            CAPA = __POP3_Internal_WaitForResponse(*THIS, 3)
            If CAPA = "" Or Left(LCase(CAPA), 4) = "-err"
               *THIS\LastError  = #POP3_ERROR_NONE
            Else
               CAPA = RemoveString(CAPA, #CR$)
               For i = 1 To CountString(CAPA, #LF$)
                  a$ = StringField(CAPA, i + 1, #LF$)
                  If a$ = "." Or a$ = ""
                     Break
                  Else
                     If *THIS\Capability = ""
                        *THIS\Capability = ";"
                     EndIf
                     *THIS\Capability + UCase(a$) + ";"
                  EndIf
               Next i
            EndIf
            ;We check, if server accepts the (more secure) APOP [Authenticated Post Office Protocol] login
            If *THIS\Capability = "" Or FindString(*THIS\Capability, ";APOP;", 1)
               ;Yes, now get the sent timestamp, we need it for the md5-hash
               i = FindString(CAPA, "<", 1)
               j = FindString(CAPA, ">", i)
               If i And j
                  TimeStamp = Mid(CAPA, i, j - i + 1)
                  If __POP3_Internal_SendString(*THIS, "APOP " + Username + " " + __POP3_Internal_MD5StringFingerprint(TimeStamp + Password) + #CRLF$) <= 0
                     *THIS\LastError = #POP3_ERROR_SENDING
                  Else
                     a$ = __POP3_Internal_WaitForResponse(*THIS)
                     If __POP3_Internal_CheckResponse(*THIS, a$)
                        ;Nice, we made it!
                        Result = #True
                     EndIf
                  EndIf
               EndIf
            EndIf
            If *THIS\LastError = #POP3_ERROR_NONE And Result = #False And (*THIS\Capability = "" Or FindString(*THIS\Capability, ";USER;", 1))
               If __POP3_Internal_SendString(*THIS, "USER " + Username + #CRLF$) > 0
                  a$ = __POP3_Internal_WaitForResponse(*THIS)
                  If __POP3_Internal_CheckResponse(*THIS, a$)
                     If __POP3_Internal_SendString(*THIS, "PASS " + Password + #CRLF$)
                        a$ = __POP3_Internal_WaitForResponse(*THIS)
                        If __POP3_Internal_CheckResponse(*THIS, a$)
                           Result = #True
                        Else
                           *THIS\LastError = #POP3_ERROR_WRONG_PASSWORD
                        EndIf
                     EndIf
                  Else
                     *THIS\LastError = #POP3_ERROR_WRONG_USERNAME
                  EndIf
               Else
                  *THIS\LastError = #POP3_ERROR_SENDING
               EndIf
            EndIf
         EndIf
         If *THIS\LastError = #POP3_ERROR_NONE
            If __POP3_Internal_SendString(*THIS, "STAT" + #CRLF$) > 0
               a$ = __POP3_Internal_WaitForResponse(*THIS)
               If __POP3_Internal_CheckResponse(*THIS, a$)
                  Result = #True
                  *THIS\MessageCount = Val(StringField(a$, 2, " "))
               Else
                  *THIS\LastError = #POP3_ERROR_NO_CONNECTION
               EndIf
            Else
               *THIS\LastError = #POP3_ERROR_SENDING
            EndIf
         EndIf
      EndIf
      If Result = #False
         CloseNetworkConnection(*THIS\ConnectionID)
         *THIS\ConnectionID = #Null
      EndIf
   EndIf

  ProcedureReturn Result
EndProcedure

Procedure.i __POP3_CountMails(*THIS._POP3_MAIN_STRUCTURE_)
   ;Messages will be count, the moment you connect.
   ;So we allready have this calue stored.
   
   If *THIS\ConnectionID = 0
      *THIS\LastError = #POP3_ERROR_NO_CONNECTION
      ProcedureReturn 0
   EndIf
   
   ProcedureReturn *THIS\MessageCount
EndProcedure

Procedure.i __POP3_CountMailParts(*THIS._POP3_MAIN_STRUCTURE_)
   Protected Result
   
   ;How many parts does the Mail have?
   ;!!CALL AFTER \LoadMail() HAS SUCCESSFULLY LOADED A MAIL!!
   
   If *THIS\ConnectionID = 0
      *THIS\LastError = #POP3_ERROR_NO_CONNECTION
      ProcedureReturn 0
   ElseIf *THIS\MailLoaded = #False
      *THIS\LastError = #POP3_ERROR_NO_MAIL_LOADED
      ProcedureReturn 0
   EndIf
   
   Result = ListSize(*THIS\MailParts())
   Result - __POP3_CountAttachments(*THIS)
   ProcedureReturn Result
EndProcedure

Procedure __POP3_Abort_Receiving(*THIS._POP3_MAIN_STRUCTURE_)
   
   ;This should be only called, if you want to disconnect
   ;and your receiving is still in action.
   ;Otherwise in the worst case, you have to wait till your timeout has expired
   ;(default 10 seconds)
   *THIS\StopReceiving = #True
EndProcedure

Procedure.s __POP3_GetMailPartHeader(*THIS._POP3_MAIN_STRUCTURE_, Index.i)
   Protected Result.s, i, a$
   
   ;Get the Header of MailPart Index
   ;!!CALL AFTER \LoadMail() HAS SUCCESSFULLY LOADED A MAIL!!
   
   If *THIS\ConnectionID = 0
      *THIS\LastError = #POP3_ERROR_NO_CONNECTION
      ProcedureReturn ""
   ElseIf *THIS\MailLoaded = #False
      *THIS\LastError = #POP3_ERROR_NO_MAIL_LOADED
      ProcedureReturn ""
   EndIf
   
   ForEach *THIS\MailParts()
      a$ = __POP3_GetHeaderField(*THIS, *THIS\MailParts()\Header, "Content-Disposition")
      If FindString(LCase(a$), "attachment;", 1) = 0
         i + 1
         If i = Index
            Result          = *THIS\MailParts()\Header
            *THIS\LastError = #POP3_ERROR_NONE
            Break
         EndIf
      EndIf
   Next
   
   ProcedureReturn Result
EndProcedure

Procedure.s __POP3_CheckHTMLFormat(*THIS._POP3_MAIN_STRUCTURE_, Header.s, Body.s)
   Protected a$, b$, j, k, l, m, n, o, CS
   
   ;This is for HTML-Output.
   ;It will check, if the Mail-Header says UTF-8, but the HTML-Header not (and vice versa)
   ;If true, it will change the Stringformat for perfect WebGadget-Output
   
   b$ = __POP3_GetHeaderField(*THIS, Header, "Content-Type")
   If FindString(LCase(b$), "utf-8", 1)
      CS = #PB_UTF8
   Else
      CS = #PB_Ascii
   EndIf
   
   If FindString(LCase(b$), "text/html", 1)
      l  = 0
      a$ = LCase(Body)
      j  = 0
      o  = FindString(a$, "</head>", 1)
      Repeat
         j = FindString(a$, "<meta", j + 1)
         If j > 0
            k = FindString(a$, ">", j)
            If k > j
               m = FindString(a$, "charset", j + 5)
               n = FindString(a$, "utf-8", m + 7)
               If m > 0 And n > m And m < k And n < k
                  l = #True
                  Break
               EndIf
            EndIf
         EndIf
      Until j = 0 Or j > o Or k > o
      If l And CS <> #PB_UTF8
         ;Change anything back to Ascii for the webgadget
         a$   = Space(StringByteLength(Body, #PB_UTF8))
         PokeS(@a$, Body, -1, #PB_UTF8)
         Body = PeekS(@a$, -1, #PB_Ascii)
      ElseIf l = 0 And CS = #PB_UTF8
         ;Change anything back to UTF-8 for the webgadget
         CompilerIf #PB_Compiler_Unicode
         a$   = Space(StringByteLength(Body, #PB_Ascii))
         PokeS(@a$, Body, -1, #PB_Ascii)
         Body = PeekS(@a$, -1, #PB_UTF8)
         CompilerElse
         Body = PeekS(@Body, -1, #PB_UTF8)
         CompilerEndIf
      EndIf
   EndIf
   
   ProcedureReturn Body
EndProcedure

Procedure.s __POP3_GetMailPartBody(*THIS._POP3_MAIN_STRUCTURE_, Index.i)
   Protected Result.s, i, CS, a$, b$, *Buffer
   
   ;Get the Body of MailPart Index
   ;!!CALL AFTER \LoadMail() HAS SUCCESSFULLY LOADED A MAIL!!
   
   If *THIS\ConnectionID = 0
      *THIS\LastError = #POP3_ERROR_NO_CONNECTION
      ProcedureReturn ""
   ElseIf *THIS\MailLoaded = #False
      *THIS\LastError = #POP3_ERROR_NO_MAIL_LOADED
      ProcedureReturn ""
   EndIf
   
   ForEach *THIS\MailParts()
      a$ = __POP3_GetHeaderField(*THIS, *THIS\MailParts()\Header, "Content-Disposition")
      If FindString(LCase(a$), "attachment;", 1) = 0
         i + 1
         If i = Index
            a$     = __POP3_GetHeaderField(*THIS, *THIS\MailParts()\Header, "Content-Transfer-Encoding")
            b$     = __POP3_GetHeaderField(*THIS, *THIS\MailParts()\Header, "Content-Type")
            Result = *THIS\MailParts()\Body
           
            If FindString(a$, "base64", 1, #PB_String_NoCase)
               *Buffer = __POP3_Internal_DecodeBinaryBase64(Result)
               If *Buffer
                  Result = PeekS(*Buffer, MemorySize(*Buffer), #PB_Ascii)
                  FreeMemory(*Buffer)
               EndIf
            EndIf
            If FindString(LCase(a$), "quoted-printable", 1)
               If FindString(b$, "utf-8", 1, #PB_String_NoCase) And FindString(b$, "text/html", 1, #PB_String_NoCase) = 0
                  CS = #PB_UTF8
               Else
                  CS = #PB_Ascii
               EndIf
               Result = __POP3_Internal_DecodeText_QuotedPrintable(Result, CS)
            EndIf
            *THIS\LastError = #POP3_ERROR_NONE
            Break
         EndIf
      EndIf
   Next
   
   ProcedureReturn Result
EndProcedure

Procedure.i __POP3_SaveAttachment(*THIS._POP3_MAIN_STRUCTURE_, Index.i, Path.s, FileName.s)
   Protected FID, a$, b$, c$, *Buffer, CS
   
   ;Will save Attachment #Index in Path.
   ;If no Filename specified, it will use the original filename.
   ;!!CALL AFTER \LoadMail() HAS SUCCESSFULLY LOADED A MAIL!!
   
   If *THIS\ConnectionID = 0
      *THIS\LastError = #POP3_ERROR_NO_CONNECTION
      ProcedureReturn 0
   ElseIf *THIS\MailLoaded = #False
      *THIS\LastError = #POP3_ERROR_NO_MAIL_LOADED
      ProcedureReturn 0
   EndIf

   If *THIS\Internal = 0
      ;Normal behaviour
      If Index < 1 Or Index > __POP3_CountAttachments(*THIS)
         *THIS\LastError = #POP3_ERROR_INDEX_OUT_OF_BOUNDS
         ProcedureReturn 0
      EndIf
      a$ = __POP3_GetAttachmentName(*THIS, Index)
      If FileName = ""
         FileName = a$
      EndIf
   EndIf
   
   If FileName
      FID = CreateFile(#PB_Any, Path + FileName)
      If FID
         a$  = __POP3_GetHeaderField(*THIS, *THIS\MailParts()\Header, "Content-Transfer-Encoding")
         If FindString(LCase(a$), "base64", 1)
            *Buffer = __POP3_Internal_DecodeBinaryBase64(*THIS\MailParts()\Body)
            If *Buffer
               WriteData(FID, *Buffer, MemorySize(*Buffer))
               FreeMemory(*Buffer)
            EndIf
         Else
            b$ = __POP3_GetHeaderField(*THIS, *THIS\MailParts()\Header, "Content-Type")
            If FindString(LCase(b$), "utf-8", 1)
               CS = #PB_UTF8
            Else
               CS = #PB_Ascii
            EndIf
            If FindString(LCase(a$), "quoted-printable", 1)
               c$ = __POP3_Internal_DecodeText_QuotedPrintable(*THIS\MailParts()\Body, CS)
               WriteString(FID, c$, CS)
            Else
               WriteString(FID, *THIS\MailParts()\Body, CS)
            EndIf
         EndIf
         CloseFile(FID)
      EndIf
   EndIf
   
   ProcedureReturn FID
EndProcedure

Procedure.i __POP3_SaveMailPartBody(*THIS._POP3_MAIN_STRUCTURE_, Index.i, Path.s, FileName.s)
   Protected a$, b$, i, j, k, Result
   
   If *THIS\ConnectionID = 0
      *THIS\LastError = #POP3_ERROR_NO_CONNECTION
      ProcedureReturn 0
   ElseIf *THIS\MailLoaded = #False
      *THIS\LastError = #POP3_ERROR_NO_MAIL_LOADED
      ProcedureReturn 0
   ElseIf Index < 1
      *THIS\LastError = #POP3_ERROR_INDEX_OUT_OF_BOUNDS
      ProcedureReturn 0
   EndIf
   
   ;Save normal Part, first get filename if none set
   If FileName = ""
      k = #False
      ForEach *THIS\MailParts()
         b$ = __POP3_GetHeaderField(*THIS, *THIS\MailParts()\Header, "Content-Disposition")
         If FindString(LCase(b$), "attachment;", 1) = 0
            i + 1
            If i = Index
               k = #True
               j = FindString(LCase(b$), "filename=", 1)
               If j > 1
                  FileName = Mid(b$, j + 9)
                  FileName = StringField(FileName, 1, #CR$)
                  FileName = RemoveString(RemoveString(RemoveString(FileName, #DQUOTE$), ";"), #LF$)
               EndIf
               Break
            EndIf
         EndIf
      Next
      If k = #False
         *THIS\LastError = #POP3_ERROR_INDEX_OUT_OF_BOUNDS
         ProcedureReturn 0
      EndIf
   EndIf
   If FileName = ""
      *THIS\LastError = #POP3_ERROR_NO_FILENAME_FOUND
      ProcedureReturn 0
   EndIf
   *THIS\Internal = #True
   Result         = __POP3_SaveAttachment(*THIS, Index, Path, FileName)
   *THIS\Internal = #False
   
   ProcedureReturn Result
EndProcedure
   
Procedure CreatePop3Object()
   Protected *POP3._POP3_MAIN_STRUCTURE_
   
   *POP3 = AllocateMemory(SizeOf(_POP3_MAIN_STRUCTURE_))
   If *POP3
      InitializeStructure(*POP3, _POP3_MAIN_STRUCTURE_)
      *POP3\VTable = ?_POP3_PROCEDURES_
   EndIf
   
   ProcedureReturn *POP3
EndProcedure

DataSection
   _POP3_PROCEDURES_:
   Data.i @__POP3_GetLastError()
   Data.i @__POP3_GetLastResponse()
   Data.i @__POP3_Connect()
   Data.i @__POP3_Disconnect()
   Data.i @__POP3_CountMails()
   Data.i @__POP3_GetHeader()
   Data.i @__POP3_GetHeaderField()
   Data.i @__POP3_LoadMail()
   Data.i @__POP3_CountAttachments()
   Data.i @__POP3_GetAttachmentName()
   Data.i @__POP3_SaveAttachment()
   Data.i @__POP3_CountMailParts()
   Data.i @__POP3_GetMailPartHeader()
   Data.i @__POP3_GetMailPartBody()
   Data.i @__POP3_SaveMailPartBody()
   Data.i @__POP3_CheckHTMLFormat()
   Data.i @__POP3_DeleteMail()
   Data.i @__POP3_ResetDelete()
   Data.i @__POP3_Abort_Receiving()
EndDataSection


;------------------------------------------------ EXAMPLE ----------------------------------------------------------
;-------------------------------------------------------------------------------------------------------------------------

InitNetwork()

Enumeration
   #Window_0
EndEnumeration

Enumeration
   #String_Server
   #String_Port
   #String_UserName
   #String_PassWord
   #String_From
   #Tree_Mails
   #WebView_Mail
   #Text_Attachments
   #ListIcon_Attachments
   #Button_Connect
   #Button_SaveMail
EndEnumeration

Enumeration
   #POP3_MSG_ALL_MSG_LOADING_FINISHED
   #POP3_MSG_MSG_LOADED
EndEnumeration

CompilerIf #PB_Compiler_Thread = 0
CompilerError "Please compile with threadsafe on"
CompilerEndIf


Global *pop3._POP3_    = CreatePop3Object() ;<- our pop3 interface
Global Pop3_Semaphore  = CreateSemaphore()  ;<- for our thread to inform us, that new Message arrived
Global Pop3_Mutex      = CreateMutex()      ;<- Mutex for the Linked List
Global NewList Tempfiles.s()               ;<- all of our temp files we created. Delete afterwards
Global NewList Messages.i()                ;<- Messages from threads to main


;a little message-queue
Procedure SetMSG(MSG)
   LockMutex(Pop3_Mutex)
   FirstElement(Messages())
   InsertElement(Messages())
   Messages() = MSG
   UnlockMutex(Pop3_Mutex)
   SignalSemaphore(Pop3_Semaphore)
EndProcedure

Procedure GetMSG()
   Protected Result

   LockMutex(Pop3_Mutex)
   If FirstElement(Messages())
      Result = Messages()
      DeleteElement(Messages())
   EndIf
   UnlockMutex(Pop3_Mutex)
   ProcedureReturn Result
EndProcedure

Procedure LoadWebGadget(GadgetID, Text.s)
   Protected FID

   CompilerIf #PB_Compiler_OS = #PB_OS_Windows
   SetGadgetItemText(GadgetID, #PB_Web_HtmlCode, Text)
   CompilerElse
   FID = CreateFile(#PB_Any, GetTemporaryDirectory() + "pop3_example.html")
   If FID
      WriteString(FID, Text, #PB_Ascii)
      CloseFile(FID)
      SetGadgetText(GadgetID, "file://" + GetTemporaryDirectory() + "pop3_example.html")
   EndIf
   CompilerEndIf
EndProcedure

Procedure LoadMailsThread(*StopMe.INTEGER)
   Protected i, j, k, a$

   If *pop3\Connect(GetGadgetText(#String_Server), Val(GetGadgetText(#String_Port)), GetGadgetText(#String_UserName), GetGadgetText(#String_PassWord))
      j = *pop3\CountMails()
      StatusBarText(0, 0, Str(j) + " Mails available")
      k = 0
      For i = 1 To j
         If *StopMe\i
            Break
         EndIf
         StatusBarText(0, 1, "Loading Mail " + Str(i))
         a$ = *pop3\GetHeader(i)
         If a$
            AddGadgetItem(#Tree_Mails, -1, *pop3\GetHeaderField(a$, "subject"))
            SetGadgetItemData(#Tree_Mails, k, i)
            k + 1
         EndIf
      Next i
   EndIf
   SetMSG(#POP3_MSG_ALL_MSG_LOADING_FINISHED)

EndProcedure

Procedure LoadSingleMailThread(Num.i)

   *pop3\LoadMail(Num)
   SetMSG(#POP3_MSG_MSG_LOADED)

EndProcedure

Procedure.s CheckMailForInlinePics(HTML.s)
   Protected i, j, k, l, m, n, ID.s, a$, b$, c$, FileName.s, Count, Found

   i = FindString(HTML, "<img src=" + #DQUOTE$ + "cid:", 1) ;<--just as example. it could also be <img id="bla" src="cid:...
   While i
      j     = FindString(HTML, #DQUOTE$, i + 14)
      ID    = Mid(HTML, i + 14, j - i - 14)
      Found = #False
      ;First search MailParts
      Count = *pop3\CountMailParts()
      For k = 1 To Count
         a$ = *pop3\GetMailPartHeader(k)
         c$ = *pop3\GetHeaderField(a$, "Content-ID")
         b$ = *pop3\GetHeaderField(a$, "Content-Disposition")
         If FindString(c$, ID, 1)
            Found = #True
            ;o.k., this is for us
            ;search filename
            l = FindString(LCase(b$), "filename=", 1)
            If l
               FileName = Mid(b$, l + 9)
               FileName = StringField(FileName, 1, #CR$)
               FileName = RemoveString(RemoveString(RemoveString(FileName, #DQUOTE$), #LF$), ";")
               If *pop3\SaveMailPartBody(k, GetTemporaryDirectory(), FileName)
                  AddElement(Tempfiles())
                  Tempfiles() = GetTemporaryDirectory() + FileName
                  ;now replace html above
                  HTML = Left(HTML, i + 9) + GetTemporaryDirectory() + FileName + Mid(HTML, j)
               EndIf
            EndIf
            Break
         EndIf
      Next k
      If Found = #False
         ;O.k., maybe in the attachments?
         Count = *pop3\CountAttachments()
         For k = 1 To Count
            a$ = *pop3\GetMailPartHeader(k)
            c$ = *pop3\GetHeaderField(a$, "Content-ID")
            b$ = *pop3\GetHeaderField(a$, "Content-Disposition")
            If FindString(c$, ID, 1)
               ;o.k., this is for us
               ;search filename
               l = FindString(LCase(b$), "filename=", 1)
               If l
                  FileName = Mid(b$, l + 9)
                  FileName = StringField(FileName, 1, #CR$)
                  FileName = RemoveString(RemoveString(RemoveString(FileName, #DQUOTE$), #LF$), ";")
                  If *pop3\SaveAttachment(k, GetTemporaryDirectory(), FileName)
                     AddElement(Tempfiles())
                     Tempfiles() = GetTemporaryDirectory() + FileName
                     ;now replace html above
                     HTML = Left(HTML, i + 9) + GetTemporaryDirectory() + FileName + Mid(HTML, j)
                  EndIf
               EndIf
               Break
            EndIf
         Next k
      EndIf
      i = FindString(HTML, "<img src=" + #DQUOTE$ + "cid:", i + 10)
   Wend

   ProcedureReturn HTML
EndProcedure

Procedure main()
   Protected i, j, k, a$, b$, c$, Connected, ThreadID, StopThread, Mails

   OpenWindow(#Window_0, 0, 0, 825, 605, "Pop3 Example", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
   TextGadget(#PB_Any, 5, 7, 75, 20, "Pop-Server:")
   StringGadget(#String_Server, 95, 5, 225, 22, "pop.gmx.net")
   TextGadget(#PB_Any, 330, 7, 40, 20, "Port:")
   StringGadget(#String_Port, 380, 5, 70, 22, "110")
   TextGadget(#PB_Any, 5, 38, 75, 20, "Username:")
   StringGadget(#String_UserName, 95, 35, 125, 22, "")
   TextGadget(#PB_Any, 225, 38, 70, 20, "Password:")
   StringGadget(#String_PassWord, 300, 35, 150, 22, "", #PB_String_Password)
   TextGadget(#PB_Any, 240, 72, 55, 20, "From:")
   StringGadget(#String_From, 300, 70, 515, 22, "", #PB_String_ReadOnly)
   TreeGadget(#Tree_Mails, 5, 70, 225, 506, #PB_Tree_AlwaysShowSelection)
   WebGadget(#WebView_Mail, 240, 100, 575, 370, "")
   TextGadget(#Text_Attachments, 240, 472, 85, 20, "Attachments:")
   ListIconGadget(#ListIcon_Attachments, 240, 495, 575, 80, "", 100)
   ButtonGadget(#Button_Connect, 475, 10, 125, 45, "Connect")
   ButtonGadget(#Button_SaveMail, 620, 30, 125, 25, "Save as...")
   DisableGadget(#Button_SaveMail, 1)
   SetGadgetAttribute(#ListIcon_Attachments, #PB_ListIcon_DisplayMode, #PB_ListIcon_List)
   SetActiveGadget(#String_UserName)
   CreateStatusBar(0, WindowID(#Window_0))
   AddStatusBarField(150)
   AddStatusBarField(#PB_Ignore)
   AddKeyboardShortcut(#Window_0, #PB_Shortcut_Delete, 0)

   Repeat
      Select WaitWindowEvent(50)
         Case #PB_Event_CloseWindow
            If ThreadID And IsThread(ThreadID)
               ;Something still is going on
               ;Just to make sure, that the receiving-procedure (if in action) won't halt our program
               *pop3\AbortReceiving()
               StopThread = #True
               If WaitThread(ThreadID, 2000) = 0
                  KillThread(ThreadID)
               EndIf
            EndIf
            If Connected
               *pop3\Disconnect()
            EndIf
            Break
         Case #PB_Event_SizeWindow
            i = WindowWidth(#Window_0)
            j = WindowHeight(#Window_0)
            ResizeGadget(#Tree_Mails, #PB_Ignore, #PB_Ignore, #PB_Ignore, j - 75 - StatusBarHeight(0))
            ResizeGadget(#ListIcon_Attachments, #PB_Ignore, j - 86 - StatusBarHeight(0), i - 250, #PB_Ignore)
            ResizeGadget(#Text_Attachments, #PB_Ignore, j - 110 - StatusBarHeight(0), #PB_Ignore, #PB_Ignore)
            ResizeGadget(#WebView_Mail, #PB_Ignore, #PB_Ignore, i - 250, j - 215 - StatusBarHeight(0))
            ResizeGadget(#String_From, #PB_Ignore, #PB_Ignore, i - 310, #PB_Ignore)
         Case #PB_Event_Menu
            Select EventMenu()
               Case 0
                  ;Delete?
                  i = GetGadgetState(#Tree_Mails)
                  If i > -1
                     If MessageRequester("Delete Mail?", "Do you really want to delete the mail" + #CRLF$ + GetGadgetItemText(#Tree_Mails, i) + "?", #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
                        j = GetGadgetItemData(#Tree_Mails, i)
                        If *pop3\DeleteMail(j)
                           RemoveGadgetItem(#Tree_Mails, i)
                           ClearGadgetItems(#ListIcon_Attachments)
                           LoadWebGadget(#WebView_Mail, "")
                           Mails - 1
                           StatusBarText(0, 0, Str(Mails) + " Mails available")
                        EndIf
                     EndIf
                  EndIf
            EndSelect
         Case #PB_Event_Gadget
            Select EventGadget()
               Case #Button_SaveMail
                  a$ = SaveFileRequester("Save this Mail", "OriginalMail.eml", "eml file (*.eml)|*.eml", 0)
                  If a$
                     If Right(a$, 4) <> ".eml"
                        a$ + ".eml"
                     EndIf
                     i = CreateFile(#PB_Any, a$)
                     If i
                        WriteStringN(i, *pop3\GetLastResponse())
                        CloseFile(i)
                     EndIf
                  EndIf
               Case #Button_Connect
                  If Connected
                     *pop3\Disconnect()
                     Connected = #False
                     SetGadgetText(#Button_Connect, "Connect")
                     ClearGadgetItems(#ListIcon_Attachments)
                     ClearGadgetItems(#Tree_Mails)
                     SetGadgetText(#String_From, "")
                     LoadWebGadget(#WebView_Mail, "")
                     DisableGadget(#Button_SaveMail, 1)
                  Else
                     StatusBarText(0, 1, "Connecting Server...")
                     DisableGadget(#Button_Connect, 1)
                     DisableGadget(#Button_SaveMail, 1)
                     DisableGadget(#Tree_Mails, 1)
                     SetGadgetText(#String_From, "")
                     ThreadID = CreateThread(@LoadMailsThread(), @StopThread)
                  EndIf
               Case #Tree_Mails
                  If EventType() = #PB_EventType_Change
                     i = GetGadgetState(#Tree_Mails)
                     If i > -1
                        ClearGadgetItems(#ListIcon_Attachments)
                        SetGadgetText(#String_From, "")
                        j = GetGadgetItemData(#Tree_Mails, i)
                        DisableGadget(#Button_Connect, 1)
                        DisableGadget(#Button_SaveMail, 1)
                        DisableGadget(#Tree_Mails, 1)
                        StatusBarText(0, 1, "Loading Mail #" + Str(j))
                        ThreadID = CreateThread(@LoadSingleMailThread(), j)
                     EndIf
                  EndIf
               Case #ListIcon_Attachments
                  If EventType() = #PB_EventType_LeftDoubleClick
                     i = GetGadgetState(#ListIcon_Attachments)
                     If i > -1
                        a$ = GetTemporaryDirectory() + GetGadgetItemText(#ListIcon_Attachments, i)
                        If FileSize(a$) = -1
                           ;not yet there
                           AddElement(Tempfiles())
                           Tempfiles() = a$
                        EndIf
                        If *pop3\SaveAttachment(i + 1, GetTemporaryDirectory())
                           RunProgram(GetTemporaryDirectory() + GetGadgetItemText(#ListIcon_Attachments, i)) ;<-won't work with linux, don't know about this apple-thing
                        EndIf
                     EndIf
                  EndIf

            EndSelect
         Case 0
            If TrySemaphore(Pop3_Semaphore)
               k = GetMSG()
               Select k
                  Case #POP3_MSG_ALL_MSG_LOADING_FINISHED
                     Select *pop3\GetLastError()
                        Case #POP3_ERROR_NONE
                           a$        = ""
                           Connected = #True
                           Mails     = *pop3\CountMails()
                           SetGadgetText(#Button_Connect, "Disconnect")
                        Case #POP3_ERROR_WRONG_USERNAME
                           a$ = "Unknown username"
                        Case #POP3_ERROR_WRONG_PASSWORD
                           a$ = "Wrong username and/or password!"
                        Case #POP3_ERROR_NO_RESPONSE
                           a$ = "No response from server"
                        Case #POP3_ERROR_NOT_ENOUGH_MEMORY
                           a$ = "You are running out of memory!"
                        Case #POP3_ERROR_NO_CONNECTION
                           a$ = "Unable to connect to server"
                     EndSelect
                     If a$
                        LoadWebGadget(#WebView_Mail, "<html><head></head><body><b>Error!<br>" + #CRLF$ + a$ + "</b></body></html>")
                     EndIf
                  Case #POP3_MSG_MSG_LOADED
                     Select *pop3\GetLastError()
                        Case #POP3_ERROR_NONE
                           ;o.k., new mail has been loaded
                           k  = *pop3\CountMailParts()
                           c$ = ""
                           For i = 1 To k
                              a$ = *pop3\GetMailPartHeader(i)
                              ;Message-Id:
                              If i = 1
                                 ;From will be in the main header
                                 b$ = *pop3\GetHeaderField(a$, "From")
                                 SetGadgetText(#String_From, b$)
                              EndIf
                              b$ = *pop3\GetHeaderField(a$, "Content-Type")
                              If FindString(LCase(b$), "text/html", 1)
                                 c$ = *pop3\GetMailPartBody(i)
                                 If c$ <> ""
                                    c$ = *pop3\CheckHTMLFormat(a$, c$)
                                    c$ = CheckMailForInlinePics(c$)
                                    LoadWebGadget(#WebView_Mail, c$)
                                    Break
                                 EndIf
                              EndIf
                           Next i
                           If c$ = ""
                              ;nothing found? Use first Part with content
                              For i = 1 To k
                                 a$ = *pop3\GetMailPartBody(i)
                                 If a$ And FindString(a$, "this is a multi-part message in mime format", 1, #PB_String_NoCase) = 0
                                    Break
                                 EndIf
                              Next i
                              c$ = "<html><head>" + #CRLF$
                              c$ + "<meta http-equiv=" + #DQUOTE$ + "content-type" + #DQUOTE$ + " content=" + #DQUOTE$ + b$ + #DQUOTE$ + ">" + #CRLF$
                              c$ + "</head><body><p>" + ReplaceString(a$, #CRLF$, "<br>") + "</p></body></html>"
                              LoadWebGadget(#WebView_Mail, c$)
                           EndIf
                           k = *pop3\CountAttachments()
                           For i = 1 To k
                              AddGadgetItem(#ListIcon_Attachments, -1, *pop3\GetAttachmentName(i))
                           Next i
                        Case #POP3_ERROR_NO_CONNECTION
                           LoadWebGadget(#WebView_Mail, "<html><head></head><body><b>Error!<br>" + #CRLF$ + "It seems we lost connection to the server!</b></body></html>")
                           Connected = #False
                           SetGadgetText(#Button_Connect, "Connect")
                           ClearGadgetItems(#ListIcon_Attachments)
                           ClearGadgetItems(#Tree_Mails)
                        Case #POP3_ERROR_NO_MAIL_LOADED
                           a$ = *pop3\GetLastResponse()
                           LoadWebGadget(#WebView_Mail, "<html><head></head><body><b>Error!<br>" + #CRLF$ + "Unable to load Mail!<br>" + #CRLF$ + "Server message: " + a$ + "</b></body></html>")
                        Case #POP3_ERROR_TIMED_OUT
                           LoadWebGadget(#WebView_Mail, "<html><head></head><body><b>Error!<br>" + #CRLF$ + "Server needs too long to answer!</b></body></html>")
                        Case #POP3_ERROR_SENDING
                           LoadWebGadget(#WebView_Mail, "<html><head></head><body><b>Error!<br>" + #CRLF$ + "Error, when trying to send to the server!" + #CRLF$ + "(Server disconnected?)</b></body></html>")
                        Default
                           LoadWebGadget(#WebView_Mail, "<html><head></head><body><b>Error!<br>" + #CRLF$ + "Error #:" + Str(*pop3\GetLastError()) + "</b></body></html>")
                     EndSelect
               EndSelect
               DisableGadget(#Button_Connect, 0)
               DisableGadget(#Button_SaveMail, 0)
               DisableGadget(#Tree_Mails, 0)
               StatusBarText(0, 1, "")
            EndIf
      EndSelect
   ForEver

   ;Clean Up
   ForEach Tempfiles()
      DeleteFile(Tempfiles())
   Next
   CompilerIf #PB_Compiler_OS <> #PB_OS_Windows
   DeleteFile(GetTemporaryDirectory() + "pop3_example.html")
   CompilerEndIf

EndProcedure


main()

_________________
malleo, caput, bang. Ego, comprehendunt in tempore


Top
 Profile  
Reply with quote  
 Post subject: Re: POP3 Include (crossplatform)
PostPosted: Sat Feb 09, 2019 8:45 pm 
Offline
User
User
User avatar

Joined: Tue Oct 06, 2009 9:11 pm
Posts: 87
thanks for sharing, code is compileable but didn't connect to the mail server.

_________________
Repeat
PureBasic
ForEver


Top
 Profile  
Reply with quote  
 Post subject: Re: POP3 Include (crossplatform)
PostPosted: Sat Feb 09, 2019 10:26 pm 
Offline
Always Here
Always Here
User avatar

Joined: Thu Jun 24, 2004 2:44 pm
Posts: 5755
Location: Berlin - Germany
Quote:
;| No SSL/TLS Supported!

_________________
PureBasic 5.71 | SpiderBasic 2.21 | Windows 10 Pro (x64) | Linux Mint 19.2 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image


Top
 Profile  
Reply with quote  
 Post subject: Re: POP3 Include (crossplatform)
PostPosted: Sun Feb 10, 2019 9:03 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Mon Sep 20, 2004 7:12 am
Posts: 519
Location: Hell
This code is from a time, where unsecured mail traffic was quite common, today it is more or less useless!
You will have problems finding a mail provider who accepts unsecured mail transfer.

_________________
Link dead?
Change h3x0r.ath.cx into hex0rs.coderbu.de and all will be fine.


Top
 Profile  
Reply with quote  
 Post subject: Re: POP3 Include (crossplatform)
PostPosted: Mon Feb 11, 2019 12:18 am 
Offline
Addict
Addict

Joined: Sun Sep 07, 2008 12:45 pm
Posts: 4461
Location: Germany
That was the reason why I compiled a version of libcurl with imap and imaps inside.
A feature request is still open about this.


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 39 posts ]  Go to page Previous  1, 2, 3

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 4 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye