' Express Mailer
' done by Wolfgang "DarkWulf" Kempin <wolfgang.kempin@gmx.de>

' This program sends e-mails using SMTP and is based on
' William Yu's CHATCLIENT.BAS. The main routine is
' TimerExpired -- it will send the mail, step by step.
' [Look at the code and you'll see what I mean.]

' Hasn't been tested very much -- but seem's to work :)
' Hope you can read my cryptic programming... I don't
' usually make _any_ comments at all...
' See RFC821 for further information on sending SMTP mails.

' Remember: Some SMTP servers require that you login with POP3
'           first. [Go and fetch your e-mails once -- then you
'           should be able to send them.]

'Versions
'--------
'
' V. 1.00    First complete and working version
' V. 1.01    Fixed '555 Syntax error' when sending mails

'To do:
'------
'
'    + Add date/time calculation
'    + Perhaps some more error checking... but works okay
'      at the moment.
'    + Make a better form -- the current one looks somehow
'      ugly IMHO.
'    + additional cool stuff


$APPTYPE GUI
' $TYPECHECK ON                 'argh... I don't need it!

CONST DELAY = 500
CONST False = 0
CONST True = NOT False

DECLARE SUB ButtonClick           '"Send mail" button
DECLARE SUB TimerExpired          'Check for incomming messages from server
                                  'and continue in sending a mail.

DIM TheFont AS QFONT              'Font for rich edit text box
TheFont.Name="Courier New"
TheFont.Size=10

DIM Socket AS QSocket             'Internet stuff
DIM SockNum AS INTEGER
    SockNum = 0

DIM LastLine AS STRING            'Last line recieved from socket
DIM LastCode AS INTEGER           'Every SMTP response from the server is
                                  'in the format "nnn Text..."
                                  'LastCode=nnn

DIM MailStep AS INTEGER           'Which step have we got to do next?
                                  'Used in SUB TimerExpired.

CREATE MainForm AS QForm          'Main Form
  Height = 350
  Width = 500
  Caption = "Express Mailer Version 1.01"
  Center
  CREATE Label1 AS QLabel
    Top = 12
    Left = 5
    Caption = "SMTP Server:"
  END CREATE
  CREATE Label2 AS QLabel
    Top = 39
    Left = 5
    Caption = "From:"
  END CREATE
  CREATE Label3 AS QLabel
    Top = 67
    Left = 5
    Caption = "To:"
  END CREATE
  CREATE Label4 AS QLabel
    Top = 73+27
    Left = 5
    Caption = "Subject:"
  END CREATE
  CREATE Edit1 AS QEdit
    Left = 110
    Top = 10
    Width = 380
    Height = 20
    Text = "mail.gmx.net"
  END CREATE
  CREATE Edit2 AS QEdit
    Left = 110
    Top = 37
    Width = 380
    Height = 20
    Text = "anyone@gmx.net"
  END CREATE
  CREATE Edit3 AS QEdit
    Left = 110
    Top = 37+27
    Width = 380
    Height = 20
    Text = "someone@anywhere.com"
  END CREATE
  CREATE Edit4 AS QEdit
    Left = 110
    Top = 71+27
    Width = 380
    Height = 20
    Text = ""
  END CREATE
  CREATE Button AS QButton
    Left = 70
    Top = 250+27
    Height = 20
    Width = 420
    Caption = "<<< Send the e-mail... >>>"
    OnClick = ButtonClick
  END CREATE
  CREATE Status AS QLabel
    Left = 70
    Top = 280+27
    Height = 20
    Width = 420
    Caption = "Please enter your e-mail."
  END CREATE
  CREATE TextBox AS QRichEdit
    Top = 95+5+27
    Left = 70
    Width = 420
    Height = 140
    PlainText = true
    Font = TheFont
  END CREATE
  CREATE Label5 AS QLabel
    Top = 98+5+27
    Left = 5
    Caption = "Message:"
  END CREATE
END CREATE

DIM Timer1 AS QTimer                         'Timer for checking the socket
    Timer1.Interval = DELAY
    Timer1.OnTimer = TimerExpired

SUB TimerExpired                             '"Main" routine
  Timer1.Enabled = False
  Timer1.Interval = DELAY
  IF SockNum <= 0 THEN
    Timer1.Enabled = True
    EXIT SUB
  END IF
  IF Socket.IsServerReady(SockNum) THEN
  LastLine=Socket.ReadLine(SockNum)
    IF Socket.Transferred  < 0 THEN                'server dropped connection
      SockNum = 0
      ShowMessage "Server disconnected unexpectedly!"
      Status.Caption = "Please enter your e-mail."
    END IF
    LastCode=val(mid$(LastLine,1,3))               'Get 3 digit error code
    if LastCode>400 then                           'indicates error message
      ShowMessage "Error: "+LastLine               ' -> abort
      Status.Caption = "Please enter your e-mail."
      Timer1.Enabled = False
      Button.Caption = "<<< Send the e-mail... >>>"
      Socket.Close(SockNum)
      SockNum = 0
      Timer1.Enabled = True
      MailStep=0
    end if
    if LastCode=221 and MailStep=6 then            'last step completed
      ShowMessage "Mail sent succesfully."         ' -> done
      Status.Caption = "Please enter your e-mail."
      Timer1.Enabled = False
      Button.Caption = "<<< Send the e-mail... >>>"
      Socket.Close(SockNum)
      SockNum = 0
      Timer1.Enabled = True
      MailStep=0
    end if
    select case MailStep                           'Send the mail
      case 1  'This mail is from...
        Status.Caption = "Negotiating transfer [step 1/2]..."
        Socket.WriteLine(SockNum, "MAIL FROM:<"+Edit2.Text+">")
        MailStep=2
      case 2  'We're gonna send it to...
        Status.Caption = "Negotiating transfer [step 2/2]..."
        Socket.WriteLine(SockNum, "RCPT TO:<"+Edit3.Text+">")
        MailStep=3
      case 3  'Dear server, I'd like to give you this "letter"...
        Status.Caption = "Starting mail transfer..."
        Socket.WriteLine(SockNum, "DATA")
        MailStep=4
      case 4  '... and here it goes
        Socket.WriteLine(SockNum, "From: "+Edit2.Text+" <"+Edit2.Text+">")
        Socket.WriteLine(SockNum, "To: "+Edit3.Text)
        Socket.WriteLine(SockNum, "X-Priority: 3")
        Socket.WriteLine(SockNum, "X-MSMail-Priority: Normal")
        Socket.WriteLine(SockNum, "X-Mailer: Rapid-Q Express Mailer by DarkWulf V. 1.01")
        Socket.WriteLine(SockNum, "Reply-to: "+Edit2.Text)
        Socket.WriteLine(SockNum, "Subject: "+Edit4.Text)
        Socket.WriteLine(SockNum, "Content-Type: text/plain; charset="+chr$(34)+"iso-8859-1"+chr$(34))
        Socket.WriteLine(SockNum, "Content-transfer-encoding: 8bit")
        Socket.WriteLine(SockNum, "Status:")
        for a=1 to TextBox.LineCount
        Status.Caption = "Sending mail ["+ltrim$(rtrim$(str$(int(100/TextBox.LineCount*a))))+"%]..."
        t$=TextBox.Line(a)
        if mid$(t$,1,1)="." then
          t$="."+t$ 'one single dot=end of mail
        end if
        Socket.WriteLine(SockNum, t$)
        next a
        Socket.WriteLine(SockNum, ".")
        MailStep=5
      case 5  'Log out
        Status.Caption = "Transfer complete ... logging out..."
        Socket.WriteLine(SockNum, "QUIT")
        MailStep=6
    end select
  END IF
  Timer1.Enabled = True
END SUB

SUB ButtonClick                                  'Begin to send the mail
  IF Button.Caption = "<<< SENDING MAIL >>>" THEN          'Abort it
    Status.Caption = "Please enter your e-mail."
    Timer1.Enabled = False
    Button.Caption = "<<< Send the e-mail... >>>"
    Socket.Close(SockNum)
    SockNum = 0
    Timer1.Enabled = True
    MailStep=0
    EXIT SUB
  END IF
  SockNum = Socket.Connect(Edit1.Text, 25)                 'Connect to port 25
  MailStep=0
  IF SockNum > 0 THEN
    Timer1.Enabled = False
    Button.Caption = "<<< SENDING MAIL >>>"
    Status.Caption = "Connecting to "+Edit1.Text+"..."
    LastLine=Socket.ReadLine(SockNum)
    LastCode=val(mid$(LastLine,1,3))             'Get 3 digit error code
    if LastCode>400 then                         'indicates error message
      ShowMessage "Error: "+LastLine
      Status.Caption = "Please enter your e-mail."
      Timer1.Enabled = False
      Button.Caption = "<<< Send the e-mail... >>>"
      Socket.Close(SockNum)
      SockNum = 0
      Timer1.Enabled = True
      MailStep=0
    end if
    MailStep=1
    Socket.WriteLine(SockNum, "HELO localhost")        'Hello server!
    Timer1.Enabled = True
  ELSE
    SockNum = 0
    ShowMessage "Unable to connect to: "+Edit1.Text      'Couldn't connect to
                                                         'server
  END IF
END SUB

MainForm.ShowModal                                       'Start the MainForm