VB.Net Tutorial/Socket Network/FTP server — различия между версиями

Материал из VB Эксперт
Перейти к: навигация, поиск
м (1 версия)
 
(нет различий)

Текущая версия на 15:55, 26 мая 2010

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>