#COMPILE EXE
#INCLUDE "PBCGI.INC"
 
$mailhost = "yourhost.com"
$mailto   = "you@yourhost.com"
$mailfrom = "cgimail@yourhost.com"
 
FUNCTION PbMain() AS LONG
 
  LOCAL hTcp      AS LONG
  LOCAL params    AS LONG
  LOCAL x         AS LONG
 
  LOCAL buffer    AS STRING
  LOCAL localhost AS STRING
 
  LOCAL mailto    AS STRING
  LOCAL mailfrom  AS STRING
  LOCAL subject   AS STRING
  LOCAL redirect  AS STRING
  LOCAL email     AS STRING
  LOCAL required  AS STRING
 
  DIM param(1 TO 1) AS STRING
 
  buffer   = ReadCGI
  params = ParseParams(buffer, param())
 
  mailfrom = CgiParam(buffer, "mailfrom")
  mailto   = CgiParam(buffer, "mailto")
  redirect = CgiParam(buffer, "redirect")
  subject  = CgiParam(buffer, "subject")
  required = CgiParam(buffer, "required")
 
  IF ISFALSE LEN(mailto) THEN
    mailto = $mailto
  END IF
 
  IF ISFALSE LEN(mailfrom) THEN
    mailfrom = $mailfrom
  END IF
 
  IF ISFALSE LEN(redirect) THEN
    redirect = Http_Referer
  END IF
 
  IF ISFALSE LEN(subject) THEN
    subject = "email from " & redirect
  END IF
 
  IF LEN(required) THEN
    FOR x = 1 TO PARSECOUNT(required)
      IF ISFALSE LEN(CgiParam(buffer,PARSE$(required,x))) THEN
        WriteCGI "<FONT SIZE=""+2"">Form Error!"
        WriteCGI "<P>Required field """ & PARSE$(required,x) & """ can not be empty.</FONT>"
        WriteCGI "<P>Please press the BACK button on your browser and re-submit the form with all required items."
        WriteCGI "<P>Thank you!"
        EXIT FUNCTION
      END IF
    NEXT
  END IF
 
' ** Get the local host name
  HOST ADDR TO hTCP
  HOST NAME hTCP TO localhost
 
' ** Connect to mail server
  hTCP = FREEFILE
  TCP OPEN "smtp" AT $mailhost AS hTCP
  IF ERR THEN
    Buffer = "Error connecting to mailhost"
    GOTO SendError
  ELSE
    TCP LINE hTCP, Buffer
    IF LEFT$(Buffer, 3) <> "220" THEN
      GOTO SendError
    END IF
  END IF
 
' ** Greet the mailhost
  TCP PRINT hTCP, "HELO " + localhost
  TCP LINE hTCP, Buffer
  IF LEFT$(Buffer, 3) <> "250" THEN
    Buffer = "HELO error: " + Buffer
    GOTO SendError
  END IF
 
' ** Tell the mailhost who we are
  TCP PRINT hTCP, "MAIL FROM: <gmail@basicguru.com>"
  TCP LINE hTCP, Buffer
  IF LEFT$(Buffer, 3) <> "250" THEN
    Buffer = "MAIL FROM error: " + Buffer
    GOTO SendError
  END IF
 
' ** Tell the mailhost who the message is for
  TCP PRINT hTCP, "RCPT TO: <" + mailto + ">"
  TCP LINE hTCP, Buffer
  IF LEFT$(Buffer, 3) <> "250" THEN
    Buffer = "RCPT TO error: " + Buffer
    GOTO SendError
  END IF
 
' ** Send the message
  TCP PRINT hTCP, "DATA"
  TCP LINE hTCP, Buffer
  IF LEFT$(Buffer, 3) <> "354" THEN
    Buffer = "DATA error: " + Buffer
    GOTO SendError
  END IF
 
  TCP PRINT hTCP, "From: " & mailfrom
  TCP PRINT hTCP, "To: " & mailto
  TCP PRINT hTCP, "Subject: " & subject
  TCP PRINT hTCP, "X-Mailer: cgimail.exe v1.0 (www.powerbasic.com)"
  TCP PRINT hTCP, ""
 
  FOR x = 1 TO params
    buffer = DecodeCGI(Param(x))
    IF ASC(buffer) = 46 THEN
      buffer = "." & buffer
    END IF
    TCP PRINT hTCP, buffer
  NEXT x
 
  TCP PRINT hTCP, ""
  TCP PRINT hTCP, "Referer: " & Http_Referer
  TCP PRINT hTCP, "Remote_Addr: " & Remote_Addr
  TCP PRINT hTCP, "Http_User_Agent: " & Http_User_Agent
 
  TCP PRINT hTCP, "."
  TCP LINE hTCP, Buffer
  IF LEFT$(Buffer, 3) <> "250" THEN
    GOTO SendError
  END IF
 
' ** Say goodbye
  TCP PRINT hTCP, "QUIT"
  TCP LINE hTCP, Buffer
  IF LEFT$(Buffer, 3) <> "221" THEN
    Buffer = "QUIT error: " + Buffer
    GOTO SendError
  END IF
 
  TCP CLOSE hTCP
 
  STDOUT "Location: " & redirect & $CRLF
 
  FUNCTION = -1
 
Done:
  EXIT FUNCTION
 
SendError:
  PRINT buffer
  TCP CLOSE hTCP
  GOTO Done
 
END FUNCTION