Send Mail's

Just starting out? Need help? Post your questions and find answers here.
Logoman
Posts: 4
Joined: Thu Aug 28, 2014 8:08 am

Send Mail's

Post by Logoman »

Hi to all,
there is in spider a "mailgadget" as in pure ?? How can I send a mail directly, from a contact page ?? :?
Sorry for my English ! :(
User avatar
T4r4ntul4
Posts: 132
Joined: Wed May 21, 2014 1:57 pm
Location: Netherlands
Contact:

Re: Send Mail's

Post by T4r4ntul4 »

I think thats not possible direct with javascript, you need to do that server side. Like PHP.
User avatar
MrTAToad
Posts: 291
Joined: Sun Apr 20, 2014 11:43 am
Location: Chichester, England
Contact:

Re: Send Mail's

Post by MrTAToad »

Its sort of possible. However, it is all control by the user. I have replicated PureBasic's procedures for use with SpiderBasic. It works well - as long as the user allows access :

Code: Select all

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

Enumeration Mail_Process_Type
  #MAIL_INVALID = -1
  #MAIL_TO      = 0
  #MAIL_CC
  #MAIL_BCC
  #MAIL_SUBJECT
  #MAIL_BODY
EndEnumeration

Code: Select all

EnableExplicit

Global NewMap receipients.Mail_Receipient(0)
Global NewList builtList.Mail_Receipient_Type()

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
  Define key.s
  ;Define.i size
  
  ;size=ArraySize(receipients())
  ;If size<0 Or mail>size : ProcedureReturn #False : EndIf
  
  key=Str(mail)
  *r=FindMapElement(receipients(),key)
  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
  Define key.s
  
  key=Str(mail)
  *r=FindMapElement(receipients(),key)
  If *r<>#Null
    *r\body=body$
    ProcedureReturn #True
  EndIf
  
  ProcedureReturn #False
EndProcedure

Procedure.i IsMail(mail.i)
  Define *r.Mail_Receipient
  Define key.s
  
  key=Str(mail)
  *r=FindMapElement(receipients(),key)
  ProcedureReturn Bool(*r<>#Null)
EndProcedure

Procedure.i MailProgress(mail.i)
  Define *r.Mail_Receipient
  Define key.s
  
  key=Str(mail)
  *r=FindMapElement(receipients(),key)
  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 key.s
   
  key=Str(mail)
  *r=FindMapElement(receipients(),key)
  If *r<>#Null
    If address$="" Or flags=#PB_Mail_To+#PB_Mail_Bcc+#PB_Mail_Cc
      ClearList(*r\receipients())
    Else
      ForEach *r\receipients()
        If *r\receipients()\recipient=address$ And *r\receipients()\flag=flags
          DeleteElement(*r\receipients())
        EndIf
      Next
    EndIf
    
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure

Procedure.i FreeMail(mail.i)
  Define *r.Mail_Receipient
  Define key.s
   
  key=Str(mail)

  If mail=#PB_Any
    ForEach receipients()
      ClearList(receipients()\receipients())
    Next
    
    ClearMap(receipients())
    ProcedureReturn #False
  Else
    *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
  Define key.s
   
  key=Str(mail)
  *r=FindMapElement(receipients(),key)
  If *r<>#Null
    ProcedureReturn *r\body
  Else
    ProcedureReturn ""
  EndIf
EndProcedure

Procedure.s GetMailAttribute(mail.i, attribute.i)
  Define *r.Mail_Receipient
  Define key.s
   
  key=Str(mail)
  *r=FindMapElement(receipients(),key)
  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
  Define key.s
   
  key=Str(mail)
  *r=FindMapElement(receipients(),key)
  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
  
  !v_result=window.open(v_email)
  
  ProcedureReturn #True
EndProcedure
Attachments aren't allowed, and it seems that BCC receipients are ignored though.
Post Reply