Announcement

**Peter Lameijn** · 26 Nov 2007, 06:07 PM

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

**Peter Lameijn** · 26 Nov 2007, 07:43 PM

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

**BOB MECHLER** · 26 Nov 2007, 09:04 PM

Worked like a charm!

Thanks,

Bob Mechler

**BOB MECHLER** · 27 Nov 2007, 11:47 AM

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** · 27 Nov 2007, 11:48 AM

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** · 27 Nov 2007, 12:01 PM

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

**BOB MECHLER** · 27 Nov 2007, 01:08 PM

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

Bob Mechler

Announcement

Send multiple attachments using SMTP

Send multiple attachments using SMTP

Comment

Comment

Comment

Comment

Comment

Comment

Comment