' Mike Trader
' cgi email with authentication
'
' Send an email with a cgi.exe.
' Includes the very necessary step of authentication!

#COMPILE EXE "testmail.exe"
#DIM ALL

#INCLUDE "PBCGIBOTH.INC"

'Account details
$mailhost = "mail.mydomain.com"    ' your host smtp out  Default Port 25
$mailfrom = "cgimail@mydomain.com" ' your email FROM address
$UserName = "BillStickers"
$Password = "mypassword"


'ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ'
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, mPad AS STRING


    sBase64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" ' Set up Base64 translation table
    mPad = STRING$(2 - (LEN(sFileData) - 1) MOD 3, "=") ' Calculate padding for Base64 stream
    lcBlocks = (LEN(sFileData) + 2) \ 3 ' Round up the length of the input data to a multiple of three
    IF lcBlocks * 3 > LEN(sFileData) THEN
        sFileData = LSET$(sFileData, lcBlocks * 3 USING $NUL)
    END IF

    sResult = SPACE$(lcBlocks * 4) ' Allocate the space for the output string
    pInput  = STRPTR(sFileData) ' Set up pointers so we can treat the data as byte streams
    pOutput = STRPTR(sResult)
    pTable  = STRPTR(sBase64)
    FOR lBlock = 1 TO lcBlocks ' Loop through our entire input buffer
        lByte1 = @pInput ' Get the next three binary data bytes to process
        INCR pInput
        lByte2 = @pInput
        INCR pInput
        lByte3 = @pInput
        INCR pInput
        lIndex1 =  lByte1 \ 4  ' Translate the three data bytes into four Base64 table indices
        lIndex2 = (lByte1 AND 3) * 16 + lByte2 \ 16
        lIndex3 = (lByte2 AND 15) * 4 + lByte3 \ 64
        lIndex4 =  lByte3 AND 63
        @pOutput = @pTable[lIndex1] ' Use the Base64 table to encode the output string
        INCR pOutput
        @pOutput = @pTable[lIndex2]
        INCR pOutput
        @pOutput = @pTable[lIndex3]
        INCR pOutput
        @pOutput = @pTable[lIndex4]
        INCR pOutput
    NEXT
    RSET ABS sResult = mPad ' Merge in the padding bytes
    FUNCTION = sResult
END FUNCTION


'ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ'
FUNCTION Authenticate( BYVAL hTCP AS LONG,  UName AS STRING, Psw AS STRING ) AS LONG

  LOCAL Code AS LONG
  LOCAL mTmp, sReply AS STRING

    DO WHILE NOT EOF(hTCP) ' Empty buffer
        TCP LINE hTCP, sReply
       'Code = VAL(LEFT$(sReply, 3)) ' Dont care
    LOOP
    '================================

    TCP PRINT hTCP, "AUTH LOGIN" ' Announce Authorization
    DO WHILE NOT EOF(hTCP)
        TCP LINE hTCP, sReply
        Code = VAL(LEFT$(sReply, 3))
    LOOP
    IF Code <> 334 THEN
        FUNCTION = Code
      EXIT FUNCTION
    END IF
    '================================

    mTmp = MimeEncode(UName) ' Send UserId - might be the same as the POP3 UserId
    TCP PRINT hTCP, mTmp
    DO WHILE NOT EOF(hTCP)
        TCP LINE hTCP, sReply
        Code = VAL(LEFT$(sReply, 3))
    LOOP
    IF Code <> 334 THEN
        FUNCTION = Code
      EXIT FUNCTION
    END IF
    '================================

    mTmp = MimeEncode(Psw) ' Send Password - might be the same as the POP3 password
    TCP PRINT hTCP, mTmp
    DO WHILE NOT EOF(hTCP)
        TCP LINE hTCP, sReply
        Code = VAL(LEFT$(sReply, 3))
    LOOP
    FUNCTION = Code ' 235 = Go Ahead (you are verified)
    '================================

END FUNCTION

'ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ'
FUNCTION SendEmail(sMailTo AS STRING, sSubject AS STRING, sMessage AS STRING, Uname AS STRING, Psw AS STRING) AS STRING

  LOCAL hTCP, Code AS LONG
  LOCAL localhost, sErr, sReply AS STRING


    'Get the local host name
    HOST ADDR TO hTCP
    HOST NAME hTCP TO localhost
    '================================

    DO ' a loop to enable jump to the end

        'Connect to mail server
        hTCP = FREEFILE
        TCP OPEN "smtp" AT $mailhost AS hTCP
        IF ERR THEN
          sErr = "Error connecting to mailhost"
          EXIT LOOP
        ELSE
          TCP LINE hTCP, sReply
          sReply = LEFT$(sReply, 3)
          IF sReply <> "220" THEN ' Server Down
            sErr = "Server is down"
            EXIT LOOP
          END IF
        END IF
        '================================

        'Greet the mailhost
        TCP PRINT hTCP, "HELO " + localhost
        TCP LINE hTCP, sReply
        sReply = LEFT$(sReply, 3)
        IF sReply <> "250" THEN
          sErr = "reply to HELO: " + sReply
          EXIT LOOP
        END IF
        '================================

        'Authenticate with mailhost
        Code = Authenticate( hTCP, Uname, Psw )
        IF Code <> 235 THEN
          sErr = "Authentication Error: " + STR$(Code)
          EXIT LOOP
        END IF
        '================================

        'Tell the mailhost who we are
        TCP PRINT hTCP, "MAIL FROM: <" + $mailfrom + ">"
        TCP LINE hTCP, sReply
        sReply = LEFT$(sReply, 3)
        IF sReply <> "250" THEN
          sErr = "MAIL FROM error: " + sReply
          EXIT LOOP
        END IF
        '================================

        'Tell the mailhost who the message is for
        TCP PRINT hTCP, "RCPT TO: <" + sMailTo + ">"
        TCP LINE hTCP, sReply
        sReply = LEFT$(sReply, 3)
        IF sReply <> "250" THEN
          sErr = "RCPT TO error: " + sReply
          EXIT LOOP
        END IF
        '================================

        'Start the message
        TCP PRINT hTCP, "DATA"
        TCP LINE hTCP, sReply
        sReply = LEFT$(sReply, 3)
        IF sReply <> "354" THEN
          sErr = "DATA error: " + sReply
          EXIT LOOP
        END IF
        '================================

        'message header
        TCP PRINT hTCP, "From: " + $mailfrom
        TCP PRINT hTCP, "To: "   + sMailTo
        TCP PRINT hTCP, "Subject: " + sSubject
        TCP PRINT hTCP, "X-Mailer: cgimail at " + $mailhost
        TCP PRINT hTCP, ""
        '================================

        'message body
        TCP PRINT hTCP, sMessage
        '================================

        'message footer
        TCP PRINT hTCP, "."
        TCP LINE hTCP, sReply
        sReply = LEFT$(sReply, 3)
        IF sReply <> "250" THEN
          sErr = "end of message error: " + sReply
          EXIT LOOP
        END IF
        '================================

        'Say goodbye
        TCP PRINT hTCP, "QUIT"
        TCP LINE hTCP, sReply
        sReply = LEFT$(sReply, 3)
        IF sReply <> "221" THEN
          sErr = "QUIT error: " + sReply
          EXIT LOOP
        END IF
        '================================

        TCP CLOSE hTCP
        sErr = ""  ' success
        EXIT LOOP
        '================================

    LOOP
    TCP CLOSE hTCP
    FUNCTION = sErr ' error

END FUNCTION


'ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ'
FUNCTION PBMAIN () AS LONG

  LOCAL sTemp AS STRING

      sTemp =         "DO NOT REPLY TO THIS EMAIL" + $CRLF  ' email visitor
      sTemp = sTemp + "If you have received this message in error, please ignore and delete" + $CRLF + $CRLF
      sTemp = sTemp + "Testing, Testing, Testing, Testing, Testing, Testing" + $CRLF + $CRLF + $CRLF
      sTemp = sTemp + "Date: " + DATE$+", "+TIME$ + $CRLF
      sTemp = SendEmail( "Mickey@Disney.com", "Test email", sTemp, $UserName, $Password )


END FUNCTION
'ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ'