POP3 Include (crossplatform)

Share your advanced PureBasic knowledge/code with the community.
User avatar
bobobo
Enthusiast
Enthusiast
Posts: 202
Joined: Mon Jun 09, 2003 8:30 am

Re: POP3 Include (crossplatform)

Post by bobobo »

noon gates :mrgreen:

well done my friend
사십 둘 .
SeregaZ
Enthusiast
Enthusiast
Posts: 617
Joined: Fri Feb 20, 2009 9:24 am
Location: Almaty (Kazakhstan. not Borat, but Triple G)
Contact:

Re: POP3 Include (crossplatform)

Post by SeregaZ »

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.
User avatar
A.D.
User
User
Posts: 98
Joined: Tue Oct 06, 2009 9:11 pm

Re: POP3 Include (crossplatform)

Post by A.D. »

does anybody have an updated version of this include for newer PB-Versions?
Repeat
PureBasic
ForEver
User avatar
GG
Enthusiast
Enthusiast
Posts: 257
Joined: Tue Jul 26, 2005 12:02 pm
Location: Lieusaint (77), France

Re: POP3 Include (crossplatform)

Post by GG »

+1
Purebasic 6.04 64 bits - Windows 11 Pro 64 bits 23H2
User avatar
Zebuddi123
Enthusiast
Enthusiast
Posts: 794
Joined: Wed Feb 01, 2012 3:30 pm
Location: Nottinghamshire UK
Contact:

Re: POP3 Include (crossplatform)

Post by Zebuddi123 »

Hi Updated to 5.70 but not tested

Code: Select all

;+-------------------------+
;|
;| 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
User avatar
A.D.
User
User
Posts: 98
Joined: Tue Oct 06, 2009 9:11 pm

Re: POP3 Include (crossplatform)

Post by A.D. »

thanks for sharing, code is compileable but didn't connect to the mail server.
Repeat
PureBasic
ForEver
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Re: POP3 Include (crossplatform)

Post by ts-soft »

;| No SSL/TLS Supported!
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
User avatar
HeX0R
Addict
Addict
Posts: 980
Joined: Mon Sep 20, 2004 7:12 am
Location: Hell

Re: POP3 Include (crossplatform)

Post by HeX0R »

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.
infratec
Always Here
Always Here
Posts: 6817
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: POP3 Include (crossplatform)

Post by infratec »

That was the reason why I compiled a version of libcurl with imap and imaps inside.
A feature request is still open about this.
BarryG
Addict
Addict
Posts: 3292
Joined: Thu Apr 18, 2019 8:17 am

Re: POP3 Include (crossplatform)

Post by BarryG »

@Hexor: Any way to update this to use SSL, so it can be used with Gmail? Or does anyone else know how to do it?
infratec
Always Here
Always Here
Posts: 6817
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: POP3 Include (crossplatform)

Post by infratec »

You can use libcurl.pbi with the external dll.
There is pop3s included.

viewtopic.php?p=591235
BarryG
Addict
Addict
Posts: 3292
Joined: Thu Apr 18, 2019 8:17 am

Re: POP3 Include (crossplatform)

Post by BarryG »

infratec wrote: Fri Nov 17, 2023 11:58 amThere is pop3s included.
Already tried that -> viewtopic.php?t=82886

But there's no POP3 example with it?
Oso
Enthusiast
Enthusiast
Posts: 595
Joined: Wed Jul 20, 2022 10:09 am

Re: POP3 Include (crossplatform)

Post by Oso »

BarryG wrote: Fri Nov 17, 2023 11:49 am @Hexor: Any way to update this to use SSL, so it can be used with Gmail? Or does anyone else know how to do it?
I believe it's possible to do with libcurl Barry. I can't see a POP3 example in Infratec's package, but the example code in C is very simple to follow at the link to the libcurl site here : https://curl.se/libcurl/c/pop3-ssl.html and then just start with another download-equivalent protocol from Infratec's.
User avatar
HeX0R
Addict
Addict
Posts: 980
Joined: Mon Sep 20, 2004 7:12 am
Location: Hell

Re: POP3 Include (crossplatform)

Post by HeX0R »

BarryG wrote: Fri Nov 17, 2023 11:49 am @Hexor: Any way to update this to use SSL, so it can be used with Gmail? Or does anyone else know how to do it?
I must admit, I had no more use for this, but I could imagine it might work with the help of the TLS include.

Maybe, in some future, I'll look into it.
libcurl doesn't contain any mail parser as far as I know (but to be true, I didn't play very long with it), but that would be something I need.

The solution from RSBasic was pretty good for my task, but it had some non-fixable limitations unfortunately. And it is windows only.

[Edit]
btw.:
For gmail, you need to create App passwords
User avatar
HeX0R
Addict
Addict
Posts: 980
Joined: Mon Sep 20, 2004 7:12 am
Location: Hell

Re: POP3 Include (crossplatform)

Post by HeX0R »

o.k., I made it work with gmail, app password and the TLS.pbi I was talking about.
Code updated.
This is a proof of concept, it can freeze when looking into mails.
Fixing that has not very high priority on my todo list, so don't expect fixes anytime soon.
Take it, improve it, or leave it.
(But be warned! That code is from more than 10 years ago, I wouldn't code in that (ugly) style today!)
Post Reply