Email Function

[Shawn Anderson]

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

[Peter Lameijn]

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

[David J Walker]

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

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

[Peter Lameijn]

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

[Peter Lameijn]

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

[Peter Lameijn]

Thanks Adam,

It's indeed shorter...

Peter

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

[Adam J. Drake]

Peter,

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

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

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

[Peter Lameijn]

Thanks,

That works! I changed it in above code.


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

[Bud Durland]

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:

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:

  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

[Peter Lameijn]

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

[Adam J. Drake]

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.

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

[Peter Lameijn]

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... )

'==================================================================================================
'  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).]