VB.Net Tutorial/Socket Network/FTP server

FTP server

"Visual Basic.Net JingCai Programming 100 Examples
"Author: Yong Zhang
"Publisher: Water Publisher China
"ISBN: 750841156
Imports System.Net
Imports System.Net.Sockets
Imports System.Threading
Imports System.IO
Imports System.Text
Imports System.Collections
Public Class FTPServer
  Public Shared Sub Main()
    Dim tcpListener As System.Net.Sockets.TcpListener
    Try
      Dim hostName As String = Dns.GetHostName()
      Dim serverIP As IPAddress = Dns.Resolve(hostName).AddressList(0)
      " FTP Server Port = 21
      Dim Port As String = "21"
      Dim serverHost As New IPEndPoint(serverIP, Int32.Parse(Port))
      tcpListener = New TcpListener(serverIP, Int32.Parse(Port))
      tcpListener.Start()
      Console.WriteLine("FTP Server started at: " + serverIP.ToString() + ":" + Port)
      Dim FTPSession As New FTPSession(tcpListener)
      Dim serverThread As New Thread(New ThreadStart(AddressOf FTPSession.ProcessThread))
      serverThread.Start()
    Catch ex As Exception
      Console.WriteLine(ex.StackTrace.ToString())
    End Try
  End Sub
End Class
Public Class FTPSession
  " Server Socket
  Private tcpListener As System.Net.Sockets.TcpListener
  " Connection Socket
  Private clientSocket As System.Net.Sockets.Socket
  " Data Socket
  Private dataSocket As System.Net.Sockets.Socket
  " FTP Root Path
  Private rootPath As String = Directory.GetCurrentDirectory() & "\FTPRoot\"
  Private currentPath As String = rootPath
  Private currentPathStr As String = "/"
  Private loginName As String = Nothing
  Private blnBinary As Boolean
  " Data Socket IP and Port
  Private clientIP As String = Nothing
  "Private ipString As String = Nothing
  Private dataPort As Integer
  Public Sub New(ByVal tcpListener As System.Net.Sockets.TcpListener)
    Me.tcpListener = tcpListener
  End Sub
  Public Sub resetDefault()
    currentPath = rootPath
    currentPathStr = "/"
    Console.WriteLine("currentPath: " & currentPath)
  End Sub
  Public Sub showMessage(ByVal Msg As String)
    Dim CurThread As Thread
    CurThread = System.Threading.Thread.CurrentThread()
    Dim sendByte() As Byte = Encoding.Default.GetBytes(Msg & ControlChars.CrLf)
    SyncLock CurThread
      clientSocket.Send(sendByte, 0, sendByte.Length, SocketFlags.None)
      Console.WriteLine(Msg)
    End SyncLock
  End Sub
  Public Sub showData(ByVal Msg As String)
    Dim dataIP As IPAddress = Dns.Resolve(clientIP).AddressList(0)
    Dim dataHost As New IPEndPoint(dataIP, Int32.Parse(dataPort))
    Dim CurThread As Thread
    Try
      CurThread = System.Threading.Thread.CurrentThread()
      Dim sendByte() As Byte = Encoding.Default.GetBytes(Msg)
      "  Establish data connection
      dataSocket = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
      dataSocket.Connect(dataHost)
      SyncLock CurThread
        dataSocket.Send(sendByte, 0, sendByte.Length, SocketFlags.None)
        Console.WriteLine(Msg)
        dataSocket.Close()
      End SyncLock
    Catch ex As Exception
      Console.WriteLine(ex.StackTrace.ToString())
      dataSocket.Close()
    End Try
  End Sub
  Public Sub ProcessThread()
    While (True)
      Try
        clientSocket = tcpListener.AcceptSocket()
        " Socket Information
        Dim clientInfo As IPEndPoint = CType(clientSocket.RemoteEndPoint, IPEndPoint)
        Console.WriteLine("Client: " + clientInfo.Address.ToString() + ":" + clientInfo.Port.ToString())
        " Set Thread for each FTP client Connection
        Dim clientThread As New Thread(New ThreadStart(AddressOf ProcessRequest))
        clientThread.Start()
      Catch ex As Exception
        Console.WriteLine(ex.StackTrace.ToString())
        If clientSocket.Connected Then
          clientSocket.Close()
        End If
      End Try
    End While
  End Sub
  Protected Sub ProcessRequest()
    Dim recvBytes(128) As Byte
    Dim htmlReq As String = Nothing
    Dim bytes As Int32
    Dim ftpCmd As String = Nothing
    Dim strDate As String = DateTime.Now.ToShortDateString() & " " & DateTime.Now.ToLongTimeString()
    Dim strMsg As String
    strMsg = "220 .NET FTP Server (Version 1.0.0) " & strDate & ControlChars.CrLf & _
       "220 Welcome to .NET FTP Server"
    showMessage(strMsg)
    ftpCmd = ""
    " if FTP command is not "QUIT"
    While Not (ftpCmd.ToLower.StartsWith("quit"))
      Try
        bytes = clientSocket.Receive(recvBytes)
        ftpCmd = Encoding.ASCII.GetString(recvBytes, 0, bytes)
        Console.WriteLine("FTP Command: " & ftpCmd)
        ftpCommand(ftpCmd)
      Catch ex As Exception
        Console.WriteLine("Exception: " & ex.StackTrace.ToString())
        ftpCmd = "quit"
      End Try
    End While
    " Close FTP Session
    Try
      If clientSocket.Connected Then
        clientSocket.Close()
      End If
    Catch ex As Exception
      Console.WriteLine(ex.StackTrace.ToString())
    End Try
  End Sub
  Private Sub ftpCommand(ByVal cmd As String)
    Dim ftpCmdtok() As String
    Dim strRequest As String
    Dim ftpCmd As String = Nothing
    Dim strArg As String
    "Dim strFromName As String
    "Dim strToName As String
    If (cmd = Nothing) Then cmd = ""
    ftpCmdtok = cmd.Trim.Split(" ")
    ftpCmd = ftpCmdtok(0).ToLower.Trim
    " user: Login
    If (ftpCmd.Equals("user")) Then
      Try
        loginName = ftpCmdtok(1).Trim
        If (loginName.ToLower.Trim = "anonymous") Then
          showMessage("331 Anonymous access allowed, send identity (e-mail name) as password.")
        Else
          showMessage("331 Password required for " & loginName & ".")
        End If
      Catch
        showMessage("500 User syntax.")
      End Try
      " pass: Verify password
    ElseIf (ftpCmd.Equals("pass")) Then
      " Add the logic of verifying password here
      showMessage("230 " & loginName & " user logged in.")
      resetDefault()
      " quit
    ElseIf (ftpCmd.Equals("quit")) Then
      showMessage("221 Service closing control connection. Goodbye.")
      resetDefault()
      " port
    ElseIf (ftpCmd.Equals("port")) Then
      Dim strPort() As String
      Try
        " PORT h1,h2,h3,h4,p1,p2
        strPort = ftpCmdtok(1).Trim.Split(",")
        " h1
        clientIP = strPort(0) & "." & strPort(1) & "." & strPort(2) & "." & strPort(3)
        " Port = p1 * 256 + p2
        dataPort = Int32.Parse(strPort(4)) * 256 + Int32.Parse(strPort(5))
        " Demo only 
        showMessage("PORT " & ftpCmdtok(1).Trim & ".")
        showMessage("200 PORT command successful.")
      Catch
        showMessage("500 PORT number syntax.")
      End Try
      " list: List Directory (dir)
    ElseIf (ftpCmd.Equals("list")) Then
      If (UBound(ftpCmdtok) >= 1) Then
        strArg = ftpCmdtok(1).Trim
      Else
        strArg = ""
      End If
      listDirectory(strArg, True)
      " NLST: Name List (ls)
    ElseIf (ftpCmd.Equals("nlst")) Then
      If (UBound(ftpCmdtok) >= 1) Then
        strArg = ftpCmdtok(1).Trim
      Else
        strArg = ""
      End If
      listDirectory(strArg, False)
      " cdup: Change to Parent Directory
    ElseIf (ftpCmd.Equals("cdup")) Then
      changeDirectory(".")
      " cwd: Change Directory (cd)
    ElseIf (ftpCmd.Equals("cwd")) Then
      strArg = ftpCmdtok(1).Trim
      changeDirectory(strArg)
      " xpwd: Current Directory (pwd)
    ElseIf (ftpCmd.Equals("xpwd")) Then
      showMessage("257 """ & currentPathStr & """ is current directory.")
      Console.WriteLine("Physical Path: " & currentPath)
      " xmkd: Make Directory (mkdir)
    ElseIf (ftpCmd.Equals("xmkd")) Then
      strArg = ftpCmdtok(1).Trim
      makeDirectory(strArg)
      " xrmd: Remove Directory (rmdir)
    ElseIf (ftpCmd.Equals("xrmd")) Then
      strArg = ftpCmdtok(1).Trim
      removeDirectory(strArg)
      " dele: Remove File (delete)
    ElseIf (ftpCmd.Equals("dele")) Then
      strArg = ftpCmdtok(1).Trim
      removeFile(strArg)
      " noop: No Operation
    ElseIf (ftpCmd.Equals("noop")) Then
      showMessage("200 OK.")
      " syst
    ElseIf (ftpCmd.Equals("syst")) Then
      showMessage("215 .NET FTP Server.")
      "  help: Remote Help (remotehelp)
    ElseIf (ftpCmd.Equals("help")) Then
      Dim strHelp As String
      strHelp = "214-The following commands are recognized(* ==>"s unimplemented).... " & ControlChars.CrLf & _
                "214 HELP command successful."
      showMessage(strHelp)
      " type
    ElseIf (ftpCmd.Equals("type")) Then
      Try
        strArg = ftpCmdtok(1).Trim
        " Binary
        If (strArg.ToLower.IndexOf("i") <> -1) Then
          blnBinary = True
          showMessage("200 TYPE set to I.")
          " ASCII
        ElseIf (strArg.ToLower.IndexOf("a") <> -1) Then
          blnBinary = False
          showMessage("200 TYPE set to A.")
        Else
          showMessage("500 TYPE " & strArg & " syntax.")
        End If
      Catch
        showMessage("500 TYPE syntax.")
      End Try
      " mode
    ElseIf (ftpCmd.Equals("mode")) Then
      Try
        strArg = ftpCmdtok(1).Trim
        If (strArg.ToLower.Equals("s")) Then
          showMessage("200 MODE S.")
        Else
          showMessage("500 MODE " & strArg & " syntax.")
        End If
      Catch
        showMessage("500 MODE syntax.")
      End Try
      " stru
    ElseIf (ftpCmd.Equals("stru")) Then
      Try
        strArg = ftpCmdtok(1).Trim
        If (strArg.ToLower.Equals("f")) Then
          showMessage("200 STRU F.")
        Else
          showMessage("501 STRU " & strArg & " not found.")
        End If
      Catch
        showMessage("500 STRU syntax.")
      End Try
    Else
      showMessage("502 " + ftpCmd + " not implemented. Invalid command.")
    End If
  End Sub
  " Change Directory
  Private Sub changeDirectory(ByVal ftpPath As String)
    "Dim dirInfo As DirectoryInfo = New DirectoryInfo(ftpPath)
    Dim strPath As String = ""
    Try
      If (ftpPath = ".") Then
        strPath = rootPath
      ElseIf (ftpPath.StartsWith("..")) Then
        If (currentPath = rootPath) Then
          strPath = rootPath
        Else
          If (currentPath.EndsWith("\")) Then
            strPath = currentPath.Substring(0, currentPath.Length - 1)
            strPath = strPath.Substring(0, strPath.LastIndexOf("\") + 1)
          Else
            strPath = currentPath.Substring(0, currentPath.LastIndexOf("\") + 1)
          End If
        End If
      ElseIf (ftpPath.StartsWith("\")) Then
        strPath = currentPath & ftpPath.Substring(1, ftpPath.Length)
      Else
        strPath = currentPath & ftpPath
      End If
      If Not strPath.EndsWith("\") Then
        strPath = strPath & "\"
      End If
      " File
      If Path.GetFileName(strPath) <> "" Then
        showMessage("550 " & ftpPath & " is not a directory.")
        Exit Sub
      End If
      Dim dirInfo As DirectoryInfo = New DirectoryInfo(strPath)
      " Path is Read-Only
      If dirInfo.Attributes = FileAttributes.ReadOnly Then
        showMessage("550 " & ftpPath & ": Access is denied.")
        Exit Sub
      End If
      If Directory.Exists(strPath) Then
        " Change Directory
        Directory.SetCurrentDirectory(strPath)
        currentPath = strPath
        If (currentPath = rootPath) Then
          currentPathStr = "/"
        Else
          currentPathStr = "/" & currentPath.Replace(rootPath, "")
        End If
        currentPathStr = currentPathStr.Replace("\", "/")
        If currentPathStr.EndsWith("/") And currentPathStr.Length > 1 Then
          currentPathStr = currentPathStr.Substring(0, currentPathStr.Length - 1)
        End If
        showMessage("250 CWD command successful. " & currentPathStr)
      Else
        showMessage("550 " & ftpPath & " is not a subdirectory of " & currentPathStr & ".")
      End If
    Catch ex As Exception
      showMessage("500 " & ex.StackTrace.ToString)
    End Try
  End Sub
  " Create a new directory
  Private Sub makeDirectory(ByVal ftpPath As String)
    Dim strPath As String = ""
    Try
      If (ftpPath.StartsWith("\")) Then
        ftpPath = ftpPath.Substring(1, ftpPath.Length)
      End If
      strPath = currentPath & ftpPath
      If Not strPath.EndsWith("\") Then
        strPath = strPath & "\"
      End If
      Console.WriteLine("New Path: " & strPath)
      Dim dirInfo As DirectoryInfo = New DirectoryInfo(currentPath)
      " Path is Read-Only
      If dirInfo.Attributes = FileAttributes.ReadOnly Then
        showMessage("550 " & ftpPath & ": Access is denied.")
        Exit Sub
      End If
      " Directory Exists
      If Directory.Exists(strPath) Then
        showMessage("550 " & ftpPath & ": Cannot create a file/path when that file/path already exists.")
      Else
        Directory.CreateDirectory(strPath)
        showMessage("257 """ & ftpPath & """ directory created.")
      End If
    Catch ex As Exception
      showMessage("500 " & ex.StackTrace.ToString)
    End Try
  End Sub
  " Delete a existing directory
  Private Sub removeDirectory(ByVal ftpPath As String)
    Dim strPath As String = ""
    Try
      If (ftpPath.StartsWith("\")) Then
        ftpPath = ftpPath.Substring(1, ftpPath.Length)
      End If
      strPath = currentPath & ftpPath
      If Not strPath.EndsWith("\") Then
        strPath = strPath & "\"
      End If
      Console.WriteLine("Delete Path: " & strPath)
      If Directory.Exists(strPath) Then
        Dim dirInfo As DirectoryInfo = New DirectoryInfo(currentPath)
        " Path is Read-Only
        If dirInfo.Attributes = FileAttributes.ReadOnly Then
          showMessage("550 " & ftpPath & ": Access is denied.")
          Exit Sub
        End If
        Dim fileEntries(), dirEntries() As String
        fileEntries = Directory.GetFiles(strPath)
        dirEntries = Directory.GetDirectories(strPath)
        " Directory is empty
        If fileEntries.Length = 0 And dirEntries.Length = 0 Then
          " Delete Directory 
          Directory.Delete(strPath)
          showMessage("250 RMD command successful.")
        Else
          showMessage("550 " & ftpPath & ": The directory is not empty.")
        End If
      Else
        showMessage("550 " & ftpPath & " is not existed.")
      End If
    Catch ex As Exception
      showMessage("500 " & ex.StackTrace.ToString)
    End Try
  End Sub
  " Delete a existing file
  Private Sub removeFile(ByVal ftpFile As String)
    Dim strFile As String = ""
    Try
      If (ftpFile.StartsWith("\")) Then
        ftpFile = ftpFile.Substring(1, ftpFile.Length)
      End If
      strFile = currentPath & ftpFile
      Console.WriteLine("Delete File: " & strFile)
      If File.Exists(strFile) Then
        Dim fileInfo As FileInfo = New FileInfo(strFile)
        " File is Read-Only
        If fileInfo.Attributes = FileAttributes.ReadOnly Then
          showMessage("550 " & ftpFile & ": Access is denied.")
        Else
          " Delete File 
          File.Delete(strFile)
          showMessage("250 DELE command successful.")
        End If
      Else
        showMessage("550 " & ftpFile & ": The system cannot find the file specified.")
      End If
    Catch ex As Exception
      showMessage("500 " & ex.StackTrace.ToString)
    End Try
  End Sub
  " ls / list / nlst
  Private Sub listDirectory(ByVal strList As String, ByVal showDetail As Boolean)
    Dim strPath As String = ""
    Dim strBuff As String = ""
    If strList = "" Then
      strPath = currentPath
    Else
      strPath = currentPath & strList
    End If
    If Directory.Exists(strPath) Then
      If blnBinary Then
        If showDetail Then
          showMessage("150 Opening Binary mode data connection /bin/ls.")
        Else
          showMessage("150 Opening Binary mode data connection for file list.")
        End If
      Else
        If showDetail Then
          showMessage("150 Opening ASCII mode data connection /bin/ls.")
        Else
          showMessage("150 Opening ASCII mode data connection for file list.")
        End If
      End If
      Dim fileEntries As String() = Directory.GetFiles(strPath)
      Dim fileInfo As FileInfo
      Dim fileName As String
      Dim strName, strSize, strDate, strSpace As String
      For Each fileName In fileEntries
        If showDetail Then
          fileInfo = New FileInfo(fileName)
          strDate = Format(fileInfo.LastWriteTime, "MM-dd-yy  HH:mm")
          strSize = fileInfo.Length.ToString
          strName = fileName.Substring(fileName.LastIndexOf("\") + 1)
          strSpace = New String(" ", 20 - strSize.Length)
          strBuff = strBuff & strDate & strSpace & strSize & " " & strName & ControlChars.CrLf
        Else
          strName = fileName.Substring(fileName.LastIndexOf("\") + 1)
          strBuff = strBuff & strName & ControlChars.CrLf
        End If
      Next fileName
      Dim dirEntries As String() = Directory.GetDirectories(strPath)
      Dim dirInfo As DirectoryInfo
      Dim dirName As String
      For Each dirName In dirEntries
        If showDetail Then
          dirInfo = New DirectoryInfo(dirName)
          strDate = Format(dirInfo.LastWriteTime, "MM-dd-yy  HH:mm")
          strName = dirName.Substring(dirName.LastIndexOf("\") + 1)
          strBuff = strBuff & strDate & "       <DIR>         " & strName & ControlChars.CrLf
        Else
          strName = dirName.Substring(dirName.LastIndexOf("\") + 1)
          strBuff = strBuff & strName & ControlChars.CrLf
        End If
      Next dirName
      " Use data port to send path information 
      showData(strBuff)
      Dim sendByte() As Byte = Encoding.Default.GetBytes(strBuff)
      showMessage("226 Transfer complete.")
      " Demo only
      showMessage("ftp: " & sendByte.Length & " bytes received.")
    Else
      showMessage(strPath & " is not a valid file or directory.")
    End If
  End Sub
End Class