POP3 Include (crossplatform)
Posted: Thu Nov 01, 2012 11:50 pm
Now, that we have sendmail from ts-soft, we also could need the opposite.
Well, o.k., in fact i were in need of pop3-functionality for a tool i've created.
I also had a look at this project from cptdark, but this was way to oversized for my needs.
As always i'm very lazy with comments, i hope the example below will help to understand how things are working.
[Edit 18.11.2023]
- restructured example and pop3.pbi, should be clearer now how to use
- improved performance of QuotedPrintable decoding.
[Edit 17.11.2023]
- Added TLS support (you need this include and a compiled libtls library)
pop3.pbi
..and, an example says more than a thousand words
Have fun!
Well, o.k., in fact i were in need of pop3-functionality for a tool i've created.
I also had a look at this project from cptdark, but this was way to oversized for my needs.
As always i'm very lazy with comments, i hope the example below will help to understand how things are working.
[Edit 18.11.2023]
- restructured example and pop3.pbi, should be clearer now how to use
- improved performance of QuotedPrintable decoding.
[Edit 17.11.2023]
- Added TLS support (you need this include and a compiled libtls library)
pop3.pbi
Code: Select all
;+-------------------------+
;|
;| pop3.pbi
;|
;| V01.009 ©HeX0R
;| 18.11.2023
;|
;| Include to read mails
;| from a pop3 server
;|
;| [x] windows
;| [x] linux
;| [x] mac
;| [x] x86
;| [x] x64
;| [x] unicode
;| [x] SSL/TLS
;| [ ] make lunch
;|
;| - for SSL/TLS, you need the TLS.pbi from here:
;| - https://www.purebasic.fr/english/viewtopic.php?p=593738#p593738
;| - and the libtls.dll or libtls.a (see remarks in TLS.pbi)
;+-------------------------+
CompilerIf #PB_Compiler_Version < 560
UseMD5Fingerprint()
CompilerEndIf
CompilerIf Defined(PB_SORT_INTEGER, #PB_Constant) = 0
#PB_Sort_Integer = #PB_Integer
CompilerEndIf
Interface POP3_INTERFACE
GetLastError.i()
GetLastResponse.s()
Connect.i(Pop3Server.s, Pop3Port.i, Username.s, Password.s, TimeOUT.i = 10000, Flags.i = #PB_Default)
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
IsSecured.i
List MailParts._POP3_MAIL_PARTS_()
EndStructure
Structure _QPHelpD_
a.a[0]
EndStructure
Structure _QPHelpS_
c.c[0]
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, Value, a$, i, Pos
Protected *Source._QPHelpS_ = @Text
Protected *Dest._QPHelpD_ = AllocateMemory(StringByteLength(Text) + 2)
;Restore the quoted-printable text
If *Dest
While *Source\c[i]
If *Source\c[i] <> '='
*Dest\a[Pos] = *Source\c[i]
Pos + 1
ElseIf *Source\c[i + 1] = #CR And *Source\c[i + 2] = #LF
;ignore the #crlf$
i + 2
Else
a$ = Chr(*Source\c[i + 1]) + Chr(*Source\c[i + 2])
Value = Val("$" + a$)
*Dest\a[Pos] = Value
Pos + 1
i + 2
EndIf
i + 1
Wend
Result = PeekS(*Dest, - 1, CS)
FreeMemory(*Dest)
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)
CompilerIf #PB_Compiler_Version < 560
i = Base64Decoder(@Buff1, j, @Buff2, j * 2)
CompilerElse
i = Base64DecoderBuffer(@Buff1, j, @Buff2, j * 2)
CompilerEndIf
CompilerElse
j = Len(Pattern)
Buff2 = Space(j * 2)
CompilerIf #PB_Compiler_Version < 560
i = Base64Decoder(@Pattern, j, @Buff2, j * 2)
CompilerElse
i = Base64DecoderBuffer(@Pattern, j, @Buff2, j * 2)
CompilerEndIf
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
Delay(0)
EndSelect
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)
CompilerIf #PB_Compiler_Version < 560
i = Base64Decoder(@Buff1, j, *Buffer, L)
CompilerElse
i = Base64DecoderBuffer(@Buff1, j, *Buffer, L)
CompilerEndIf
*Buffer = ReAllocateMemory(*Buffer, i)
CompilerElse
*Buffer = AllocateMemory(L)
CompilerIf #PB_Compiler_Version < 560
i = Base64Decoder(@Body, j, *Buffer, L)
CompilerElse
i = Base64Decoder(@Body, j, *Buffer, L)
CompilerEndIf
*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)
CompilerIf #PB_Compiler_Version < 540
Result = MD5Fingerprint(*Buffer, Len(String))
CompilerElse
Result = Fingerprint(*Buffer, Len(String), #PB_Cipher_MD5)
CompilerEndIf
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 = 10000, Flags.i = #PB_Default)
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
CompilerIf Defined(PB_Network_TLSv1, #PB_Constant)
If Flags & #PB_Network_TLSv1
*THIS\IsSecured = #True
Flags = #PB_Network_TCP | Flags
Else
Flags = #PB_Network_TCP
EndIf
CompilerElse
Flags = #PB_Network_TCP
CompilerEndIf
*THIS\ConnectionID = OpenNetworkConnection(Pop3Server, Pop3Port, Flags)
If *THIS\ConnectionID = 0
*THIS\LastError = #POP3_ERROR_NO_CONNECTION
FreeMemory(*THIS\Buffer)
*THIS\Buffer = #Null
Else
If *THIS\IsSecured = #False
;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
EndIf
EndIf
EndIf
If *THIS\IsSecured Or (*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
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
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 = AllocateStructure(_POP3_MAIN_STRUCTURE_)
If *POP3
*POP3\VTable = ?_POP3_PROCEDURES_
EndIf
ProcedureReturn *POP3
EndProcedure
Procedure ReleasePop3Object(*POP3._POP3_MAIN_STRUCTURE_)
FreeStructure(*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
Code: Select all
EnableExplicit
CompilerIf #PB_Compiler_Version < 600
InitNetwork()
CompilerEndIf
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
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 LIBTLSFILE$ = "libtls-26.dll" ;<- change to your version and add the path to it in case it is not in the same folder
XIncludeFile "TLS.pbi" ;<- https://www.purebasic.fr/english/viewtopic.php?p=593738#p593738
XIncludeFile "pop3.pbi" ;<- https://www.purebasic.fr/english/viewtopic.php?t=51959
Global POP3.POP3_INTERFACE = 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
If TLSG\DLL = 0
MessageRequester("Warning", "No TLS active!" + #LF$ + "Please check your libtls-xx.dll path", #PB_MessageRequester_Warning)
EndIf
;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), 10000, #PB_Network_TLSv1_2)
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.gmail.com")
TextGadget(#PB_Any, 330, 7, 40, 20, "Port:")
StringGadget(#String_Port, 380, 5, 70, 22, "995")
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, 575, 10, 125, 45, "Connect")
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_Connect
If Connected
POP3\Disconnect()
Connected = #False
SetGadgetText(#Button_Connect, "Connect")
ClearGadgetItems(#ListIcon_Attachments)
ClearGadgetItems(#Tree_Mails)
SetGadgetText(#String_From, "")
LoadWebGadget(#WebView_Mail, "")
Else
StatusBarText(0, 1, "Connecting Server...")
DisableGadget(#Button_Connect, 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(#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
c$ = "<html><head>" + #CRLF$
c$ + "<meta http-equiv=" + #DQUOTE$ + "content-type" + #DQUOTE$ + " content=" + #DQUOTE$ + b$ + #DQUOTE$ + ">" + #CRLF$
c$ + "</head><body><pre>" + ReplaceString(POP3\GetMailPartBody(1), #CRLF$, "<br>") + "</pre></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(#Tree_Mails, 0)
StatusBarText(0, 1, "")
EndIf
EndSelect
ForEver
;Clean Up
ForEach Tempfiles()
DeleteFile(Tempfiles())
Next
DeleteFile(GetTemporaryDirectory() + "pop3_example.html")
ReleasePop3Object(POP3)
FreeSemaphore(Pop3_Semaphore)
FreeMutex(Pop3_Mutex)
EndProcedure
main()
Great stuff
