Elle est très bien et plus avancée que l'include qui suit.
Mais ce code permet de programmer dans le style OOP
et puis c'est un petit exercice sympa.
pour le moment il manque deux choses très importantes (todo) :
- l'authentification
- les pièces jointes
Code : Tout sélectionner
;-
;- Title: IEMAIL.pbi
;- Version: 1.0
;- Author: flype - flype44 (at) gmail (.) com
;-
;- Compiler: PureBasic 4.02
;-
;- Description: Simple OOP include for sending mails
;- It use PureBasic functions, so it should be cross-platform (not tested).
;-
EnableExplicit
;-
;- CONSTANTS - PUBLIC
;-
Enumeration 1 ; #EMAIL_PRIORITY
#EMAIL_PRIORITY_HIGHEST
#EMAIL_PRIORITY_HIGH
#EMAIL_PRIORITY_NORMAL
#EMAIL_PRIORITY_LOW
#EMAIL_PRIORITY_LOWEST
EndEnumeration
;-
;- PROCEDURES - PRIVATE
;-
#IEMAIL_EHLO = "purebasic"
If Not InitNetwork() ;{
MessageRequester("Error", "InitNetwork() failed !", #MB_ICONERROR)
End
EndIf ;}
Structure IEMAIL_VTABLE
*hAttachment
*hBcc
*hBody
*hCc
*hContentType
*hDestroy
*hFooter
*hLogin
*hMailFrom
*hMailTo
*hNotify
*hPriority
*hReplyTo
*hSend
*hServer
*hSubject
*hTimeOut
*hXMailer
EndStructure
Structure SEMAIL
*vt.IEMAIL_VTABLE
*hCallBack
ServerID.l
ServerName.s
ServerPort.l
ServerTimeOut.l
UserName.s
UserPassword.s
XMailer.s
ContentType.s
MailFrom.s
MailReplyTo.s
MailTo.s
MailCC.s
MailBcc.s
MailAttachment.s
MailSubject.s
MailBody.s
MailFooter.s
MailPriority.l
MailNotify.l
EndStructure
Interface IEMAIL
Attachment(string.s) ; [...]
Bcc(string.s) ; [...]
Body(string.s) ; [...]
Cc(string.s) ; [...]
ContentType(string.s) ; Set the content type.
Destroy() ; Destroy this object.
Footer(string.s) ; [...]
Login(UserName.s, UserPwd.s) ; [...]
MailFrom(string.s) ; Set the `From` email address.
MailTo(string.s) ; Set the `To` email address.
Notify(TrueOrFalse.l) ; [...]
Priority(Priority.l) ; [...]
ReplyTo(string.s) ; [...]
Send() ; Send the email.
Server(ServerName.s, ServerPort.l = 25) ; Set the name and the port number of the SMTP server.
Subject(string.s) ; [...]
TimeOut(MilliSecs.l) ; [...]
XMailer(string.s) ; [...]
EndInterface
Procedure.l Email_Read(*self.SEMAIL)
Protected Timer.l, Index.l, BufferLength.l, BufferString.s, ResponseLength.l, ResponseString.s
Timer = ElapsedMilliseconds()
Repeat
If NetworkClientEvent(*self\ServerID) = #PB_NetworkEvent_Data
BufferLength = 1024
BufferString = Space(BufferLength)
ResponseLength = ReceiveNetworkData(*self\ServerID, @BufferString, BufferLength)
If ResponseLength
Repeat
Index + 1
ResponseString = Trim(StringField(BufferString, Index, #LF$))
If *self\hCallBack And ResponseString
CallFunctionFast(*self\hCallBack, #True, Val(Left(ResponseString, 3)), Mid(ResponseString, 5, Len(ResponseString) - 5))
EndIf
Until Not ResponseString
ProcedureReturn Val(Left(BufferString, 3))
EndIf
EndIf
If *self\hCallBack
CallFunctionFast(*self\hCallBack, #False, #Null, "WAIT")
EndIf
Delay(50)
Until (ElapsedMilliseconds() - Timer) > *self\ServerTimeOut
If *self\hCallBack
CallFunctionFast(*self\hCallBack, #False, #Null, "TIMEOUT")
EndIf
EndProcedure
Procedure.l Email_Write(*self.SEMAIL, string.s)
If *self\hCallBack
CallFunctionFast(*self\hCallBack, #False, #Null, ReplaceString(string, #CRLF$, "\n"))
EndIf
string + #CRLF$
ProcedureReturn SendNetworkData(*self\ServerID, @string, Len(string))
EndProcedure
Procedure.l Email_Dialog(*self.SEMAIL, string.s)
If Email_Write(*self, string)
ProcedureReturn Email_Read(*self)
EndIf
EndProcedure
Procedure.l Email_Attachment(*self.SEMAIL, string.s) ; ***** TODO *****
*self\MailAttachment = string
EndProcedure
Procedure.l Email_Bcc(*self.SEMAIL, string.s)
If *self\MailBcc
*self\MailBcc + ", "
EndIf
*self\MailBcc + string
EndProcedure
Procedure.l Email_Body(*self.SEMAIL, string.s)
*self\MailBody + string + #CRLF$
EndProcedure
Procedure.l Email_Cc(*self.SEMAIL, string.s)
If *self\MailCC
*self\MailCC + ", "
EndIf
*self\MailCC + string
EndProcedure
Procedure.l Email_ContentType(*self.SEMAIL, string.s)
*self\ContentType = string
EndProcedure
Procedure.l Email_Destroy(*self.SEMAIL)
If *self
If *self\vt
FreeMemory(*self\vt)
EndIf
FreeMemory(*self)
EndIf
EndProcedure
Procedure.l Email_Footer(*self.SEMAIL, string.s)
If Not *self\MailFooter
*self\MailFooter = "____________________________" + #CRLF$
EndIf
*self\MailFooter + string + #CRLF$
EndProcedure
Procedure.l Email_Login(*self.SEMAIL, UserName.s, UserPassword.s) ; ***** TODO *****
*self\UserName = UserName
*self\UserPassword = UserPassword
EndProcedure
Procedure.l Email_MailFrom(*self.SEMAIL, string.s)
*self\MailFrom = "<" + string + ">"
EndProcedure
Procedure.l Email_MailTo(*self.SEMAIL, string.s)
*self\MailTo = "<" + string + ">"
EndProcedure
Procedure.l Email_Notify(*self.SEMAIL, TrueOrFalse.l)
*self\MailNotify = TrueOrFalse
EndProcedure
Procedure.l Email_Priority(*self.SEMAIL, Priority.l)
*self\MailPriority = Priority
EndProcedure
Procedure.l Email_ReplyTo(*self.SEMAIL, string.s)
*self\MailReplyTo = string
EndProcedure
Procedure.l Email_Send(*self.SEMAIL)
Protected result.l
*self\ServerID = OpenNetworkConnection(*self\ServerName, *self\ServerPort, #PB_Network_TCP)
If *self\ServerID
If Email_Read(*self) = 220
If Email_Dialog(*self, "EHLO " + #IEMAIL_EHLO) = 250
If Email_Dialog(*self, "MAIL FROM: " + *self\MailFrom) = 250
If Email_Dialog(*self, "RCPT TO: " + *self\MailTo) = 250
If Email_Dialog(*self, "DATA") = 354
If *self\ContentType
Email_Write(*self, "ContentType: " + *self\ContentType)
EndIf
If *self\MailReplyTo
Email_Write(*self, "Reply-To: " + *self\MailReplyTo)
EndIf
If *self\MailPriority
Email_Write(*self, "X-Priority: " + Str(*self\MailPriority))
EndIf
If *self\XMailer
Email_Write(*self, "X-Mailer: " + *self\XMailer)
EndIf
If *self\MailNotify
Email_Write(*self, "Disposition-Notification-To: " + *self\MailTo)
EndIf
Email_Write(*self, "Date: ")
Email_Write(*self, "From: " + *self\MailFrom)
Email_Write(*self, "To: " + *self\MailTo)
If *self\MailCC
Email_Write(*self, "Cc: " + *self\MailCC)
EndIf
If *self\MailBcc
Email_Write(*self, "Bcc: " + *self\MailBcc)
EndIf
Email_Write(*self, "Subject: " + *self\MailSubject)
Email_Write(*self, *self\MailBody)
If *self\MailFooter
Email_Write(*self, *self\MailFooter)
EndIf
If Email_Dialog(*self, #CRLF$ + ".") = 250
result = #True
EndIf
EndIf
EndIf
EndIf
EndIf
Email_Dialog(*self, "QUIT")
EndIf
CloseNetworkConnection(*self\ServerID)
EndIf
ProcedureReturn result
EndProcedure
Procedure.l Email_Server(*self.SEMAIL, name.s, Port.l = 25)
*self\ServerName = name
*self\ServerPort = Port
EndProcedure
Procedure.l Email_Subject(*self.SEMAIL, string.s)
*self\MailSubject = string
EndProcedure
Procedure.l Email_TimeOut(*self.SEMAIL, MilliSecs.l)
*self\ServerTimeOut = MilliSecs
EndProcedure
Procedure.l Email_XMailer(*self.SEMAIL, name.s)
*self\XMailer = name
EndProcedure
;-
;- PROCEDURES - PUBLIC
;-
ProcedureDLL.l Email(*hCallBack = #Null) ; Create a new email object.
Protected *this.SEMAIL = AllocateMemory(SizeOf(SEMAIL))
If *this
*this\vt = AllocateMemory(SizeOf(IEMAIL_VTABLE))
If *this\vt
*this\vt\hAttachment = @Email_Attachment()
*this\vt\hBcc = @Email_Bcc()
*this\vt\hBody = @Email_Body()
*this\vt\hCc = @Email_Cc()
*this\vt\hContentType = @Email_ContentType()
*this\vt\hDestroy = @Email_Destroy()
*this\vt\hLogin = @Email_Login()
*this\vt\hMailFrom = @Email_MailFrom()
*this\vt\hMailTo = @Email_MailTo()
*this\vt\hNotify = @Email_Notify()
*this\vt\hPriority = @Email_Priority()
*this\vt\hReplyTo = @Email_ReplyTo()
*this\vt\hSend = @Email_Send()
*this\vt\hServer = @Email_Server()
*this\vt\hFooter = @Email_Footer()
*this\vt\hSubject = @Email_Subject()
*this\vt\hTimeOut = @Email_TimeOut()
*this\vt\hXMailer = @Email_XMailer()
*this\hCallBack = *hCallBack
*this\ServerID = #Null
*this\ServerName = #Null$
*this\ServerPort = 25
*this\ServerTimeOut = 5000
*this\UserName = #Null$
*this\UserPassword = #Null$
*this\XMailer = #Null$
*this\ContentType = #Null$
*this\MailFrom = #Null$
*this\MailReplyTo = #Null$
*this\MailTo = #Null$
*this\MailCC = #Null$
*this\MailBcc = #Null$
*this\MailAttachment = #Null$
*this\MailSubject = #Null$
*this\MailBody = #Null$
*this\MailPriority = #Null
*this\MailNotify = #False
ProcedureReturn *this
EndIf
FreeMemory(*this)
EndIf
EndProcedure
ProcedureDLL.l SendMail(MailTo.s, MailFrom.s, MailSubject.s, MailBody.s, ServerName.s, ServerPort.l = 25) ; Send an email.
Protected result.l, x.IEMAIL = Email()
If x
x\Server(ServerName, ServerPort)
x\MailFrom(MailFrom)
x\MailTo(MailTo)
x\Subject(MailSubject)
x\Body(MailBody)
result = x\Send()
x\Destroy()
EndIf
ProcedureReturn result
EndProcedure
;-
;- END OF INCLUDE
;-
DisableExplicit
Et un exemple d'utilisation.
Il faut bien entendu modifier votre serveur SMTP.
Code : Tout sélectionner
IncludeFile #PB_Compiler_Home + "Includes\IEMAIL.pbi"
Procedure.l myCallBack(InOut.l, ServerStatus.l, ServerMessage.s)
If InOut
Debug "<<< [" + RSet(Str(ServerStatus), 3, "0") + "] " + ServerMessage
Else
Debug ">>>"
EndIf
EndProcedure
x.IEMAIL = Email(@myCallBack())
If x
x\TimeOut (20000)
x\XMailer ("MyMailer")
x\Priority(#EMAIL_PRIORITY_LOWEST)
x\Server ("smtp.orange.fr")
x\Subject ("[TEST] Essai de mail envoyé depuis PureBasic.")
x\MailFrom("test@test.fr")
x\MailTo ("flype44@gmail.com")
;x\ReplyTo ("flype44@gmail.com")
x\Body ("Hello world !")
x\Body ("çà marche ?")
x\Footer ("flype - flype44(at)gmail(.)com")
If x\Send()
Debug "Message envoyé !"
Else
Debug "Echec d'envoi du message !"
EndIf
x\Destroy()
EndIf
faites en ce que vous voulez.
.