Announcement

Collapse
No announcement yet.

Email Function

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

  • Email Function

    I've made one Function from the mailfile example, to be used to send single E-mails, and also add one or multiple
    attachment files. It works, but I'm not sure if the boundary locations are correct in all cases.
    When a stand-alone mail is sent, only an opening boundary is sent; with attachment(s) both opening
    and closing boundaries are sent. Also with multiple attachments, a boundary is sent between files...
    Is this correct? (want to avoid troubles; I need it to send error loggings from an application, and
    the last thing you want that the error-sending itself generates errors... )
    Code:
    '==================================================================================================
    '  MailFile : Send E-mail with a file attachment using TCP statements
    '==================================================================================================
    #Compile Exe   
    #Register All   
    #Dim All         
      
    %USEMACROS = 1
    #Include "Win32API.INC" 
     
    '--------------------------------------------------------------------------------------------------
    ' Modify these equates to match your E-mail server and desired E-mail headers.
    '--------------------------------------------------------------------------------------------------
    $mailhost = "smtp.mymailserver.nl"                               'The name of your SMTP E-mailserver.
    $MailFrom = "[email protected]"
    $MailTo   = "[email protected]" 
    $Subject  = "Arcovox E-mail, attachment demo"
     
    '--------------------------------------------------------------------------------------------------
    ' Retrieve the current time and date in E-mail header format
    '--------------------------------------------------------------------------------------------------
    Function MailDate () As String 
        Local szFormat As Asciiz * 40, szTemp As Asciiz * 40, sResult As String 
        Local t As SYSTEMTIME, sUCTOffset As String, tzi As TIME_ZONE_INFORMATION 
     
        GetLocalTime 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) 
     
        Select Case GetTimeZoneInformation(tzi) 
        Case %TIME_ZONE_ID_DAYLIGHT 
            sUCTOffset = IIF$((tzi.bias + tzi.DaylightBias) <= 0, "+", "-") _
                       + Format$(Abs(tzi.bias + tzi.DaylightBias) \ 60, "00") _ 
                       + Format$(Abs(tzi.bias + tzi.DaylightBias) Mod 60, "00") 
        Case %TIME_ZONE_ID_STANDARD                                           
            sUCTOffset = IIF$((tzi.bias + tzi.StandardBias) <= 0, "+", "-") _
                       + Format$(Abs(tzi.bias + tzi.StandardBias) \ 60, "00") _ 
                       + Format$(Abs(tzi.bias + tzi.StandardBias) Mod 60, "00") 
        Case Else                                             
            sUCTOffset = "-0000"
        End Select                                           
        Function = sResult + " " + szTemp + " " + sUCTOffset 
    End Function 
     
    '--------------------------------------------------------------------------------------------------
    ' Encode binary file data using Base64 encoding for MIME.
    '--------------------------------------------------------------------------------------------------
    Function 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 Send_Email(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) As Long             'Attachment files ($Cr separated)
     
      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                                          
     
      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 the terminating boundary marker
      End If    
     
      Tcp Print nTCP, "."                                         'Now finish E-mail off; we're done sending the 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
     
    '--------------------------------------------------------------------------------------------------
    Function PbMain () As Long                                        
      Local Result As Long
      Result = Send_Email($MailHost, $MailFrom, $MailTo, $Subject, _
               "Line 1" & $Cr & "Line 2" & $Cr & $Cr & "Line 4", _
               "\scratch\makewav2.bak" & $Cr & "mailfile.exe")   
               MsgBox Str$(result)
     
    End Function
    ------------------
    Regards,
    Peter



    [This message has been edited by Peter Lameijn (edited September 06, 2005).]
    Regards,
    Peter

  • #2
    For the text only emails, since you don't send html and plain text, you could just drop the mime encoding altogether if there are no attachments, and be done with it. Send the header, send the message, done.

    However, if you want to keep the mime encoding, make it where the closing boundary always gets sent.

    ------------------
    Adam Drake
    Drake Software

    Comment


    • #3
      Thanks,

      I also try to send emails to multiple receivers. (I need to send alarm messages to 5 email adresses)
      Is it possible in 1 email? (tried comma-separated adresses, but that doesn't work...)


      ------------------
      Regards,
      Peter
      Regards,
      Peter

      Comment


      • #4
        IIRC, to send e-mail to multiple addresses you simply do multiple RCPT TO lines. The code change would be something like this:

        Old Code:
        Code:
        Tcp Print nTCP, "RCPT TO:<" + sTo + ">"                       'Tell mailhost who message is for                                                    
        Tcp Line nTCP, sResponse                                                                        
        If Left$(sResponse, 3) <> "250" Then Exit Function
        new code:
        Code:
          FOR i = 1 to parsecount(sTo)
            TempStr = parse$(sTo,i)
            Tcp Print nTCP, "RCPT TO:<" + TempStr + ">"                       'Tell mailhost who message is for                                                    
            Tcp Line nTCP, sResponse                                                                        
            If Left$(sResponse, 3) <> "250" Then Exit Function                                              
          next i

        ------------------
        [email protected] http://bud.thedurlands.com
        Real programmers use a magnetized needle and a steady hand

        Comment


        • #5
          Thanks,

          That works! I changed it in above code.


          ------------------
          Regards,
          Peter
          Regards,
          Peter

          Comment


          • #6
            Peter,

            The above code will work, however, wouldn't it be easier and a little less processor intensive to do this?

            Code:
            addrCount=PARSECOUNT(sTo, ",")
            FOR Cnt=1 TO addrCount
                sPart=PARSE$(sTo, Cnt)
                TCP PRINT nTCP, "RCPT TO: <"+sPart+">"
                TCP LINE nTCP, sResponse
                IF LEFT$(sResponse, 3) <> "250" THEN EXIT FUNCTION
            NEXT
            Maybe I'm wrong, but it seems the fewer the string operations, the faster. While the difference would probably be negligible at best, just a thought...

            ------------------
            Adam Drake
            Drake Software

            Comment


            • #7
              Thanks Adam,

              It's indeed shorter...

              Peter

              ------------------
              Regards,
              Peter
              Regards,
              Peter

              Comment


              • #8
                Above code works fine now. I'm using it through broadband. But it should also be usable if the internetconnection
                is through a modem. (Call the provider, send email and disconnect. If possible without popup dialogs from MS dialer)

                What would be the best way to make it universal? (through default connection)



                ------------------
                Regards,
                Peter
                Regards,
                Peter

                Comment


                • #9
                  I'm using the above code to send email. Works fine here, but my customer uses McAfee virus scanner,
                  which refuses to let it pass (gives warning that a worm virus probably is trying to access???)

                  He has other emailing programs that work normal. Is the problem caused by using TCP? (Is there a way to
                  satisfy McAfee virus, so I can run an automated email send? )

                  At my dev PC I use AVG, which doesn't complain about anything...


                  ------------------
                  Regards,
                  Peter
                  Regards,
                  Peter

                  Comment


                  • #10
                    Is it the attachments McAfee doesn't like or does it not like your emails at all?

                    ------------------

                    Comment


                    • #11
                      I don't even send attachments; McAfee just gives pop-up with message that probably a Worm virus is
                      active... (McAfee log also says that incorrect protocol is used...)

                      It's used on a large government network, that uses McAfee anti-virus and Firewall on all connected
                      systems. (Firewall is already configured to give full access to my program...)

                      ------------------
                      Regards,
                      Peter
                      Regards,
                      Peter

                      Comment


                      • #12
                        Peter,
                        We email our invoices here and at first many of the emails were
                        being held as spam. What I learned is that by eliminating
                        capital letters from the subject line and keeping less than
                        75% capital letters in the body of the email, our emails
                        passed without being flagged as spam. Also try to keep the
                        combined images on your email less than 2800 bytes. Lastly,
                        don't use a unique ID in the subject line. For instance,
                        instead of writing "invoice #12345" just put "invoice enclosed"
                        or something like that.

                        ------------------

                        I think they should continue the policy of
                        not giving a Nobel Prize for paneling.

                        - Jack Handy

                        Comment

                        Working...
                        X