Imports System.IO
Imports System.Net
Imports System.Net.Sockets
Imports System.Threading
Imports System.Text
Imports Microsoft.VisualBasic.ControlChars
'<Author    Pramod Kumar Singh />
'<Company   ConcretioIndia Pvt Ltd Nagpur />
'<Purpose   SMTP Server Minimun Implementation on Visual Basic.NET/>
'<Date      28th Dec 2000 />
'<History                 />  
Public Class SMTPServer
    'Change this Path for the SMTP and POP3 MailBoxs as per Implementation    
    Private ReadOnly MyDomainPath As String = "C:\Temp\SMTP\"
    Private ReadOnly SMTPSpool As String = "SPOOL"
    'SMTP COMMAND
    Private ReadOnly SMTPHELO As String = "HELO"
    Private ReadOnly SMTPMAIL As String = "MAIL"
    Private ReadOnly SMTPRCPT As String = "RCPT"
    Private ReadOnly SMTPDATA As String = "DATA"
    Private ReadOnly SMTPRSET As String = "RSET"
    Private ReadOnly SMTPNOOP As String = "NOOP"
    Private ReadOnly SMTPQUIT As String = "QUIT"
    Private ReadOnly SMTPVRFY As String = "VRFY"
    'Recieve data till the end of file
    Private ReadOnly SMTPDATAEND As String = "." & CrLf
    Private ReadOnly SMTPDATAFOLLOW As String = "DATAFOLLOW"
    Private ReadOnly SMTPREQACCP As String = "REQACCEPTED"
    'For converstion of String to Byte and vice versa
    Private ASCII As Encoding = Encoding.ASCII
    Private SMTPListner As TCPListener
    Private SMTPPort As Integer
    Private ReadOnly MAXCLIENT As Integer = 10
    Private ServerSocketForClientThread As Socket
    'Count the Active Client on SMTPServer
    Private Shared ClientCount As Integer
    Private ReadOnly SPOOL_FILE_DATA_START As String = "<<MAIL-DATA>>"
    'Constructor 
    Public Sub New(ByVal SMTPPort As Integer)
        MyBase.New()
        'Get the Port on which SMTP Server Should Work
        Me.SMTPPort = SMTPPort
    End Sub
    'A Start a Main SMTP Thread as Listner
    Public Sub StartSMTPServer()
        'SMTPPort for SMTPListner
        Console.WriteLine("Trying to Start the SMTP Server...")
        SMTPListner = New TCPListener(SMTPPort)
        'Start the Server
        SMTPListner.Start()
        'Wait for SMTPClient to Connect
        While (True)
            'Socket on which SMTP Server will Connect and Talk with Client
            Console.WriteLine("SMTP Server Started waiting for Client Connection...")
            Dim ServerSocketForClient As Socket = SMTPListner.AcceptSocket
            'If the Client Strat the Communication
            'Create a NEW Thread for Each Client
            'Increase the ClientCount on This SMTPServer
            ClientCount += 1
            If ClientCount <= MAXCLIENT Then
                'Get the Socket on which 
                'Server and Client will Talk Within ClientThread
                ServerSocketForClientThread = ServerSocketForClient
                Console.WriteLine("Client Connection {0} from IP {1}...", ClientCount, ServerSocketForClient.RemoteEndpoint())
                Dim ClientThread As Thread = New Thread(AddressOf CreateClientThread)
                'Start the Processing of client Thread
                ClientThread.Start()
            Else
                'Make the Count Stable So the Operation of Exsiting Client is Performed
                ClientCount -= 1
            End If
        End While
    End Sub
    'All other functioning of the SMTPServer is Private
    'Create a Client Thread
    Private Sub CreateClientThread()
        Dim ServerSocketForClient As Socket
        Dim SMTPLastCommand As String
        Dim r As Random = New Random()
        'Dim UserMailBox As String
        
        Dim pFile As FileStream
        Dim pFileWriter As StreamWriter
        
        ServerSocketForClient = ServerSocketForClientThread
        'Send a Ready Message to Client
        SendMessageToClient(ServerSocketForClient, "220 SMTP Server is Ready" & CrLf)
        
        'Wait for Client to Finish
        
        While (True)
            'Wait for Client Command on this socket
            Dim bFlagNotToExitFromCommand As Boolean = False
            Dim SMTPCommand As String
            Dim byteArray(2048) As Byte
            Try
                Dim iBytes As Integer = ServerSocketForClient.Receive(byteArray, byteArray.Length, 0)
                Dim MessageFromClient As String = Encoding.ASCII.GetString(byteArray)
                If iBytes > 0 Then
                    SMTPCommand = ParseCommandFromMessage(MessageFromClient, SMTPLastCommand)
                Else
                    SMTPCommand = SMTPQUIT
                End If
                'There may be more than one file to be tranfered in the same connection
                'this will lead to close the file and open again for next file
                If SMTPCommand = SMTPRSET Then
                    If SMTPLastCommand = SMTPREQACCP Then
                        If Not pFile Is Nothing Then
                            pFileWriter.Close()
                            pFile.Close()
                            'open new file
                            pFile = CreateFileForSMTPClient(SMTPSpool & "\" & CStr(ClientCount & r.Next(1, 100)))
                            pFileWriter = New StreamWriter(pFile)
                        End If
                    End If
                Else
                    If SMTPCommand = SMTPMAIL And pFile Is Nothing Then
                        pFile = CreateFileForSMTPClient(SMTPSpool & "\" & CStr(ClientCount & r.Next(1, 100)))
                        pFileWriter = New StreamWriter(pFile)
                    End If
                    bFlagNotToExitFromCommand = SMTPHandleCommand(SMTPCommand, MessageFromClient, ServerSocketForClient, pFileWriter)
                End If
            Catch e As NotSupportedException
                Console.WriteLine(e.ToString)
            End Try
            If Not bFlagNotToExitFromCommand Then Exit While
        End While
        If Not pFile Is Nothing Then
            pFileWriter.Close()
            CloseSMTPFile(pFile)
        End If
        Console.WriteLine("Client Thread {0} From {1} Exited ", ClientCount, ServerSocketForClient.RemoteEndpoint())
        'Decrement the Global SMTP Client Count
        ClientCount -= 1
        'Close the Socket
        ServerSocketForClient.Close()
        'BYE BYE
    End Sub
    
    Private Function ValidSMTPCommandSequence(ByRef SMTPCommand As String, ByRef SMTPLastCommand As String) As String
        If SMTPLastCommand = Nothing Then
            If (SMTPCommand <> SMTPHELO And SMTPCommand <> SMTPNOOP And SMTPCommand <> SMTPVRFY) Then
                Return SMTPQUIT
            Else
                SMTPLastCommand = SMTPCommand
            End If
        Else
            Select Case SMTPCommand
                Case SMTPMAIL
                    If (SMTPLastCommand = SMTPHELO Or SMTPLastCommand = SMTPNOOP Or SMTPLastCommand = SMTPVRFY) Then
                        SMTPLastCommand = SMTPCommand
                    End If
                Case SMTPRCPT
                    If (SMTPLastCommand = SMTPMAIL Or SMTPLastCommand = SMTPNOOP Or SMTPLastCommand = SMTPVRFY) Then
                        SMTPLastCommand = SMTPCommand
                    End If
                Case SMTPDATA
                    If (SMTPLastCommand = SMTPRCPT Or SMTPLastCommand = SMTPNOOP Or SMTPLastCommand = SMTPVRFY) Then
                        SMTPLastCommand = SMTPCommand
                    End If
                Case SMTPDATAFOLLOW
                    If SMTPLastCommand = SMTPDATA Or SMTPLastCommand = SMTPDATAFOLLOW Then
                        SMTPLastCommand = SMTPCommand
                    End If
                Case SMTPREQACCP
                    If SMTPLastCommand = SMTPDATAFOLLOW Then
                        SMTPLastCommand = SMTPCommand
                    End If
            End Select
        End If
        Return SMTPCommand
    End Function
    Private Sub SendMessageToClient(ByVal SokectToUse As Socket, ByVal MessageToSend As String)
        Dim ByteArray() As Byte = ASCII.Getbytes(MessageToSend.ToCharArray())
        Try
            SokectToUse.Send(ByteArray, ByteArray.Length, 0)
        Catch e As SocketException
            
        End Try
    End Sub
    Private Function ParseCommandFromMessage(ByVal MessageFromClient As String, ByRef SMTPLastCommand As String) As String
        Dim SMTPCommand As String = ""
        ' Termination of Data from Client 
        If InStrRev(MessageFromClient, CrLf & "." & CrLf) > 0 Then
            'This will Indicate for Quit
            SMTPLastCommand = SMTPDATAEND
            Return SMTPREQACCP
        End If
        If Trim(MessageFromClient) = "" Then Return SMTPQUIT
        If SMTPLastCommand = SMTPDATA Or SMTPLastCommand = SMTPDATAFOLLOW Then
            'GET the Mail File From Client till we get SMTPDATAEND
            SMTPCommand = SMTPDATAFOLLOW
        Else
            SMTPCommand = Microsoft.VisualBasic.Trim(MessageFromClient.Substring(0, 4))
            'Check for the FROM and RCPT TO Address for this Server
        End If
        SMTPCommand = ValidSMTPCommandSequence(SMTPCommand, SMTPLastCommand)
        Return SMTPCommand
    End Function
    Private Function SMTPHandleCommand(ByVal SMTPCommand As String, ByVal MessageFromClient As String, ByRef ServerSocketForClient As Socket, ByRef pFileWriter As StreamWriter) As Boolean
        Select Case SMTPCommand
            Case SMTPHELO
                Return HandleCommandHELLO(MessageFromClient, ServersocketForClient)
            Case SMTPMAIL
                Return HandleCommandMAIL(MessageFromClient, ServersocketForClient, pFileWriter)
            Case SMTPRCPT
                Return HandleCommandRCPT(MessageFromClient, ServersocketForClient, pFileWriter)
            Case SMTPDATA
                Return HandleCommmandDATA(MessageFromClient, ServersocketForClient, pFileWriter)
            Case SMTPDATAFOLLOW
                Return HandleCommmandDATAFOLLOW(MessageFromClient, ServerSocketForClient, pFileWriter)
            Case SMTPREQACCP
                Return HandleCommmandREQACCP(MessageFromClient, ServersocketForClient, pFileWriter)
            Case SMTPNOOP
                Return HandleCommandNOOP(MessageFromClient, ServersocketForClient)
            Case SMTPVRFY
                Return HandleCommandVRFY(MessageFromClient, ServersocketForClient)
            Case SMTPRSET
                Return HandleCommandRSET(MessageFromClient, ServersocketForClient)
            Case SMTPQUIT
                Return HandleCommandQUIT(MessageFromClient, ServersocketForClient)
            Case Else
                Return False
        End Select
    End Function
    Private Function HandleCommandHELLO(ByVal MessageFromClient As String, ByRef ServerSocketForClient As Socket) As Boolean
        'This process will check the MAIL FROM and will create the local file store for message
        SendMessageToClient(ServerSocketForClient, "250 OK" & CrLf)
        Return True
    End Function
    Private Function HandleCommandVRFY(ByVal MessageFromClient As String, ByRef ServerSocketForClient As Socket) As Boolean
        SendMessageToClient(ServerSocketForClient, "250 OK" & CrLf)
        Return True
    End Function
    Private Function HandleCommandMAIL(ByVal MessageFromClient As String, ByRef ServerSocketForClient As Socket, ByRef pFileWriter As StreamWriter) As Boolean
        Dim MessageToWrite As String
        '1 Line
        'Information
        MessageToWrite = "dev14.com;" & ServerSocketForClient.RemoteEndpoint.ToString() & ";" & "Dev14.com;" & ServerSocketForClient.LocalEndpoint.ToString() & ";" & Now & ";MySMTpServer"
        WriteToFile(pFileWriter, MessageToWrite)
        '2 line
        'Domain Name
        MessageToWrite = "Dev14"
        WriteToFile(pFileWriter, MessageToWrite)
        '3 Line
        'MessageID
        MessageToWrite = "S" & "1111"
        WriteToFile(pFileWriter, MessageToWrite)
        '4 line
        'MAIL FROM
        MessagetoWrite = MessageFromClient
        WriteToFile(pFileWriter, MessageToWrite)
        'Send the Client to Proceed
        SendMessageToClient(ServerSocketForClient, "250 OK" & CrLf)
        Return True
    End Function
    Private Function HandleCommandRCPT(ByVal MessageFromClient As String, ByRef ServerSocketForClient As Socket, ByRef pFileWriter As StreamWriter) As Boolean
        Dim MessageToWrite As String
        '5 line RCPT TO:<>
        MessagetoWrite = Trim(MessageFromClient)
        WriteToFile(pFileWriter, MessageToWrite)
        SendMessageToClient(ServerSocketForClient, "251 OK" & CrLf)
        Return True
    End Function
    Private Function HandleCommmandDATA(ByVal MessageFromClient As String, ByRef ServerSocketForClient As Socket, ByRef pFileWriter As StreamWriter) As Boolean
        Dim MessageToWrite As String
        MessagetoWrite = SPOOL_FILE_DATA_START
        WriteToFile(pFileWriter, MessageToWrite)
        SendMessageToClient(ServerSocketForClient, "354 OK  Start mail input; end with <CRLF>.<CRLF" & CrLf)
        Return True
    End Function
    Private Function HandleCommmandDATAFOLLOW(ByVal MessageFromClient As String, ByRef ServerSocketForClient As Socket, ByRef pFileWriter As StreamWriter) As Boolean
        Dim MessageToWrite As String
        MessagetoWrite = Trim(MessageFromClient)
        WriteToFile(pFileWriter, MessageToWrite)
        Return True
    End Function
    Private Function HandleCommmandREQACCP(ByVal MessageFromClient As String, ByRef ServerSocketForClient As Socket, ByRef pFileWriter As StreamWriter) As Boolean
        'End of Data Signalled
        Dim MessageToWrite As String
        MessagetoWrite = Trim(MessageFromClient)
        WriteToFile(pFileWriter, MessageToWrite)
        SendMessageToClient(ServerSocketForClient, "250 OK" & CrLf)
        Return True
    End Function
    Private Function HandleCommandNOOP(ByVal MessageFromClient As String, ByRef ServerSocketForClient As Socket) As Boolean
        SendMessageToClient(ServerSocketForClient, "250 OK  ...For NOOP")
        Return True
    End Function
    Private Function HandleCommandQUIT(ByVal MessageFromClient As String, ByRef ServerSocketForClient As Socket) As Boolean
        SendMessageToClient(ServerSocketForClient, "221 OK Closing Connection " & CrLf)
        Return False
    End Function
    Private Function HandleCommandRSET(ByVal MessageFromClient As String, ByRef ServerSocketForClient As Socket) As Boolean
        SendMessageToClient(ServerSocketForClient, "250 OK  ...For RSET")
        Return True
    End Function
    Private Function CreateFileForSMTPClient(ByVal FileName As String) As FileStream
        Dim pFile As FileStream
        Try
            pFile = New FileStream(MyDomainPath & FileName & ".smtp", IO.FileMode.CreateNew, IO.FileAccess.Write)
        Catch e As IOException
            Console.WriteLine(e.ToString())
            pFile = Nothing
        End Try
        Return pFile
    End Function
    Private Sub CloseSMTPFile(ByRef pFile As FileStream)
        pFile.Close()
    End Sub
    Private Function WriteToFile(ByRef pFile As StreamWriter, ByVal SMTPMessage As String) As Boolean
        pFile.WriteLine(SMTPMessage)
    End Function
    'Private Function CheckForMailBoxes(ByVal UserName As String) As Boolean
    '    Dim MailBoxPath As String = left(MyDomainPath, MyDomainPath.Length - 1)
    '    Dim UserMailBoxPath As String = MyDomainPath & UserName
    '    Dim pDirectory As Directory = New Directory(MailBoxPath)
    '    Return pDirectory.DirectoryExists(UserMailBoxPath)
    'End Function
    Private Function GetNameFromClientMessages(ByVal MessageFromClient As String) As String
        Dim tempValue As String = Microsoft.VisualBasic.Trim(MessageFromClient.Substring(4))
        Dim iFirstValue As Integer = InStr(tempValue, "<")
        Dim iSecondValue As Integer = instr(iFirstValue + 1, tempValue, ">")
        Dim iLength As Integer
        Dim iSeperator As Integer = instr(tempValue, "@")
        If iSeperator > 0 Then
            iLength = iSeperator - iFirstValue
        Else
            iLength = iSecondValue - iFirstValue
        End If
        Return Microsoft.VisualBasic.Trim(tempValue.Substring(iFirstValue, iLength - 1))
    End Function
    
End Class