VB.Net Tutorial/Socket Network/FTP server
FTP server
<source lang="vbnet">"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</source>