'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 & " " & 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