POP3 Include (crossplatform)

Share your advanced PureBasic knowledge/code with the community.
User avatar
HeX0R
Addict
Addict
Posts: 980
Joined: Mon Sep 20, 2004 7:12 am
Location: Hell

POP3 Include (crossplatform)

Post by HeX0R »

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

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
..and, an example says more than a thousand words ;)

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()
Have fun!
Last edited by HeX0R on Sat Nov 18, 2023 8:39 pm, edited 12 times in total.
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 »

Image Great stuff
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 »

V01.001 (02.11.2012)
- Changed Timeout to default 10 Seconds (had problems with heavy net-traffic)
- Added a few more error messages
- Changed example, now also showing from whom the mail came from and showing more error messages
- Made the receiving-procedure more robust
- Fixed two bugs
User avatar
idle
Always Here
Always Here
Posts: 5042
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: POP3 Include (crossplatform)

Post by idle »

Nice work! thanks
Windows 11, Manjaro, Raspberry Pi OS
Image
IdeasVacuum
Always Here
Always Here
Posts: 6425
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Re: POP3 Include (crossplatform)

Post by IdeasVacuum »

Brilliant stuff! :mrgreen:
I also had a look at this project from cptdark, but this was way to oversized for my needs.
scary :shock:
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
User avatar
HeX0R
Addict
Addict
Posts: 980
Joined: Mon Sep 20, 2004 7:12 am
Location: Hell

Re: POP3 Include (crossplatform)

Post by HeX0R »

V01.002 (03.11.2012)
- Fixed: Now showing UTF-8 Subjects base64 encoded correctly (depending on the characters used, you will only see this when unicode activated).
IdeasVacuum wrote:
I also had a look at this project from cptdark, but this was way to oversized for my needs.
scary :shock:
Indeed :mrgreen:
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: POP3 Include (crossplatform)

Post by Kwai chang caine »

Wonderfull !!! Your code works very good.
Thanks to you, TsSoft, cptdark, Infratec, finally a way for replace Outlook express, Outlook, Thunderbird ,etc ...with a PB open source tool :shock:
One thousand of thanks Hexor and all other for sharing your great code. 8)

Except perhaps, the picture including in the mail.
I have sending a JPG by attachement, and include a picture in the body for the try.
The picture in attachment appears, but the picture in the body i have a square with red cross inside, is it normal ??? :(
ImageThe happiness is a road...
Not a destination
User avatar
HeX0R
Addict
Addict
Posts: 980
Joined: Mon Sep 20, 2004 7:12 am
Location: Hell

Re: POP3 Include (crossplatform)

Post by HeX0R »

Kwaï chang caïne wrote:Except perhaps, the picture including in the mail.
I have sending a JPG by attachement, and include a picture in the body for the try.
The picture in attachment appears, but the picture in the body i have a square with red cross inside, is it normal ??? :(
It's not that easy to show those embedded pictures.
See this article.

In short:
- You have to search the html-code for <img src="cid:HERE_IS_THE_ID"
- Then search all email-part-headers for a Content-ID: HERE_IS_THE_ID
- If you found the email-part, you have to save the content to disk (not yet possible, will be added)
- Then replace the HERE_IS_THE_ID of your sourcecode with the path and filename of your saved pic.

Not that trivial... if it would be that easy to create an email-client we would get flooded by such programs ;)
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 added the functionality to save mail bodys also to disk.

Also i changed the example to add (not that clever) inline picture showing.
There is more work to do, to make it failsafe, but it should be enough to see how it has to be done.
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: POP3 Include (crossplatform)

Post by Kwai chang caine »

Thanks, i have try and the picture not appears in the body, but she appears in the Attachment stringGadget.
ImageThe happiness is a road...
Not a destination
User avatar
HeX0R
Addict
Addict
Posts: 980
Joined: Mon Sep 20, 2004 7:12 am
Location: Hell

Re: POP3 Include (crossplatform)

Post by HeX0R »

As i wrote, it is not perfect.
I'm quite sure you can solve it on your own when you are reading what i wrote above.

You can rightclick a webgadget and look at it's source, then you should see what's wrong.
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: POP3 Include (crossplatform)

Post by Kwai chang caine »

I have right clicked, on the webGadget and have this, nowhere the picture is mentioned

Code: Select all

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML><HEAD>
<META http-equiv=Content-Type content="text/html; charset=iso-8859-1">
<META content="MSHTML 6.00.5730.13" name=GENERATOR>
<STYLE></STYLE>
</HEAD>
<BODY bgColor=#ffffff>
<DIV><FONT face=Arial size=2>hello </FONT></DIV>
<DIV>&nbsp;</DIV>
<DIV><FONT face=Arial size=2>Goodbye</FONT></DIV></BODY></HTML>
Never mind, if it's too difficult to do. :wink:

You have already do a enormous works with your great code. 8)
It's not the first time i see splendid codes of you 8)
I take this opportunity, to thank you and express my admiration, for all codes of crazy that you have already provided :shock: 8)

Have a good day, and thanks again for having tried to answer my request 8)
ImageThe happiness is a road...
Not a destination
User avatar
HeX0R
Addict
Addict
Posts: 980
Joined: Mon Sep 20, 2004 7:12 am
Location: Hell

Re: POP3 Include (crossplatform)

Post by HeX0R »

If this is anything inside your webgadget you didn't insert the picture.
You said above, you see a square with a red cross, which indicates, that the picture have been inserted (not attached),
then you should see it with the updated code.

If you attach pictures, most email clients show them at the end of the mail, but they are not really inside the html source.
This would also be possible, just add them above </body> for example.
IdeasVacuum
Always Here
Always Here
Posts: 6425
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Re: POP3 Include (crossplatform)

Post by IdeasVacuum »

Well, just deleted a nice post describing a problem I was having - and that helped me to spot my error :)
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
User avatar
bobobo
Enthusiast
Enthusiast
Posts: 202
Joined: Mon Jun 09, 2003 8:30 am

Re: POP3 Include (crossplatform)

Post by bobobo »

very nice .. but
mails sent with opera mail (standaloneVersion) (and attachement) will not show correct in the demo-appliation above.
(those mails will show correct with usual emailclients)


Dont know how to check what goes wrong. This PBI is too complex for me to even put in some debug-code to surround this
behaviour
사십 둘 .
Post Reply