Send email class

[paolo tacconi]

I will try to study the code you have posted me, thanks so much

[Mike Doty]

I think it is ok since TCP PRINT / TCP LINE INPUT is used not TCP RECV.
Looks like error 334 is being checked on each line.
The author or an email expert might step in.

It is unusual to see such an old unanswered question.

          ' Send authentication if required
         IF m_EnableAuth THEN
              DO WHILE NOT EOF(hTCP)
                 TCP LINE hTCP, sBuffer
                 errcode = VAL(LEFT$(sBuffer, 3))
             LOOP
             [B]TCP PRINT hTCP, m_AuthType[/B]
              DO WHILE NOT EOF(hTCP)
                 TCP LINE hTCP, sBuffer
                 errcode = VAL(LEFT$(sBuffer, 3))
             LOOP
              IF errcode = 334 THEN
                 sTmp = Me.MimeEncode(m_AuthUsername)     ' UserId (might be the same as the POP3 UserId)
                 TCP PRINT hTCP, sTmp
                 DO WHILE NOT EOF(hTCP)
                     TCP LINE hTCP, sBuffer
                     errcode = VAL(LEFT$(sBuffer, 3))
                 LOOP
                 IF errcode = 334 THEN
                     sTmp = Me.MimeEncode(m_AuthPassword) ' Password (might be the same as the POP3 password)
                     TCP PRINT hTCP, sTmp
                     DO WHILE NOT EOF(hTCP)
                         TCP LINE hTCP, sBuffer
                         errcode = VAL(LEFT$(sBuffer, 3))
                     LOOP
                 END IF
             END IF

[David Clarke]

I think this code is an error? If you loop you need to accumulate, right? Do While Not Eof(hTCP) Tcp Line hTCP, sBuffer errcode = Val(Left$(sBuffer, 3)) Loop

[Mike Doty]

TCP open "smtp" did not work after modification.

Caught testing godaddy that uses the following and authorization
'cMail.SMTPPort = 3535 'godaddy
'cMail.SMTPServer = "smtpout.secureserver.net" 'godaddy

All code consolidated with this correction in second post.

' Connect to E-mail server (mailhost)
  hTCP = FREEFILE
  ' RBoyd: Configurable port change
  IF m_SMTPPort = 0 THEN '1/13/2016
    TCP OPEN "smtp" AT m_Server AS hTCP TIMEOUT m_Timeout
  ELSE
    TCP OPEN PORT m_SMTPPort AT m_Server AS hTCP TIMEOUT m_Timeout
  END IF
  m_Response = "Cannot connect to E-mail server: " & m_Server
  IF ERR THEN GOTO SendError

CLASS clsEmail     'clsEmail2.inc
   INSTANCE m_Server       AS STRING
   INSTANCE m_SMTPPort     AS LONG    ' RBoyd: added for port configuration
   INSTANCE m_From         AS STRING
   INSTANCE m_ReplyTo      AS STRING
   INSTANCE m_TO           AS STRING
   INSTANCE m_CC           AS STRING
   INSTANCE m_BCC          AS STRING
   INSTANCE m_Subject      AS STRING
   INSTANCE m_PlainMessage AS STRING
   INSTANCE m_HTMLMessage  AS STRING
   INSTANCE m_Response     AS STRING
   INSTANCE m_EnableAuth   AS LONG
   INSTANCE m_AuthType     AS STRING
   INSTANCE m_AuthUsername AS STRING
   INSTANCE m_AuthPassword AS STRING
   INSTANCE m_Style        AS STRING
   INSTANCE m_Timeout      AS LONG
   INSTANCE m_Attachments  AS STRING
   INSTANCE m_LocalHost    AS STRING
   INSTANCE m_CharSet      AS STRING
    '------------------------------------------------------------
   '  Private Class methods
   '------------------------------------------------------------
    '//
   '//
   CLASS METHOD CREATE()   ' Constructor
      ' Initialize default properties
      m_Timeout     = 60000   '(60 seconds)
      m_CharSet     = "iso-8859-1"
      m_Style       = "plain"
      HOST NAME TO m_LocalHost
   END METHOD
    '//
   '//
   CLASS METHOD 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
       METHOD = sResult
   END METHOD
    '//
   '//
   CLASS METHOD GetMailDateTime() AS STRING
       ' Retrieve the current time and date to put in E-mail header format
       LOCAL szFormat   AS ASCIIZ * 40
       LOCAL szTemp     AS ASCIIZ * 40
       LOCAL sResult    AS STRING
       LOCAL t          AS SYSTEMTIME
       LOCAL sUCTOffset AS STRING
       LOCAL tzi        AS TIME_ZONE_INFORMATION
        GetLocalTime t
        szFormat = "ddd',' dd MMM yyyy"
       GetDateFormat %LANG_INVARIANT, 0, t, szFormat, szTemp, SIZEOF(szTemp)   '%LANG_INVARIANT in other countries
       sResult = szTemp
        szFormat = "HH':'mm':'ss"
       GetTimeFormat %LANG_INVARIANT, 0, t, szFormat, szTemp, SIZEOF(szTemp)   'LANG_INVARIANT in other countries
        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
        METHOD = sResult & " " & szTemp & " " & sUCTOffset
    END METHOD
    '------------------------------------------------------------
   '  End of Private Class methods
   '------------------------------------------------------------
    '------------------------------------------------------------
   '  Public Interface
   '------------------------------------------------------------
    '//
   '//
   INTERFACE EMailInterface: INHERIT IUNKNOWN
       PROPERTY GET SMTPServer() AS STRING
         PROPERTY = m_Server
      END PROPERTY
      PROPERTY SET SMTPServer( BYVAL sServerName AS STRING )
         m_Server = RTRIM$(sServername)
      END PROPERTY
       ' RBoyd: Added this get/set block for port configuration
      PROPERTY GET SMTPPort() AS LONG
         PROPERTY = m_SMTPPort
      END PROPERTY
      PROPERTY SET SMTPPort( BYVAL nSMTPPort AS LONG )
         m_SMTPPort = nSMTPPort
      END PROPERTY
       PROPERTY GET SendFrom() AS STRING
         PROPERTY = m_From
      END PROPERTY
      PROPERTY SET SendFrom( BYVAL sRecipientFrom AS STRING )
         m_From = RTRIM$(sRecipientFrom)
      END PROPERTY
       PROPERTY GET SendTo() AS STRING
         PROPERTY = m_TO
      END PROPERTY
      PROPERTY SET SendTo( BYVAL sRecipientTo AS STRING )
         m_TO = RTRIM$(sRecipientTo)
      END PROPERTY
       PROPERTY GET CC() AS STRING
         PROPERTY = m_CC
      END PROPERTY
      PROPERTY SET CC( BYVAL sRecipientCC AS STRING )
         m_CC = RTRIM$(sRecipientCC)
      END PROPERTY
       PROPERTY GET BCC() AS STRING
         PROPERTY = m_BCC
      END PROPERTY
      PROPERTY SET BCC( BYVAL sRecipientBCC AS STRING )
         m_BCC = RTRIM$(sRecipientBCC)
      END PROPERTY
       PROPERTY GET ReplyTo() AS STRING
         PROPERTY = m_ReplyTo
      END PROPERTY
      PROPERTY SET ReplyTo( BYVAL sReplyTo AS STRING )
         m_ReplyTo = RTRIM$(sReplyTo)
      END PROPERTY
       PROPERTY GET Subject() AS STRING
         PROPERTY = m_Subject
      END PROPERTY
      PROPERTY SET Subject( BYVAL sSubject AS STRING )
         m_Subject = sSubject
      END PROPERTY
       PROPERTY GET PlainMessage() AS STRING
         PROPERTY = m_PlainMessage
      END PROPERTY
      PROPERTY SET PlainMessage( BYVAL sPlainMessage AS STRING )
         m_PlainMessage = sPlainMessage
      END PROPERTY
       PROPERTY GET HTMLMessage() AS STRING
         PROPERTY = m_HTMLMessage
      END PROPERTY
      PROPERTY SET HTMLMessage( BYVAL sHTMLMessage AS STRING )
         m_HTMLMessage = sHTMLMessage
      END PROPERTY
       PROPERTY GET Response() AS STRING
         PROPERTY = m_Response
      END PROPERTY
       PROPERTY GET EnableAuth() AS LONG
         PROPERTY = m_EnableAuth
      END PROPERTY
      PROPERTY SET EnableAuth( BYVAL nEnableAuth AS LONG )
         m_EnableAuth = nEnableAuth
      END PROPERTY
       PROPERTY GET AuthType() AS STRING
         PROPERTY = m_AuthType
      END PROPERTY
      PROPERTY SET AuthType( BYVAL sAuthType AS STRING )
         m_AuthType = RTRIM$(sAuthType)
      END PROPERTY
       PROPERTY GET AuthUserName() AS STRING
         PROPERTY = m_AuthUserName
      END PROPERTY
      PROPERTY SET AuthUserName( BYVAL sAuthUserName AS STRING )
         m_AuthUserName = RTRIM$(sAuthUserName)
      END PROPERTY
       PROPERTY GET AuthPassword() AS STRING
         PROPERTY = m_AuthPassword
      END PROPERTY
      PROPERTY SET AuthPassword( BYVAL sAuthPassword AS STRING )
         m_AuthPassword = RTRIM$(sAuthPassword)
      END PROPERTY
       PROPERTY GET MessageStyle() AS STRING
         PROPERTY = m_Style
      END PROPERTY
      PROPERTY SET MessageStyle( BYVAL sMessageStyle AS STRING )
         m_Style = UCASE$(RTRIM$(sMessageStyle))
      END PROPERTY
       PROPERTY GET ServerTimeout() AS LONG
         PROPERTY = m_Timeout
      END PROPERTY
      PROPERTY SET ServerTimeout( BYVAL nServerTimeout AS LONG )
         m_Timeout = nServerTimeout
      END PROPERTY
       PROPERTY GET Attachments() AS STRING
         PROPERTY = m_Attachments
      END PROPERTY
      PROPERTY SET Attachments( BYVAL sAttachments AS STRING )
         m_Attachments = RTRIM$(sAttachments)
      END PROPERTY
       PROPERTY GET LocalHost() AS STRING
         PROPERTY = m_LocalHost
      END PROPERTY
      PROPERTY SET LocalHost( BYVAL sLocalHost AS STRING )
         m_LocalHost = RTRIM$(sLocalHost)
      END PROPERTY
       PROPERTY GET CharSet() AS STRING
         PROPERTY = m_CharSet
      END PROPERTY
      PROPERTY SET CharSet( BYVAL sCharSet AS STRING )
         m_CharSet = RTRIM$(sCharSet)
      END PROPERTY
       '//
      '//
      METHOD SendMail() AS LONG
         LOCAL hTCP           AS LONG
         LOCAL y              AS LONG
         LOCAL f              AS LONG
         LOCAL z              AS LONG
         LOCAL NumLines       AS LONG
         LOCAL errcode        AS LONG
         LOCAL sTmp           AS STRING
         LOCAL sBuffer        AS STRING
         LOCAL sBoundary      AS STRING
         LOCAL sAllRecipients AS STRING
         LOCAL NumAttachments AS LONG
          ' Make a unique file data boundary marker
         sBoundary = "Boundary." & REMOVE$(GUIDTXT$(GUID$), ANY "{-}")
          ' Connect to E-mail server (mailhost)
         hTCP = FREEFILE
         ' RBoyd: Configurable port change
         IF m_SMTPPort = 0 THEN
            TCP OPEN "smtp" AT m_Server AS hTCP TIMEOUT m_Timeout
         ELSE
            TCP OPEN PORT m_SMTPPort AT m_Server AS hTCP TIMEOUT m_Timeout
         END IF
          m_Response = "Cannot connect to E-mail server: " & m_Server
         IF ERR THEN GOTO SendError
          TCP LINE hTCP, m_Response
         IF LEFT$(m_Response, 3) <> "220" THEN GOTO SendError
          ' Get the local host name
         IF RTRIM$(m_LocalHost) = "" THEN m_LocalHost = "localhost"
          ' Greet the mailhost
         TCP PRINT hTCP, "HELO " & m_LocalHost
         TCP LINE hTCP, m_Response
         IF LEFT$(m_Response, 3) <> "250" THEN GOTO SendError
          ' Send authentication if required
         IF m_EnableAuth THEN
              DO WHILE NOT EOF(hTCP)
                 TCP LINE hTCP, sBuffer
                 errcode = VAL(LEFT$(sBuffer, 3))
             LOOP
             TCP PRINT hTCP, m_AuthType
              DO WHILE NOT EOF(hTCP)
                 TCP LINE hTCP, sBuffer
                 errcode = VAL(LEFT$(sBuffer, 3))
             LOOP
              IF errcode = 334 THEN
                 sTmp = Me.MimeEncode(m_AuthUsername)     ' UserId (might be the same as the POP3 UserId)
                 TCP PRINT hTCP, sTmp
                 DO WHILE NOT EOF(hTCP)
                     TCP LINE hTCP, sBuffer
                     errcode = VAL(LEFT$(sBuffer, 3))
                 LOOP
                 IF errcode = 334 THEN
                     sTmp = Me.MimeEncode(m_AuthPassword) ' Password (might be the same as the POP3 password)
                     TCP PRINT hTCP, sTmp
                     DO WHILE NOT EOF(hTCP)
                         TCP LINE hTCP, sBuffer
                         errcode = VAL(LEFT$(sBuffer, 3))
                     LOOP
                 END IF
             END IF
          END IF
          ' Tell the mailhost who we are
         REM tcp print hTCP, "MAIL FROM:<" & m_From & ">"
         y = INSTR(m_from, "<")
         IF y THEN
          TCP PRINT hTCP, "MAIL FROM:" & MID$(m_from,y)
        ELSE
          TCP PRINT hTCP, "MAIL FROM:<" & m_From & ">"
        END IF
         TCP LINE hTCP, m_Response
        IF LEFT$(m_Response, 3) <> "250" THEN GOTO SendError
          ' Tell the mailhost who the message is for
         ' There could be multiple recipients so iterate through
         ' the semicolon or comma deliminated list. The total RCPT
         ' list is the combination of the TO, CC, BCC lists.
         sAllRecipients = m_TO & ";" & m_CC & ";" & m_BCC
          NumLines = PARSECOUNT(sAllRecipients, ANY ";,")
         REDIM sArray(1 TO NumLines) AS STRING
         PARSE sAllRecipients, sArray(), ANY ";,"
          FOR y = 1 TO NumLines
            sTmp = RTRIM$(sArray(y))
            IF LEN(sTmp) THEN
               TCP PRINT hTCP, "RCPT TO:<" & sTmp & ">"
               TCP LINE hTCP, m_Response
               IF LEFT$(m_Response, 3) <> "250" THEN GOTO SendError
            END IF
         NEXT
          ' Send the message
         TCP PRINT hTCP, "DATA"
         TCP LINE hTCP, m_Response
         IF LEFT$(m_Response, 3) <> "354" THEN GOTO SendError
          ' The E-mail header
         TCP PRINT hTCP, "Date: " & Me.GetMailDateTime
         TCP PRINT hTCP, "From: " & m_From
          TCP PRINT hTCP, "To: " & m_To
          IF LEN(m_ReplyTo) THEN
            TCP PRINT hTCP, "Reply-To: " & m_ReplyTo
         END IF
          IF LEN(m_CC) THEN
            TCP PRINT hTCP, "Cc: "  & m_CC
         END IF
          ' Obviously we won't output the BCC list to the email
          TCP PRINT hTCP, "Subject: " & m_Subject
          TCP PRINT hTCP, "X-Mailer: pMailer Mail"
         TCP PRINT hTCP, "MIME-Version: 1.0"
          TCP PRINT hTCP, "Content-Type: multipart/mixed; boundary=" & $DQ & sBoundary & $DQ
         TCP PRINT hTCP, ""
          ' Create a main E-mail body section for the Plain message.
         ' Break the message down into lines
          IF (m_Style = "PLAIN") OR (m_Style = "BOTH") THEN
            TCP PRINT hTCP, "--" & sBoundary
            TCP PRINT hTCP, "Content-Type: text/plain; charset=" & $DQ & m_CharSet & $DQ
            TCP PRINT hTCP, "Content-Transfer-Encoding: 7bit"
            TCP PRINT hTCP, ""
            ' Any crlf pairs or plain lf's will be replaced with cr's for easy parsing
            REPLACE $CRLF WITH $CR IN m_PlainMessage
            REPLACE $LF   WITH $CR IN m_PlainMessage
             NumLines = PARSECOUNT( m_PlainMessage, $CR )
            REDIM sArray(1 TO NumLines) AS STRING
            PARSE m_PlainMessage, sArray(), $CR
             FOR y = 1 TO NumLines
               TCP PRINT hTCP, sArray(y)
            NEXT
         END IF
          IF (m_Style = "HTML") OR (m_Style = "BOTH") THEN
            TCP PRINT hTCP, "--" & sBoundary
            TCP PRINT hTCP, "Content-Type: text/html; charset=" & $DQ & m_CharSet & $DQ
            TCP PRINT hTCP, "Content-Transfer-Encoding: 7bit"
            TCP PRINT hTCP, ""
            ' Any crlf pairs or plain lf's will be replaced with cr's for easy parsing
            REPLACE $CRLF WITH $CR IN m_HTMLMessage
            REPLACE $LF   WITH $CR IN m_HTMLMessage
             NumLines = PARSECOUNT( m_HTMLMessage, $CR )
            REDIM sArray(1 TO NumLines) AS STRING
            PARSE m_HTMLMessage, sArray(), $CR
             FOR y = 1 TO NumLines
               TCP PRINT hTCP, sArray(y)
            NEXT
         END IF
          ' Create the attachment body section
         IF LEN(m_Attachments) > 0 THEN
            REM NumAttachments = PARSECOUNT( m_Attachments, ";," )
            NumAttachments = PARSECOUNT( m_Attachments, ANY ";," ) '8/17/13
            REDIM sArray(1 TO NumAttachments) AS STRING
            REM PARSE m_Attachments, sArray(), ";,"
            PARSE m_Attachments, sArray(), ANY ";," '8/17/13
             FOR y = 1 TO NumAttachments
               IF DIR$(sArray(y)) = "" THEN ITERATE FOR
                f = FREEFILE
               OPEN sArray(y) FOR BINARY AS #f
               GET$ #f, LOF(f), sBuffer
               CLOSE #f
                ' Encode the file
               sBuffer = Me.MimeEncode( sBuffer )
                TCP PRINT hTCP, "--" & sBoundary
               TCP PRINT hTCP, "Content-Type: application/octet-stream; name=" & $DQ & PATHNAME$(NAMEX, sArray(y)) & $DQ
               TCP PRINT hTCP, "Content-Transfer-Encoding: base64"
               TCP PRINT hTCP, ""
                ' Write the encoded data in lines of 76 characters.  Add an equality
               ' character if the last line is less than 76 bytes long
               FOR z = 1 TO LEN(sBuffer) STEP 76
                  IF LEN(sBuffer) - z >= 76 THEN
                     TCP PRINT hTCP, MID$(sBuffer, z, 76)
                  ELSE
                     TCP PRINT hTCP, MID$(sBuffer, z) & "="
                  END IF
               NEXT
             NEXT
         END IF
          ' Send the terminating boundary marker
         TCP PRINT hTCP, "--" & sBoundary & "--"
          ' Now finish the E-mail off as we're done sending the message
         TCP PRINT hTCP, "."
         TCP LINE hTCP, m_Response
         IF LEFT$(m_Response, 3) <> "250" THEN GOTO SendError
          ' Say goodbye
         TCP PRINT hTCP, "QUIT"
         TCP LINE hTCP, m_Response
         IF LEFT$(m_Response, 3) <> "221" THEN GOTO SendError
          TCP CLOSE hTCP
          EXIT METHOD
 SendError:
        METHOD = %TRUE    ' error occurred
       END METHOD
    END INTERFACE
    '------------------------------------------------------------
   '  End of Public Interface
   '------------------------------------------------------------
 END CLASS
 FUNCTION ISEMAIL(BYVAL e AS STRING, MailAddr AS STRING) AS LONG
'------------------------------------------------------------
' verifies that the passed string contains at least one
' valid e-mail address and returns a fixed up version
'------------------------------------------------------------
  LOCAL Mask    AS STRING
  LOCAL p       AS LONG
  LOCAL l       AS LONG
   MailAddr = ""
  IF LEN(e) = 0 THEN
    FUNCTION = 0
    EXIT FUNCTION
  END IF
   Mask = "([a-z0-9._-]+)(@[a-z0-9._-]+)(\.[a-z]+)"
  REGEXPR Mask IN e TO p,l
   IF l > 0 THEN MailAddr = "<" + MID$(e,p,l) + ">"
   FUNCTION = (l > 0)
 END FUNCTION

[Mike Doty]

Consolidated changes

CLASS clsEmail
   INSTANCE m_Server       AS STRING
   INSTANCE m_SMTPPort     AS LONG    ' RBoyd: added for port configuration
   INSTANCE m_From         AS STRING
   INSTANCE m_ReplyTo      AS STRING
   INSTANCE m_TO           AS STRING
   INSTANCE m_CC           AS STRING
   INSTANCE m_BCC          AS STRING
   INSTANCE m_Subject      AS STRING
   INSTANCE m_PlainMessage AS STRING
   INSTANCE m_HTMLMessage  AS STRING
   INSTANCE m_Response     AS STRING
   INSTANCE m_EnableAuth   AS LONG
   INSTANCE m_AuthType     AS STRING
   INSTANCE m_AuthUsername AS STRING
   INSTANCE m_AuthPassword AS STRING
   INSTANCE m_Style        AS STRING
   INSTANCE m_Timeout      AS LONG
   INSTANCE m_Attachments  AS STRING
   INSTANCE m_LocalHost    AS STRING
   INSTANCE m_CharSet      AS STRING
    '------------------------------------------------------------
   '  Private Class methods
   '------------------------------------------------------------
    '//
   '//
   CLASS METHOD CREATE()   ' Constructor
      ' Initialize default properties
      m_Timeout     = 60000   '(60 seconds)
      m_CharSet     = "iso-8859-1"
      m_Style       = "plain"
      HOST NAME TO m_LocalHost
   END METHOD
 
   '//
   '//
   CLASS METHOD 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
       METHOD = sResult
   END METHOD
 
   '//
   '//
   CLASS METHOD GetMailDateTime() AS STRING
       ' Retrieve the current time and date to put in E-mail header format
       LOCAL szFormat   AS ASCIIZ * 40
       LOCAL szTemp     AS ASCIIZ * 40
       LOCAL sResult    AS STRING
       LOCAL t          AS SYSTEMTIME
       LOCAL sUCTOffset AS STRING
       LOCAL tzi        AS TIME_ZONE_INFORMATION
        GetLocalTime t
        szFormat = "ddd',' dd MMM yyyy"
       GetDateFormat %LANG_INVARIANT, 0, t, szFormat, szTemp, SIZEOF(szTemp)   '%LANG_INVARIANT in other countries
       sResult = szTemp
        szFormat = "HH':'mm':'ss"
       GetTimeFormat %LANG_INVARIANT, 0, t, szFormat, szTemp, SIZEOF(szTemp)   'LANG_INVARIANT in other countries
        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
        METHOD = sResult & " " & szTemp & " " & sUCTOffset
    END METHOD
    '------------------------------------------------------------
   '  End of Private Class methods
   '------------------------------------------------------------
 
   '------------------------------------------------------------
   '  Public Interface
   '------------------------------------------------------------
    '//
   '//
   INTERFACE EMailInterface: INHERIT IUNKNOWN
       PROPERTY GET SMTPServer() AS STRING
         PROPERTY = m_Server
      END PROPERTY
      PROPERTY SET SMTPServer( BYVAL sServerName AS STRING )
         m_Server = RTRIM$(sServername)
      END PROPERTY
       ' RBoyd: Added this get/set block for port configuration
      PROPERTY GET SMTPPort() AS LONG
         PROPERTY = m_SMTPPort
      END PROPERTY
      PROPERTY SET SMTPPort( BYVAL nSMTPPort AS LONG )
         m_SMTPPort = nSMTPPort
      END PROPERTY
       PROPERTY GET SendFrom() AS STRING
         PROPERTY = m_From
      END PROPERTY
      PROPERTY SET SendFrom( BYVAL sRecipientFrom AS STRING )
         m_From = RTRIM$(sRecipientFrom)
      END PROPERTY
       PROPERTY GET SendTo() AS STRING
         PROPERTY = m_TO
      END PROPERTY
      PROPERTY SET SendTo( BYVAL sRecipientTo AS STRING )
         m_TO = RTRIM$(sRecipientTo)
      END PROPERTY
       PROPERTY GET CC() AS STRING
         PROPERTY = m_CC
      END PROPERTY
      PROPERTY SET CC( BYVAL sRecipientCC AS STRING )
         m_CC = RTRIM$(sRecipientCC)
      END PROPERTY
       PROPERTY GET BCC() AS STRING
         PROPERTY = m_BCC
      END PROPERTY
      PROPERTY SET BCC( BYVAL sRecipientBCC AS STRING )
         m_BCC = RTRIM$(sRecipientBCC)
      END PROPERTY
       PROPERTY GET ReplyTo() AS STRING
         PROPERTY = m_ReplyTo
      END PROPERTY
      PROPERTY SET ReplyTo( BYVAL sReplyTo AS STRING )
         m_ReplyTo = RTRIM$(sReplyTo)
      END PROPERTY
       PROPERTY GET Subject() AS STRING
         PROPERTY = m_Subject
      END PROPERTY
      PROPERTY SET Subject( BYVAL sSubject AS STRING )
         m_Subject = sSubject
      END PROPERTY
       PROPERTY GET PlainMessage() AS STRING
         PROPERTY = m_PlainMessage
      END PROPERTY
      PROPERTY SET PlainMessage( BYVAL sPlainMessage AS STRING )
         m_PlainMessage = sPlainMessage
      END PROPERTY
       PROPERTY GET HTMLMessage() AS STRING
         PROPERTY = m_HTMLMessage
      END PROPERTY
      PROPERTY SET HTMLMessage( BYVAL sHTMLMessage AS STRING )
         m_HTMLMessage = sHTMLMessage
      END PROPERTY
       PROPERTY GET Response() AS STRING
         PROPERTY = m_Response
      END PROPERTY
       PROPERTY GET EnableAuth() AS LONG
         PROPERTY = m_EnableAuth
      END PROPERTY
      PROPERTY SET EnableAuth( BYVAL nEnableAuth AS LONG )
         m_EnableAuth = nEnableAuth
      END PROPERTY
       PROPERTY GET AuthType() AS STRING
         PROPERTY = m_AuthType
      END PROPERTY
      PROPERTY SET AuthType( BYVAL sAuthType AS STRING )
         m_AuthType = RTRIM$(sAuthType)
      END PROPERTY
       PROPERTY GET AuthUserName() AS STRING
         PROPERTY = m_AuthUserName
      END PROPERTY
      PROPERTY SET AuthUserName( BYVAL sAuthUserName AS STRING )
         m_AuthUserName = RTRIM$(sAuthUserName)
      END PROPERTY
       PROPERTY GET AuthPassword() AS STRING
         PROPERTY = m_AuthPassword
      END PROPERTY
      PROPERTY SET AuthPassword( BYVAL sAuthPassword AS STRING )
         m_AuthPassword = RTRIM$(sAuthPassword)
      END PROPERTY
       PROPERTY GET MessageStyle() AS STRING
         PROPERTY = m_Style
      END PROPERTY
      PROPERTY SET MessageStyle( BYVAL sMessageStyle AS STRING )
         m_Style = UCASE$(RTRIM$(sMessageStyle))
      END PROPERTY
       PROPERTY GET ServerTimeout() AS LONG
         PROPERTY = m_Timeout
      END PROPERTY
      PROPERTY SET ServerTimeout( BYVAL nServerTimeout AS LONG )
         m_Timeout = nServerTimeout
      END PROPERTY
       PROPERTY GET Attachments() AS STRING
         PROPERTY = m_Attachments
      END PROPERTY
      PROPERTY SET Attachments( BYVAL sAttachments AS STRING )
         m_Attachments = RTRIM$(sAttachments)
      END PROPERTY
       PROPERTY GET LocalHost() AS STRING
         PROPERTY = m_LocalHost
      END PROPERTY
      PROPERTY SET LocalHost( BYVAL sLocalHost AS STRING )
         m_LocalHost = RTRIM$(sLocalHost)
      END PROPERTY
       PROPERTY GET CharSet() AS STRING
         PROPERTY = m_CharSet
      END PROPERTY
      PROPERTY SET CharSet( BYVAL sCharSet AS STRING )
         m_CharSet = RTRIM$(sCharSet)
      END PROPERTY
 
      '//
      '//
      METHOD SendMail() AS LONG
         LOCAL hTCP           AS LONG
         LOCAL y              AS LONG
         LOCAL f              AS LONG
         LOCAL z              AS LONG
         LOCAL NumLines       AS LONG
         LOCAL errcode        AS LONG
         LOCAL sTmp           AS STRING
         LOCAL sBuffer        AS STRING
         LOCAL sBoundary      AS STRING
         LOCAL sAllRecipients AS STRING
         LOCAL NumAttachments AS LONG
 
         ' Make a unique file data boundary marker
         sBoundary = "Boundary." & REMOVE$(GUIDTXT$(GUID$), ANY "{-}")
          ' Connect to E-mail server (mailhost)
         hTCP = FREEFILE
         ' RBoyd: Configurable port change
'         Tcp Open "smtp" At m_Server As hTCP TimeOut m_Timeout
         TCP OPEN PORT m_SMTPPort AT m_Server AS hTCP TIMEOUT m_Timeout
          m_Response = "Cannot connect to E-mail server: " & m_Server
         IF ERR THEN GOTO SendError
          TCP LINE hTCP, m_Response
         IF LEFT$(m_Response, 3) <> "220" THEN GOTO SendError
          ' Get the local host name
         IF RTRIM$(m_LocalHost) = "" THEN m_LocalHost = "localhost"
          ' Greet the mailhost
         TCP PRINT hTCP, "HELO " & m_LocalHost
         TCP LINE hTCP, m_Response
         IF LEFT$(m_Response, 3) <> "250" THEN GOTO SendError
          ' Send authentication if required
         IF m_EnableAuth THEN
              DO WHILE NOT EOF(hTCP)
                 TCP LINE hTCP, sBuffer
                 errcode = VAL(LEFT$(sBuffer, 3))
             LOOP
             TCP PRINT hTCP, m_AuthType
              DO WHILE NOT EOF(hTCP)
                 TCP LINE hTCP, sBuffer
                 errcode = VAL(LEFT$(sBuffer, 3))
             LOOP
              IF errcode = 334 THEN
                 sTmp = Me.MimeEncode(m_AuthUsername)     ' UserId (might be the same as the POP3 UserId)
                 TCP PRINT hTCP, sTmp
                 DO WHILE NOT EOF(hTCP)
                     TCP LINE hTCP, sBuffer
                     errcode = VAL(LEFT$(sBuffer, 3))
                 LOOP
                 IF errcode = 334 THEN
                     sTmp = Me.MimeEncode(m_AuthPassword) ' Password (might be the same as the POP3 password)
                     TCP PRINT hTCP, sTmp
                     DO WHILE NOT EOF(hTCP)
                         TCP LINE hTCP, sBuffer
                         errcode = VAL(LEFT$(sBuffer, 3))
                     LOOP
                 END IF
             END IF
          END IF
 
         ' Tell the mailhost who we are
         REM tcp print hTCP, "MAIL FROM:<" & m_From & ">"
         y = INSTR(m_from, "<")
         IF y THEN
          TCP PRINT hTCP, "MAIL FROM:" & MID$(m_from,y)
        ELSE
          TCP PRINT hTCP, "MAIL FROM:<" & m_From & ">"
        END IF
 
        TCP LINE hTCP, m_Response
        IF LEFT$(m_Response, 3) <> "250" THEN GOTO SendError
          ' Tell the mailhost who the message is for
         ' There could be multiple recipients so iterate through
         ' the semicolon or comma deliminated list. The total RCPT
         ' list is the combination of the TO, CC, BCC lists.
         sAllRecipients = m_TO & ";" & m_CC & ";" & m_BCC
          NumLines = PARSECOUNT(sAllRecipients, ANY ";,")
         REDIM sArray(1 TO NumLines) AS STRING
         PARSE sAllRecipients, sArray(), ANY ";,"
          FOR y = 1 TO NumLines
            sTmp = RTRIM$(sArray(y))
            IF LEN(sTmp) THEN
               TCP PRINT hTCP, "RCPT TO:<" & sTmp & ">"
               TCP LINE hTCP, m_Response
               IF LEFT$(m_Response, 3) <> "250" THEN GOTO SendError
            END IF
         NEXT
 
         ' Send the message
         TCP PRINT hTCP, "DATA"
         TCP LINE hTCP, m_Response
         IF LEFT$(m_Response, 3) <> "354" THEN GOTO SendError
          ' The E-mail header
         TCP PRINT hTCP, "Date: " & Me.GetMailDateTime
         TCP PRINT hTCP, "From: " & m_From
          TCP PRINT hTCP, "To: " & m_To
          IF LEN(m_ReplyTo) THEN
            TCP PRINT hTCP, "Reply-To: " & m_ReplyTo
         END IF
          IF LEN(m_CC) THEN
            TCP PRINT hTCP, "Cc: "  & m_CC
         END IF
          ' Obviously we won't output the BCC list to the email
 
         TCP PRINT hTCP, "Subject: " & m_Subject
          TCP PRINT hTCP, "X-Mailer: pMailer Mail"
         TCP PRINT hTCP, "MIME-Version: 1.0"
          TCP PRINT hTCP, "Content-Type: multipart/mixed; boundary=" & $DQ & sBoundary & $DQ
         TCP PRINT hTCP, ""
 
         ' Create a main E-mail body section for the Plain message.
         ' Break the message down into lines
          IF (m_Style = "PLAIN") OR (m_Style = "BOTH") THEN
            TCP PRINT hTCP, "--" & sBoundary
            TCP PRINT hTCP, "Content-Type: text/plain; charset=" & $DQ & m_CharSet & $DQ
            TCP PRINT hTCP, "Content-Transfer-Encoding: 7bit"
            TCP PRINT hTCP, ""
            ' Any crlf pairs or plain lf's will be replaced with cr's for easy parsing
            REPLACE $CRLF WITH $CR IN m_PlainMessage
            REPLACE $LF   WITH $CR IN m_PlainMessage
             NumLines = PARSECOUNT( m_PlainMessage, $CR )
            REDIM sArray(1 TO NumLines) AS STRING
            PARSE m_PlainMessage, sArray(), $CR
             FOR y = 1 TO NumLines
               TCP PRINT hTCP, sArray(y)
            NEXT
         END IF
          IF (m_Style = "HTML") OR (m_Style = "BOTH") THEN
            TCP PRINT hTCP, "--" & sBoundary
            TCP PRINT hTCP, "Content-Type: text/html; charset=" & $DQ & m_CharSet & $DQ
            TCP PRINT hTCP, "Content-Transfer-Encoding: 7bit"
            TCP PRINT hTCP, ""
            ' Any crlf pairs or plain lf's will be replaced with cr's for easy parsing
            REPLACE $CRLF WITH $CR IN m_HTMLMessage
            REPLACE $LF   WITH $CR IN m_HTMLMessage
             NumLines = PARSECOUNT( m_HTMLMessage, $CR )
            REDIM sArray(1 TO NumLines) AS STRING
            PARSE m_HTMLMessage, sArray(), $CR
             FOR y = 1 TO NumLines
               TCP PRINT hTCP, sArray(y)
            NEXT
         END IF
 
         ' Create the attachment body section
         IF LEN(m_Attachments) > 0 THEN
            REM NumAttachments = PARSECOUNT( m_Attachments, ";," )
            NumAttachments = PARSECOUNT( m_Attachments, ANY ";," ) '8/17/13
            REDIM sArray(1 TO NumAttachments) AS STRING
            REM PARSE m_Attachments, sArray(), ";,"
            PARSE m_Attachments, sArray(), ANY ";," '8/17/13
             FOR y = 1 TO NumAttachments
               IF DIR$(sArray(y)) = "" THEN ITERATE FOR
                f = FREEFILE
               OPEN sArray(y) FOR BINARY AS #f
               GET$ #f, LOF(f), sBuffer
               CLOSE #f
                ' Encode the file
               sBuffer = Me.MimeEncode( sBuffer )
                TCP PRINT hTCP, "--" & sBoundary
               TCP PRINT hTCP, "Content-Type: application/octet-stream; name=" & $DQ & PATHNAME$(NAMEX, sArray(y)) & $DQ
               TCP PRINT hTCP, "Content-Transfer-Encoding: base64"
               TCP PRINT hTCP, ""
                ' Write the encoded data in lines of 76 characters.  Add an equality
               ' character if the last line is less than 76 bytes long
               FOR z = 1 TO LEN(sBuffer) STEP 76
                  IF LEN(sBuffer) - z >= 76 THEN
                     TCP PRINT hTCP, MID$(sBuffer, z, 76)
                  ELSE
                     TCP PRINT hTCP, MID$(sBuffer, z) & "="
                  END IF
               NEXT
             NEXT
         END IF
          ' Send the terminating boundary marker
         TCP PRINT hTCP, "--" & sBoundary & "--"
          ' Now finish the E-mail off as we're done sending the message
         TCP PRINT hTCP, "."
         TCP LINE hTCP, m_Response
         IF LEFT$(m_Response, 3) <> "250" THEN GOTO SendError
          ' Say goodbye
         TCP PRINT hTCP, "QUIT"
         TCP LINE hTCP, m_Response
         IF LEFT$(m_Response, 3) <> "221" THEN GOTO SendError
          TCP CLOSE hTCP
          EXIT METHOD
 SendError:
        METHOD = %TRUE    ' error occurred
       END METHOD
    END INTERFACE
    '------------------------------------------------------------
   '  End of Public Interface
   '------------------------------------------------------------
 END CLASS
 
FUNCTION ISEMAIL(BYVAL e AS STRING, MailAddr AS STRING) AS LONG
'------------------------------------------------------------
' verifies that the passed string contains at least one
' valid e-mail address and returns a fixed up version
'------------------------------------------------------------
  LOCAL Mask    AS STRING
  LOCAL p       AS LONG
  LOCAL l       AS LONG
   MailAddr = ""
  IF LEN(e) = 0 THEN
    FUNCTION = 0
    EXIT FUNCTION
  END IF
   Mask = "([a-z0-9._-]+)(@[a-z0-9._-]+)(\.[a-z]+)"
  REGEXPR Mask IN e TO p,l
   IF l > 0 THEN MailAddr = "<" + MID$(e,p,l) + ">"
   FUNCTION = (l > 0)
 END FUNCTION

[Bernhard Fomm]

Unicode is important! Правда
--> Solution with ChrToUtf8$ and CHARSET = "UTF-8"

Also:

The types of class members (PROPERTY, METHOD) should be WSTRING.
Otherwise, I can use the class only with PB.

[Mike Stefanik]

When it comes to parsing email addresses, there's two general formats that contain human-readable names along with the address itself:

User Name <[email protected]>
[email protected] (User Name)

You may also find that the printable name is surrounded in single or double quotes, such as:

"User Name" <[email protected]>
'[email protected]' <[email protected]>

If there are quotes present, you need to be careful when parsing, because something like this is permissible:

"User Name <[email protected]>" <[email protected]>
'[email protected] (User Name)' <[email protected]>

Multiple addresses can be separated by a comma or semi-colon as well, so you can end up with:

"Foo Bar; Director of Operations" <[email protected]>; "Bar Foo; Patch Panel Peon" <[email protected]>

[Gary Beene]

Hubert,
Did you also make a change so that SendTo could have a preceding user name, like this:

cMail.SendTo = "Gary Beene <[email protected]>"

If so, would you post what you did? Thanks!

[Gary Beene]

Howdy, Paul !
Is there a latest version which implements the various suggestions folks posted in this thread?

If not, I'll build one from the comments.

[Andrea Mariani]

I found an issue that sometimes the date would be set to 1/1/1970.

I later pinpointed the issue to the user's locale where Mon 12 May 2014 would be, for example,in Italy, Lun 12 Mag 2014 and the SMTP server will not recognize it.

To fix this issue I changed the folloing code:

       szFormat = "ddd',' dd MMM yyyy"
       GetDateFormat %[B]LANG_INVARIANT[/B], 0, t, szFormat, szTemp, SIZEOF(szTemp)
       sResult = szTemp

       szFormat = "HH':'mm':'ss"
       GetTimeFormat %[B]LANG_INVARIANT[/B], 0, t, szFormat, szTemp, SIZEOF(szTemp)

[Bud Durland]

You might also try using this function to validate & extract the e-mail address

FUNCTION ISEMAIL(BYVAL e AS STRING, MailAddr as string) AS LONG
'------------------------------------------------------------
' verifies that the passed string contains at least one
' valid e-mail address and returns a fixed up version
'------------------------------------------------------------
  LOCAL Mask    AS STRING
  LOCAL p       AS LONG
  LOCAL l       AS LONG

  MailAddr = ""
  IF LEN(e) = 0 THEN
    FUNCTION = 0
    EXIT FUNCTION
  END IF

  Mask = "([a-z0-9._-]+)(@[a-z0-9._-]+)(\.[a-z]+)"
  REGEXPR Mask IN e TO p,l

  if l > 0 then MailAddr = "<" + mid$(e,p,l) + ">"

  FUNCTION = (l > 0)

END FUNCTION

[Hubert Brandel]

Hi,

nice code and good to learn the CLASS programming

I found an error when SendFrom is filled with a eMail adress like this:

cMail.SendFrom = "Harry Testmann <[email protected]>"

To fix that change:

' Tell the mailhost who we are
TCP PRINT hTCP, "MAIL FROM:<" & m_From & ">"

to

y = INSTR(m_from, "<")
IF y THEN
    TCP PRINT hTCP, "MAIL FROM:" & MID$(m_from,y)
ELSE
    TCP PRINT hTCP, "MAIL FROM:<" & m_From & ">"
END IF

[Stuart McLachlan]

> Actually, I have clients that require SPF configuration to work with Google Apps.

So do I and I always set them up with +all at the end , but that doesn't alter my opinion about it

[Jim Dunn]

... SPF is ... experimental protocol...

Actually, I have clients that require SPF configuration to work with Google Apps.

[Stuart McLachlan]

> It might be a bit friendlier of you to also check for SPF records

SPF is a brain-dead, misguided experimental protocol which is much abused and causes problems for many RFC compliant systems.

[Stuart McLachlan]

> No. If those "inhouse" servers send mail, they need too have a MX entry, too. Problem solved.

Sorry, but that is 100% wrong.

An MX record tells external servers where to send mail TO for that domain.

When using an intermediate spam/filter server, best practice is to configure the organisation's router to only accept Port 25 connections from that filter server. If you create an MX record pointing to the sending server, outside organisations will end up trying to send direct to that address and will be blocked.

Even if you don't block Port 25 from other sources, creating an MX record pointing to the sending server WILL result in spam being sent direct to the in house server rather than to the filters.

Problem NOT solved. Problem compounded!

[Mike Stefanik]

No. If those "inhouse" servers send mail, they need too have a MX entry, too. Problem solved.

It might be a bit friendlier of you to also check for SPF records. I could see where there might be reasons that they don't want to advertise those systems as mail exchanges, even if they do handle mail internally.

But this is starting to get far afield of the source code issue, so we might want to discuss the vagaries of mail delivery elsewhere.

[Knuth Konrad]

BAD!!! You will drop all mail from quite a few of my clients and a heck of a lot of other organisations as well. Their MX records point to a cloud based spam/virus filter server which forwards to their in house mail server. This in house mail server sends all of their mail from a totally different IP address.

No. If those "inhouse" servers send mail, they need too have a MX entry, too. Problem solved.

[Stuart McLachlan]

If sending IP address <> MX record of sender's domain Then
Handle as spam/Drop connection
Else
Accept email
End If

BAD!!! You will drop all mail from quite a few of my clients and a heck of a lot of other organisations as well. Their MX records point to a cloud based spam/virus filter server which forwards to their in house mail server. This in house mail server sends all of their mail from a totally different IP address.

The correct test is:

If domain part of PTR record of sending IP address <> sender's domain Then
   Handle as spam/Drop connection
Else
   Accept email
End If

That is what PTR records are for.

[Knuth Konrad]

Generally speaking, that's not such a good idea because you'll find a large percentage of your email getting bounced. Today, properly configured SMTP servers will not accept email from unauthenticated, "out of policy" senders [...]

As a sys/mail admin, I can confim the above. Basically:

If sending IP address <> MX record of sender's domain Then
   Handle as spam/Drop connection
Else
   Accept email
End If