Send multiple attachments using SMTP

[BOB MECHLER]

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

'==============================================================================
'
'  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

[Peter Lameijn]

I found this old code in one of my projects...

'--------------------------------------------------------------------------------------------------
' 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

[Peter Lameijn]

Just send email this way with above function:

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

[BOB MECHLER]

Worked like a charm!

Thanks,

Bob Mechler

[BOB MECHLER]

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

[BOB MECHLER]

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

Bob Mechler

[Ralph Bing]

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

[BOB MECHLER]

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

Bob Mechler