POP3 Include (crossplatform)
-
- Enthusiast
- Posts: 619
- Joined: Fri Feb 20, 2009 9:24 am
- Location: Almaty (Kazakhstan. not Borat, but Triple G)
- Contact:
Re: POP3 Include (crossplatform)
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.
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.
Re: POP3 Include (crossplatform)
does anybody have an updated version of this include for newer PB-Versions?
Repeat
PureBasic
ForEver
PureBasic
ForEver
- Zebuddi123
- Enthusiast
- Posts: 794
- Joined: Wed Feb 01, 2012 3:30 pm
- Location: Nottinghamshire UK
- Contact:
Re: POP3 Include (crossplatform)
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
Re: POP3 Include (crossplatform)
thanks for sharing, code is compileable but didn't connect to the mail server.
Repeat
PureBasic
ForEver
PureBasic
ForEver
Re: POP3 Include (crossplatform)
;| 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.
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Re: POP3 Include (crossplatform)
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.
You will have problems finding a mail provider who accepts unsecured mail transfer.
{Home}.:|:.{Dialog Design0R}.:|:.{Codes}.:|:.{Downloads}.:|:.{History Viewer Online}
Re: POP3 Include (crossplatform)
That was the reason why I compiled a version of libcurl with imap and imaps inside.
A feature request is still open about this.
A feature request is still open about this.
Re: POP3 Include (crossplatform)
@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?
Re: POP3 Include (crossplatform)
Re: POP3 Include (crossplatform)
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.
Re: POP3 Include (crossplatform)
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
{Home}.:|:.{Dialog Design0R}.:|:.{Codes}.:|:.{Downloads}.:|:.{History Viewer Online}
Re: POP3 Include (crossplatform)
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!)
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!)
{Home}.:|:.{Dialog Design0R}.:|:.{Codes}.:|:.{Downloads}.:|:.{History Viewer Online}