SendMail_Include.pbi (windows / linux / macos)

Share your advanced PureBasic knowledge/code with the community.
infratec
Always Here
Always Here
Posts: 6817
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

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

Post by infratec »

Hi,

inspired by a coding question from dige,
I found it a good idea to extend the code of this thread.

I added the possibility to send also HTML e-mails.

SendMail.pbi:

Code: Select all

;- _____________________________________________________________________________
;- |                                                                           |
;- |                              SendEmail (New)                              |
;- |                              _______________                              |
;- |                                                                           |
;- |___________________________________________________________________________|
;{ SendEmail (New) (Start)                                       
; Author : clipper
; PureBasic 3.93
; Changed to Purebasic 4.61 x86 from Falko
; 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
;}
EnableExplicit

Enumeration
  #eHlo
  #RequestAuthentication
  #Username
  #Password
  #MailFrom
  #RcptTo
  #Data
  #Quit
  #Complete
EndEnumeration

Structure SendMail_Parameter
  Name.s
  Sender.s
  Recipient.s
  UserName.s
  Password.s
  SMTPServer.s
  Subject.s
  Message.s
  MessageHtml.s
  Port.w
  ProgressAttachedFile.i
  EnableProtocol.b
EndStructure

Prototype SendMail_Callback(percent.i)

Global NewList SendMail_Attachments.s()
Global SendMail_ConnectionID

Procedure SendMail_AddAttachment(File.s)
  AddElement(SendMail_Attachments())
  SendMail_Attachments() =  File
EndProcedure

Procedure SendMail_NoAttachment()
  ClearList(SendMail_Attachments())
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 = AllocateMemory(Len(strText) + 1)
  Protected *B64EncodeBufferB = AllocateMemory((Len(strText) * 3) + 1)
  PokeS(*B64EncodeBufferA, strText, -1, #PB_Ascii)
  Base64Encoder(*B64EncodeBufferA, Len(strText), *B64EncodeBufferB, Len(strText) * 3)
  Result = PeekS(*B64EncodeBufferB, -1, #PB_Ascii)
  FreeMemory(*B64EncodeBufferA)
  FreeMemory(*B64EncodeBufferB)
  ProcedureReturn Result
EndProcedure

Procedure __SendMail_Send(msg.s)
  Protected *mem, length
  msg + #CRLF$
  length = StringByteLength(msg, #PB_UTF8)
  *mem = AllocateMemory(length + 1)
  If *mem
    PokeS(*mem, msg, -1, #PB_UTF8)
    SendNetworkData(SendMail_ConnectionID, *mem, length)
    FreeMemory(*mem)
  EndIf
EndProcedure

Procedure __SendMail_SendFiles(ProgressCB.SendMail_Callback = 0)
  Protected file.s, FF, InputBufferLength.i, OutputBufferLength.i
  Protected *memin, *memout, Boundry.s, temp.s, i
 
  ResetList(SendMail_Attachments())
  While(NextElement(SendMail_Attachments()))
    file = SendMail_Attachments()
    __SendMail_Send("")
    FF = ReadFile(#PB_Any, file)
    InputBufferLength = Lof(FF)
    OutputBufferLength = InputBufferLength * 1.4
    *memin = AllocateMemory(InputBufferLength)
    If *memin
      *memout = AllocateMemory(OutputBufferLength)
      If *memout
        Boundry = "--MyMixedBoundary"
        __SendMail_Send(Boundry)
        __SendMail_Send("Content-Type: " + __SendMail_GetMIMEType(GetExtensionPart(file)) + "; name=" + Chr(34) + GetFilePart(file.s) + Chr(34))
        __SendMail_Send("Content-Transfer-Encoding: base64")
        __SendMail_Send("Content-Disposition: Attachment; filename=" + Chr(34) + GetFilePart(file) + Chr(34))
        __SendMail_Send("")
        ReadData(FF, *memin, InputBufferLength)
        Base64Encoder(*memin, 60, *memout, OutputBufferLength)
        __SendMail_Send(PeekS(*memout, 60, #PB_Ascii)) ; this must be done because For i=0 To OutputBufferLength/60 doesn't work
        If ProgressCB
          ProgressCB(60 / (OutputBufferLength / 100))
        EndIf
        Base64Encoder(*memin, InputBufferLength, *memout, OutputBufferLength)               
        For i = 1 To OutputBufferLength / 60
          temp = Trim(PeekS(*memout + i * 60, 60, #PB_Ascii))
          If Len(temp) > 0
            __SendMail_Send(temp)
            If ProgressCB
              ProgressCB((60 * i) / (OutputBufferLength / 100))
            EndIf
          EndIf
        Next
        FreeMemory(*memout)
      EndIf
      FreeMemory(*memin)
    EndIf
    CloseFile(FF)
  Wend
  ProcedureReturn
EndProcedure

Procedure.s __SendMail_SendEmail(*para.SendMail_Parameter, TimeOut.l, Number = 0)
  Protected loop250, ReceivedData.s, ct, cmdID.s, cmdText.s
  Protected State, quit, ProtocolTxt.s, Time.l = ElapsedMilliseconds()

  If *para\Port = 0 : *para\Port = 25 : EndIf
 
  SendMail_ConnectionID = OpenNetworkConnection(*para\SMTPServer, *para\Port)
  With *para
    If SendMail_ConnectionID
      Repeat   
        If NetworkClientEvent(SendMail_ConnectionID)
          ReceivedData = Space(9999)
          ct = ReceiveNetworkData(SendMail_ConnectionID, @ReceivedData, 9999)
          ReceivedData = PeekS(@ReceivedData, -1, #PB_Ascii)
          If ct
            cmdID = Left(ReceivedData, 3)
            cmdText = Mid(ReceivedData, 5, ct - 6)
            If \EnableProtocol = #True
              ProtocolTxt + "[" + FormatDate("%hh:%ii:%ss", Date()) + "] " + cmdText + #CRLF$
            EndIf
            Select cmdID
              Case "220"
                If Len(\Username) > 0
                  __SendMail_Send("Ehlo " + Hostname())
                  State = #eHlo
                Else
                  __SendMail_Send("HELO " + Hostname())
                  State = #MailFrom
                EndIf   
              Case "221"
                __SendMail_Send("[connection closed]")
                State = #Complete
                quit = 1     
              Case "235"
                __SendMail_Send("MAIL FROM: <" + \Sender + ">")
                State = #RcptTo
               
              Case "334"
                If State=#RequestAuthentication
                  __SendMail_Send(__SendMail_Base64Encode(\UserName))
                  State = #Username
                EndIf
                If State = #Username
                  __SendMail_Send(__SendMail_Base64Encode(\Password))
                  state = #Password
                EndIf
               
              Case "250"
                Select state
                  Case #eHlo
                    __SendMail_Send("AUTH LOGIN")
                    state = #RequestAuthentication     
                  Case #MailFrom   
                    __SendMail_Send("MAIL FROM: <" + \Sender + ">")
                    state = #RcptTo
                  Case #RcptTo
                    __SendMail_Send("RCPT TO: <" + StringField(\Recipient, Number + 1, ";") + ">")
                    state = #Data
                  Case #Data
                    __SendMail_Send("DATA")
                    state = #Quit
                  Case #Quit
                    __SendMail_Send("QUIT")
                EndSelect
               
              Case "251"
                __SendMail_Send("DATA")
                state = #Data
              Case "354"
                __SendMail_Send("X-Mailer: eSMTP 1.0")
                __SendMail_Send("To: " + \Recipient)
                __SendMail_Send("From: " + \Name + " <" + \Sender + ">")
                __SendMail_Send("Reply-To: " + \Sender)
                __SendMail_Send("Date:" + FormatDate("%dd/%mm/%yyyy @ %hh:%ii:%ss", Date()))
                __SendMail_Send("Subject: " + \Subject)
                __SendMail_Send("MIME-Version: 1.0")
                __SendMail_Send("Content-Type: multipart/mixed; boundary=" + #DQUOTE$ + "MyMixedBoundary" + #DQUOTE$)
                __SendMail_Send("")
                __SendMail_Send("--MyMixedBoundary")
                If \MessageHtml
                  __SendMail_Send("Content-Type: multipart/alternative; boundary=" + #DQUOTE$ + "MyAlternativeBoundary" + #DQUOTE$)
                  __SendMail_Send("")
                  __SendMail_Send("--MyAlternativeBoundary")
                EndIf
                __SendMail_Send("Content-Type: text/plain; charset=utf-8")
                __SendMail_Send("Content-Transfer-Encoding: 8bit")
                __SendMail_Send("")
                __SendMail_Send(\Message)
                If \MessageHtml
                  __SendMail_Send("--MyAlternativeBoundary")
                  __SendMail_Send("Content-Type: text/html; charset=utf-8")
                  __SendMail_Send("Content-Transfer-Encoding: 8bit")
                  __SendMail_Send("")
                  __SendMail_Send(\MessageHtml)
                  __SendMail_Send("--MyAlternativeBoundary--")
                EndIf
                __SendMail_SendFiles(\ProgressAttachedFile)
                __SendMail_Send("--MyMixedBoundary--")
                __SendMail_Send(".")
                
              Case "421", "450", "451", "452", "454", "500", "501", "502", "503", "535","550", "551", "552", "553", "554"
                ProtocolTxt + cmdID + " " + cmdText + #CRLF$
                quit = 1     
            EndSelect
          EndIf
        EndIf
       
      Until quit = 1 Or ElapsedMilliseconds() > (Time + TimeOut)
      CloseNetworkConnection(SendMail_ConnectionID)
     
    EndIf
  EndWith
 
  ProcedureReturn ProtocolTxt
EndProcedure

Procedure.s SendMail_SendEmail(*para.SendMail_Parameter, TimeOut.l = 15000)
  Protected Result.s
  Protected I, Count = CountString(*para\Recipient, ";")
  For I = 0 To Count
    Result + StringField(*para\Recipient, I + 1, ";") + ":" + #CRLF$
    Result + __SendMail_SendEmail(*para, TimeOut.l, I)
  Next
  ProcedureReturn Result
EndProcedure

And an example:

Code: Select all

IncludeFile "SendMail.pbi"


InitNetwork()

Define mpara.SendMail_Parameter
With mpara
  \Name = ""  ; Hier ist egal was steht.
  \Sender = "you@your_host.org"       ; E-Mail des Senders
  \Recipient = "to@somewhere.net"      ; E-Mail des Empfängers
  \UserName = ""     ; Username
  \Password = ""              ; hier dein Kennwort
  \SMTPServer = "your.smtp_server.net"
  \Subject = "Test" ; Hier Betreffzeile
  \Message = "Testtext" ; Hier der Text im Body
  \MessageHtml = "<html><body><h1>TestHTMLText</h1></body></html>"
  \Port = 25
  \EnableProtocol = #True
EndWith

;SendMail_AddAttachment("c:\tmp\a_picture.png")
Define.s ProtocolTxt.s = SendMail_SendEmail(mpara)

If ProtocolTxt
  OpenWindow(0, #PB_Ignore, #PB_Ignore, 640, 480, "SendMail - Protocol")
  EditorGadget(0, 5, 5, 630, 470, #PB_Editor_ReadOnly)
  SetGadgetText(0, ProtocolTxt)
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
Bernd
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

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

Post by Kwai chang caine »

Thanks TsSoft for sharing this great job 8)
It works very good, i go to use it, againts bad sender of mail, who want have your return address, for put it in robot for spam :?
Thanks to your code i can send mail without anwer possible, like when a robot answer you with "NoAnswer@xxx.fr" :D

You adding multiple recipient, but is it possible to sending CC and CCI recipient.
CC = A copy where the name of the other recipients appears ???
CCI = A copy where the name of the other recipients is hidden ???
ImageThe happiness is a road...
Not a destination
infratec
Always Here
Always Here
Posts: 6817
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

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

Post by infratec »

Hi KCC,

here a modified version with CC and KCC oh... BCC :mrgreen: :mrgreen: :mrgreen:

Code: Select all

;- _____________________________________________________________________________
;- |                                                                           |
;- |                              SendEmail (New)                              |
;- |                              _______________                              |
;- |                                                                           |
;- |___________________________________________________________________________|
;{ SendEmail (New) (Start)
; Author : clipper
; PureBasic 3.93
; Changed to Purebasic 4.61 x86 from Falko
; 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
;}
EnableExplicit

Enumeration
  #eHlo
  #RequestAuthentication
  #Username
  #Password
  #MailFrom
  #RcptTo
  #Data
  #Quit
  #Complete
EndEnumeration

Structure SendMail_Parameter
  Name.s
  Sender.s
  Recipient.s
  Blind.s
  UserName.s
  Password.s
  SMTPServer.s
  Subject.s
  Message.s
  MessageHtml.s
  Port.w
  ProgressAttachedFile.i
  EnableProtocol.b
EndStructure

Prototype SendMail_Callback(percent.i)

Global NewList SendMail_Attachments.s()
Global SendMail_ConnectionID

Procedure SendMail_AddAttachment(File.s)
  AddElement(SendMail_Attachments())
  SendMail_Attachments() =  File
EndProcedure

Procedure SendMail_NoAttachment()
  ClearList(SendMail_Attachments())
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.i
  Protected hKey.i, lKeyValue.s, lDataSize.l, lLoop.i
  Protected lLof.q, *lMemoryID, lBytesRead.i, lFileContents.s
  Protected lPos1.i, lPos2.i, lMimeLen.i, lMyChar.s, lDefault.s
  Protected MimeFile.i
  
  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 = AllocateMemory(Len(strText) + 1)
  Protected *B64EncodeBufferB = AllocateMemory((Len(strText) * 3) + 1)
  PokeS(*B64EncodeBufferA, strText, -1, #PB_Ascii)
  Base64Encoder(*B64EncodeBufferA, Len(strText), *B64EncodeBufferB, Len(strText) * 3)
  Result = PeekS(*B64EncodeBufferB, -1, #PB_Ascii)
  FreeMemory(*B64EncodeBufferA)
  FreeMemory(*B64EncodeBufferB)
  ProcedureReturn Result
EndProcedure

Procedure __SendMail_Send(msg.s)
  Protected *mem, length
  msg + #CRLF$
  length = StringByteLength(msg, #PB_UTF8)
  *mem = AllocateMemory(length + 1)
  If *mem
    PokeS(*mem, msg, -1, #PB_UTF8)
    SendNetworkData(SendMail_ConnectionID, *mem, length)
    FreeMemory(*mem)
  EndIf
EndProcedure

Procedure __SendMail_SendFiles(ProgressCB.SendMail_Callback = 0)
  Protected file.s, FF, InputBufferLength.i, OutputBufferLength.i
  Protected *memin, *memout, Boundry.s, temp.s, i
 
  ResetList(SendMail_Attachments())
  While(NextElement(SendMail_Attachments()))
    file = SendMail_Attachments()
    __SendMail_Send("")
    FF = ReadFile(#PB_Any, file)
    InputBufferLength = Lof(FF)
    OutputBufferLength = InputBufferLength * 1.4
    *memin = AllocateMemory(InputBufferLength)
    If *memin
      *memout = AllocateMemory(OutputBufferLength)
      If *memout
        Boundry = "--MyMixedBoundary"
        __SendMail_Send(Boundry)
        __SendMail_Send("Content-Type: " + __SendMail_GetMIMEType(GetExtensionPart(file)) + "; name=" + Chr(34) + GetFilePart(file.s) + Chr(34))
        __SendMail_Send("Content-Transfer-Encoding: base64")
        __SendMail_Send("Content-Disposition: Attachment; filename=" + Chr(34) + GetFilePart(file) + Chr(34))
        __SendMail_Send("")
        ReadData(FF, *memin, InputBufferLength)
        Base64Encoder(*memin, 60, *memout, OutputBufferLength)
        __SendMail_Send(PeekS(*memout, 60, #PB_Ascii)) ; this must be done because For i=0 To OutputBufferLength/60 doesn't work
        If ProgressCB
          ProgressCB(60 / (OutputBufferLength / 100))
        EndIf
        Base64Encoder(*memin, InputBufferLength, *memout, OutputBufferLength)               
        For i = 1 To OutputBufferLength / 60
          temp = Trim(PeekS(*memout + i * 60, 60, #PB_Ascii))
          If Len(temp) > 0
            __SendMail_Send(temp)
            If ProgressCB
              ProgressCB((60 * i) / (OutputBufferLength / 100))
            EndIf
          EndIf
        Next
        FreeMemory(*memout)
      EndIf
      FreeMemory(*memin)
    EndIf
    CloseFile(FF)
  Wend
  ProcedureReturn
EndProcedure

Procedure.s __SendMail_SendEmail(*para.SendMail_Parameter, TimeOut.i, Number.i = 0)
  Protected loop250.i, ReceivedData.s, ct.i, cmdID.s, cmdText.s
  Protected State, quit, ProtocolTxt.s, Time.i = ElapsedMilliseconds()
  Protected Receivers.i, Receiver.s, Cc.s, Bcc.s, i.i, Help.s

  If *para\Port = 0 : *para\Port = 25 : EndIf
 
  SendMail_ConnectionID = OpenNetworkConnection(*para\SMTPServer, *para\Port)
  With *para
    If SendMail_ConnectionID
      Receivers = CountString(*para\Recipient, ";")
      Receiver = StringField(\Recipient, Number + 1, ";")
      For i = 1 To Receivers
        If i <> Number + 1
          Help = StringField(\Recipient, i, ";")
          If Not FindString(\Blind, Help)
            If Cc <> "" : Cc + "," : EndIf
            Cc + Help
          EndIf
        EndIf
      Next i
      If \Blind <> ""
        For i = 0 To CountString(\Blind, ";")
          Help = StringField(\Blind, i + 1, ";")
          If Help <> Receiver
            If Bcc <> "" : Bcc + "," : EndIf
            Bcc + Help
          EndIf
        Next i
      EndIf
      Repeat
        If NetworkClientEvent(SendMail_ConnectionID)
          ReceivedData = Space(9999)
          ct = ReceiveNetworkData(SendMail_ConnectionID, @ReceivedData, 9999)
          ReceivedData = PeekS(@ReceivedData, -1, #PB_Ascii)
          If ct
            cmdID = Left(ReceivedData, 3)
            cmdText = Mid(ReceivedData, 5, ct - 6)
            If \EnableProtocol = #True
              ProtocolTxt + "[" + FormatDate("%hh:%ii:%ss", Date()) + "] " + cmdText + #CRLF$
            EndIf
            Select cmdID
              Case "220"
                If Len(\Username) > 0
                  __SendMail_Send("Ehlo " + Hostname())
                  State = #eHlo
                Else
                  __SendMail_Send("HELO " + Hostname())
                  State = #MailFrom
                EndIf   
              Case "221"
                __SendMail_Send("[connection closed]")
                State = #Complete
                quit = 1     
              Case "235"
                __SendMail_Send("MAIL FROM: <" + \Sender + ">")
                State = #RcptTo
               
              Case "334"
                If State=#RequestAuthentication
                  __SendMail_Send(__SendMail_Base64Encode(\UserName))
                  State = #Username
                EndIf
                If State = #Username
                  __SendMail_Send(__SendMail_Base64Encode(\Password))
                  state = #Password
                EndIf
               
              Case "250"
                Select state
                  Case #eHlo
                    __SendMail_Send("AUTH LOGIN")
                    state = #RequestAuthentication     
                  Case #MailFrom   
                    __SendMail_Send("MAIL FROM: <" + \Sender + ">")
                    state = #RcptTo
                  Case #RcptTo
                    __SendMail_Send("RCPT TO: <" + Receiver + ">")
                    state = #Data
                  Case #Data
                    __SendMail_Send("DATA")
                    state = #Quit
                  Case #Quit
                    __SendMail_Send("QUIT")
                EndSelect
               
              Case "251"
                __SendMail_Send("DATA")
                state = #Data
              Case "354"
                __SendMail_Send("X-Mailer: eSMTP 1.0")
                __SendMail_Send("To: " + Receiver)
                If Receivers
                  If Bcc <> "" : __SendMail_Send("Bcc: " + Bcc) : EndIf
                  If Cc <> "" : __SendMail_Send("Cc: " + Cc) : EndIf
                EndIf
                __SendMail_Send("From: " + \Name + " <" + \Sender + ">")
                __SendMail_Send("Reply-To: " + \Sender)
                __SendMail_Send("Date:" + FormatDate("%dd/%mm/%yyyy @ %hh:%ii:%ss", Date()))
                __SendMail_Send("Subject: " + \Subject)
                __SendMail_Send("MIME-Version: 1.0")
                __SendMail_Send("Content-Type: multipart/mixed; boundary=" + #DQUOTE$ + "MyMixedBoundary" + #DQUOTE$)
                __SendMail_Send("")
                __SendMail_Send("--MyMixedBoundary")
                If \MessageHtml
                  __SendMail_Send("Content-Type: multipart/alternative; boundary=" + #DQUOTE$ + "MyAlternativeBoundary" + #DQUOTE$)
                  __SendMail_Send("")
                  __SendMail_Send("--MyAlternativeBoundary")
                EndIf
                __SendMail_Send("Content-Type: text/plain; charset=utf-8")
                __SendMail_Send("Content-Transfer-Encoding: 8bit")
                __SendMail_Send("")
                __SendMail_Send(\Message)
                If \MessageHtml
                  __SendMail_Send("--MyAlternativeBoundary")
                  __SendMail_Send("Content-Type: text/html; charset=utf-8")
                  __SendMail_Send("Content-Transfer-Encoding: 8bit")
                  __SendMail_Send("")
                  __SendMail_Send(\MessageHtml)
                  __SendMail_Send("--MyAlternativeBoundary--")
                EndIf
                __SendMail_SendFiles(\ProgressAttachedFile)
                __SendMail_Send("--MyMixedBoundary--")
                __SendMail_Send(".")
               
              Case "421", "450", "451", "452", "454", "500", "501", "502", "503", "535","550", "551", "552", "553", "554"
                ProtocolTxt + cmdID + " " + cmdText + #CRLF$
                quit = 1     
            EndSelect
          EndIf
        EndIf
       
      Until quit = 1 Or ElapsedMilliseconds() > (Time + TimeOut)
      CloseNetworkConnection(SendMail_ConnectionID)
     
    EndIf
  EndWith
 
  ProcedureReturn ProtocolTxt
EndProcedure

Procedure.s SendMail_SendEmail(*para.SendMail_Parameter, TimeOut.i = 15000)
  Protected Result.s
  Protected.i I, Count
  
  Count = CountString(*para\Recipient, ";")
  For I = 0 To Count
    Result + StringField(*para\Recipient, I + 1, ";") + ":" + #CRLF$
    Result + __SendMail_SendEmail(*para, TimeOut, I)
  Next
  ProcedureReturn Result
EndProcedure
And an example:

Code: Select all

IncludeFile "SendMail.pbi"


InitNetwork()

Define mpara.SendMail_Parameter
With mpara
  \Name = ""  ; Hier ist egal was steht.
  \Sender = "you@your_host.org"       ; E-Mail des Senders
  \Recipient = "to@somewhere.net;and@another.one"      ; E-Mail des Empfängers
  \Blind = "and@another.one"
  \UserName = ""     ; Username
  \Password = ""              ; hier dein Kennwort
  \SMTPServer = "your.smtp_server.net"
  \Subject = "Test" ; Hier Betreffzeile
  \Message = "Testtext" ; Hier der Text im Body
  \MessageHtml = "<html><body><h1>TestHTMLText</h1></body></html>"
  \Port = 25
  \EnableProtocol = #True
EndWith

;SendMail_AddAttachment("c:\tmp\a_picture.png")
Define.s ProtocolTxt.s = SendMail_SendEmail(mpara)

If ProtocolTxt
  OpenWindow(0, #PB_Ignore, #PB_Ignore, 640, 480, "SendMail - Protocol")
  EditorGadget(0, 5, 5, 630, 470, #PB_Editor_ReadOnly)
  SetGadgetText(0, ProtocolTxt)
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
So you can specify the recipients separated with a ;
and specify which of them are 'blind' :mrgreen:

Bernd
User avatar
fsw
Addict
Addict
Posts: 1572
Joined: Tue Apr 29, 2003 9:18 pm
Location: North by Northwest

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

Post by fsw »

The smtp server says success but no mail is delivered :cry:
Tried several things , even with different recipients; but no luck.
xxx.xx@xx.xxx:
[16:52:24] omta17.emeryville.ca.mail.comcast.net comcast ESMTP server ready
[16:52:24] omta17.emeryville.ca.mail.comcast.net hello [75.175.92.51], pleased to meet you
250-HELP
250-AUTH LOGIN PLAIN
250-SIZE 36700160
250-ENHANCEDSTATUSCODES
250-8BITMIME
250-STARTTLS
250 OK
[16:52:24] VXNlcm5hbWU6
[16:52:24] UGFzc3dvcmQ6
[16:52:24] 2.7.0 ... Authentication succeeded
[16:52:29] 2.1.0 <xxxxxx.xxxx@comcast.net> sender ok
As you can see I'm on Comcast.
OS -> Win7-64

I am to provide the public with beneficial shocks.
Alfred Hitshock
User avatar
leonhardt
Enthusiast
Enthusiast
Posts: 220
Joined: Wed Dec 23, 2009 3:26 pm

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

Post by leonhardt »

mark
poor English...

PureBasic & Delphi & VBA
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

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

Post by Kwai chang caine »

Hi KCC,
here a modified version with CC and KCC oh... BCC
:lol: :lol:
Waooouuhh !!! :shock:
Thanks a lot INFRATEC for your good adding to the splendid code of TsSfoft 8)
Works perfectly here !!!!
The HTML can be very useful...
And mainly, the blind option is very cool.
At the beginning, i have not understand how use it, but after one hundred mails....i have understand :lol:
In fact, if i have good understand, we can write in the Recipient as adress we want separate by a ;
And after, in the blind parameter, we can write what is the adress above, we not want to appears....top cool !! :D

Again thanks at you too, for this splendid job

For the BCC it's good, but i have not found again how create a CCI sending
With the CCI send, each recipient not see the others.
If i send to "Infratec@PureBasic.fr; Kcc@PureBasic.fr" , Infratec not see the mail is also sending at KCC, and the opposite it's the same thing, Kcc not see the mail is also sending at Infratec (Undisclosed-Recipient)
In the property, it's write

Code: Select all

From:  Kcc"<Kcc@PureBasic.fr">
To: <Undisclosed-Recipient:;>
So if you see in the properties of the mail received, the BCC appears... :shock:

Code: Select all

To: infratec@PureBasic.fr
Bcc: kcc@PureBasic.fr
So here...Kcc is spotted :lol: :lol:
ImageThe happiness is a road...
Not a destination
infratec
Always Here
Always Here
Posts: 6817
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

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

Post by infratec »

Hi KCC,
Kwaï chang caïne wrote:
So if you see in the properties of the mail received, the BCC appears... :shock:

Code: Select all

To: infratec@PureBasic.fr
Bcc: kcc@PureBasic.fr
So here...Kcc is spotted :lol: :lol:
That's strange.
With postfix as smtp server and Thunderbird as client, you don't see the bcc in the sourcecode of the mail.

I'll have a deeper look.

Bernd
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

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

Post by Kwai chang caine »

Thanks 8)
I use Outlook express for receive my mails, and i'm under XP but i suppose it's not important
ImageThe happiness is a road...
Not a destination
infratec
Always Here
Always Here
Posts: 6817
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

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

Post by infratec »

Hi,

I added Undisclosed to the structure.
If it is set to #True no To, CC or BCC is send.

Code: Select all

;- _____________________________________________________________________________
;- |                                                                           |
;- |                              SendEmail (New)                              |
;- |                              _______________                              |
;- |                                                                           |
;- |___________________________________________________________________________|
;{ SendEmail (New) (Start)
; Author : clipper
; PureBasic 3.93
; Changed to Purebasic 4.61 x86 from Falko
; 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
;}
EnableExplicit

Enumeration
  #eHlo
  #RequestAuthentication
  #Username
  #Password
  #MailFrom
  #RcptTo
  #Data
  #Quit
  #Complete
EndEnumeration

Structure SendMail_Parameter
  Name.s
  Sender.s
  Recipient.s
  Blind.s
  UserName.s
  Password.s
  SMTPServer.s
  Subject.s
  Message.s
  MessageHtml.s
  Port.w
  ProgressAttachedFile.i
  EnableProtocol.b
  Undisclosed.i
EndStructure

Prototype SendMail_Callback(percent.i)

Global NewList SendMail_Attachments.s()
Global SendMail_ConnectionID

Procedure SendMail_AddAttachment(File.s)
  AddElement(SendMail_Attachments())
  SendMail_Attachments() =  File
EndProcedure

Procedure SendMail_NoAttachment()
  ClearList(SendMail_Attachments())
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.i
  Protected hKey.i, lKeyValue.s, lDataSize.l, lLoop.i
  Protected lLof.q, *lMemoryID, lBytesRead.i, lFileContents.s
  Protected lPos1.i, lPos2.i, lMimeLen.i, lMyChar.s, lDefault.s
  Protected MimeFile.i
  
  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 = AllocateMemory(Len(strText) + 1)
  Protected *B64EncodeBufferB = AllocateMemory((Len(strText) * 3) + 1)
  PokeS(*B64EncodeBufferA, strText, -1, #PB_Ascii)
  Base64Encoder(*B64EncodeBufferA, Len(strText), *B64EncodeBufferB, Len(strText) * 3)
  Result = PeekS(*B64EncodeBufferB, -1, #PB_Ascii)
  FreeMemory(*B64EncodeBufferA)
  FreeMemory(*B64EncodeBufferB)
  ProcedureReturn Result
EndProcedure

Procedure __SendMail_Send(msg.s)
  Protected *mem, length
  msg + #CRLF$
  length = StringByteLength(msg, #PB_UTF8)
  *mem = AllocateMemory(length + 1)
  If *mem
    PokeS(*mem, msg, -1, #PB_UTF8)
    SendNetworkData(SendMail_ConnectionID, *mem, length)
    FreeMemory(*mem)
  EndIf
EndProcedure

Procedure __SendMail_SendFiles(ProgressCB.SendMail_Callback = 0)
  Protected file.s, FF, InputBufferLength.i, OutputBufferLength.i
  Protected *memin, *memout, Boundry.s, temp.s, i
 
  ResetList(SendMail_Attachments())
  While(NextElement(SendMail_Attachments()))
    file = SendMail_Attachments()
    __SendMail_Send("")
    FF = ReadFile(#PB_Any, file)
    InputBufferLength = Lof(FF)
    OutputBufferLength = InputBufferLength * 1.4
    *memin = AllocateMemory(InputBufferLength)
    If *memin
      *memout = AllocateMemory(OutputBufferLength)
      If *memout
        Boundry = "--MyMixedBoundary"
        __SendMail_Send(Boundry)
        __SendMail_Send("Content-Type: " + __SendMail_GetMIMEType(GetExtensionPart(file)) + "; name=" + Chr(34) + GetFilePart(file.s) + Chr(34))
        __SendMail_Send("Content-Transfer-Encoding: base64")
        __SendMail_Send("Content-Disposition: Attachment; filename=" + Chr(34) + GetFilePart(file) + Chr(34))
        __SendMail_Send("")
        ReadData(FF, *memin, InputBufferLength)
        Base64Encoder(*memin, 60, *memout, OutputBufferLength)
        __SendMail_Send(PeekS(*memout, 60, #PB_Ascii)) ; this must be done because For i=0 To OutputBufferLength/60 doesn't work
        If ProgressCB
          ProgressCB(60 / (OutputBufferLength / 100))
        EndIf
        Base64Encoder(*memin, InputBufferLength, *memout, OutputBufferLength)               
        For i = 1 To OutputBufferLength / 60
          temp = Trim(PeekS(*memout + i * 60, 60, #PB_Ascii))
          If Len(temp) > 0
            __SendMail_Send(temp)
            If ProgressCB
              ProgressCB((60 * i) / (OutputBufferLength / 100))
            EndIf
          EndIf
        Next
        FreeMemory(*memout)
      EndIf
      FreeMemory(*memin)
    EndIf
    CloseFile(FF)
  Wend
  ProcedureReturn
EndProcedure

Procedure.s __SendMail_SendEmail(*para.SendMail_Parameter, TimeOut.i, Number.i = 0)
  Protected loop250.i, ReceivedData.s, ct.i, cmdID.s, cmdText.s
  Protected State, quit, ProtocolTxt.s, Time.i = ElapsedMilliseconds()
  Protected Receivers.i, Receiver.s, Cc.s, Bcc.s, i.i, Help.s

  If *para\Port = 0 : *para\Port = 25 : EndIf
 
  SendMail_ConnectionID = OpenNetworkConnection(*para\SMTPServer, *para\Port)
  With *para
    If SendMail_ConnectionID
      Receivers = CountString(*para\Recipient, ";")
      Receiver = StringField(\Recipient, Number + 1, ";")
      For i = 1 To Receivers
        If i <> Number + 1
          Help = StringField(\Recipient, i, ";")
          If Not FindString(\Blind, Help)
            If Cc <> "" : Cc + "," : EndIf
            Cc + Help
          EndIf
        EndIf
      Next i
      If \Blind <> ""
        For i = 0 To CountString(\Blind, ";")
          Help = StringField(\Blind, i + 1, ";")
          If Help <> Receiver
            If Bcc <> "" : Bcc + "," : EndIf
            Bcc + Help
          EndIf
        Next i
      EndIf
      Repeat
        If NetworkClientEvent(SendMail_ConnectionID)
          ReceivedData = Space(9999)
          ct = ReceiveNetworkData(SendMail_ConnectionID, @ReceivedData, 9999)
          ReceivedData = PeekS(@ReceivedData, -1, #PB_Ascii)
          If ct
            cmdID = Left(ReceivedData, 3)
            cmdText = Mid(ReceivedData, 5, ct - 6)
            If \EnableProtocol = #True
              ProtocolTxt + "[" + FormatDate("%hh:%ii:%ss", Date()) + "] " + cmdText + #CRLF$
            EndIf
            Select cmdID
              Case "220"
                If Len(\Username) > 0
                  __SendMail_Send("Ehlo " + Hostname())
                  State = #eHlo
                Else
                  __SendMail_Send("HELO " + Hostname())
                  State = #MailFrom
                EndIf   
              Case "221"
                __SendMail_Send("[connection closed]")
                State = #Complete
                quit = 1     
              Case "235"
                __SendMail_Send("MAIL FROM: <" + \Sender + ">")
                State = #RcptTo
               
              Case "334"
                If State=#RequestAuthentication
                  __SendMail_Send(__SendMail_Base64Encode(\UserName))
                  State = #Username
                EndIf
                If State = #Username
                  __SendMail_Send(__SendMail_Base64Encode(\Password))
                  state = #Password
                EndIf
               
              Case "250"
                Select state
                  Case #eHlo
                    __SendMail_Send("AUTH LOGIN")
                    state = #RequestAuthentication     
                  Case #MailFrom   
                    __SendMail_Send("MAIL FROM: <" + \Sender + ">")
                    state = #RcptTo
                  Case #RcptTo
                    __SendMail_Send("RCPT TO: <" + Receiver + ">")
                    state = #Data
                  Case #Data
                    __SendMail_Send("DATA")
                    state = #Quit
                  Case #Quit
                    __SendMail_Send("QUIT")
                EndSelect
               
              Case "251"
                __SendMail_Send("DATA")
                state = #Data
              Case "354"
                __SendMail_Send("X-Mailer: eSMTP 1.0")
                If Not \Undisclosed
                  __SendMail_Send("To: " + Receiver)
                  If Receivers
                    If Bcc <> "" : __SendMail_Send("Bcc: " + Bcc) : EndIf
                    If Cc <> "" : __SendMail_Send("Cc: " + Cc) : EndIf
                  EndIf
                EndIf
                __SendMail_Send("From: " + \Name + " <" + \Sender + ">")
                __SendMail_Send("Reply-To: " + \Sender)
                __SendMail_Send("Date:" + FormatDate("%dd/%mm/%yyyy @ %hh:%ii:%ss", Date()))
                __SendMail_Send("Subject: " + \Subject)
                __SendMail_Send("MIME-Version: 1.0")
                __SendMail_Send("Content-Type: multipart/mixed; boundary=" + #DQUOTE$ + "MyMixedBoundary" + #DQUOTE$)
                __SendMail_Send("")
                __SendMail_Send("--MyMixedBoundary")
                If \MessageHtml
                  __SendMail_Send("Content-Type: multipart/alternative; boundary=" + #DQUOTE$ + "MyAlternativeBoundary" + #DQUOTE$)
                  __SendMail_Send("")
                  __SendMail_Send("--MyAlternativeBoundary")
                EndIf
                __SendMail_Send("Content-Type: text/plain; charset=utf-8")
                __SendMail_Send("Content-Transfer-Encoding: 8bit")
                __SendMail_Send("")
                __SendMail_Send(\Message)
                If \MessageHtml
                  __SendMail_Send("--MyAlternativeBoundary")
                  __SendMail_Send("Content-Type: text/html; charset=utf-8")
                  __SendMail_Send("Content-Transfer-Encoding: 8bit")
                  __SendMail_Send("")
                  __SendMail_Send(\MessageHtml)
                  __SendMail_Send("--MyAlternativeBoundary--")
                EndIf
                __SendMail_SendFiles(\ProgressAttachedFile)
                __SendMail_Send("--MyMixedBoundary--")
                __SendMail_Send(".")
               
              Case "421", "450", "451", "452", "454", "500", "501", "502", "503", "535","550", "551", "552", "553", "554"
                ProtocolTxt + cmdID + " " + cmdText + #CRLF$
                quit = 1     
            EndSelect
          EndIf
        EndIf
       
      Until quit = 1 Or ElapsedMilliseconds() > (Time + TimeOut)
      CloseNetworkConnection(SendMail_ConnectionID)
     
    EndIf
  EndWith
 
  ProcedureReturn ProtocolTxt
EndProcedure

Procedure.s SendMail_SendEmail(*para.SendMail_Parameter, TimeOut.i = 15000)
  Protected Result.s
  Protected.i I, Count
  
  Count = CountString(*para\Recipient, ";")
  For I = 0 To Count
    Result + StringField(*para\Recipient, I + 1, ";") + ":" + #CRLF$
    Result + __SendMail_SendEmail(*para, TimeOut, I)
  Next
  ProcedureReturn Result
EndProcedure
Example:

Code: Select all

IncludeFile "SendMail.pbi"


InitNetwork()

Define mpara.SendMail_Parameter
With mpara
  \Name = ""  ; Hier ist egal was steht.
  \Sender = "you@your_host.org"       ; E-Mail des Senders
  \Recipient = "to@somewhere.net;and@another.one"      ; E-Mail des Empfängers
  \Blind = "and@another.one"
  \UserName = ""     ; Username
  \Password = ""              ; hier dein Kennwort
  \SMTPServer = "your.smtp_server.net"
  \Subject = "Test" ; Hier Betreffzeile
  \Message = "Testtext" ; Hier der Text im Body
  \MessageHtml = "<html><body><h1>TestHTMLText</h1></body></html>"
  \Port = 25
  \EnableProtocol = #True
  \Undisclosed = #True
EndWith

;SendMail_AddAttachment("c:\tmp\a_picture.png")
Define.s ProtocolTxt.s = SendMail_SendEmail(mpara)

If ProtocolTxt
  OpenWindow(0, #PB_Ignore, #PB_Ignore, 640, 480, "SendMail - Protocol")
  EditorGadget(0, 5, 5, 630, 470, #PB_Editor_ReadOnly)
  SetGadgetText(0, ProtocolTxt)
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
But still: BCC is not shown in the sourcecode with Postfix/Thunderbird.
At least you can comment out the 'Bcc:' line in SendMail.pbi

Bernd
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

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

Post by Kwai chang caine »

Works great now !!! 8)
If i enter this parameter

Code: Select all

\Sender = "you@yahoo.fr"
  \Recipient = "infratec@PureBasic.fr;Kcc@PureBasic.fr"
  \Blind = "infratec@PureBasic.fr;Kcc@PureBasic.fr"
Each mail have the "you@yahoo.fr" for return :D
And each mail, have NONE ("Aucun" in french) :D

Image

Again thanks for this adding.
Have a very good day, and week-end 8)
ImageThe happiness is a road...
Not a destination
User avatar
fsw
Addict
Addict
Posts: 1572
Joined: Tue Apr 29, 2003 9:18 pm
Location: North by Northwest

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

Post by fsw »

leonhardt wrote:mark
:?:

Am I the only one having problems with this code?

I am to provide the public with beneficial shocks.
Alfred Hitshock
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

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

Post by Kwai chang caine »

Well i continue to try this splendid code 8)

But i have like always again little problem.
Several method exist for sending mail (I use Outlook express)
And i have not really understand what is the parameter i must use :oops:

There are two variables \Recipient and \Blind

1/ I send a message to one person

\Recipient = "1@PB.fr"
\Bind = ""
Simple and works perfectly, the mail return "To : 1@PB.fr" and is all

2/ I send a message to three persons

\Recipient = "1@PB.fr;2@PB.fr;3@PB.fr"
\Bind = ""
Here, that begin to be strange, i send good the mails, for the three recipient, it's good
But the mail of the First return "To : 1@PB.fr" and "Cc : 2@PB.fr"
and the mail of the Second return "To : 2@PB.fr" and "Cc : 1@PB.fr"
and the mail of the Third return "To : 3@PB.fr" and "Cc : 1@PB.fr;2@PB.fr"

Is it normal ???
Have you the same result ??

Me, i thought, if i write "\Recipient = 1@PB.fr;2@PB.fr;3@PB.fr"
The mail of each recipient should be like that, no ??? :oops:

Mail of the First "To : 1@PB.fr" and "Cc : 2@PB.fr;3@PB.fr" (Not the case :( )
Mail of the Second "To : 2@PB.fr" and "Cc : 1@PB.fr;3@PB.fr" (Not the case :( )
Mail of the Third "To : 3@PB.fr" and "Cc : 1@PB.fr;2@PB.fr" (It's done :D )
ImageThe happiness is a road...
Not a destination
lolotlse
New User
New User
Posts: 1
Joined: Fri May 31, 2013 8:04 am

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

Post by lolotlse »

Hi All,
Very good thred i try It. But i have a problem with html mail. It is limited buffer text ? because i use long text with One or Two variable Body1$ for example with html quote text <br> etc... My text amount 1000 characters.

Thanks for your answer and good coding.

Kind regards
nalor
Enthusiast
Enthusiast
Posts: 115
Joined: Thu Apr 02, 2009 9:48 pm

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

Post by nalor »

Hi! Used the code from the first post and enhanced it a little bit so that it better fits my needs.

My main changes:
# removed global variables
# better error handling
# mail to multiple recipients is sent as 1 email to multiple recipients (in the past a separate email has been sent to each recipient..)

Here comes my version:

Code: Select all

;- _____________________________________________________________________________
;- |                                                                           |
;- |                              SendEmail (New)                              |
;- |                              _______________                              |
;- |                                                                           |
;- |___________________________________________________________________________|
;{ SendEmail (New) (Start)                                       
; Author : clipper
; PureBasic 3.93
; Changed to Purebasic 4.61 x86 from Falko
; 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


;}
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_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(Len(strText) + 1)
	If *B64EncodeBufferA
		*B64EncodeBufferB = AllocateMemory((Len(strText) * 3) + 1)
		If *B64EncodeBufferB
			PokeS(*B64EncodeBufferA, strText, -1, #PB_Ascii)
			Base64Encoder(*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(Len(strText) + 1)
	If *B64DecodeBufferA
		*B64DecodeBufferB = AllocateMemory(Len(strText))
		If *B64DecodeBufferB
			PokeS(*B64DecodeBufferA, strText, -1, #PB_Ascii)
			Base64Decoder(*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
						__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=Base64Encoder(*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.l = 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) ; '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("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()

Define mpara.SendEmail_Parameter
Define.s ProtocolTxt.s

With mpara
	\Sender_Name = "NameOfSender"  ; Hier ist egal was steht.
	\Sender_Email = "sender@address.to"       ; E-Mail des Senders
	\RecipientTO="recipient@address.to;recipient2@address.to"
;	\RecipientCC=""
;	\RecipientBCC=""
	\UserName = ""; Username
	\Password = ""; Password
	\SMTPServer = "my.mailserver.com"
	\Subject = "The subject line" ; Hier Betreffzeile
	\Message = "Das ist eine Mail, die ich mal testweise an mich selber über PB schicke" ; Hier der Text im Body
	\Port = 25
	\Protocol_Enable = #True
	\ProgressAttachedFile=@SendEmail_Callback()
	
	AddElement(\Attachments())
	\Attachments()="d:\abc.pdf"
	AddElement(\Attachments())
	\Attachments()="d:\xyz.pdf"
  
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
Have fun with it! :D
IdeasVacuum
Always Here
Always Here
Posts: 6425
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

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

Post by IdeasVacuum »

There have been some brilliant updates to this pbi, but the most brilliant would be compatibility with Gmail (smtp.gmail.com), as it is one of the most popular, if not the most popular.
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
Post Reply