[Visual Basic] FTP Klasse

Dieses Thema im Forum "Programmier Tutorials" wurde erstellt von Yaso, 3. Dezember 2006 .

Schlagworte:
Status des Themas:
Es sind keine weiteren Antworten möglich.
  1. Diese Seite verwendet Cookies. Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies. Weitere Informationen
  1. #1 3. Dezember 2006
    FTP Klasse

    Hier eine FTP Klasse mit sehr vielen Möglichkeiten vom uploaden\download bis zum Ordner am FTP Server anlegen
    Code:
    
    
    Imports System
    Imports System.Net
    Imports System.IO
    Imports System.Text
    Imports System.Net.Sockets
    
    ' Main FTP Class.
    Public Class clsFTP
    
    #Region "Main Class Variable Declarations"
     Private m_sRemoteHost, m_sRemotePath, m_sRemoteUser As String
     Private m_sRemotePassword, m_sMess As String
     Private m_iRemotePort, m_iBytes As Int32
     Private m_objClientSocket As Socket
    
     Private m_iRetValue As Int32
     Private m_bLoggedIn As Boolean ' Change to loggedIn
     Private m_sMes, m_sReply As String
    
    
     Public Const BLOCK_SIZE = 512
     Private m_aBuffer(BLOCK_SIZE) As Byte
     Private ASCII As Encoding = Encoding.ASCII
    
     
     Private m_sMessageString As String
    #End Region
    
    #Region "Class Constructors"
     
     Public Sub New()
     m_sRemoteHost = "microsoft"
     m_sRemotePath = "."
     m_sRemoteUser = "anonymous"
     m_sRemotePassword = ""
     m_sMessageString = ""
     m_iRemotePort = 21
     m_bLoggedIn = False
     End Sub
    
     Public Sub New(ByVal sRemoteHost As String, _
     ByVal sRemotePath As String, _
     ByVal sRemoteUser As String, _
     ByVal sRemotePassword As String, _
     ByVal iRemotePort As Int32)
     m_sRemoteHost = sRemoteHost
     m_sRemotePath = sRemotePath
     m_sRemoteUser = sRemoteUser
     m_sRemotePassword = sRemotePassword
     m_sMessageString = ""
     m_iRemotePort = iRemotePort
     m_bLoggedIn = False
     End Sub
    #End Region
    
    #Region "Public Properties"
     
     Public Property RemoteHost() As String
     Get
     Return m_sRemoteHost
     End Get
     Set(ByVal Value As String)
     m_sRemoteHost = Value
     End Set
     End Property
    
     
     Public Property RemotePort() As Int32
     Get
     Return m_iRemotePort
     End Get
     Set(ByVal Value As Int32)
     m_iRemotePort = Value
     End Set
     End Property
    
    
     Public Property RemotePath() As String
     Get
     Return m_sRemotePath
     End Get
     Set(ByVal Value As String)
     m_sRemotePath = Value
     End Set
     End Property
    
     
     Public Property RemotePassword() As String
     Get
     Return m_sRemotePassword
     End Get
     Set(ByVal Value As String)
     m_sRemotePassword = Value
     End Set
     End Property
    
     
     Public Property RemoteUser() As String
     Get
     Return m_sRemoteUser
     End Get
     Set(ByVal Value As String)
     m_sRemoteUser = Value
     End Set
     End Property
    
     
     Public Property MessageString() As String
     Get
     Return m_sMessageString
     End Get
     Set(ByVal Value As String)
     m_sMessageString = Value
     End Set
     End Property
    
    #End Region
    
    #Region "Public Subs and Functions"
     
     Public Function GetFileList(ByVal sMask As String) As String()
     Dim cSocket As Socket
     Dim bytes As Int32
     Dim seperator As Char = ControlChars.Lf
     Dim mess() As String
    
     m_sMes = ""
     If (Not (m_bLoggedIn)) Then
     Login()
     End If
    
     cSocket = CreateDataSocket()
     SendCommand("NLST " & sMask)
    
     If (Not (m_iRetValue = 150 Or m_iRetValue = 125)) Then
     MessageString = m_sReply
     Throw New IOException(m_sReply.Substring(4))
     End If
    
     m_sMes = ""
     Do While (True)
     m_aBuffer.Clear(m_aBuffer, 0, m_aBuffer.Length)
     bytes = cSocket.Receive(m_aBuffer, m_aBuffer.Length, 0)
     m_sMes += ASCII.GetString(m_aBuffer, 0, bytes)
    
     If (bytes < m_aBuffer.Length) Then
     Exit Do
     End If
     Loop
    
     mess = m_sMes.Split(seperator)
     cSocket.Close()
     ReadReply()
    
     If (m_iRetValue <> 226) Then
     MessageString = m_sReply
     Throw New IOException(m_sReply.Substring(4))
     End If
    
     Return mess
     End Function
    
     '
     ' Get the size of the file on the FTP Server.
     Public Function GetFileSize(ByVal sFileName As String) As Long
     Dim size As Long
    
     If (Not (m_bLoggedIn)) Then
     Login()
     End If
    
     SendCommand("SIZE " & sFileName)
     size = 0
    
     If (m_iRetValue = 213) Then
     size = Int64.Parse(m_sReply.Substring(4))
     Else
     MessageString = m_sReply
     Throw New IOException(m_sReply.Substring(4))
     End If
    
     Return size
     End Function
    
     '
     ' Log into the FTP Server.
     Public Function Login() As Boolean
     m_objClientSocket = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
     Dim ep As New IPEndPoint(Dns.Resolve(m_sRemoteHost).AddressList(0), m_iRemotePort)
    
     Try
     m_objClientSocket.Connect(ep)
     Catch ex As Exception
     MessageString = m_sReply
     Throw New IOException("Couldn't connect to remote server")
     End Try
    
     ReadReply()
     If (m_iRetValue <> 220) Then
     CloseConnection()
     MessageString = m_sReply
     Throw New IOException(m_sReply.Substring(4))
     End If
    
     SendCommand("USER " & m_sRemoteUser)
     If (Not (m_iRetValue = 331 Or m_iRetValue = 230)) Then
     Cleanup()
     MessageString = m_sReply
     Throw New IOException(m_sReply.Substring(4))
     End If
    
     If (m_iRetValue <> 230) Then
     SendCommand("PASS " & m_sRemotePassword)
     If (Not (m_iRetValue = 230 Or m_iRetValue = 202)) Then
     Cleanup()
     MessageString = m_sReply
     Throw New IOException(m_sReply.Substring(4))
     End If
     End If
    
     m_bLoggedIn = True
     ChangeDirectory(m_sRemotePath)
    
     ' Return the end result.
     Return m_bLoggedIn
     End Function
    
     '
     ' If the value of mode is true, set binary mode for 
     ' downloads.
     ' Else, set Ascii mode.
     Public Sub SetBinaryMode(ByVal bMode As Boolean)
    
     If (bMode) Then
     SendCommand("TYPE I")
     Else
     SendCommand("TYPE A")
     End If
    
     If (m_iRetValue <> 200) Then
     MessageString = m_sReply
     Throw New IOException(m_sReply.Substring(4))
     End If
     End Sub
    
     '
     ' Download a file to the Assembly's local directory,
     ' keeping the same file name.
     Public Sub DownloadFile(ByVal sFileName As String)
     DownloadFile(sFileName, "", False)
     End Sub
    
     '
     ' Download a remote file to the Assembly's local 
     ' directory, keeping the same file name, and set 
     ' the resume flag.
     Public Sub DownloadFile(ByVal sFileName As String, _
     ByVal bResume As Boolean)
     DownloadFile(sFileName, "", bResume)
     End Sub
    
     '
     ' Download a remote file to a local file name which can 
     ' include a path. The local file name will be created or 
     ' overwritten, but the path must exist.
     Public Sub DownloadFile(ByVal sFileName As String, _
     ByVal sLocalFileName As String)
     DownloadFile(sFileName, sLocalFileName, False)
     End Sub
    
     '
     ' Download a remote file to a local file name which can 
     ' include a path, and set the resume flag. The local file 
     ' name will be created or overwritten, but the path must 
     ' exist.
     Public Sub DownloadFile(ByVal sFileName As String, _
     ByVal sLocalFileName As String, _
     ByVal bResume As Boolean)
     Dim st As Stream
     Dim output As FileStream
     Dim cSocket As Socket
     Dim offset, npos As Long
    
     If (Not (m_bLoggedIn)) Then
     Login()
     End If
    
     SetBinaryMode(True)
    
     If (sLocalFileName.Equals("")) Then
     sLocalFileName = sFileName
     End If
    
     If (Not (File.Exists(sLocalFileName))) Then
     st = File.Create(sLocalFileName)
     st.Close()
     End If
    
     output = New FileStream(sLocalFileName, FileMode.Open)
     cSocket = CreateDataSocket()
     offset = 0
    
     If (bResume) Then
     offset = output.Length
    
     If (offset > 0) Then
     SendCommand("REST " & offset)
     If (m_iRetValue <> 350) Then
     'throw new IOException(reply.Substring(4));
     'Some servers may not support resuming.
     offset = 0
     End If
     End If
    
     If (offset > 0) Then
     npos = output.Seek(offset, SeekOrigin.Begin)
     End If
     End If
    
     SendCommand("RETR " & sFileName)
    
     If (Not (m_iRetValue = 150 Or m_iRetValue = 125)) Then
     MessageString = m_sReply
     Throw New IOException(m_sReply.Substring(4))
     End If
    
     Do While (True)
     m_aBuffer.Clear(m_aBuffer, 0, m_aBuffer.Length)
     m_iBytes = cSocket.Receive(m_aBuffer, m_aBuffer.Length, 0)
     output.Write(m_aBuffer, 0, m_iBytes)
    
     If (m_iBytes <= 0) Then
     Exit Do
     End If
     Loop
    
     output.Close()
     If (cSocket.Connected) Then
     cSocket.Close()
     End If
    
     ReadReply()
     If (Not (m_iRetValue = 226 Or m_iRetValue = 250)) Then
     MessageString = m_sReply
     Throw New IOException(m_sReply.Substring(4))
     End If
    
     End Sub
    
     '
     ' Upload a file.
     Public Sub UploadFile(ByVal sFileName As String)
     UploadFile(sFileName, False)
     End Sub
    
     '
     ' Upload a file and set the resume flag.
     Public Sub UploadFile(ByVal sFileName As String, _
     ByVal bResume As Boolean)
     Dim cSocket As Socket
     Dim offset As Long
     Dim input As FileStream
     Dim bFileNotFound As Boolean
    
     If (Not (m_bLoggedIn)) Then
     Login()
     End If
    
     cSocket = CreateDataSocket()
     offset = 0
    
     If (bResume) Then
     Try
     SetBinaryMode(True)
     offset = GetFileSize(sFileName)
     Catch ex As Exception
     offset = 0
     End Try
     End If
    
     If (offset > 0) Then
     SendCommand("REST " & offset)
     If (m_iRetValue <> 350) Then
     'throw new IOException(reply.Substring(4));
     'Remote server may not support resuming.
     offset = 0
     End If
     End If
    
     SendCommand("STOR " & Path.GetFileName(sFileName))
     If (Not (m_iRetValue = 125 Or m_iRetValue = 150)) Then
     MessageString = m_sReply
     Throw New IOException(m_sReply.Substring(4))
     End If
    
     ' Check to see if the file exists before the upload.
     bFileNotFound = False
     If (File.Exists(sFileName)) Then
     ' Open input stream to read source file
     input = New FileStream(sFileName, FileMode.Open)
     If (offset <> 0) Then
     input.Seek(offset, SeekOrigin.Begin)
     End If
    
     ' Upload the file 
     m_iBytes = input.Read(m_aBuffer, 0, m_aBuffer.Length)
     Do While (m_iBytes > 0)
     cSocket.Send(m_aBuffer, m_iBytes, 0)
     m_iBytes = input.Read(m_aBuffer, 0, m_aBuffer.Length)
     Loop
     input.Close()
     Else
     bFileNotFound = True
     End If
    
     If (cSocket.Connected) Then
     cSocket.Close()
     End If
    
     ' No point in reading the return value if the file was
     ' not found.
     If (bFileNotFound) Then
     MessageString = m_sReply
     Throw New IOException("The file: " & sFileName & " was not found. Can not upload the file to the FTP Site.")
     End If
    
     ReadReply()
     If (Not (m_iRetValue = 226 Or m_iRetValue = 250)) Then
     MessageString = m_sReply
     Throw New IOException(m_sReply.Substring(4))
     End If
     End Sub
    
     '
     ' Delete a file from the remote FTP server.
     Public Function DeleteFile(ByVal sFileName As String) As Boolean
     Dim bResult As Boolean
    
     bResult = True
     If (Not (m_bLoggedIn)) Then
     Login()
     End If
    
     SendCommand("DELE " & sFileName)
     If (m_iRetValue <> 250) Then
     bResult = False
     MessageString = m_sReply
     End If
    
     ' Return the final result.
     Return bResult
     End Function
    
     '
     ' Rename a file on the remote FTP server.
     Public Function RenameFile(ByVal sOldFileName As String, _
     ByVal sNewFileName As String) As Boolean
     Dim bResult As Boolean
    
     bResult = True
     If (Not (m_bLoggedIn)) Then
     Login()
     End If
    
     SendCommand("RNFR " & sOldFileName)
     If (m_iRetValue <> 350) Then
     MessageString = m_sReply
     Throw New IOException(m_sReply.Substring(4))
     End If
    
     ' known problem
     ' rnto will not take care of existing file.
     ' i.e. It will overwrite if newFileName exist
     SendCommand("RNTO " & sNewFileName)
     If (m_iRetValue <> 250) Then
     MessageString = m_sReply
     Throw New IOException(m_sReply.Substring(4))
     End If
    
     Return bResult
     End Function
    
     '
     ' Create a directory on the remote FTP server.
     Public Function CreateDirectory(ByVal sDirName As String) As Boolean
     Dim bResult As Boolean
    
     bResult = True
     If (Not (m_bLoggedIn)) Then
     Login()
     End If
    
     SendCommand("MKD " & sDirName)
     If (m_iRetValue <> 257) Then
     bResult = False
     MessageString = m_sReply
     End If
    
     ' Return the final result.
     Return bResult
     End Function
    
     '
     ' Delete a directory on the remote FTP server.
     Public Function RemoveDirectory(ByVal sDirName As String) As Boolean
     Dim bResult As Boolean
    
     bResult = True
     If (Not (m_bLoggedIn)) Then
     Login()
     End If
    
     SendCommand("RMD " & sDirName)
     If (m_iRetValue <> 250) Then
     bResult = False
     MessageString = m_sReply
     End If
    
     ' Return the final result.
     Return bResult
     End Function
    
     '
     ' Change the current working directory on the remote FTP 
     ' server.
     Public Function ChangeDirectory(ByVal sDirName As String) As Boolean
     Dim bResult As Boolean
    
     bResult = True
     If (sDirName.Equals(".")) Then
     Exit Function
     End If
    
     If (Not (m_bLoggedIn)) Then
     Login()
     End If
    
     SendCommand("CWD " & sDirName)
     If (m_iRetValue <> 250) Then
     bResult = False
     MessageString = m_sReply
     End If
    
     Me.m_sRemotePath = sDirName
    
     ' Return the final result.
     Return bResult
     End Function
    
     '
     ' Close the FTP connection.
     Public Sub CloseConnection()
     If (Not (m_objClientSocket Is Nothing)) Then
     SendCommand("QUIT")
     End If
    
     Cleanup()
     End Sub
    
    #End Region
    
    #Region "Private Subs and Functions"
     '
     ' Read the reply from the FTP Server
     Private Sub ReadReply()
     m_sMes = ""
     m_sReply = ReadLine()
     m_iRetValue = Int32.Parse(m_sReply.Substring(0, 3))
     End Sub
    
     '
     ' Clean up some variables.
     Private Sub Cleanup()
     If Not (m_objClientSocket Is Nothing) Then
     m_objClientSocket.Close()
     m_objClientSocket = Nothing
     End If
    
     m_bLoggedIn = False
     End Sub
    
     '
     ' Read a line from the server.
     Private Function ReadLine(Optional ByVal bClearMes As Boolean = False) As String
     Dim seperator As Char = ControlChars.Lf
     Dim mess() As String
    
     If (bClearMes) Then
     m_sMes = ""
     End If
     Do While (True)
     m_aBuffer.Clear(m_aBuffer, 0, BLOCK_SIZE)
     m_iBytes = m_objClientSocket.Receive(m_aBuffer, m_aBuffer.Length, 0)
     m_sMes += ASCII.GetString(m_aBuffer, 0, m_iBytes)
     If (m_iBytes < m_aBuffer.Length) Then
     Exit Do
     End If
     Loop
    
     mess = m_sMes.Split(seperator)
     If (m_sMes.Length > 2) Then
     m_sMes = mess(mess.Length - 2)
     Else
     m_sMes = mess(0)
     End If
    
     If (Not (m_sMes.Substring(3, 1).Equals(" "))) Then
     Return ReadLine(True)
     End If
    
     Return m_sMes
     End Function
    
     '
     ' Send a command to the FTP Server.
     Private Sub SendCommand(ByVal sCommand As String)
     sCommand = sCommand & ControlChars.CrLf
     Dim cmdbytes As Byte() = ASCII.GetBytes(sCommand)
    
     m_objClientSocket.Send(cmdbytes, cmdbytes.Length, 0)
     ReadReply()
     End Sub
    
     '
     ' Create a Data socket.
     Private Function CreateDataSocket() As Socket
     Dim index1, index2, len As Int32
     Dim partCount, i, port As Int32
     Dim ipData, buf, ipAddress As String
     Dim parts(6) As Int32
     Dim ch As Char
     Dim s As Socket
     Dim ep As IPEndPoint
    
     SendCommand("PASV")
     If (m_iRetValue <> 227) Then
     MessageString = m_sReply
     Throw New IOException(m_sReply.Substring(4))
     End If
    
     index1 = m_sReply.IndexOf("(")
     index2 = m_sReply.IndexOf(")")
     ipData = m_sReply.Substring(index1 + 1, index2 - index1 - 1)
    
     len = ipData.Length
     partCount = 0
     buf = ""
    
     For i = 0 To ((len - 1) And partCount <= 6)
     ch = Char.Parse(ipData.Substring(i, 1))
     If (Char.IsDigit(ch)) Then
     buf += ch
     ElseIf (ch <> ",") Then
     MessageString = m_sReply
     Throw New IOException("Malformed PASV reply: " & m_sReply)
     End If
    
     If ((ch = ",") Or (i + 1 = len)) Then
     Try
     parts(partCount) = Int32.Parse(buf)
     partCount += 1
     buf = ""
     Catch ex As Exception
     MessageString = m_sReply
     Throw New IOException("Malformed PASV reply: " & m_sReply)
     End Try
     End If
     Next
    
     ipAddress = parts(0) & "." & parts(1) & "." & parts(2) & "." & parts(3)
    
     port = parts(4) * (2 ^ 8)
    
     
     
    
     port = port + parts(5)
    
     s = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
     ep = New IPEndPoint(Dns.Resolve(ipAddress).AddressList(0), port)
    
     Try
     s.Connect(ep)
     Catch ex As Exception
     MessageString = m_sReply
     Throw New IOException("Can't connect to remote server")
     End Try
    
     Return s
     End Function
    #End Region
    End Class
    
    
     

  2. Anzeige

  3. Videos zum Thema
Die Seite wird geladen...
Similar Threads - Visual Basic FTP
  1. Antworten:
    8
    Aufrufe:
    1.574
  2. Antworten:
    6
    Aufrufe:
    1.426
  3. Antworten:
    9
    Aufrufe:
    389
  4. Antworten:
    10
    Aufrufe:
    358
  5. Antworten:
    1
    Aufrufe:
    1.373