EMAIL using TCP goes to SPAM

[BOB MECHLER]

Starting with the EMAIL example provided by PB and others, I have succeeded in sending email with a .txt and/or .pdf attachment using STMP and AUTH LOGIN but internally it will go into the SPAM folder and externally to a test site at hotmail.com into the JUNK folder. In my gmail account just setup it goes to the inbox.

I used a Telnet session and BASE64 Mime encoder to make sure normal Domain users would work.

The same email sent from Outlook works fine, but we want the email to arrive in the INBOX of the recipient without relying on Outlook.

Will each recipient need to add the bank's email address to their safe sender's list?

[John Petty]

Bob
I think you need to provide more details. I have automated PB email programs running that have no problems being received through Spam Assassin or Outlook 2003. I suspect you are missing something in your outgoing headers.
John

[BOB MECHLER]

That is my guess also. I'll post relevant code here.

Bob Mechler

[BOB MECHLER]

I reworked the program to isolate the email sending part.
Emails sent by this code end up in the spam folder.
The TCP steps I duplicated using a telnet session but didn't know how to do the attachment in telnet so I don't know if that was the problem or not.

Bob Mechler

'Sample program to show method

      '-----------------------------------------------------------------------------
      ' Retrieve the current time and date in E-mail header format
      '
#INCLUDE "WIN32API.INC"
      MACRO m_DisplayResults (sText)
      #IF %DEF(%PB_CC32)
          STDOUT sText
      #ELSE
          MSGBOX sText, %MB_SYSTEMMODAL
      #ENDIF
      END MACRO
      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
      FUNCTION PBMAIN
      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
      LOCAL un          AS STRING
      LOCAL ps          AS STRING
      LOCAL e_MAILHOST  AS STRING
      LOCAL e_FILE      AS STRING
      LOCAL e_MAILFROM  AS STRING
      LOCAL e_MAILTO    AS STRING
      LOCAL e_SUBJECT   AS STRING
      LOCAL e_USERNAME  AS STRING
      LOCAL e_PASSWORD  AS STRING
      
      '
      ' replace below values with your own
      '
      e_MAILHOST$   = "mail.hwainternational.com" 'our mail server
      e_USERNAME$   = "username" 'Normal domain user  Windows login 
      e_PASSWORD$   = "password"
      e_MAILTO$     = "[email protected]" 'Normal domain user internally or an external email, same results
      e_MAILFROM$   = "[email protected]"
      e_FILE$       = "c:\pdfs\a.pdf"             '
      GOSUB SENDIT
      MSGBOX("Finished")
      EXIT FUNCTION
      
      
      
            
SENDIT: 'Send the email
          ' Read the target file
          OPEN e_FILE$ FOR BINARY ACCESS READ LOCK SHARED AS #1
          GET$ #1, LOF(1), sAttachment
          CLOSE #1
          ERRSECTION$ = "E100"
          sResponse = "Cannot open file"
          IF ERR THEN GOTO SendError
          sResponse = "File does not contain any data"
          ERRSECTION$ = "E101"
          IF LEN(sAttachment) = 0 THEN GOTO SendError
      
          ' Encode the file data in Base64 for MIME
          MimeEncode sAttachment
          ERRSECTION$ = "E102"
      
          ' Invent a unique file data boundary marker
          sBoundary = "Boundary." + REMOVE$(GUIDTXT$(GUID$), ANY "{-}")
          ERRSECTION$ = "E103"
      
          ' Tell the user what's happening...
      
          ' Connect to E-mail server (mailhost)
          nTCP = 2
          ERRSECTION$ = "E104"
          TCP OPEN "smtp" AT e_MAILHOST$ AS nTCP
          sResponse = "Cannot connect to E-mail server: " + e_MAILHOST$
          ERRSECTION$ = "E105"
          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, "ehlo " + sLocalHost
          TCP LINE nTCP, sResponse
          IF LEFT$(sResponse, 3) <> "250" THEN GOTO SendError
          ' Authenticate for remote email
          TCP PRINT nTCP, "auth login"
          WHILE NOT EOF(nTCP)
              TCP LINE nTCP, sResponse '
          WEND
          MSGBOX(sResponse + "1")
          un = e_USERNAME$
          MimeEncode un
          TCP PRINT nTCP, un
          WHILE NOT EOF(nTCP)
            TCP LINE nTCP, sResponse
          WEND
          MSGBOX(sResponse + "2")
          ps = e_PASSWORD$
          MimeEncode ps
          TCP PRINT nTCP, ps
          WHILE NOT EOF(nTCP)
            TCP LINE nTCP, sResponse
          WEND
          MSGBOX(sResponse + "3")
          ' Tell the mailhost who we are
          TCP PRINT nTCP, "MAIL FROM: <" + e_MAILFROM$ + ">"
          WHILE NOT EOF(nTCP)
            TCP LINE nTCP, sResponse
          WEND
          MSGBOX(sResponse + "4")
          IF LEFT$(sResponse, 3) <> "235" THEN GOTO SendError
      
          ' Tell the mailhost who the message is for
          TCP PRINT nTCP, "RCPT TO: <" + e_MAILTO$ + ">"
          WHILE NOT EOF(nTCP)
            TCP LINE nTCP, sResponse
          WEND
          MSGBOX(sResponse + "5")
          IF LEFT$(sResponse, 3) <> "250" THEN GOTO SendError
      
          ' Send the message
          TCP PRINT nTCP, "DATA"
          WHILE NOT EOF(nTCP)
            TCP LINE nTCP, sResponse
          WEND
          MSGBOX(sResponse + "6")
          IF LEFT$(sResponse, 3) <> "250" THEN GOTO SendError
      
          ' The E-mail header
          TCP PRINT nTCP, "Date: " + MailDate
          TCP PRINT nTCP, "From: " + e_MAILFROM$
          TCP PRINT nTCP, "To: " + e_MAILTO$
          TCP PRINT nTCP, "Subject: " + e_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 + e_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 e_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, "."
          WHILE NOT EOF(nTCP)
            TCP LINE nTCP, sResponse
          WEND
          MSGBOX(sResponse + "7")
          IF LEFT$(sResponse, 3) <> "354" THEN GOTO SendError
      
          ' Say goodbye
          TCP PRINT nTCP, "QUIT"
          WHILE NOT EOF(nTCP)
            TCP LINE nTCP, sResponse
          WEND
          MSGBOX(sResponse + "8")
          IF LEFT$(sResponse, 3) <> "250" THEN GOTO SendError
      
          TCP CLOSE nTCP
          m_DisplayResults("E-mail has been successfully sent to " + e_MAILTO$)
          GOTO Terminate
      
      SendError:
      
          m_DisplayResults("Error sending E-mail!" + $CRLF + sResponse)
      
      Terminate:
      
      
        RETURN
      END FUNCTION

[Adam J. Drake]

The only thing I see different that I do and typically don't have a problem is a slightly different format for the date/time - I don't put "UT" at the end, but actually figure up the time zone offset like Outlook does:

FUNCTION FormatDateTime() AS STRING

    LOCAL SysTime       AS SYSTEMTIME
    LOCAL LocalTime     AS SYSTEMTIME
    LOCAL Bias          AS STRING
    LOCAL WeekDay       AS STRING

    LOCAL m AS INTEGER
    LOCAL d AS STRING
    LOCAL y AS STRING

    CALL GetSystemTime(SysTime)
    CALL GetLocalTime(LocalTime)

    IF LocalTime.wDay<SysTime.wDay THEN
        SysTime.wHour=SysTime.wHour+24
    ELSEIF LocalTime.wDay>SysTime.wDay THEN
        LocalTime.wHour=LocalTime.wHour+24
    END IF

    Bias = FORMAT$((LocalTime.wHour - SysTime.wHour) * 100,"+0000;-0000")

    WeekDay=READ$(LocalTime.wDayOfWeek+13)

    m=VAL(MID$(DATE$,1,2))
    d=MID$(DATE$,4,2)
    y=MID$(DATE$,7,4)

    FUNCTION=WeekDay & ", " & d & " " & READ$(m) & " " & y & " " & TIME$ & " " & Bias

    EXIT FUNCTION

    DATA "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"
    DATA "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"

END FUNCTION

[Scott Turchin]

This worked for me on Outlook, have not used it in many years.

Change the name on teh x-mailer and give it a shot.
THe getpctimeanddate just gets it from Windows..
Do a search in teh source code forum, I'm sure I've posted it more than once (GetTimeandDate()).

'------------------------------------------------------------------------------------------

Function SmtpSendMail(ByVal SmtpHost As String, _
                      ByVal EmailFrom As String, _
                      ByVal EmailTo As String, _
                      ByVal Subject As String, _
                      ByVal FileSpec As String,_
                      ByVal FileString As String, _
                      Priority As String)Export As Long

  Local hTCP   As Long
  Local u      As Long
  Local x      As Long
  Local Buffer As String
  Local ip     As Long
  Local sHOSTNAME As String
  Local i      As Long
  Local vEFlag As Long
  Local lLoop  As Long


  g_Result = SetPriorityClass(GetCurrentProcess(), %HIGH_PRIORITY_CLASS)

  'ON ERROR GOTO SmtpError
  Host Addr To ip
  Host Name ip To sHOSTNAME
  hTCP = FreeFile
  Tcp Open "smtp" At SmtpHost As hTCP
  If Err Then
     buffer= "Error connecting to SMTP mail server"
     Function = 1
     GoTo SmtpError
     Exit Function
  Else
     Tcp Line hTCP, Buffer
     If Left$(Buffer, 3) <> "220" Then
        buffer = "Mail Server Error: " & Buffer
        GoTo SmtpError
        Function = 1
     End If
  End If

  vEFlag = 0
  If Not Eof(hTcp) Then
     Tcp Line hTCP, Buffer
     If Len(buffer) > 8 Then
        If Left$(buffer,9) = "220 ESMTP" Then vEFlag = 1
        Do While Not Eof(hTcp)
           Tcp Line hTCP, Buffer
        Loop
     End If
  End If

  '   IF e <> 220 THEN SmtpDone

  If vEFlag = 0 Then
      ' ** Meet & greet the SMTP host
      Tcp Print hTCP, "HELO " + sHOSTNAME
      Tcp Line hTCP, Buffer
      If Left$(Buffer, 3) <> "250" Then
         buffer = "HELO Error: " & Buffer
         GoTo SmtpError
      End If
  Else
     ' ** Meet & greet the ESMTP host
     Tcp Print hTCP, "EHLO " + sHOSTNAME
     Tcp Line hTCP, Buffer
     If Left$(Buffer, 3) <> "250" Then
        buffer = "EHLO Error: " & Buffer
        GoTo SmtpError
     End If
     Do While Not Eof(hTcp)
        Tcp Line hTCP, Buffer
     Loop
  End If

  '// Tell The mailhost who we are //
  Tcp Print hTCP, "MAIL FROM:<" & EmailFrom & ">"
  Tcp Line hTCP, Buffer
  If Left$(Buffer, 3) <> "250" Then
     buffer = "MAIL FROM Error: " & Buffer
     GoTo SmtpError
  End If

  '// Tell The mail host whi we want to send the message to //
  Tcp Print hTCP, "RCPT TO:<" & EmailTo & ">"
  Tcp Line hTCP, Buffer
  If Left$(Buffer, 3) <> "250" Then
     buffer ="RCPT Error: " & Buffer
     GoTo SmtpError
  End If

  '// Now We can send DATA //
  Tcp Print hTCP, "DATA"
  Tcp Line hTCP, Buffer
  If Left$(Buffer, 3) <> "354" Then
     buffer ="DATA Error: " & Buffer
     GoTo SmtpError
  End If



  ' ** Message header
  Tcp Print hTCP, "From: " & EmailFrom
  Tcp Print hTCP, "To: " & EmailTo
  Tcp Print hTCP, "Subject: " & Subject
  Tcp Print hTcp, "Date: " & GetPCTimeandDate
  Tcp Print hTCP, "X-Mailer: SPYDER32 " & g_Ver
  Tcp Print hTcp, "X-MSMail-Priority: " & Priority
  Tcp Print hTCP, "MIME-Version: 1.0"
  Tcp Print hTCP, "Content-Type: application/octet-stream; name=" + Dir$(FileSpec)
  Tcp Print hTCP, "Content-transfer-encoding: base64"
  Tcp Print hTCP, ""

  Tcp Print hTCP, FileString

  ' ** End of message
  Tcp Print hTCP, "."
  Tcp Line hTCP, Buffer
  If Left$(Buffer, 3) <> "250" Then
     buffer ="DATA Error: " & Buffer
     GoTo SmtpError
  End If

  Tcp Print hTCP, "QUIT"
  Tcp Line hTCP, Buffer
  If Left$(Buffer, 3) <> "221" Then
     buffer ="QUIT Error: " & Buffer
     GoTo SmtpError
  End If
  buffer ="The EMail Message Has Been Sent" & $CrLf & $CrLf & Buffer

SmtpDone:
  g_Result = SetPriorityClass(GetCurrentProcess(), %NORMAL_PRIORITY_CLASS)
'  MsgBox buffer
  Function = %TRUE
  Tcp Close hTCP
  Exit Function

SmtpError:
  g_Result = SetPriorityClass(GetCurrentProcess(), %NORMAL_PRIORITY_CLASS)
'  MsgBox buffer
  Function = %FALSE
  Tcp Close hTCP
End Function

'----------------------------------------------------------------------------
' Convert a file to MIME text (Base64 Encoded) for PB/DLL or PB/CC
' by Dave Navarro ([email protected])
' Modified by Scott Turchin
Function FileToMIME(sName As Asciiz, InFile As Asciiz)Export As String
   Local Enc As String * 64
   Local b As Asciiz * 4
   Local InBuff As String
   Local OutBuff As String
   Local FinalBuff  As String
   Local i As Long
   Local hFile      As Long
   Enc = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

   Open InFile For Binary As #hFile
      While Not Eof(hFile)
         Get$ hFile, 57, InBuff
         OutBuff = ""
         While Len(InBuff)
            b = Left$(InBuff, 3)
            ! mov AL, b[0]
            ! shr AL, 2
            ! movzx i, AL
            OutBuff = OutBuff + Mid$(Enc, i+1, 1)
            ! mov AL, b[1]
            ! mov AH, b[0]
            ! shr AX, 4
            ! and AL, &H3F
            ! movzx i, AL
            OutBuff = OutBuff + Mid$(Enc, i+1, 1)
            If Len(InBuff) = 1 Then
               OutBuff = OutBuff + "=="
               Exit Do
            End If
            ! mov AL, b[2]
            ! mov AH, b[1]
            ! shr AX, 6
            ! and AL, &H3F
            ! movzx i, AL
            OutBuff = OutBuff + Mid$(Enc, i+1, 1)
            If Len(InBuff) = 2 Then
               OutBuff = OutBuff + "="
               Exit Do
            End If
            ! mov AL, b[2]
            ! and AL, &H3F
            ! movzx i, AL
            OutBuff = OutBuff + Mid$(Enc, i+1, 1)
            InBuff = Mid$(InBuff, 4)
         Wend
         FinalBuff = FinalBuff & $CrLf & OutBuff
      Wend
   Close
Function = FinalBuff' & $CRLF' & g_Boundary & $CRLF
End Function

'------------------------------------------------------------------------------

[BOB MECHLER]

I changed to the GetDateandTime function and carefully compared my code with that posted and it now seems to be fine. Had to add back AUTH LOGIN but I'm ok now with both internal and external recipients.

The 'UT' business in the date might have been the problem, I'm not sure.

Thanks,

Bob Mechler

[Scott Turchin]

If you are connecting to Exchange I understand you can use an EHELO command as well for more options (??)..

[Wayne Diamond]

Not sure if this is of any help but it's code I used only a few months ago. I had to make a few modifications to get it to work, but I'm not sure who the original author is.

I also have code for sending an email with file attachment using ESMTP, but I dont think you need that for this problem.

'==============================================================================
'
'  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.
'
'  Updated 16 Nov 2004 to remove spaces from MAIL FROM:, RCTP TO: greetings.
'  Updated 02 Jul 2003 to correct handling of negative time offsets.
'  Updated 10 Apr 2003 to support Daylight Savings Time.
'  Updated 06 Mar 2003 to bring Date field formatting up to RFC spec.
'  Updated 24 Feb 2003 to improve Mime data padding.
'
'==============================================================================


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

' The name of your SMTP E-mail server.
$mailhost = "smtp.server.com"

' E-mail and header info
$File     = "c:\temp\myfile.bin"
$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 sUCTOffset AS STRING
    LOCAL 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   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
    LOCAL Pad      AS STRING

    ' Set up Base64 translation table
    sBase64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

    ' Calculate padding for Base64 stream
    Pad = STRING$(2 - (LEN(sFileData) - 1) MOD 3, "=")

    ' 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

    ' Merge in the padding bytes
    RSET ABS sResult = Pad
    FUNCTION = sResult

END FUNCTION


'-----------------------------------------------------------------------------
' The main application entry point.
'
FUNCTION PBMAIN () AS LONG

    LOCAL lLine       AS LONG
    LOCAL nTCP        AS LONG
    LOCAL sAttachment AS STRING
    LOCAL sLocalHost  AS STRING
    LOCAL sResponse   AS STRING
    LOCAL sBoundary   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
    sAttachment = 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)
    nTCP = FREEFILE
    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 + "--"

    ' 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

    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

[BOB MECHLER]

Thanks for additional versions. I see the differences between what I started with and the updated code. I think I'm good to go.


Bob Mechler