frmmailserver.frm

JK Proxy Project - Version 0.1 ------------------------------ This was going to be a proxy serve

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmMailServer 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Test email server"
   ClientHeight    =   6870
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5925
   Icon            =   "frmMailServer.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   458
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   395
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox txtCommMon 
      Height          =   1695
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   18
      Top             =   5040
      Width           =   5655
   End
   Begin MSWinsockLib.Winsock Winsock1 
      Left            =   5280
      Top             =   840
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      LocalPort       =   567
   End
   Begin VB.Frame Frame2 
      Caption         =   "Message 2"
      Height          =   2535
      Left            =   3000
      TabIndex        =   7
      Top             =   1560
      Width           =   2775
      Begin VB.TextBox txtSubject2 
         Height          =   285
         Left            =   240
         Locked          =   -1  'True
         TabIndex        =   9
         Text            =   "Message 2"
         Top             =   600
         Width           =   2295
      End
      Begin VB.TextBox txtBody2 
         Height          =   1095
         Left            =   240
         Locked          =   -1  'True
         MultiLine       =   -1  'True
         TabIndex        =   8
         Text            =   "frmMailServer.frx":000C
         Top             =   1200
         Width           =   2295
      End
      Begin VB.Label Label6 
         Caption         =   "Subject:"
         Height          =   255
         Left            =   240
         TabIndex        =   11
         Top             =   360
         Width           =   1695
      End
      Begin VB.Label Label5 
         Caption         =   "Body:"
         Height          =   255
         Left            =   240
         TabIndex        =   10
         Top             =   960
         Width           =   1215
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "Message 1"
      Height          =   2535
      Left            =   120
      TabIndex        =   2
      Top             =   1560
      Width           =   2775
      Begin VB.TextBox txtBody1 
         Height          =   1095
         Left            =   240
         Locked          =   -1  'True
         MultiLine       =   -1  'True
         TabIndex        =   6
         Text            =   "frmMailServer.frx":004A
         Top             =   1200
         Width           =   2295
      End
      Begin VB.TextBox txtSubject1 
         Height          =   285
         Left            =   240
         Locked          =   -1  'True
         TabIndex        =   4
         Text            =   "Message 1"
         Top             =   600
         Width           =   2295
      End
      Begin VB.Label Label4 
         Caption         =   "Body:"
         Height          =   255
         Left            =   240
         TabIndex        =   5
         Top             =   960
         Width           =   1215
      End
      Begin VB.Label Label3 
         Caption         =   "Subject:"
         Height          =   255
         Left            =   240
         TabIndex        =   3
         Top             =   360
         Width           =   1695
      End
   End
   Begin VB.Label Label10 
      Caption         =   "Communication monitor:"
      Height          =   255
      Left            =   120
      TabIndex        =   17
      Top             =   4800
      Width           =   3375
   End
   Begin VB.Label Label9 
      Caption         =   "Server will use  'proxyproject <proxy@project>' as email sender"
      Height          =   255
      Left            =   120
      TabIndex        =   16
      Top             =   840
      Width           =   4695
   End
   Begin VB.Label lblListenPort 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   1320
      TabIndex        =   15
      Top             =   4440
      Width           =   2055
   End
   Begin VB.Label lblStatus 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   1320
      TabIndex        =   14
      Top             =   4200
      Width           =   3255
   End
   Begin VB.Label Label8 
      Caption         =   "Listening port:"
      Height          =   255
      Left            =   120
      TabIndex        =   13
      Top             =   4440
      Width           =   1215
   End
   Begin VB.Label Label7 
      Caption         =   "Status:"
      Height          =   255
      Left            =   120
      TabIndex        =   12
      Top             =   4200
      Width           =   2175
   End
   Begin VB.Label Label2 
      Caption         =   "Only one connection at a time is supported."
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   1200
      Width           =   4095
   End
   Begin VB.Label Label1 
      Caption         =   $"frmMailServer.frx":00A3
      Height          =   615
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   5655
   End
End
Attribute VB_Name = "frmMailServer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private strMsg1 As String, strMsg2 As String
Private len1 As Long, len2 As Long, fulllen As Long

Private Conn As CONNSTATE

Private Enum CONNSTATE
  CS_WAITUSER
  CS_WAITPASS
  CS_READY
End Enum

Private bWillClose As Boolean
  

Private Sub Form_Load()
BuildMsgs
Listen
End Sub

Private Sub BuildMsgs()
' builds the messages from the text controls
strMsg1 = "Subject: " + txtSubject1 + vbCrLf + _
          "From: proxyproject <proxy@project>" + vbCrLf + _
          vbCrLf + _
          txtBody1
          
strMsg2 = "Subject: " + txtSubject2 + vbCrLf + _
          "From: proxyproject <proxy@project>" + vbCrLf + _
          vbCrLf + _
          txtBody2
          
len1 = Len(strMsg1)
len2 = Len(strMsg2)
fulllen = len1 + len2
End Sub

Private Sub Listen()
' starts listening
Winsock1.Close
Winsock1.Listen

' set status labels
lblStatus = "Listening for connection..."
lblListenPort = CStr(Winsock1.LocalPort)
End Sub

Private Sub Form_Unload(Cancel As Integer)
Winsock1.Close
End Sub

Private Sub Winsock1_Close()
' when connection closed -> start listening again
txtCommMon = txtCommMon + "[Connection closed]" + vbCrLf + vbCrLf
txtCommMon.SelStart = Len(txtCommMon)

Listen
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
' accept connection
Winsock1.Close
Winsock1.Accept requestID

lblStatus = "Accepted connection from " + Winsock1.RemoteHostIP
lblListenPort = "-"

Conn = CS_WAITUSER

' add message to communication monitor
txtCommMon = txtCommMon + "[Connection accepted]" + vbCrLf
txtCommMon.SelStart = Len(txtCommMon)

' send hello
Send "+OK test server ready..." + vbCrLf
End Sub


Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
' data arrival, process command here
Dim num As Long


Dim data As String
' extract data from winsock control
Winsock1.GetData data
' add to comm monitor
txtCommMon = txtCommMon + "<- " + data
txtCommMon.SelStart = Len(txtCommMon)

' QUIT?
If (LCase(Left(data, 4)) = "quit") Then
  ' send good bye and close connection
  Send "+OK good-bye" + vbCrLf
  bWillClose = True
  Exit Sub
End If

' wrong command?
If (Conn = CS_WAITUSER) And (LCase(Left(data, 4)) <> "user") Then
  Send "-ERR awaiting USER command" + vbCrLf
  Exit Sub
End If
If (Conn = CS_WAITPASS) And (LCase(Left(data, 4)) <> "pass") Then
  Send "-ERR awaiting PASS command" + vbCrLf
  Exit Sub
End If


' switch between commands
Select Case LCase(Left(data, 4))
  
  Case "user"
    ' username was sent; any user name is accepted
    Send "+OK send password" + vbCrLf
    Conn = CS_WAITPASS
    
  Case "pass"
    'password was sent; any password is accepted
    Send "+OK logged in" + vbCrLf
    Conn = CS_READY
    
  Case "stat"
    ' send STAT response
    Send "+OK 2 " + CStr(fulllen) + vbCrLf
  
  Case "list"
    ' send LIST response
    Send "+OK 2 messages (" + CStr(fulllen) + " octets)" + vbCrLf + _
         "1 " + CStr(len1) + vbCrLf + _
         "2 " + CStr(len2) + vbCrLf + _
         "." + vbCrLf
         
  Case "retr"
    ' client is requesting a message, extract number and send
    num = Val(Mid(data, 6))
    
    ' switch msg number
    Select Case num
      Case 1
        ' send msg 1
        Send "+OK " + CStr(len1) + " octets" + vbCrLf + _
             strMsg1 + vbCrLf + "." + vbCrLf
      Case 2
        ' send msg 2
        Send "+OK " + CStr(len2) + " octets" + vbCrLf + _
             strMsg2 + vbCrLf + "." + vbCrLf
      Case 3
        ' no such message
        Send "-ERR no such message" + vbCrLf
    End Select
    
  Case "dele"
    ' extract number to see if message "1" or "2" is given...
    num = Val(Mid(data, 6))
    
    If (num = 1) Or (num = 2) Then
      ' simply send an OK as no actual message is deleted
      Send "+OK message deleted" + vbCrLf
    Else
      ' no such message
      Send "-ERR no such message" + vbCrLf
    End If
    
   
End Select
End Sub

Private Sub Send(strData As String)
' sends data via 'Winsock1' and logs data in txtCommMon
txtCommMon = txtCommMon.Text + "-> " + strData
txtCommMon.SelStart = Len(txtCommMon)

Winsock1.SendData strData
End Sub

Private Sub Winsock1_SendComplete()
If bWillClose = True Then
  Winsock1.Close
  Winsock1_Close
End If
End Sub