SendMail_Include.pbi (windows / linux / macos)

Share your advanced PureBasic knowledge/code with the community.
Rbender
User
User
Posts: 14
Joined: Thu Sep 19, 2013 8:23 am

Re: SendMail_Include.pbi (windows / linux / macos)

Post by Rbender »

Hi,

ist anyone using this pbi like me?

After Update PB from 5.42 to 5.50 it doesn't work anymore. It jumps directly into timeout
Rbender
User
User
Posts: 14
Joined: Thu Sep 19, 2013 8:23 am

Re: SendMail_Include.pbi (windows / linux / macos)

Post by Rbender »

Find the problem: ElapsedMilliseconds() is now a Quad in PureBasic 5.50
Rbender wrote:Hi,

ist anyone using this pbi like me?

After Update PB from 5.42 to 5.50 it doesn't work anymore. It jumps directly into timeout
normeus
Enthusiast
Enthusiast
Posts: 414
Joined: Fri Apr 20, 2012 8:09 pm
Contact:

Re: SendMail_Include.pbi (windows / linux / macos)

Post by normeus »

updated for 5.62 x86 windows 7, I didn't try macos or linux:
I had to force "AUTH LOGIN" because my server did not reply properly, this is done in line 605 and 606 ( ELSE ... ) remove those lines if you don't use password
NO SSL/TLS but this code is needed because PB's SendMail() does not do HTML.

added other changes like date and q for elapsedmilliseconds():

Code: Select all

;- _____________________________________________________________________________
;- |                                                                           |
;- |                              SendEmail (New)                              |
;- |                              _______________                              |
;- |                                                                           |
;- |___________________________________________________________________________|
;{ SendEmail (New) (Start)                                       
; Author : clipper
; PureBasic 3.93
; Changed to Purebasic 4.61 x86 from Falko
; Changed to Purebasic 5.62 x86
; Sending Mail with SMTP-AUTH + add multiple attachments
; Don't fill the Username if you don't want authentification
; 
; changed by ts-soft:
; + variabledeclaration (for EnableExplicit)
; + Prefix SendMail_ for Functions and global Vars, __SendMail_ for private Functions
; + compatibility to linux
; + option to set the port in SendMail_SendEmail()
; + Unicode-Support
; ^ fixed many bugs
; + added Structure for SendMail_SendEMail() Parameter
; + added Callback for AttachedFile
; + added Protocol option
; + added timeout
; + cancel on more errors, thx to IdeasVacuum
; + mime-support for MacOS
; + supports multiple recipients
;
; changed by infratec:
; + added html support
; + added Cc and Bcc possibility
; + added Undisclosed possibilty
;
; 20130621..NALOR..removed all global vars, better error handling
;                modified Structure - added AttachmentList, Protocol and Timeout to structure
;                modified Callback  - now also offers current-file-nr and total-nr-of-files
;                modified Send      - reports if transmission successfull or not
;                modified SendFiles - now it reads the file step by step instead of all at once
;                                   - in case 'Send' reports an error an error msg ist added to protocol
;                modified SendEmail - combined 'SendMail_SendEmail' and '__SendMail_SendEmail' into one procedure 'SendEmail'
;                                   - \Protocol includes a lot more information
;                                   - now it monitors the result of 'NetworkClientEvent'
;                                   - it checks with EHLO if the dest. server supports "AUTH LOGIN"
;                                   - it returns TRUE of FALSE depending on success or error
;                                   - only 1 Email is sent to multiple Recipients
;                                   - merged changes of infratec back in
;                                   - whenever 'NetworkData' is received the Timeout-Timer is reset
;                                   - added message nr. 530 to the list of error messages 'SMTP authentication is required.'
;                                   - in case 'Send' reports an error an error msg ist added to protocol
;                removed separate procedures to add/remove attachments
;                and a lot of other small changes
;                used it with PureBasic 5.11 x86 - never tried it with x64

; 20180828 changed by normeus: 
; +added Procedure.s __SendMail_GetFormatedDate(date.i) as created by @dige
;  make sure you change the -0800 to match your timeZone 
; +to make it PB 5.62 x86 complient
;     for nonASCII strings added StringByteLength to make it PB 5.62 x86 complient
;     new Base64EncoderBuffer() Base64DecoderBuffer() and function
;     Time.q = ElapsedMilliseconds()        as per @Rbender
; +error if sending empty files , changed If FileSize(file)>=0 to If FileSize(file)>0
; +                                        If (CountString(RcvTmp, "AUTH LOGIN")>0 Or CountString(RcvTmp, "AUTH GSSAPI")>0 ) ; 'AUTH LOGIN' is supported
;                                          State=#AuthLogin
;                                       EndIf
; 
;    my server did not send an "AUTH LOGIN" back it sent "AUTH GSSAPI"
; + added an HTML sample 
; some attachments are not sent (mainly office documents ) , pdfs work fine 
; still no SSL but looking into a program called "mailsend" //https://github.com/muquit/mailsend
; for its use of a single file to send SSL emails

;}
EnableExplicit

Structure SendEmail_Parameter
  Sender_Name.s                ; Name of Sender
  Sender_Email.s               ; Address of Sender
  RecipientTO.s                ; List of Recipient Addresses (';' separated)
  RecipientCC.s                ; List of Carbon-Copy-Recipient Adresses (';' separated)
  RecipientBCC.s               ; List of Blind-Carbon-Copy-Recipient Adresses (';' separated)
  Undisclosed.b                ; if TRUE all recipients are hidden in the email
  UserName.s                   ; Username for Authentication
  Password.s                   ; Password for Authentication
  SMTPServer.s                 ; Address of SMTP Server
  Port.w                       ; Port of SMTP Server
  Subject.s                    ; Subject of Email
  Message.s                    ; Text-Body
  MessageHtml.s                ; HTML-Body
  Hostname.s                   ; Hostname used for HELO/EHLO introduction
  ProgressAttachedFile.i       ; Address of Callback procedure for attached files
  Protocol_Enable.b            ; if Protocol should be written or not
  Protocol.s                   ; Protocol
  Timeout.i                    ; Timeout Value in Seconds
  List Attachments.s()         ; List of Attachments
EndStructure

Prototype SendEmail_Callback(File.i, FileCnt.i, Percent.i)

Procedure.s __SendMail_GetFormatedDate(date.i)
  Protected Result.s
 
  ; DateTime Format RFC 5322
  ; Date: Mon, 4 Dec 2006 15:51:37 -0800
  ; -0800 is for PST USA  
 
  Select DayOfWeek(date)
    Case 0 : Result = "Sun"
    Case 1 : Result = "Mon"
    Case 2 : Result = "Tue"
    Case 3 : Result = "Wed"
    Case 4 : Result = "Thu"
    Case 5 : Result = "Fri"
    Case 6 : Result = "Sat"
  EndSelect
 
  Result + ", " + FormatDate("%dd", date) + " "
 
  Select Month(date)
    Case 1 : Result + "Jan"
    Case 2 : Result + "Feb"
    Case 3 : Result + "Mar"
    Case 4 : Result + "Apr"
    Case 5 : Result + "May"
    Case 6 : Result + "Jun"
    Case 7 : Result + "Jul"
    Case 8 : Result + "Aug"
    Case 9 : Result + "Sep"
    Case 10: Result + "Oct"
    Case 11: Result + "Nov"
    Case 12: Result + "Dec"
  EndSelect
 
  Result + " " + FormatDate("%yyyy %hh:%ii:%ss", date) + " -0800";   make sure you change the -0800 to match your timeZone
  ProcedureReturn Result
EndProcedure

Procedure.s __SendMail_GetMimeType(pExt.s)
  ; Cross-Platform
  ; Windows code originally by Kale
  ; Linux code by Straker
  ;
  ; returns as default "application/octet-stream" if Mime Type is not found.
 
  Protected lRetVal.s, lMimeFile.s, lContinue
  Protected hKey, lKeyValue.s, lDataSize.l, lLoop
  Protected lLof.q, *lMemoryID, lBytesRead, lFileContents.s
  Protected lPos1, lPos2, lMimeLen, lMyChar.s, lDefault.s
  Protected MimeFile
 
  Protected Dim lExt.s(7)
 
  lContinue = 1
  lDefault = "application/octet-stream"
 
  CompilerSelect #PB_Compiler_OS

    CompilerCase #PB_OS_MacOS
      Select LCase(pExt)
        Case "pdf" : lRetVal = "application/pdf"
        Case "ai", "eps", "ps" : lRetVal = "application/postscript"
        Case "rtf" : lRetVal = "application/rtf"
        Case "tar" : lRetVal = "application/x-tar"
        Case "zip" : lRetVal = "application/zip"
        Case "au", "snd" : lRetVal = "audio/basic"
        Case "aif", "aiff", "aifc" : lRetVal = "audio/x-aiff"
        Case "wav" : lRetVal = "audio/x-wav"
        Case "gif" : lRetVal = "image/gif"
        Case "jpg", "jpeg", "jpe" : lRetVal = "image/jpeg"
        Case "png" : lRetVal = "image/png"
        Case "tiff", "tif" : lRetVal = "image/tiff"
        Case "zip" : lRetVal = "multipart/x-zip"
        Case "gz", "gzip" : lRetVal = "multipart/x-gzip"
        Case "htm", "html" : lRetVal = "text/html"
        Case "txt", "g", "h", "c", "cc", "hh", "m", "f90" : lRetVal = "text/plain"
        Case "mpeg", "mpg", "mpe" : lRetVal = "video/mpeg"
        Case "qt", "mov" : lRetVal = "video/quicktime"
        Case "avi" : lRetVal = "video/msvideo "
        Case "movie" : lRetVal = "video/x-sgi-movie"
        Default
          lRetVal = lDefault
      EndSelect   

    CompilerCase #PB_OS_Windows
      pExt = ("." + pExt)
      lKeyValue = Space(255)
      lDataSize = 255
      If (RegOpenKeyEx_(#HKEY_CLASSES_ROOT, pExt, 0, #KEY_READ, @hKey))
        lKeyValue = lDefault
      Else
        If RegQueryValueEx_(hKey, "Content Type", 0, 0, @lKeyValue, @lDataSize)
          lKeyValue = lDefault
        Else
          lKeyValue = Left(lKeyValue, (lDataSize - 1))
        EndIf
        RegCloseKey_(hKey)
      EndIf
      lRetVal = lKeyValue
     
    CompilerCase #PB_OS_Linux
     
      pExt = LCase(pExt)
      lRetVal = lDefault
      lMimeFile = "/etc/mime.types"
     
      MimeFile = ReadFile(#PB_Any, lMimeFile)
      If MimeFile
        lLof = Lof(MimeFile)
        *lMemoryID = AllocateMemory(lLof)
        If (*lMemoryID)
          lBytesRead = ReadData(MimeFile, *lMemoryID, lLof)
          lFileContents = PeekS(*lMemoryID, lLof, #PB_UTF8)
        Else
          lContinue = 0
        EndIf
        CloseFile(MimeFile)
      Else
        lContinue = 0
      EndIf
     
      If (lContinue = 1)
        ; find the extension in the /etc/mime.types file
       
        lExt.s(0) = (Space(1) + pExt + Space(1))
        lExt.s(1) = (Chr(9) + pExt + Chr(10))
        lExt.s(2) = (Chr(9) + pExt + Space(1))
        lExt.s(3) = (Chr(9) + pExt + Chr(9))
        lExt.s(4) = (Chr(9) + pExt)
        lExt.s(5) = (Space(1) + pExt + Chr(10))
        lExt.s(6) = (Space(1) + pExt + Chr(9))
        lExt.s(7) = (Space(1) + pExt)
       
        lContinue = 0
       
        For lLoop = 0 To 7 Step 1
          lPos1 = FindString(lFileContents, lExt.s(lLoop), 1)
          If (lPos1 > 0)
            lContinue = 1
            Break
          EndIf
        Next
       
      EndIf
     
      If (lContinue = 1)
        ; found the line - parse the mime type...
        For lLoop = 1 To 80 Step 1
          If (Mid(lFileContents, (lPos1 - lLoop), 1) = Chr(10))
            lPos2 = (lPos1 - lLoop + 1)
            Break
          EndIf
        Next
      EndIf
     
      If (lPos2 > 0)
        For lLoop = 1 To 80 Step 1
          lMyChar = Mid(lFileContents, (lPos2 + lLoop), 1)
          If ((lMyChar = Chr(9)) Or (lMyChar = " "))
            lMimeLen = lLoop
            Break
          EndIf
        Next
      EndIf
     
      If (lMimeLen > 0)
        lRetVal = Trim(Mid(lFileContents, lPos2, lMimeLen))
        If (Left(lRetVal, 1) = "#")
          lRetVal = lDefault
        EndIf
      EndIf
     
      FreeMemory(*lMemoryID)
     
  CompilerEndSelect
 
  ProcedureReturn lRetVal
EndProcedure

Procedure.s __SendMail_Base64Encode(strText.s)
   Protected Result.s
   Protected *B64EncodeBufferA
   Protected *B64EncodeBufferB
   
   *B64EncodeBufferA = AllocateMemory(StringByteLength(strText) + 1)
   If *B64EncodeBufferA
      *B64EncodeBufferB = AllocateMemory((StringByteLength(strText) * 3) + 1)
      If *B64EncodeBufferB
         PokeS(*B64EncodeBufferA, strText, -1, #PB_Ascii)
         Base64EncoderBuffer(*B64EncodeBufferA, MemorySize(*B64EncodeBufferA)-1, *B64EncodeBufferB, MemorySize(*B64EncodeBufferB)-1)
         Result = PeekS(*B64EncodeBufferB, -1, #PB_Ascii)
         FreeMemory(*B64EncodeBufferB)
      EndIf
      FreeMemory(*B64EncodeBufferA)
   EndIf
   ProcedureReturn Result
EndProcedure

Procedure.s __SendMail_Base64Decode(strText.s)
   Protected Result.s
   Protected *B64DecodeBufferA
   Protected *B64DecodeBufferB
   
   *B64DecodeBufferA = AllocateMemory(StringByteLength(strText) + 1)
   If *B64DecodeBufferA
      *B64DecodeBufferB = AllocateMemory(StringByteLength(strText))
      If *B64DecodeBufferB
         PokeS(*B64DecodeBufferA, strText, -1, #PB_Ascii)
         Base64DecoderBuffer(*B64DecodeBufferA, MemorySize(*B64DecodeBufferA)-1, *B64DecodeBufferB, MemorySize(*B64DecodeBufferB))
         Result = PeekS(*B64DecodeBufferB, -1, #PB_Ascii)
         FreeMemory(*B64DecodeBufferB)
      EndIf
      FreeMemory(*B64DecodeBufferA)
   EndIf
   ProcedureReturn Result
EndProcedure

Procedure.b __SendMail_Send(ConnId.i, msg.s)
   Protected *MemoryBuffer
   Protected DataLen.i
   Protected SentNow.i=0
   Protected SentTotal.i
   msg + #CRLF$
   DataLen = StringByteLength(msg, #PB_UTF8)
   *MemoryBuffer = AllocateMemory(DataLen + 1)
   If *MemoryBuffer
      PokeS(*MemoryBuffer, msg, -1, #PB_UTF8)
      
      SentTotal=0
      Repeat
         SentNow=SendNetworkData(ConnId, *MemoryBuffer+SentTotal, DataLen-SentTotal)
         
         If SentNow=-1
            Debug "Error! Could not send data"
            Break
         EndIf
         
         SentTotal+SentNow
      Until SentTotal=DataLen      

      FreeMemory(*MemoryBuffer)
   EndIf
   
   If (SentTotal<>DataLen)
      Debug "Error Send >"+Str(SentTotal)+"< >"+Str(DataLen)+"<"
      ProcedureReturn #False
   Else
      ProcedureReturn #True
   EndIf
EndProcedure

Macro __SMFile_Send(SndData)
   If Not __SendMail_Send(ConnId, SndData)
      If *para\Protocol_Enable = #True
         *para\Protocol + "[" + FormatDate("%hh:%ii:%ss", Date()) + "] ERR >Error sending Data - Quit<"+#CRLF$
      EndIf      
      Break
   EndIf
EndMacro

Procedure.b __SendMail_SendFiles(ConnId.i, *para.SendEmail_Parameter)
   Protected file.s, FF
   Protected OutputBufferLength.i
   Protected BufferLen.i
   Protected Buffer.i
   Protected *memin, *memout, Boundary.s, temp.s
   Protected BytesSent.i
   Protected ReadBytes_Max.i=49140; needs to be a multiple of 3 to keep the Base64 encoding in shape, the base64 result-length should be a multiple of 72 to allow 72char lines and it should be less than 65536 because this is the max. possible size for tcp
   Protected ReadBytes_Cur.i
   Protected ReadBytes.i
   Protected FileSize.i
   Protected FileCnt.i
   Protected CurFileNr.i
   Protected iTemp.i
   Protected NrOfFilesSent=0
   Protected ProgressCB.SendEmail_Callback
   
   Boundary = "--MyMixedBoundary"
   OutputBufferLength = ReadBytes_Max * 1.4

   *memin = AllocateMemory(ReadBytes_Max)
   If *memin
      *memout = AllocateMemory(OutputBufferLength)
      If *memout   
         
         With *para
            ProgressCB=\ProgressAttachedFile
            
            ResetList(\Attachments())
            FileCnt=ListSize(\Attachments())
            CurFileNr=0
            While(NextElement(\Attachments()))
               CurFileNr+1
               file = \Attachments()
               If FileSize(file)>0 ; only send file if it has data
                  __SMFile_Send("")
                  FF = ReadFile(#PB_Any, file)
                  FileSize=Lof(FF)
                  ReadBytes=0            
                     
                  __SMFile_Send(Boundary)
                  __SMFile_Send("Content-Type: " + __SendMail_GetMIMEType(GetExtensionPart(file)) + "; name=" + Chr(34) + GetFilePart(file.s) + Chr(34))
                  __SMFile_Send("Content-Transfer-Encoding: base64")
                  __SMFile_Send("Content-Disposition: Attachment; filename=" + Chr(34) + GetFilePart(file) + Chr(34))
                  __SMFile_Send( "")
                  
                  If ProgressCB
                     ProgressCB(CurFileNr, FileCnt, 0)
                  EndIf
                  
                  Repeat
                     ReadBytes_Cur=ReadData(FF, *memin, ReadBytes_Max)
                     ReadBytes+ReadBytes_Cur
                     
                     BufferLen=Base64EncoderBuffer(*memin, ReadBytes_Cur, *memout, OutputBufferLength)
                     
                     If BufferLen>72
                        temp=PeekS(*memout, 72, #PB_Ascii)
                        iTemp=72
                        Repeat ; insert CRLF every 72 Bytes
                           If (BufferLen-iTemp)>72
                              Buffer=72
                           Else
                              Buffer=BufferLen-iTemp
                           EndIf
                           temp+#CRLF$+PeekS(*memout+iTemp, Buffer, #PB_Ascii)
                           iTemp+Buffer
                        Until iTemp=BufferLen
                        Debug "iTemp >"+Str(iTemp)+"< Len >"+Str(BufferLen)+"<"
                     Else
                        temp = PeekS(*memout, BufferLen, #PB_Ascii)
                     EndIf
                     
                     If Len(temp) > 0
                        __SMFile_Send(temp)
                        If ProgressCB
                           ProgressCB(CurFileNr, FileCnt, ReadBytes/(FileSize/100) )
                     ;      Debug "ReadBytes >"+Str(ReadBytes)+"< FileSize >"+Str(FileSize)+"<"
                        EndIf
                     EndIf               
      
                  Until ReadBytes=FileSize
                  CloseFile(FF)
                  NrOfFilesSent+1
               Else
                  Debug "file not valid >"+file+"<"
               EndIf
            Wend
            
         EndWith
         FreeMemory(*memout)
      Else
         Debug "Error allocating memory 'memout'"         
      EndIf
      FreeMemory(*memin)
   Else
      Debug "Error allocating memory 'memin'"
   EndIf

   ProcedureReturn NrOfFilesSent
EndProcedure

Enumeration
   #CheckAuth
   #AuthLogin
   #MailFrom
   #RcptTo
   #Data
   #Quit
   #Complete
EndEnumeration

Enumeration
   #SendEmail_OK
   #SendEmail_Error
   #SendEmail_AttachmentError
EndEnumeration

Macro __SM_AddProt(RcvSnd, Text)
   If *para\Protocol_Enable = #True
      *para\Protocol + "[" + FormatDate("%hh:%ii:%ss", Date()) + "] "+RcvSnd+" >"+Trim(Text)+"<"+#CRLF$
   EndIf
EndMacro

Macro __SM_SendAndProt(SndData)
   __SM_AddProt("SND", SndData)
   If Not __SendMail_Send(ConnId, SndData)
      __SM_AddProt("ERR", "Error sending Data - Quit")
      Quit=#True
      Break
   EndIf
EndMacro

Procedure.b SendEmail(*para.SendEmail_Parameter)
   ; Basic SMTP RFC: http://tools.ietf.org/html/rfc821
   
   Protected Result.s
   Protected Number.i
   Protected Count.i
   
   Protected *ReceiveMem
   Protected RecDataLen.i
   Protected RecData.s
   Protected cmdID.s
   Protected cmdText.s
   Protected RcvTmp.s
   Protected State.i
   Protected Quit.b
   Protected RetVal.b=#SendEmail_Error
   Protected Time.q = ElapsedMilliseconds()
   Protected ConnId.i
   Protected RcpAll.s ; includes \RecipientTO, \RecipientCC and \RecipientBCC
   Protected RcpCnt.i
   Protected RcpSnt.i
   Protected AttachErr.b=#False
   Protected Hostname.s
   Protected Timeout.i
   
   If *para\Timeout>0
      Timeout=*para\Timeout*1000
   Else
      Timeout=15000
   EndIf
   
   If *para\Port = 0
      *para\Port = 25
   EndIf   
   
   If *para\Hostname=""
      *para\Hostname=Hostname()
   EndIf   
   
   With *para

      RcpAll=\RecipientTO
      If \RecipientCC<>""
         If RcpAll<>"" : RcpAll+";" : EndIf
         RcpAll+ \RecipientCC
      EndIf
      If \RecipientBCC<>""
         If RcpAll<>"" : RcpAll+";" : EndIf
         RcpAll+ \RecipientBCC
      EndIf      
      RcpCnt=CountString(RcpAll, ";")+1
      RcpSnt=0
      
      ConnId = OpenNetworkConnection(\SMTPServer, \Port)
      If ConnId
         *ReceiveMem=AllocateMemory(65536)
         
         If *ReceiveMem
            Quit=#False
            If Len(\Username) > 0
               State=#CheckAuth
            Else
               State=#MailFrom
            EndIf

            Repeat
               Select NetworkClientEvent(ConnId)
                  Case #PB_NetworkEvent_Data
                     RecDataLen = ReceiveNetworkData(ConnId, *ReceiveMem, 65536)
                     If RecDataLen
                        Time=ElapsedMilliseconds()
                        RecData=PeekS(*ReceiveMem, RecDataLen, #PB_Ascii)
                        RecData=Trim(ReplaceString(RecData, #CRLF$, ""))
                        cmdID = Left(RecData, 3)
                        cmdText = Trim(Right(RecData, Len(RecData)-3))
                        __SM_AddProt("RCV", RecData)
                        
                        Select cmdID
                           Case "220"
                              Select State
                                 Case #MailFrom
                                    __SM_SendAndProt("HELO "+ \Hostname )
                                 Case #CheckAuth
                                    __SM_SendAndProt("EHLO "+ \Hostname ) ; we want to get all Extensions and Check if 'AUTH LOGIN' is supported
                              EndSelect
                                    
                           Case "221"
                              __SM_AddProt("END", "[connection closed]")
                              State = #Complete
                              Quit=#True
                           
                           Case "334"
                              If State=#AuthLogin
                                 Select LCase(__SendMail_Base64Decode(cmdText))
                                    Case "username:"
                                       __SM_SendAndProt(__SendMail_Base64Encode(\UserName))
                                    Case "password:"
                                       __SM_SendAndProt(__SendMail_Base64Encode(\Password))
                                 EndSelect
                              EndIf
                              
                           Case "235"
                              If State=#AuthLogin
                                 __SM_SendAndProt("MAIL FROM: <" + \Sender_Email + ">")
                                 State = #RcptTo
                              EndIf
                              
                           Case "250"
                              Select State
                                 Case #CheckAuth
                                    Count=CountString(cmdText, "250")
                                    For Number=1 To Count+1
                                       RcvTmp=Trim(StringField(cmdText, Number, "250"))
                                       If (CountString(RcvTmp, "AUTH LOGIN")>0 Or CountString(RcvTmp, "AUTH GSSAPI")>0 ) ; 'AUTH LOGIN' is supported
                                          State=#AuthLogin
                                       EndIf
 
                                       
                                       If Left(RcvTmp, 1)<>"-" ; in case it's the final command
                                          If State=#AuthLogin
                                             __SM_SendAndProt("AUTH LOGIN")
                                          Else
                                             __SM_AddProt("ERR", "Extension 'AUTH LOGIN' not supported - Quit")
                                             Quit=#True
                                          EndIf
                                       EndIf
                                    Next
                                    
                                 Case #MailFrom   
                                    __SM_SendAndProt("MAIL FROM: <" + \Sender_Email + ">")
                                    State = #RcptTo
                                    
                                 Case #RcptTo
                                    __SM_SendAndProt("RCPT TO: <" + StringField(RcpAll, RcpSnt+1, ";") + ">")
                                    RcpSnt+1
                                    
                                    If RcpSnt=RcpCnt
                                       State=#Data
                                    EndIf
                                    
                                 Case #Data
                                    __SM_SendAndProt("DATA")
                                    
                                 Case #Quit
                                    __SM_SendAndProt("QUIT")
                              EndSelect
                           
                           Case "251"
                              If State=#RcptTo
                                 __SM_SendAndProt("RCPT TO: <" + StringField(RcpAll, RcpSnt+1, ";") + ">")
                                 RcpSnt+1
                                 
                                 If RcpSnt=RcpCnt
                                    State=#Data
                                 EndIf
                              EndIf
                              
                           Case "354"
                              If State=#Data
                                 __SM_SendAndProt("X-Mailer: eSMTP 1.0")
                                 
                                 If Not \Undisclosed
                                    If \RecipientTO<>""
                                       __SM_SendAndProt("To: " + ReplaceString(\RecipientTO, ";", ",") )
                                    EndIf
                                    If \RecipientCC<>""
                                       __SM_SendAndProt("CC: " + ReplaceString(\RecipientCC, ";", ",") )
                                    EndIf
                                 EndIf

                                 __SM_SendAndProt("From: " + \Sender_Name + " <" + \Sender_Email + ">")
                                 __SM_SendAndProt("Reply-To: " + \Sender_Email)
                                 ;__SM_SendAndProt("Date:" + FormatDate("%dd/%mm/%yyyy @ %hh:%ii:%ss", Date()))
                                 __SM_SendAndProt("Date:" + __SendMail_GetFormatedDate(Date()))
                                 __SM_SendAndProt("Subject: " + \Subject)
                                 __SM_SendAndProt("MIME-Version: 1.0")
                                 __SM_SendAndProt("Content-Type: multipart/mixed; boundary=" + #DQUOTE$ + "MyMixedBoundary" + #DQUOTE$)
                                 __SM_SendAndProt("")
                                 __SM_SendAndProt("--MyMixedBoundary")
                                 If \MessageHtml
                                    __SM_SendAndProt("Content-Type: multipart/alternative; boundary=" + #DQUOTE$ + "MyAlternativeBoundary" + #DQUOTE$)
                                    __SM_SendAndProt("")
                                    __SM_SendAndProt("--MyAlternativeBoundary")
                                 EndIf
                                 __SM_SendAndProt("Content-Type: text/plain; charset=utf-8")
                                 __SM_SendAndProt("Content-Transfer-Encoding: 8bit")
                                 __SM_SendAndProt("")                     
                                 
                                 __SM_AddProt("SND", "Message-Placeholder")
                                 If Not __SendMail_Send(ConnId, \Message)
                                    __SM_AddProt("ERR", "Error sending Message - Quit")
                                    Quit=#True
                                    Break
                                 EndIf
                                 
                                 If \MessageHtml
                                    __SM_SendAndProt("--MyAlternativeBoundary")
                                    __SM_SendAndProt("Content-Type: text/html; charset=utf-8")
                                    __SM_SendAndProt("Content-Transfer-Encoding: 8bit")
                                    __SM_SendAndProt("")
                                    
                                    __SM_AddProt("SND", "MessageHtml-Placeholder")
                                    If Not __SendMail_Send(ConnId, \MessageHtml)
                                       __SM_AddProt("ERR", "Error sending MessageHtml - Quit")
                                       Quit=#True
                                       Break
                                    EndIf                                    

                                    __SM_SendAndProt("--MyAlternativeBoundary--")
                                 EndIf
                                 __SM_AddProt("SND", "SendFiles-Placeholder")                        
                                 Number=__SendMail_SendFiles(ConnId, *para)
                                 If (Number<>ListSize(\Attachments()))
                                    __SM_AddProt("ERR", "Not all files could be attached! Only >"+Str(Number)+"< of >"+Str(ListSize(\Attachments()))+"< !!")
                                    AttachErr=#True
                                 EndIf
                                 
                                 __SM_SendAndProt("--MyMixedBoundary--")
                                 __SM_SendAndProt(".")
                                 Time=ElapsedMilliseconds() ; no Timeout after sending DATA!
                                 State = #Quit
                              EndIf
                              
                           Case "421", "450", "451", "452", "454", "500", "501", "502", "503", "530", "535","550", "551", "552", "553", "554"
                              __SM_AddProt("ERR", "Error received - quit")
                              Quit=#True 
                              
                        EndSelect
                        
                        
                     EndIf
                     
                  Case #PB_NetworkEvent_Disconnect
                     __SM_AddProt("ERR", "Received Network Disconnect Event")
                     Quit=#True
                     
                  Case #PB_NetworkEvent_None
                     Delay(10)
                     
               EndSelect
               If (ElapsedMilliseconds() > (Time + TimeOut))
                  __SM_AddProt("ERR", "Timeout reached >"+Str(TimeOut/1000)+"< Sec.")
                  Quit=#True
               EndIf

            Until Quit=#True
            
            If (State=#Complete)
               If AttachErr
                  RetVal=#SendEmail_AttachmentError
               Else
                  RetVal=#SendEmail_OK
               EndIf
            EndIf
            
            FreeMemory(*ReceiveMem)
         Else
            __SM_AddProt("ERR", "Error allocating receive memory")
         EndIf
         CloseNetworkConnection(ConnId)
      Else
         __SM_AddProt("ERR", "Error opening network connection")
      EndIf
   EndWith
   
  ProcedureReturn RetVal
EndProcedure

Procedure SendEmail_Callback(File.i, FileCnt.i, Percent.i)
   Debug "Callback File >"+Str(File)+"/"+Str(FileCnt)+"< Progress >"+Str(percent)+"< %"
EndProcedure

InitNetwork()
CompilerIf #PB_Compiler_IsMainFile
Define mpara.SendEmail_Parameter
Define.s ProtocolTxt.s
InitNetwork()


Define HTMLS$="<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Transitional//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd'>"+
       "<html xmlns='http://www.w3.org/1999/xhtml'>"+
       "    <head>"+
       "        <meta http-equiv='Content-Type' content='text/html; charset=utf-8' />"+
       "        <title>Bert L Howe and Assoc</title>"+
       "        <style type='text/css'>"+
       "        body {margin: 0; padding: 0; min-width: 100%!important;}"+
       "        .content {width: 100%; max-width: 600px;}  "+
       "        </style>"+
       "    </head>"+
       "    <body yahoo bgcolor='#f6f8f1'>"+

"        <table width='100%' bgcolor='#f6f8f1' border='0' cellpadding='0' cellspacing='0'>"+
"            <tr>"+
"                <td>"+
"     <h1>Salutations!</h1>"+
"                            </td>"+
"                        </tr>"+
"            <tr>"+
"                <td>"+
"                    <table class='content' align='center' cellpadding='0' cellspacing='0' border='0'>"+
"                        <tr>"+
"                            <td>"+
"                                Hello! this is a table inside of this html email plus small image -> "+
"<img src='Data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAACR0lEQVRYha1XvU4bQRD+bF/JjzEnpUDwCPROywPgB4h0PUWkFEkLposUIYyEU4N5AEpewnkDCiQcjBQpWLiLjk3DrnZnZ3buTv4ae25mZ+Z2Zr7daxljDGpg++Mv978Y5Nhc6+Di5tk9u7/bR3cjY9eOJnMUh3mg5y0roBjk+PF1F+1WCwCCJKTgpz9/ozjMg+ftVQQ/PtrB508f1OAcau8ADW5xfLRTOzgAZMPxTNy+YpDj6vaPGtxPgvpL7QwAtKXts8GqBveT8P1p5YF5x8nlo+n1p6bXn5ov3x9M+fZmjDGRXBXWH5X/Lv4FdqCLaLAmwX1/VKYJtIwJeYDO+dm3PSePJnO8vJbJhqN62hOUJ8QpoD1Au5kmIentr9TobAK04RyJEOazzjV9KokogVRwjvm6652kniYRJUBrTkft5bUEAGyuddzz7noHALBYls5O09skaE+4HdAYruobUz1FVI6qcy7xRFW95A915pzjiTp6zj7za6fB1lay1/Ssfa8/jRiLw/n1k9tizl7TS/aZ3xDakdqUByR/gDcF0qJV8QAXHACy+7v9wGA4ngWLVskDo8kcg4Ot8FpGa8PV0I7MyeWjq53f7Zrer3nyOLYJpJJowgN+g9IExNNQ4vLFskwyJtVrd8JoB7g3b4rz66dIpv7UHqg611xw/0om8QT7XXBx84zheCbKGui2U9n3p/YAlSVyqRqc+kt+mCyWJTSeoMGjOQciOQDXA6kjVTsL6JhpYHtA+wihPaGOWgLqnVACPQua4j8NK7bPLP4+qQAAAABJRU5ErkJggg==' width='32' height='32'>"+
"                            </td>"+
"                        </tr>"+
"<tr><td><img src='https://i.imgur.com/okFg6Q7.jpg' width='320' height='320'>"+ 
"                            </td>"+
"                        </tr>"+
"                        <tr><td></h2>"+
"</td></tr>"+
"                        <tr><td><h5> </h5></td></tr>"+
"                        <tr><td><h5> There is another way to add images so I will try it next</h5></td></tr>"+
"                    </table>"+
"                </td>"+
"            </tr>"+
"        </table>"+
"    </body>"+
"</html>"

With mpara
   \Sender_Name = "Name of Sender"  ; Name of Sender.
   \Sender_Email = "sender@address.to"       ; Address of Sender
   \RecipientTO="recipient@address.to;recipient2@address.to" ; List of Recipient Addresses (';' separated)
;   \RecipientCC="" ; List of Carbon-Copy-Recipient Adresses (';' separated)
;   \RecipientBCC=""  ; List of Blind-Carbon-Copy-Recipient Adresses (';' separated)
   \UserName = "myemail@myserver.com"; ; Username for Authentication
   \Password = "secretpassword"                 ; Password for Authentication
   \SMTPServer = "myserver.com" ; Address of SMTP Server
   \Subject = "A Subject Line" ; Subject of Email
   \Message = "text of this email" ; Text-Body
   \MessageHtml= HTMLS$            ; HTML-Body
   \Hostname="yourIPaddress.com" ; Hostname used for HELO/EHLO introduction if left blank, your computer name
   \Port = 587 ; or 25 or 465
   \Protocol_Enable = #True
;  \Protocol ;  Returned text, contains dialog of handshake when   \Protocol_Enable = #True
   \ProgressAttachedFile=@SendEmail_Callback() ; Address of Callback procedure for attached files
   \Timeout=20 ; Timeout Value in Seconds
;  \Attachments.s()         ; List of Attachments to be added to email
   \Undisclosed=#False ; set it to true if you want to see undisclosed instead of From eMail
   AddElement(\Attachments())
   \Attachments()="C:\abc.pdf" ; a file to attach to this email
EndWith
Select SendEmail(mpara)
   Case #SendEmail_OK
      ProtocolTxt=mpara\Protocol
   Case #SendEmail_AttachmentError
      ProtocolTxt="Attachment ERROR!!!"+#CRLF$+mpara\Protocol
   Case #SendEmail_Error
      ProtocolTxt="ERROR!!!"+#CRLF$+mpara\Protocol
EndSelect

If ProtocolTxt
  OpenWindow(0, #PB_Ignore, #PB_Ignore, 640, 480, "SendEmail - Protocol")
  EditorGadget(0, 5, 5, 630, 470, #PB_Editor_ReadOnly)
  SetGadgetText(0, ProtocolTxt)
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf

CompilerEndIf

Again, this code is needed because PB's SendMail() does not do HTML

edit:
added "AUTH GSSAPI" because it was the reply from 2 of my servers for AUTH

Thank you.
norm.
google Translate;Makes my jokes fall flat- Fait mes blagues tombent à plat- Machte meine Witze verpuffen- Eh cumpari ci vo sunari
Little_man
Enthusiast
Enthusiast
Posts: 143
Joined: Fri Mar 29, 2013 4:55 pm
Location: The Netherland

Re: SendMail_Include.pbi (windows / linux / macos)

Post by Little_man »

I am using Purebasic 4.61

I am using the code of "infratec" with the date of "Sun Oct 28, 2012 11:50 am".

Part of the program code:
With mpara
\Name = "Myname" ;Hier ist egal was steht.
\Sender = "myname@kpnmail.nl" ;E-Mail des Senders.
\Recipient = "SendMailtoAddress" ;E-Mail des Empfängers.
\Blind = ""
\UserName = "myname@kpnmail.nl" ;Username.
\Password = "password" ;Hier dein Kennwort.
\SMTPServer = "smtp.kpnmail.nl"
\Subject = "Test" ;Hier Betreffzeile.
\Message = "Testtext" ;Hier der Text im Body.
\MessageHtml = "<html><body><h1>TestHTMLText</h1></body></html>"
\Port = 587
\EnableProtocol = #True
EndWith

Output information
SendMailtoAddress (xxxx@ziggo.nl:)
[18:22:08] smtp.kpnmail.nl ESMTP
[18:22:08] smtp.kpnmail.nl
250-PIPELINING
250-SIZE 52428800
250-STARTTLS
250-ENHANCEDSTATUSCODES
250 8BITMIME
[18:22:08] 5.5.1 Error: authentication not enabled <----- Error !!...
503 5.5.1 Error: authentication not enabled <----- Error !!...

Can anyone tell me how to correct the error ?

Kind regards,
Littleman
dige
Addict
Addict
Posts: 1247
Joined: Wed Apr 30, 2003 8:15 am
Location: Germany
Contact:

Re: SendMail_Include.pbi (windows / linux / macos)

Post by dige »

How to extend this great include, so that attachments can also be sent inline?

I have the problem that e.g. Outlook does not show embedded graphics,
if they are directly contained in the html source code as <img src="data:image/png;base[..]"/>

Like mentioned from NicTheQuick in viewtopic.php?f=13&t=76329

Anyone can help?
"Daddy, I'll run faster, then it is not so far..."
loulou2522
Enthusiast
Enthusiast
Posts: 495
Joined: Tue Oct 14, 2014 12:09 pm

Re: SendMail_Include.pbi (windows / linux / macos)

Post by loulou2522 »

HI all,
Anyone knows the answering of including inlin attahements with this mailer ?
Thanks
Post Reply