Announcement

Collapse
No announcement yet.

Send multiple attachments using SMTP

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Send multiple attachments using SMTP

    I've got sample code that works with SMTP and one attachment but have trouble sending two attachments with the same email.

    Code:
    '==============================================================================
    '
    '  MailFile : Send E-mail with a file attachment using TCP statements
    '  This example derived from the article in the PowerBASIC Gazette, issue #33
    '
    '  Donated to the Public Domain by PowerBASIC, Inc. 08 January 2003.
    '
    '==============================================================================
    
    
    #COMPILE EXE
    #REGISTER ALL
    #DIM ALL
    #INCLUDE "WIN32API.INC"
    
    '-----------------------------------------------------------------------------
    ' Modify these equates to match your E-mail server and desired E-mail headers.
    '
    
    ' The name of your SMTP E-mail server.
    $mailhost = "youremailserver"
    
    ' E-mail and header info
    $File     = "somefile.TXT"
    $MailFrom = "[email protected]"
    $MailTo   = "[email protected]"
    $Subject  = "PowerBASIC E-mail attachment demo"
    
    
    '-----------------------------------------------------------------------------
    ' Display a status message.
    '
    MACRO m_DisplayResults (sText)
    #IF %DEF(%PB_CC32)
        STDOUT sText
    #ELSE
        MSGBOX sText, %MB_SYSTEMMODAL
    #ENDIF
    END MACRO
    
    
    '-----------------------------------------------------------------------------
    ' Retrieve the current time and date in E-mail header format
    '
    FUNCTION MailDate () AS STRING
    
        LOCAL szFormat AS ASCIIZ * 40
        LOCAL szTemp   AS ASCIIZ * 40
        LOCAL sResult  AS STRING
        LOCAL t        AS SYSTEMTIME
        LOCAL tzone    AS TIME_ZONE_INFORMATION
    
        GetSystemTime t
    
        szFormat = "ddd',' dd MMM yyyy"
        GetDateFormat %LOCALE_USER_DEFAULT, 0, t, szFormat, szTemp, SIZEOF(szTemp)
        sResult = szTemp
    
        szFormat = "HH':'mm':'ss"
        GetTimeFormat %LOCALE_USER_DEFAULT, 0, t, szFormat, szTemp, SIZEOF(szTemp)
        FUNCTION = sResult + " " + szTemp + " UT"
    
    END FUNCTION
    
    
    '-----------------------------------------------------------------------------
    ' Encode binary file data using Base64 encoding for MIME.
    '
    SUB MimeEncode (sFileData AS STRING)
    
        LOCAL lBlock   AS LONG
        LOCAL lcBlocks AS LONG
        LOCAL lByte1   AS LONG
        LOCAL lByte2   AS LONG
        LOCAL lByte3   AS LONG
        LOCAL lIndex1  AS LONG
        LOCAL lIndex2  AS LONG
        LOCAL lIndex3  AS LONG
        LOCAL lIndex4  AS LONG
        LOCAL pInput   AS BYTE PTR
        LOCAL pOutput  AS BYTE PTR
        LOCAL pTable   AS BYTE PTR
        LOCAL sBase64  AS STRING
        LOCAL sResult  AS STRING
    
        ' Set up Base64 translation table
        sBase64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    
        ' Round up the length of the input data to a multiple of three
        lcBlocks = (LEN(sFileData) + 2) \ 3
        IF lcBlocks * 3 > LEN(sFileData) THEN
            sFileData = LSET$(sFileData, lcBlocks * 3 USING $NUL)
        END IF
    
        ' Allocate the space for the output string
        sResult = SPACE$(lcBlocks * 4)
    
        ' Set up pointers so we can treat the data as byte streams
        pInput  = STRPTR(sFileData)
        pOutput = STRPTR(sResult)
        pTable  = STRPTR(sBase64)
    
        ' Loop through our entire input buffer
        FOR lBlock = 1 TO lcBlocks
            ' Get the next three binary data bytes to process
            lByte1 = @pInput
            INCR pInput
            lByte2 = @pInput
            INCR pInput
            lByte3 = @pInput
            INCR pInput
    
            ' Translate the three data bytes into four Base64 table indices
            lIndex1 = lByte1 \ 4
            lIndex2 = (lByte1 AND 3) * 16 + lByte2 \ 16
            lIndex3 = (lByte2 AND 15) * 4 + lByte3 \ 64
            lIndex4 = lByte3 AND 63
    
            ' Use the Base64 table to encode the output string
            @pOutput = @pTable[lIndex1]
            INCR pOutput
            @pOutput = @pTable[lIndex2]
            INCR pOutput
            @pOutput = @pTable[lIndex3]
            INCR pOutput
            @pOutput = @pTable[lIndex4]
            INCR pOutput
        NEXT
    
        sFileData = sResult
    
    END SUB
    
    
    '-----------------------------------------------------------------------------
    ' The main application entry point.
    '
    FUNCTION PBMAIN () AS LONG
    
        LOCAL lLine       AS LONG
        LOCAL nTCP        AS LONG
        LOCAL sAttachment AS STRING
        LOCAL sAttachment1 AS STRING
        LOCAL sLocalHost  AS STRING
        LOCAL sResponse   AS STRING
        LOCAL sBoundary   AS STRING
        LOCAL y           AS LONG
        LOCAL mailto      AS STRING
        LOCAL file2       AS STRING
    
        ' Read the target file
        OPEN $File FOR BINARY ACCESS READ LOCK SHARED AS #1
        GET$ #1, LOF(1), sAttachment
        CLOSE #1
    
        sResponse = "Cannot open file"
        IF ERR THEN GOTO SendError
        sResponse = "File does not contain any data"
        IF LEN(sAttachment) = 0 THEN GOTO SendError
    
        ' Encode the file data in Base64 for MIME
        MimeEncode sAttachment
    
        ' Invent a unique file data boundary marker
        sBoundary = "Boundary." + REMOVE$(GUIDTXT$(GUID$), ANY "{-}")
    
        ' Tell the user what's happening...
    #IF %DEF(%PB_CC32)
        m_DisplayResults("Attachment loaded, sending E-mail...")
    #ENDIF
    
        ' Connect to E-mail server (mailhost)
    FOR Y& = 1 TO 1
        SELECT CASE Y&
          CASE 1 TO 20
            mailto$ = "[email protected]"
        END SELECT
        nTCP = 2
        TCP OPEN "smtp" AT $mailhost AS nTCP
        sResponse = "Cannot connect to E-mail server: " + $mailhost
        IF ERR THEN GOTO SendError
    
        TCP LINE nTCP, sResponse
        IF LEFT$(sResponse, 3) <> "220" THEN GOTO SendError
    
        ' Get the local host name
        HOST NAME TO sLocalHost
    
        ' Greet the mailhost
        TCP PRINT nTCP, "HELO " + sLocalHost
        TCP LINE nTCP, sResponse
        IF LEFT$(sResponse, 3) <> "250" THEN GOTO SendError
    
        ' Tell the mailhost who we are
        TCP PRINT nTCP, "MAIL FROM: <" + $mailfrom + ">"
        TCP LINE nTCP, sResponse
        IF LEFT$(sResponse, 3) <> "250" THEN GOTO SendError
    
        ' Tell the mailhost who the message is for
        TCP PRINT nTCP, "RCPT TO: <" + mailto$ + ">"
        TCP LINE nTCP, sResponse
        IF LEFT$(sResponse, 3) <> "250" THEN GOTO SendError
    
        ' Send the message
        TCP PRINT nTCP, "DATA"
        TCP LINE nTCP, sResponse
        IF LEFT$(sResponse, 3) <> "354" THEN GOTO SendError
    
        ' The E-mail header
        TCP PRINT nTCP, "Date: " + MailDate
        TCP PRINT nTCP, "From: " + $MailFrom
        TCP PRINT nTCP, "To: " + $MailTo
        TCP PRINT nTCP, "Subject: " + $Subject
        TCP PRINT nTCP, "X-Mailer: PowerBASIC MIME/Base64 E-mail Demo 1.0"
        TCP PRINT nTCP, "MIME-Version: 1.0"
        TCP PRINT nTCP, "Content-Type: multipart/mixed; boundary=" + $DQ + sBoundary + $DQ
        TCP PRINT nTCP, ""
        TCP PRINT nTCP, "--" + sBoundary
    
        ' Create a Plain-text section
        TCP PRINT nTCP, "Content-Type: text/plain; charset=" + $DQ + "us-ascii" + $DQ
        TCP PRINT nTCP, "Content-Transfer-Encoding: 7bit"
        TCP PRINT nTCP, ""
    
        ' Create a main E-mail body section
        TCP PRINT nTCP, "Dear Customer,"
        TCP PRINT nTCP, ""
        TCP PRINT nTCP, "The file you requested is attached to this E-mail."
        TCP PRINT nTCP, ""
        TCP PRINT nTCP, "We hope it helps!"
        TCP PRINT nTCP, ""
    
        ' Create the attachment body section
        TCP PRINT nTCP, "--" + sBoundary
        TCP PRINT nTCP, "Content-Type: application/octet-stream; name=" + $DQ + $File + $DQ
        TCP PRINT nTCP, "Content-Transfer-Encoding: base64"
        TCP PRINT nTCP, ""
    
        ' Write the encoded data in lines of 76 characters.  Add an equality
        ' character if the last line is less than 76 bytes long
        FOR lLine = 1 TO LEN(sAttachment) STEP 76
            IF LEN(sAttachment) - lLine >= 76 THEN
                TCP PRINT nTCP, MID$(sAttachment, lLine, 76)
            ELSE
                TCP PRINT nTCP, MID$(sAttachment, lLine) + "="
            END IF
        NEXT
    
        ' Send the terminating boundary marker
        TCP PRINT nTCP, "--" + sBoundary + "--"
    'Attempted to repeat the process by using a different name on the attachment header
    '-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
        ' Read the target file
        OPEN $File FOR BINARY ACCESS READ LOCK SHARED AS #1
        GET$ #1, LOF(1), sAttachment1
        CLOSE #1
    
        sResponse = "Cannot open file2"
        IF ERR THEN GOTO SendError
        sResponse = "File does not contain any data"
        IF LEN(sAttachment1) = 0 THEN GOTO SendError
    
        ' Encode the file data in Base64 for MIME
        MimeEncode sAttachment1
        sResponse = "3"
    
        ' Invent a unique file data boundary marker
        sBoundary = "Boundary." + REMOVE$(GUIDTXT$(GUID$), ANY "{-}")
        sResponse = "4"
        file2$ = "snail.txt"
        ' Create second attachment body section
        TCP PRINT nTCP, "--" + sBoundary
        TCP PRINT nTCP, "Content-Type: application/octet-stream; name=" + $DQ + file2$ + $DQ
        TCP PRINT nTCP, "Content-Transfer-Encoding: base64"
        TCP PRINT nTCP, ""
    
        ' Write the encoded data in lines of 76 characters.  Add an equality
        ' character if the last line is less than 76 bytes long
        FOR lLine = 1 TO LEN(sAttachment1) STEP 76
            IF LEN(sAttachment1) - lLine >= 76 THEN
                TCP PRINT nTCP, MID$(sAttachment1, lLine, 76)
            ELSE
                TCP PRINT nTCP, MID$(sAttachment1, lLine) + "="
            END IF
        NEXT
        '
        ' Send the terminating boundary marker
        TCP PRINT nTCP, "--" + sBoundary + "--"
    '-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
    
        ' Now finish the E-mail off as we're done sending the message
        TCP PRINT nTCP, "."
        TCP LINE nTCP, sResponse
        IF LEFT$(sResponse, 3) <> "250" THEN GOTO SendError
    
        ' Say goodbye
        TCP PRINT nTCP, "QUIT"
        TCP LINE nTCP, sResponse
        IF LEFT$(sResponse, 3) <> "221" THEN GOTO SendError
    
        TCP CLOSE nTCP
    NEXT
        m_DisplayResults("E-mail has been successfully sent to " + $MailTo)
        GOTO Terminate
    
    SendError:
    
        m_DisplayResults("Error sending E-mail!" + $CRLF + sResponse)
    
    Terminate:
    
    #IF %DEF(%PB_CC32)
        m_DisplayResults("Press any key to end")
        WAITKEY$
    #ENDIF
    
    END FUNCTION

  • #2
    I found this old code in one of my projects...

    Code:
    '--------------------------------------------------------------------------------------------------
    ' Encode binary file data using Base64 encoding for MIME.
    '--------------------------------------------------------------------------------------------------
    Function MimeEncode Alias "MimeEncode"(ByVal sFileData As String) As String
      Local lBlock, lcBlocks, lByte1, lByte2, lByte3, lIndex1, lIndex2, lIndex3, lIndex4 As Long
        Local pInput, pOutput, pTable As Byte Ptr
        Local sBase64, sResult, Pad As String
     
        sBase64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"   'Base64 table
        Pad = String$(2 - (Len(sFileData) - 1) Mod 3, "=")          'Calculate padding on Base64 stream
     
        lcBlocks = (Len(sFileData) + 2) \ 3                         'Round up the length of the input
        If lcBlocks * 3 > Len(sFileData) Then                       'data to a multiple of three
          sFileData = LSet$(sFileData, lcBlocks * 3 Using $Nul)
        End If
     
        sResult = Space$(lcBlocks * 4)                              'Allocate space for output string
     
        pInput  = StrPtr(sFileData)                                 'Set up pointers so we can treat
        pOutput = StrPtr(sResult)                                   'the data as byte streams
        pTable  = StrPtr(sBase64)
     
        For lBlock = 1 To lcBlocks                                  'Loop through the input buffer
          lByte1 = @pInput : Incr pInput                            'Get the next three binary data-
          lByte2 = @pInput : Incr pInput                            'bytes to process
          lByte3 = @pInput : Incr pInput
     
          lIndex1 = lByte1 \ 4                                      'Translate 3 databytes to 4 Base64
          lIndex2 = (lByte1 And 3) * 16 + lByte2 \ 16               'table indices
          lIndex3 = (lByte2 And 15) * 4 + lByte3 \ 64
          lIndex4 = lByte3 And 63
     
          @pOutput = @pTable[lIndex1] : Incr pOutput                'Use Base64 table to encode the
          @pOutput = @pTable[lIndex2] : Incr pOutput                'output string
          @pOutput = @pTable[lIndex3] : Incr pOutput
          @pOutput = @pTable[lIndex4] : Incr pOutput
        Next
      RSet Abs sResult = Pad                                        'Merge in the padding bytes
      Function = sResult
    End Function
     
    '==================================================================================================
    '
    '--------------------------------------------------------------------------------------------------
    Function SendEmail Alias "SendEmail"   (ByVal sHost As String, _     'Mailhost URL
                                           ByVal sFrom As String, _     'Sender email address
                                           ByVal sTo As String, _       'Receiver email address
                                           ByVal sSubject As String, _  'Message header
                                           ByVal sMsgText As String, _  'Message text ($Cr separated)
                                           ByVal sFiles As String) _    'Attachments ($Cr separated)
                                           Export As Long
     
      Local lLine As Long, nTCP As Long, sAttachment As String, hFile As Dword
      Local sLocalHost  As String, sResponse As String, sBoundary As String
      Local Cnt As Long, sPart As String, sCut As String, sFile As String
      Local Recipient As String
     
      sBoundary = "Boundary." + Remove$(GuidTxt$(Guid$), Any "{-}") 'Make a unique filedata boundarymarker
     
      nTCP = FreeFile                                               'Connect to E-mailserver (mailhost)
      Tcp Open "smtp" At sHost As nTCP : If Err Then Exit Function
     
      Tcp Line nTCP, sResponse
      If Left$(sResponse, 3) <> "220" Then Exit Function
     
      Host Name To sLocalHost                                       'Get the local host name
     
      Tcp Print nTCP, "HELO " + sLocalHost                          'Greet the mailhost
      Tcp Line nTCP, sResponse
      If Left$(sResponse, 3) <> "250" Then Exit Function
     
      Tcp Print nTCP, "MAIL FROM:<" + sFrom + ">"                   'Tell the mailhost who we are
      Tcp Line nTCP, sResponse
      If Left$(sResponse, 3) <> "250" Then Exit Function
     
      sPart = sTo
      For Cnt = 0 To Tally (sTo, ",")
        SCut =  Extract$(sPart, ",")
        Tcp Print nTCP, "RCPT TO:<" + sCut + ">"                       'Tell mailhost who message is for
        Tcp Line nTCP, sResponse
        If Left$(sResponse, 3) <> "250" Then Exit Function
        sPart = Remain$(sPart, ",")
      Next
     
      Tcp Print nTCP, "DATA"                                        'Send the message
      Tcp Line nTCP, sResponse
      If Left$(sResponse, 3) <> "354" Then Exit Function
     
      Tcp Print nTCP, "Date: "    + MailDate                        'The E-mail header
      Tcp Print nTCP, "From: "    + sFrom
      Tcp Print nTCP, "To: "      + sTo
      Tcp Print nTCP, "Subject: " + sSubject
      Tcp Print nTCP, "X-Mailer: Arcovox MIME/Base64 E-mailer 1.0"
      Tcp Print nTCP, "MIME-Version: 1.0"
      Tcp Print nTCP, "Content-Type: multipart/mixed; boundary=" + $Dq + sBoundary + $Dq
      Tcp Print nTCP, ""
      Tcp Print nTCP, "--" + sBoundary
     
      ' Create a Plain-text section
      Tcp Print nTCP, "Content-Type: text/plain; charset=" + $Dq + "us-ascii" + $Dq
      Tcp Print nTCP, "Content-Transfer-Encoding: 7bit"
      Tcp Print nTCP, ""
     
      ' Create a main E-mail body section
      sPart = sMsgText
      For Cnt = 0 To Tally(sPart, $Cr)
        sCut = Extract$(sPart, $Cr)
        Tcp Print nTCP, sCut
        sPart = Remain$(sPart, $Cr)
      Next
     
     
      If (sFiles <> "") Then
        ' Create the attachment body section
        sPart = sFiles
        For Cnt = 0 To Tally(sFiles, $Cr)
          sCut = Extract$(sPart, $Cr)
          sPart = Remain$(sPart, $Cr)
          Dir$ Close
          If Dir$(sCut) <> "" Then
            Open sCut For Binary Access Read Lock Shared As #hFile 'Read the target file
            Get$ #hFile, Lof(hFile), sAttachment                                  '
            Close #hFile                                                      '
            If Len (sAttachment) > 0 Then
              sAttachment = MimeEncode(sAttachment)                         'Encode filedata in Base64 for MIME
              sFile = sCut
              While InStr(sFile, Any "\:")
                sFile = Right$(sFile, Len(sFile) -1)
              Wend
              Tcp Print nTCP, "--" + sBoundary
              Tcp Print nTCP, "Content-Type: application/octet-stream; name=" + $Dq + sFile + $Dq
              Tcp Print nTCP, "Content-Transfer-Encoding: base64"
              Tcp Print nTCP, ""
     
              ' Write the encoded data in lines of 76 characters.  Add an equality
              ' character if the last line is less than 76 bytes long
              For lLine = 1 To Len(sAttachment) Step 76
                If Len(sAttachment) - lLine >= 76 Then
                  Tcp Print nTCP, Mid$(sAttachment, lLine, 76)
                Else
                  Tcp Print nTCP, Mid$(sAttachment, lLine) + "="
                End If
              Next
            End If
          End If
        Next
    '    Tcp Print nTCP, "--" + sBoundary + "--"                     'Send terminating boundary marker
      End If
     
      Tcp Print nTCP, "--" + sBoundary + "--"                     'Send terminating boundary marker
      Tcp Print nTCP, "."                                           'Finish Email; done sending message
      Tcp Line nTCP, sResponse
      If Left$(sResponse, 3) <> "250" Then Exit Function
     
      Tcp Print nTCP, "QUIT"                                      'Say goodbye
      Tcp Line nTCP, sResponse
      If Left$(sResponse, 3) <> "221" Then Exit Function
     
      Tcp Close nTCP
      Function = -1
    End Function
    Regards,
    Peter

    Comment


    • #3
      Just send email this way with above function:

      Code:
      Function PBMain () As Long
        SendEmail 
          "myhost.mymail.com", _
          "[email protected]", _  
          "[email protected]", _
          "MyMailHeader", _
          "This is a mailtest",  
          "file.1" & $Cr & "file.2" & $Cr & "file.3"
        MsgBox "done..."
      End Function
      Regards,
      Peter

      Comment


      • #4
        Worked like a charm!

        Thanks,

        Bob Mechler

        Comment


        • #5
          Well it worked fine for testing in our building, but sending it to my home email did not work. We use Microsoft Exchange server and I set the host to mail.comcast.net. Didn't get through. Is there a sender filter or something that has to be configured?

          Bob Mechler

          Comment


          • #6
            Also is there a way to put the email with attachments into the draft folder instead for later review and sending?

            Bob Mechler

            Comment


            • #7
              you will need to set the host to the exchange server and allow the exchange server to relay

              Comment


              • #8
                I had it set to mail2 which is our exchange server and that worked internally but not externally.

                Bob Mechler

                Comment

                Working...
                X