SMTP and POP3 helper functions for PB/DLL 6.0 and PB/CC 2.0

'=============================================================================
'
'  TCP communications for 32-bit powerbasic
'  Copyright (c) 1999 PowerBASIC, Inc. All Rights Reserved.
'
'=============================================================================

%TCPDEBUG     = 0
$TCPDEBUGFILE = "TCPDEBUG.LOG"

'-----------------------------------------------------------------------------
' Helper function for TCP
'
FUNCTION TcpGetLine(BYVAL hTCP AS LONG, Buffer AS STRING) AS LONG

#IF %TCPDEBUG
  LOCAL hFile AS LONG
  hFile = FREEFILE
  OPEN $TCPDEBUGFILE FOR APPEND AS hFile
#ENDIF

  Buffer = ""

  TCP LINE hTCP, Buffer

  IF ERR THEN
#IF %TCPDEBUG
    PRINT# hFile, "PowerBASIC Error =" & STR$(ERR)
#ENDIF
    FUNCTION = ERR
#IF %TCPDEBUG
  ELSE
    PRINT# hFile, Buffer
#ENDIF
  END IF

#IF %TCPDEBUG
  CLOSE hFile
#ENDIF

END FUNCTION

'-----------------------------------------------------------------------------
' Helper function for SMTP protocol
'
FUNCTION SmtpGetLine (BYVAL hTCP AS LONG, Buffer AS STRING) AS LONG

  IF TcpGetLine(hTCP, Buffer) THEN
    EXIT FUNCTION
  ELSE
    FUNCTION = VAL(LEFT$(Buffer, 3))
    Buffer = MID$(Buffer, 5)
  END IF

END FUNCTION

'-----------------------------------------------------------------------------
' Send a text email message to a single recipient.  Returns zero (0) if
' successful.
'
FUNCTION SmtpSendMail(BYVAL SmtpHost AS STRING, BYVAL EmailFrom AS STRING, _
                      BYVAL EmailTo AS STRING, BYVAL Subject AS STRING, _
                      Message() AS STRING) AS LONG

  LOCAL hTCP   AS LONG
  LOCAL e      AS LONG
  LOCAL u      AS LONG
  LOCAL x      AS LONG
  LOCAL Buffer AS STRING

  ON ERROR GOTO SmtpError

  hTCP = FREEFILE

  TCP OPEN "smtp" AT SmtpHost AS hTCP

  e = SmtpGetLine(hTCP, Buffer)
  IF e <> 220 THEN SmtpDone

' ** Meet & greet the SMTP host
  TCP PRINT hTCP, "HELO " + TCPHOST$
  e = SmtpGetLine(hTCP, Buffer)
  IF e <> 250 THEN SmtpDone

  TCP PRINT hTCP, "MAIL FROM:<" & EmailFrom & ">"
  e = SmtpGetLine(hTCP, Buffer)
  IF e <> 250 THEN SmtpDone

  TCP PRINT hTCP, "RCPT TO:<" & EmailTo & ">"
  e = SmtpGetLine(hTCP, Buffer)
  IF e <> 250 THEN SmtpDone

  TCP PRINT hTCP, "DATA"
  e = SmtpGetLine(hTCP, Buffer)
  IF e <> 354 THEN SmtpDone

' ** Message header
  TCP PRINT hTCP, "From: " & EmailFrom
  TCP PRINT hTCP, "To: " & EmailTo
  TCP PRINT hTCP, "Subject: " & Subject
  TCP PRINT hTCP, "X-Mailer: PowerBASIC for Windows"

' ** Message text
  u = UBOUND(Message(1))
  FOR x = 1 TO u
    Buffer = Message(x)
    IF LEFT$(Buffer, 1) = "." THEN
      Buffer = "." + Buffer
    END IF
    TCP PRINT hTCP, Buffer
  NEXT x

' ** End of message
  TCP PRINT hTCP, "."
  e = SmtpGetLine(hTCP, Buffer)
  IF e <> 250 THEN SmtpDone

  TCP PRINT hTCP, "QUIT"
  e = SmtpGetLine(hTCP, Buffer)
  IF e <> 221 THEN SmtpDone

  e = 0  'success!

SmtpDone:
  FUNCTION = e
  CLOSE hTCP
  EXIT FUNCTION

SmtpError:
  e = ERR
  RESUME SmtpDone

END FUNCTION

'-----------------------------------------------------------------------------
' Connect to POP3 mail server.
'
FUNCTION Pop3Connect(BYVAL Pop3Host AS STRING, BYVAL User AS STRING, _
                     BYVAL password AS STRING) AS LONG

  LOCAL hTCP   AS LONG
  LOCAL Buffer AS STRING

  ON ERROR GOTO Pop3Error

  hTCP = FREEFILE

  TCP OPEN "pop3" AT Pop3Host AS hTCP

  TCP LINE hTCP, Buffer
  IF LEFT$(Buffer, 3) <> "+OK" THEN Pop3Error

  TCP PRINT hTCP, "USER " & User
  TCP LINE hTCP, Buffer
  IF LEFT$(Buffer, 3) <> "+OK" THEN Pop3Error

  TCP PRINT hTCP, "PASS " & password
  TCP LINE hTCP, Buffer
  IF LEFT$(Buffer, 3) <> "+OK" THEN Pop3Error

  FUNCTION = hTCP
  EXIT FUNCTION

Pop3Error:
  CLOSE hTCP

END FUNCTION

'-----------------------------------------------------------------------------
' Disconnect from POP3 mail server
'
FUNCTION Pop3Quit(BYVAL hTCP AS LONG) AS LONG

  LOCAL Buffer AS STRING

  TCP PRINT hTCP, "QUIT"
  TCP LINE hTCP, Buffer

  IF LEFT$(Buffer, 3) <> "+OK" THEN
    FUNCTION = -1  'error
  END IF

END FUNCTION

'-----------------------------------------------------------------------------
' Get the status of the POP3 account
'
FUNCTION Pop3GetStat(BYVAL hTCP AS LONG, Messages AS LONG, MsgSize AS LONG) AS
LONG

  LOCAL Buffer AS STRING

  TCP PRINT hTCP, "STAT"
  TCP LINE hTCP, Buffer

  IF LEFT$(Buffer, 3) <> "+OK" THEN
    FUNCTION = -1  'error
    EXIT FUNCTION
  END IF

  Messages = VAL(PARSE$(Buffer, " ", 2))
  MsgSize  = VAL(PARSE$(Buffer, " ", 3))

END FUNCTION

'-----------------------------------------------------------------------------
' Retrieve a message from a POP3 server
'
FUNCTION Pop3RetrMessage(BYVAL hTCP AS LONG, BYVAL MsgNumber AS LONG, _
                         Msg() AS STRING) AS LONG

  LOCAL x      AS LONG
  LOCAL Buffer AS STRING

  ON ERROR GOTO Pop3RetrDone

  REDIM Msg(1 to 100) AS STRING

  TCP PRINT hTCP, "RETR" & STR$(MsgNumber)
  TCP LINE hTCP, Buffer

  IF LEFT$(Buffer, 3) <> "+OK" THEN Pop3RetrDone

  DO
    TCP LINE hTCP, Buffer
    IF Buffer = "." THEN
      EXIT DO
    END IF
    INCR x
    IF LEFT$(Buffer, 2) = ".." THEN
      Buffer = "." + MID$(Buffer, 3)
    END IF
    IF x > UBOUND(Msg(1)) THEN
      REDIM PRESERVE Msg(1 to x + 50) AS STRING
    END IF
    Msg(x) = Buffer
  LOOP

Pop3RetrDone:
  IF x = 0 THEN
    ERASE Msg()
  ELSE
    REDIM PRESERVE Msg(1 to x) AS STRING
    FUNCTION = x
  END IF
  EXIT FUNCTION

END FUNCTION