PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Send email with attachments...

https://www.purebasic.fr/english/viewtopic.php?t=6536

Page 1 of 1

Send email with attachments...

Posted: Thu Jun 12, 2003 10:41 pm
by Kale
Code updated for 5.20+. The 'mail' library is now available for this.

This is a simple email procedure that encodes and send attachments, i think maybe more error checking could be implemented.

This is really a work in progress but i thought i would post it here to get other peoples input. I know this had been requested alot.

I may be opening the floodgates here but any comments/optimisations are welcome. I'm sure things could be done better but it seems to work ok for me. :twisted:

Code: Select all

;Modified code originally posted by Paul IIRC  :)

;USAGE:
;PBSendMail(
;                        RecipientEmailAddress as String
;                        SenderEmailAddress as String
;                        MailServerHost as String
;                        Subject as String
;                        Message as String
;                        AttachmentIncluded as Byte (Flag: 0/1)
;                     )

;NOTES:
;When the 'AttachmentIncluded' flag is set to '1', the mail procedure loops through a linked list
;called 'Attachments()' then encodes or processes the attachments. So to send attachments
;you must have a linked list called 'Attachments()'.

;===============================================
;-GLOBAL FLAGS / VARIABLES / STRUCTURES / ARRAYS
;===============================================

Global ConnectionID.l
Global MailResponse.s

;Example linked list
Global NewList Attachments.s()
InsertElement(Attachments())
Attachments() = "C:\Documents And Settings\User\Desktop\Image.jpg"
;InsertElement(Attachments())
;Attachments() = "C:\Documents And Settings\User\Desktop\Archive.zip"
;InsertElement(Attachments())
;Attachments() = "C:\Documents And Settings\User\Desktop\ObscureText.fff"

;===============================================
;-PROCEDURES
;===============================================

;Check to see if the file is binary
Procedure IsBinary(File.s)
  If ReadFile(0, File)
    While Loc(0) <> Lof(0)
      CurrentByte.b = ReadByte(0)
      If CurrentByte <= 9 Or CurrentByte = 127
        CloseFile(0)
        ProcedureReturn 1
      EndIf
      If CurrentByte > 10 And CurrentByte < 13
        CloseFile(0)
        ProcedureReturn 1
      EndIf
      If CurrentByte > 13 And CurrentByte < 32
        CloseFile(0)
        ProcedureReturn 1
      EndIf
    Wend
  EndIf
EndProcedure

;Find the MIME type for a given file extension
Procedure.s GetMIMEType(Extension.s)
  Extension = "." + Extension
  hKey.l = 0
  KeyValue.s = Space(255)
  datasize.l = 255
  If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, Extension, 0, #KEY_READ, @hKey)
    KeyValue = "application/octet-stream"
  Else
    If RegQueryValueEx_(hKey, "Content Type", 0, 0, @KeyValue, @datasize)
      KeyValue = "application/octet-stream"
    Else
      KeyValue = Left(KeyValue, datasize-1)
    EndIf
    RegCloseKey_(hKey)
  EndIf
  ProcedureReturn KeyValue
EndProcedure

;Send a piece of mail data
Procedure SendMailData(msg.s)
  SendNetworkData(ConnectionID, @msg, Len(msg))
EndProcedure

;Check the server responses
Procedure.s MailResponse()
  MailResponse=Space(9999)
  ReceiveNetworkData(ConnectionID,@MailResponse,9999)
  MailResponse=Left(MailResponse,3)
  ProcedureReturn MailResponse
EndProcedure

;Send the mail
Procedure PBSendMail(RecipientEmailAddress.s, SenderEmailAddress.s, MailServerHost.s, Subject.s, Message.s, AttachmentIncluded.b)
  If InitNetwork()
    ConnectionID = OpenNetworkConnection(MailServerHost, 25)
    If ConnectionID <> 0
      MailResponse()
      If MailResponse = "220"
        Index = FindString(MailServerHost, ".", 1)
        MailServerDomain.s = Mid(MailServerHost, Index + 1, Len(MailServerHost))
        SendMailData("HELO "+MailServerDomain+Chr(13)+Chr(10))
        MailResponse()
        If MailResponse="250"
          Sleep_(125)
          SendMailData("MAIL FROM: <"+SenderEmailAddress+">"+Chr(13)+Chr(10))
          MailResponse()
          If MailResponse="250"
            SendMailData("RCPT TO: <"+RecipientEmailAddress+">"+Chr(13)+Chr(10))
            MailResponse()
            If MailResponse="250"
              SendMailData("DATA"+Chr(13)+Chr(10))
              MailResponse()
              If MailResponse="354"
                Sleep_(125)
                SendMailData("X-Mailer: PBSendMail v1.0" + Chr(13) + Chr(10))
                SendMailData("To: " + RecipientEmailAddress + Chr(13) + Chr(10))
                SendMailData("From: " + SenderEmailAddress + Chr(13) + Chr(10))
                SendMailData("Reply-To:" + SenderEmailAddress + Chr(13) + Chr(10))
                SendMailData("Date: " + FormatDate("%dd/%mm/%yyyy @ %hh:%ii:%ss", Date()) + Chr(13) + Chr(10))
                SendMailData("Subject: " + Subject + Chr(13) + Chr(10))
                SendMailData("MIME-Version: 1.0" + Chr(13) + Chr(10))
                ;Handle any attachments
                If AttachmentIncluded
                  Debug "Processing 'multipart/mixed' Email..."
                  Boundry.s = "PBSendMailv1.0_Boundry_"+ FormatDate("%dd%mm%yyyy%hh%ii%ss", Date())
                  SendMailData("Content-Type: multipart/mixed; boundary=" + Chr(34) + Boundry + Chr(13) + Chr(10) + Chr(34))
                  SendMailData(Chr(13) + Chr(10))
                  ;Main message
                  Debug "Processing Messsage..."
                  SendMailData("--" + Boundry + Chr(13) + Chr(10)) ; Boundry
                  SendMailData("Content-Type: text/plain; charset=" + Chr(34) + "iso-8859-1" + Chr(34) + Chr(13) + Chr(10))
                  SendMailData("Content-Transfer-Encoding: 7bit" + Chr(13) + Chr(10))
                  SendMailData(Chr(13) + Chr(10))
                  Sleep_(125)
                  SendMailData(Message + Chr(13) + Chr(10))
                  SendMailData(Chr(13) + Chr(10))
                  Sleep_(125)
                  Debug "Processing Attachments..."
                  ResetList(Attachments())
                  While(NextElement(Attachments()))
                    ;Attachment headers
                    SendMailData("--" + Boundry + Chr(13) + Chr(10)) ; Boundry
                    SendMailData("Content-Type: " + GetMIMEType(GetExtensionPart(Attachments())) + "; name=" + Chr(34) + GetFilePart(Attachments()) + Chr(34) + Chr(13) + Chr(10))
                    If IsBinary(Attachments())
                      SendMailData("Content-Transfer-Encoding: base64" + Chr(13) + Chr(10))
                      SendMailData("Content-Disposition: Attachment; filename=" + Chr(34) + GetFilePart(Attachments()) + Chr(34) + Chr(13) + Chr(10))
                      SendMailData(Chr(13) + Chr(10))
                      Sleep_(125)
                      ;Encode the Attachments using Base64
                      If ReadFile(0, Attachments())
                        InputBufferLength.l = Lof(0)
                        *InputBuffer = AllocateMemory(InputBufferLength)
                        If *InputBuffer
                          OutputBufferLength.l = InputBufferLength + InputBufferLength/3 + 2
                          If OutputBufferLength < 64 : OutputBufferLength = 64 : EndIf
                          
                          *OutputBuffer = AllocateMemory(OutputBufferLength)
                          If *OutputBuffer
                            ReadData(0, *InputBuffer, InputBufferLength)
                            Base64Encoder(*InputBuffer, InputBufferLength, *OutputBuffer, OutputBufferLength)
                            SendMailData(PeekS(*OutputBuffer, OutputBufferLength) + Chr(13) + Chr(10))
                            Debug GetFilePart(Attachments()) + " (base64) Encoded"
                            FreeMemory(*OutputBuffer)
                          Else
                            Debug "ERROR: Unable to allocate memory for Bank 1 to process " + GetFilePart(Attachments())
                            ProcedureReturn 0
                          EndIf
                          
                          FreeMemory(*InputBuffer)
                        Else
                          Debug "ERROR: Unable to allocate memory for Bank 0 to process " + GetFilePart(Attachments())
                          ProcedureReturn 0
                        EndIf
                      Else
                        Debug "ERROR: Unable to read file: " + GetFilePart(Attachments())
                        ProcedureReturn 0
                      EndIf
                      CloseFile(0)
                    Else
                      SendMailData("Content-Transfer-Encoding: 7bit" + Chr(13) + Chr(10))
                      SendMailData("Content-Disposition: Attachment; filename=" + Chr(34) + GetFilePart(Attachments()) + Chr(34) + Chr(13) + Chr(10))
                      SendMailData(Chr(13) + Chr(10))
                      Sleep_(125)
                      If ReadFile(0, Attachments())
                        InputBufferLength.l = Lof(0)
                        *InputBuffer = AllocateMemory(InputBufferLength)
                        If *InputBuffer
                          ReadData(0, *InputBuffer, InputBufferLength)
                          SendMailData(PeekS(*InputBuffer, InputBufferLength) + Chr(13) + Chr(10))
                          Debug GetFilePart(Attachments()) + " (7bit) Processed"
                          FreeMemory(*InputBuffer)
                        Else
                          Debug "ERROR: Unable to allocate memory for Bank 0 to process " + GetFilePart(Attachments())
                          ProcedureReturn 0
                        EndIf
                      Else
                        Debug "ERROR: Unable to read file: " + GetFilePart(Attachments())
                        ProcedureReturn 0
                      EndIf
                    EndIf
                    
                    Sleep_(125)
                    SendMailData(Chr(13) + Chr(10))
                  Wend
                  SendMailData("--" + Boundry + "--" + Chr(13) + Chr(10)) ; End Boundry
                Else
                  Debug "Processing messsage..."
                  SendMailData("Content-Type: text/plain; charset=" + Chr(34) + "iso-8859-1" + Chr(34) + Chr(13) + Chr(10))
                  SendMailData("Content-Transfer-Encoding: 7bit" + Chr(13) + Chr(10))
                  SendMailData(Chr(13) + Chr(10))
                  Sleep_(125)
                  SendMailData(Message + Chr(13) + Chr(10))
                EndIf
                Sleep_(125)
                SendMailData(Chr(13)+Chr(10))
                SendMailData("."+Chr(13)+Chr(10))
                MailResponse()
                If MailResponse="250"
                  Sleep_(125)
                  SendMailData("QUIT"+Chr(13)+Chr(10))
                  MailResponse()
                  Debug "Mail sent successfully."
                  ProcedureReturn 1
                EndIf
              EndIf
            EndIf
          EndIf
        EndIf
      EndIf
      CloseNetworkConnection(ConnectionID)
    EndIf
  EndIf
EndProcedure

;Testing:
PBSendMail("test@server.com", "test@purebasic.com", "smtp.server.com", "Subject Line", "Lorem Ipsum Dolar Sit Amet...", 0)

Re: Send email with attachments...

Posted: Thu Jun 12, 2003 10:54 pm
by Num3
Kale wrote:I may be opening the floodgates here but any comments/optimisations are welcome.
Flood starts here :mrgreen:

/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/


1. Files should be encoded before sending
2. Header routines should be pre-built before sending
3. Error implementation... tss tsss...

Of course i'm just making critics :twisted:

Anyway:

Congrats... Excelent work :lol:

Posted: Thu Jun 12, 2003 11:28 pm
by Kale
>1. Files should be encoded before sending
>2. Header routines should be pre-built before sending
>3. Error implementation... tss tsss...

he...he... technically the files are encoded before sending :) im not sure what you mean by No.2 the headers need to be dynamically created depending on the file types attached, or do you mean these should be pre-built along with the encoding before the actual net access takes place? I think thats maybe a better idea. No.3 = :twisted:

Posted: Tue Jun 17, 2003 10:35 pm
by Kale
A new approach using an external freeware .dll called blat.

http://www.garyw.uklinux.net/PB/Email%20Example.zip

Have fun!

Posted: Tue Jun 17, 2003 10:58 pm
by Num3
Kale wrote:A new approach using an external freeware .dll called blat.

http://www.garyw.uklinux.net/PB/Email%20Example.zip

Have fun!
I already knew of this DLL... I was just seeing how long it would take you to find it :mrgreen:

Ehhehhehe :twisted:

Posted: Wed Jun 18, 2003 12:20 pm
by Kale
>I already knew of this DLL... I was just seeing how long
>it would take you to find it

>Ehhehhehe :twisted:

8O Grrrrr... :twisted:

Posted: Mon Jul 21, 2003 2:17 pm
by gnozal
@ Kale :
I just tried you example and it works really nice.
I have one problem though : when i send some binary files (*.EXE, *.ICO, ...) ( = Base64 encoded), sometimes I get an attachement with file size = 0 (I tested it with Outlook).
Do you have an updated version ?

Posted: Mon Jul 21, 2003 5:26 pm
by Kale
Hmmm... maybe some data wasn't sent... :roll: There should really be a check to see that the data has been sent succesfully and if not retry'd. This is the only version of this code, because i prefer to use blat.dll now :)

Posted: Tue Jul 22, 2003 8:02 am
by gnozal
Thanks. I will check this out.
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited