- a basic to master the web -
https://forums.spiderbasic.com/
Code: Select all
DeclareModule Mail
EnableExplicit
Declare.i AddMailAttachment(mail.i,description$,fileName$,mimeType$="")
Declare.i AddMailAttachmentData(mail.i,description$,*Buffer,BufferLength,mimeType$="")
Declare.i AddMailRecipient(mail.i, address$, flags.i=#PB_UTF8)
Declare.i CreateMail(mail.i,sender$,subject$,encoding.i=#PB_UTF8)
Declare.i SetMailBody(mail.i,body$)
Declare.i IsMail(mail.i)
Declare.i MailProgress(mail.i)
Declare.i RemoveMailRecipient(mail.i,address$="",flags.i=#PB_Mail_To+#PB_Mail_Bcc+#PB_Mail_Cc)
Declare.i FreeMail(mail.i)
Declare.s GetMailBody(mail.i)
Declare.s GetMailAttribute(mail.i, attribute.i)
Declare.i SetMailAttribute(mail.i, attribute.i, value$)
Declare.i SendMail(mail.i, Smtp$,port.i=25,flags.i=#PB_Mail_Asynchronous,user$="",password$="")
EndDeclareModule
Module Mail
Global NewMap receipients.Mail_Receipient(0)
Global NewList builtList.Mail_Receipient_Type()
Declare.b AddToBuiltList(email.s,flag.i)
Procedure.i AddMailAttachment(mail.i,description$,fileName$,mimeType$="") : ProcedureReturn #False : EndProcedure
Procedure.i AddMailAttachmentData(mail.i,description$,*Buffer,BufferLength,mimeType$="") : ProcedureReturn #False : EndProcedure
Procedure.i AddMailRecipient(mail.i, address$, flags.i=#PB_UTF8)
Define *r.Mail_Receipient
Define *r2.Mail_Receipient_Type
*r=FindMapElement(receipients(),Str(mail))
If *r<>#Null
*r2=AddElement(*r\receipients())
If *r2<>#Null
*r2\recipient=address$
*r2\flag=flags
ProcedureReturn #True
EndIf
EndIf
ProcedureReturn #False
EndProcedure
Procedure.i CreateMail(mail.i,sender$,subject$,encoding.i=#PB_UTF8)
Define *r.Mail_Receipient
Define.i size
Define.s key
key=Str(mail)
*r=FindMapElement(receipients(),key)
If *r=#Null
*r=AddMapElement(receipients(),key,#PB_Map_ElementCheck)
If *r<>#Null
*r\sender=sender$
*r\subject=subject$
*r\flags=encoding
*r\body=""
ClearList(*r\receipients())
ProcedureReturn #True
EndIf
EndIf
ProcedureReturn #False
EndProcedure
Procedure.i SetMailBody(mail.i,body$)
Define *r.Mail_Receipient
*r=FindMapElement(receipients(),Str(mail))
If *r<>#Null
*r\body=body$
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure.i IsMail(mail.i)
Define *r.Mail_Receipient
*r=FindMapElement(receipients(),Str(mail))
ProcedureReturn Bool(*r<>#Null)
EndProcedure
Procedure.i MailProgress(mail.i)
Define *r.Mail_Receipient
*r=FindMapElement(receipients(),Str(mail))
If *r<>#Null
ProcedureReturn #PB_Mail_Finished
Else
ProcedureReturn #PB_Mail_Error
EndIf
EndProcedure
Procedure.i RemoveMailRecipient(mail.i,address$="",flags.i=#PB_Mail_To+#PB_Mail_Bcc+#PB_Mail_Cc)
Define *r.Mail_Receipient
Define.b found
*r=FindMapElement(receipients(),Str(mail))
If *r<>#Null
ForEach *r\receipients()
found=#False
If Len(address$)=0 Or *r\receipients()\recipient=address$ : found=#True : EndIf
If *r\receipients()\flag=flags : found=#True : EndIf
If found=#True
DeleteElement(*r\receipients())
EndIf
Next
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure.i FreeMail(mail.i)
Define *r.Mail_Receipient
Define key.s
If mail=#PB_Any
ForEach receipients()
ClearList(receipients()\receipients())
Next
ClearMap(receipients())
ProcedureReturn #False
Else
key=Str(mail)
*r=FindMapElement(receipients(),key)
If *r<>#Null
ClearList(*r\receipients())
DeleteMapElement(receipients(),key)
ProcedureReturn #True
EndIf
EndIf
ProcedureReturn #True
EndProcedure
Procedure.s GetMailBody(mail.i)
Define *r.Mail_Receipient
*r=FindMapElement(receipients(),Str(mail))
If *r<>#Null
ProcedureReturn *r\body
Else
ProcedureReturn ""
EndIf
EndProcedure
Procedure.s GetMailAttribute(mail.i, attribute.i)
Define *r.Mail_Receipient
*r=FindMapElement(receipients(),Str(mail))
If *r=#Null : ProcedureReturn "" : EndIf
Select attribute
Case #PB_Mail_From ; Change the 'From' attribute, set With CreateMail().
ProcedureReturn *r\sender
Case #PB_Mail_Subject ; Change the 'Subject' attribute, set With CreateMail().
ProcedureReturn *r\subject
Case #PB_Mail_XMailer ; Change the 'X-Mailer' attribute (Not sent by Default). Does nothing
Case #PB_Mail_Date ; Change the 'Date' attribute (Default is the computer date). Does nothing
Case #PB_Mail_Custom ; Add customs fields (can be multi-line). Does nothing
EndSelect
ProcedureReturn ""
EndProcedure
Procedure.i SetMailAttribute(mail.i, attribute.i, value$)
Define *r.Mail_Receipient
*r=FindMapElement(receipients(),Str(mail))
If *r=#Null : ProcedureReturn #False : EndIf
Select attribute
Case #PB_Mail_From ; Change the 'From' attribute, set With CreateMail().
*r\sender=value$
Case #PB_Mail_Subject ; Change the 'Subject' attribute, set With CreateMail().
*r\subject=value$
Case #PB_Mail_XMailer ; Change the 'X-Mailer' attribute (Not sent by Default). Does nothing
Case #PB_Mail_Date ; Change the 'Date' attribute (Default is the computer date). Does nothing
Case #PB_Mail_Custom ; Add customs fields (can be multi-line). Does nothing
EndSelect
ProcedureReturn #True
EndProcedure
Procedure.b AddToBuiltList(email.s,flag.i)
If Len(email)>0
If AddElement(builtList())
builtList()\recipient=email
builtList()\flag=flag
ProcedureReturn #True
EndIf
EndIf
ProcedureReturn #False
EndProcedure
Procedure.i SendMail(mail.i, Smtp$,port.i=25,flags.i=#PB_Mail_Asynchronous,user$="",password$="")
Define *r.Mail_Receipient
Define key.s
Define.s seperator,email
Define currentFlag.i
;Define result
key=Str(mail)
*r=FindMapElement(receipients(),key)
If *r=#Null : ProcedureReturn #False : EndIf
ClearList(builtList())
email="" ; mailto:"
AddToBuiltList(*r\sender,#MAIL_TO)
; Do any TO address first
ForEach *r\receipients()
If *r\receipients()\flag=#PB_Mail_To : AddToBuiltList(*r\receipients()\recipient,#MAIL_TO) : EndIf
Next
; Now CC
ForEach *r\receipients()
If *r\receipients()\flag=#PB_Mail_Cc : AddToBuiltList(*r\receipients()\recipient,#MAIL_CC) : EndIf
Next
; Now BCC
ForEach *r\receipients()
If *r\receipients()\flag=#PB_Mail_Bcc : AddToBuiltList(*r\receipients()\recipient,#MAIL_BCC) : EndIf
Next
AddToBuiltList(*r\subject,#MAIL_SUBJECT)
AddToBuiltList(*r\body,#MAIL_BODY)
currentFlag=#MAIL_INVALID
;count=0
seperator="?" ; First seperator, after which & is used instead
ForEach builtList()
If builtList()\flag<>currentFlag
;count+1
;lDebug builtList()\recipient+" Count : "+Str(count)
;Debug Str(count)+" "+Str(currentFlag)+" "+Str(builtList()\flag)+" "+builtList()\recipient
If Len(email)=0
email+"mailto:"
EndIf
;If count>2
; email+"&"
;Else
; email+"?"
;EndIf
Select builtList()\flag
Case #MAIL_TO
Case #MAIL_CC
email+seperator+"cc="
Case #MAIL_BCC
email+seperator+"bcc="
Case #MAIL_SUBJECT
email+seperator+"subject="
Case #MAIL_BODY
email+seperator+"body="
EndSelect
currentFlag=builtList()\flag
If builtList()\flag<>#MAIL_TO : seperator="&" : EndIf
ElseIf ListIndex(builtList())<ListSize(builtList())
If builtList()\flag<>#MAIL_SUBJECT And builtList()\flag<>#MAIL_BODY
email+","
EndIf
EndIf
email+builtList()\recipient
Next
Debug "Result : "+email
!v_result=window.open(v_email)
ProcedureReturn #True
EndProcedure
EndModuleCode: Select all
XIncludeFile "..\Modules\Mail.sb"
Global.s moduleName="Example"
Global.s procedureName="A Procedure"
Global.i lineNumber=1234
Global.s error="Testing"
If Mail::CreateMail(0, "njk@blurg.com", "Program Error")
Mail::SetMailBody(0,"Error report For module : "+moduleName+", Procedure : "+procedureName+", Line : "+Str(lineNumber)+", Error message : "+error)
Mail::SendMail(0,"")
Mail::FreeMail(#PB_Any)
Else
Debug "Unable to create mail"
EndIfCode: Select all
Enumeration Mail_Process_Type
#MAIL_INVALID = -1
#MAIL_TO = 0
#MAIL_CC
#MAIL_BCC
#MAIL_SUBJECT
#MAIL_BODY
EndEnumeration
Structure Mail_Receipient_Type
recipient.s
flag.i
EndStructure
Structure Mail_Receipient
List receipients.Mail_Receipient_Type()
sender.s
subject.s
flags.i
body.s
EndStructure