سلام
کلاسی با نام FTPClient.vb ایجاد کن و کدهای زیر رو درش کپی کن
Imports System.Collections.Generic
Imports System.Net
Imports System.IO
Imports System.Text.RegularExpressions
Namespace Utilities.FTP
#Region "FTP client class"
Public Class FTPclient
#Region "CONSTRUCTORS"
Sub New()
End Sub
Sub New(ByVal Hostname As String)
_hostname = Hostname
End Sub
Sub New(ByVal Hostname As String, ByVal Username As String, ByVal Password As String)
_hostname = Hostname
_username = Username
_password = Password
End Sub
#End Region
#Region "Directory functions"
Public Function ListDirectory(Optional ByVal directory As String = "") As List(Of String)
Dim ftp As Net.FtpWebRequest = GetRequest(GetDirectory(directory))
ftp.Method = Net.WebRequestMethods.Ftp.ListDirectory
Dim str As String = GetStringResponse(ftp)
str = str.Replace(vbCrLf, vbCr).TrimEnd(Chr(13))
Dim result As New List(Of String)
result.AddRange(str.Split(Chr(13)))
Return result
End Function
Public Function ListDirectoryDetail(Optional ByVal directory As String = "") As FTPdirectory
Dim ftp As Net.FtpWebRequest = GetRequest(GetDirectory(directory))
ftp.Method = Net.WebRequestMethods.Ftp.ListDirectoryDetails
Dim str As String = GetStringResponse(ftp)
str = str.Replace(vbCrLf, vbCr).TrimEnd(Chr(13))
Return New FTPdirectory(str, _lastDirectory)
End Function
#End Region
#Region "Upload: File transfer TO ftp server"
Public Function Upload(ByVal localFilename As String, Optional ByVal targetFilename As String = "") As Boolean
If Not File.Exists(localFilename) Then
Throw New ApplicationException("File " & localFilename & " not found")
End If
Dim fi As New FileInfo(localFilename)
Return Upload(fi, targetFilename)
End Function
Public Function Upload(ByVal fi As FileInfo, Optional ByVal targetFilename As String = "") As Boolean
Dim target As String
If targetFilename.Trim = "" Then
target = Me.CurrentDirectory & fi.Name
ElseIf targetFilename.Contains("/") Then
target = AdjustDir(targetFilename)
Else
target = CurrentDirectory & targetFilename
End If
Dim URI As String = Hostname & target
Dim ftp As Net.FtpWebRequest = GetRequest(URI)
ftp.Method = Net.WebRequestMethods.Ftp.UploadFile
ftp.UseBinary = True
ftp.ContentLength = fi.Length
Const BufferSize As Integer = 2048
Dim content(BufferSize - 1) As Byte, dataRead As Integer
Using fs As FileStream = fi.OpenRead()
Try
Using rs As Stream = ftp.GetRequestStream
Do
dataRead = fs.Read(content, 0, BufferSize)
rs.Write(content, 0, dataRead)
Loop Until dataRead < BufferSize
rs.Close()
End Using
Catch ex As Exception
MsgBox(ex.Message)
Finally
fs.Close()
End Try
End Using
ftp = Nothing
Return True
End Function
#End Region
#Region "Download: File transfer FROM ftp server"
Public Function Download(ByVal sourceFilename As String, ByVal localFilename As String, Optional ByVal PermitOverwrite As Boolean = False) As Boolean
Dim fi As New FileInfo(localFilename)
Return Me.Download(sourceFilename, fi, PermitOverwrite)
End Function
Public Function Download(ByVal file As FTPfileInfo, ByVal localFilename As String, Optional ByVal PermitOverwrite As Boolean = False) As Boolean
Return Me.Download(file.FullName, localFilename, PermitOverwrite)
End Function
Public Function Download(ByVal file As FTPfileInfo, ByVal localFI As FileInfo, Optional ByVal PermitOverwrite As Boolean = False) As Boolean
Return Me.Download(file.FullName, localFI, PermitOverwrite)
End Function
Public Function Download(ByVal sourceFilename As String, ByVal targetFI As FileInfo, Optional ByVal PermitOverwrite As Boolean = False) As Boolean
If targetFI.Exists And Not (PermitOverwrite) Then Throw New ApplicationException("Target file already exists")
Dim target As String
If sourceFilename.Trim = "" Then
Throw New ApplicationException("File not specified")
ElseIf sourceFilename.Contains("/") Then
'treat as a full path
target = AdjustDir(sourceFilename)
Else
'treat as filename only, use current directory
target = CurrentDirectory & sourceFilename
End If
Dim URI As String = Hostname & target
'3. perform copy
Dim ftp As Net.FtpWebRequest = GetRequest(URI)
'Set request to download a file in binary mode
ftp.Method = Net.WebRequestMethods.Ftp.DownloadFile
ftp.UseBinary = True
'open request and get response stream
Using response As FtpWebResponse = CType(ftp.GetResponse, FtpWebResponse)
Using responseStream As Stream = response.GetResponseStream
'loop to read & write to file
Using fs As FileStream = targetFI.OpenWrite
Try
Dim buffer(2047) As Byte
Dim read As Integer = 0
Do
read = responseStream.Read(buffer, 0, buffer.Length)
fs.Write(buffer, 0, read)
Loop Until read = 0
responseStream.Close()
fs.Flush()
fs.Close()
Catch ex As Exception
'catch error and delete file only partially downloaded
fs.Close()
'delete target file as it's incomplete
targetFI.Delete()
Throw
End Try
End Using
responseStream.Close()
End Using
response.Close()
End Using
Return True
End Function
#End Region
#Region "Other functions: Delete rename etc."
Public Function FtpDelete(ByVal filename As String) As Boolean
'Determine if file or full path
Dim URI As String = Me.Hostname & GetFullPath(filename)
Dim ftp As Net.FtpWebRequest = GetRequest(URI)
'Set request to delete
ftp.Method = Net.WebRequestMethods.Ftp.DeleteFile
Try
'get response but ignore it
Dim str As String = GetStringResponse(ftp)
Catch ex As Exception
Return False
End Try
Return True
End Function
Public Function FtpFileExists(ByVal filename As String) As Boolean
Try
Dim size As Long = GetFileSize(filename)
Return True
Catch ex As Exception
If TypeOf ex Is System.Net.WebException Then
If ex.Message.Contains("550") Then
'clear
Return False
Else
Throw
End If
Else
Throw
End If
End Try
End Function
Public Function GetFileSize(ByVal filename As String) As Long
Dim path As String
If filename.Contains("/") Then
path = AdjustDir(filename)
Else
path = Me.CurrentDirectory & filename
End If
Dim URI As String = Me.Hostname & path
Dim ftp As Net.FtpWebRequest = GetRequest(URI)
'Try to get info on file/dir?
ftp.Method = Net.WebRequestMethods.Ftp.GetFileSize
Dim tmp As String = Me.GetStringResponse(ftp)
Return GetSize(ftp)
End Function
Public Function FtpRename(ByVal sourceFilename As String, ByVal newName As String) As Boolean
'Does file exist?
Dim source As String = GetFullPath(sourceFilename)
If Not FtpFileExists(source) Then
Throw New FileNotFoundException("File " & source & " not found")
End If
'build target name, ensure it does not exist
Dim target As String = GetFullPath(newName)
If target = source Then
Throw New ApplicationException("Source and target are the same")
ElseIf FtpFileExists(target) Then
Throw New ApplicationException("Target file " & target & " already exists")
End If
'perform rename
Dim URI As String = Me.Hostname & source
Dim ftp As Net.FtpWebRequest = GetRequest(URI)
'Set request to delete
ftp.Method = Net.WebRequestMethods.Ftp.Rename
ftp.RenameTo = target
Try
'get response but ignore it
Dim str As String = GetStringResponse(ftp)
Catch ex As Exception
Return False
End Try
Return True
End Function
Public Function FtpCreateDirectory(ByVal dirpath As String) As Boolean
'perform create
Dim URI As String = Me.Hostname & AdjustDir(dirpath)
Dim ftp As Net.FtpWebRequest = GetRequest(URI)
'Set request to MkDir
ftp.Method = Net.WebRequestMethods.Ftp.MakeDirectory
Try
'get response but ignore it
Dim str As String = GetStringResponse(ftp)
Catch ex As Exception
Return False
End Try
Return True
End Function
Public Function FtpDeleteDirectory(ByVal dirpath As String) As Boolean
'perform remove
Dim URI As String = Me.Hostname & AdjustDir(dirpath)
Dim ftp As Net.FtpWebRequest = GetRequest(URI)
'Set request to RmDir
ftp.Method = Net.WebRequestMethods.Ftp.RemoveDirectory
Try
'get response but ignore it
Dim str As String = GetStringResponse(ftp)
Catch ex As Exception
Return False
End Try
Return True
End Function
#End Region
#Region "private supporting fns"
Private Function GetRequest(ByVal URI As String) As FtpWebRequest
'create request
Dim result As FtpWebRequest = CType(FtpWebRequest.Create(URI), FtpWebRequest)
'Set the login details
result.Credentials = GetCredentials()
'Do not keep alive (stateless mode)
result.KeepAlive = False
Return result
End Function
Private Function GetCredentials() As Net.ICredentials
Return New Net.NetworkCredential(Username, Password)
End Function
Private Function GetFullPath(ByVal file As String) As String
If file.Contains("/") Then
Return AdjustDir(file)
Else
Return Me.CurrentDirectory & file
End If
End Function
Private Function AdjustDir(ByVal path As String) As String
Return CStr(IIf(path.StartsWith("/"), "", "/")) & path
End Function
Private Function GetDirectory(Optional ByVal directory As String = "") As String
Dim URI As String
If directory = "" Then
'build from current
URI = Hostname & Me.CurrentDirectory
_lastDirectory = Me.CurrentDirectory
Else
If Not directory.StartsWith("/") Then Throw New ApplicationException("Directory should start with /")
URI = Me.Hostname & directory
_lastDirectory = directory
End If
Return URI
End Function
'stores last retrieved/set directory
Private _lastDirectory As String = ""
Private Function GetStringResponse(ByVal ftp As FtpWebRequest) As String
'Get the result, streaming to a string
Dim result As String = ""
Using response As FtpWebResponse = CType(ftp.GetResponse, FtpWebResponse)
Dim size As Long = response.ContentLength
Using datastream As Stream = response.GetResponseStream
Using sr As New StreamReader(datastream)
result = sr.ReadToEnd()
sr.Close()
End Using
datastream.Close()
End Using
response.Close()
End Using
Return result
End Function
Private Function GetSize(ByVal ftp As FtpWebRequest) As Long
Dim size As Long
Using response As FtpWebResponse = CType(ftp.GetResponse, FtpWebResponse)
size = response.ContentLength
response.Close()
End Using
Return size
End Function
#End Region
#Region "Properties"
Private _hostname As String
Public Property Hostname() As String
Get
If _hostname.StartsWith("ftp://") Then
Return _hostname
Else
Return "ftp://" & _hostname
End If
End Get
Set(ByVal value As String)
_hostname = value
End Set
End Property
Private _username As String
Public Property Username() As String
Get
Return IIf(_username = "", "anonymous", _username)
End Get
Set(ByVal value As String)
_username = value
End Set
End Property
Private _password As String
Public Property Password() As String
Get
Return _password
End Get
Set(ByVal value As String)
_password = value
End Set
End Property
Private _currentDirectory As String = "/"
Public Property CurrentDirectory() As String
Get
'return directory, ensure it ends with /
Return _currentDirectory & CStr(IIf(_currentDirectory.EndsWith("/"), "", "/"))
End Get
Set(ByVal value As String)
If Not value.StartsWith("/") Then Throw New ApplicationException("Directory should start with /")
_currentDirectory = value
End Set
End Property
#End Region
End Class
#End Region
#Region "FTP file info class"
Public Class FTPfileInfo
'Stores extended info about FTP file
#Region "Properties"
Public ReadOnly Property FullName() As String
Get
Return Path & Filename
End Get
End Property
Public ReadOnly Property Filename() As String
Get
Return _filename
End Get
End Property
Public ReadOnly Property Path() As String
Get
Return _path
End Get
End Property
Public ReadOnly Property FileType() As DirectoryEntryTypes
Get
Return _fileType
End Get
End Property
Public ReadOnly Property Size() As Long
Get
Return _size
End Get
End Property
Public ReadOnly Property FileDateTime() As Date
Get
Return _fileDateTime
End Get
End Property
Public ReadOnly Property Permission() As String
Get
Return _permission
End Get
End Property
Public ReadOnly Property Extension() As String
Get
Dim i As Integer = Me.Filename.LastIndexOf(".")
If i >= 0 And i < (Me.Filename.Length - 1) Then
Return Me.Filename.Substring(i + 1)
Else
Return ""
End If
End Get
End Property
Public ReadOnly Property NameOnly() As String
Get
Dim i As Integer = Me.Filename.LastIndexOf(".")
If i > 0 Then
Return Me.Filename.Substring(0, i)
Else
Return Me.Filename
End If
End Get
End Property
Private _filename As String
Private _path As String
Private _fileType As DirectoryEntryTypes
Private _size As Long
Private _fileDateTime As Date
Private _permission As String
#End Region
Public Enum DirectoryEntryTypes
File
Directory
End Enum
Sub New(ByVal line As String, ByVal path As String)
'parse line
Dim m As Match = GetMatchingRegex(line)
If m Is Nothing Then
'failed
Throw New ApplicationException("Unable to parse line: " & line)
Else
_filename = m.Groups("name").Value
_path = path
_size = CLng(m.Groups("size").Value)
_permission = m.Groups("permission").Value
Dim _dir As String = m.Groups("dir").Value
If (_dir <> "" And _dir <> "-") Then
_fileType = DirectoryEntryTypes.Directory
Else
_fileType = DirectoryEntryTypes.File
End If
Try
_fileDateTime = Date.Parse(m.Groups("timestamp").Value)
Catch ex As Exception
_fileDateTime = Nothing
End Try
End If
End Sub
Private Function GetMatchingRegex(ByVal line As String) As Match
Dim rx As Regex, m As Match
For i As Integer = 0 To _ParseFormats.Length - 1
rx = New Regex(_ParseFormats(i))
m = rx.Match(line)
If m.Success Then Return m
Next
Return Nothing
End Function
#Region "Regular expressions for parsing LIST results"
Private Shared _ParseFormats As String() = { _
"(?<dir>[\-d])(?<permission>([\-r][\-w][\-xs]){3})\s+\d+\s+\w+\s+\w+\s+(?<size>\d+)\s+(?<timest amp>\w+\s+\d+\s+\d{4})\s+(?<name>.+)", _
"(?<dir>[\-d])(?<permission>([\-r][\-w][\-xs]){3})\s+\d+\s+\d+\s+(?<size>\d+)\s+(?<timestamp>\w +\s+\d+\s+\d{4})\s+(?<name>.+)", _
"(?<dir>[\-d])(?<permission>([\-r][\-w][\-xs]){3})\s+\d+\s+\d+\s+(?<size>\d+)\s+(?<timestamp>\w +\s+\d+\s+\d{1,2}:\d{2})\s+(?<name>.+)", _
"(?<dir>[\-d])(?<permission>([\-r][\-w][\-xs]){3})\s+\d+\s+\w+\s+\w+\s+(?<size>\d+)\s+(?<timest amp>\w+\s+\d+\s+\d{1,2}:\d{2})\s+(?<name>.+)", _
"(?<dir>[\-d])(?<permission>([\-r][\-w][\-xs]){3})(\s+)(?<size>(\d+))(\s+)(?<ctbit>(\w+\s\w+))( \s+)(?<size2>(\d+))\s+(?<timestamp>\w+\s+\d+\s+\d{ 2}:\d{2})\s+(?<name>.+)", _
"(?<timestamp>\d{2}\-\d{2}\-\d{2}\s+\d{2}:\d{2}[Aa|Pp][mM])\s+(?<dir>\<\w+\>){0,1}(?<size>\d+){0,1}\s+(?<nam e>.+)"}
#End Region
End Class
#End Region
#Region "FTP Directory class"
Public Class FTPdirectory
Inherits List(Of FTPfileInfo)
Sub New()
'creates a blank directory listing
End Sub
Sub New(ByVal dir As String, ByVal path As String)
For Each line As String In dir.Replace(vbLf, "").Split(CChar(vbCr))
'parse
If line <> "" Then Me.Add(New FTPfileInfo(line, path))
Next
End Sub
Public Function GetFiles(Optional ByVal ext As String = "") As FTPdirectory
Return Me.GetFileOrDir(FTPfileInfo.DirectoryEntryTypes.Fi le, ext)
End Function
Public Function GetDirectories() As FTPdirectory
Return Me.GetFileOrDir(FTPfileInfo.DirectoryEntryTypes.Di rectory)
End Function
'internal: share use function for GetDirectories/Files
Private Function GetFileOrDir(ByVal type As FTPfileInfo.DirectoryEntryTypes, Optional ByVal ext As String = "") As FTPdirectory
Dim result As New FTPdirectory()
For Each fi As FTPfileInfo In Me
If fi.FileType = type Then
If ext = "" Then
result.Add(fi)
ElseIf ext = fi.Extension Then
result.Add(fi)
End If
End If
Next
Return result
End Function
Public Function FileExists(ByVal filename As String) As Boolean
For Each ftpfile As FTPfileInfo In Me
If ftpfile.Filename = filename Then
Return True
End If
Next
Return False
End Function
Private Const slash As Char = "/"
Public Shared Function GetParentDirectory(ByVal dir As String) As String
Dim tmp As String = dir.TrimEnd(slash)
Dim i As Integer = tmp.LastIndexOf(slash)
If i > 0 Then
Return tmp.Substring(0, i - 1)
Else
Throw New ApplicationException("No parent for root")
End If
End Function
End Class
#End Region
End Namespace
حال با دستورات زیر میتوانی فایل رو آپلود کنی
Dim FileInServerPath As String = ' Masiri ke mikhay file Upload beshe dar site ba name file
Dim ftp As New Utilities.FTP.FTPclient(Hostname,User name, Password)' "www.bbbbb.nl", "username", "password)
ftp.Upload(Filename, FileInServerPath)
در ضمن این کلاسهای توابعی برای دانلود و کپی و غیره هم داره که میتوانید استفاده کنید.
البته منهم این کلاس رو از یه جایی دانلود کردم و نوشته خودم نیست اما در 3 تا پروژه بکارش بردم عالی جواب میده
آپلود فایل؟
نوشته شده توسط mvb_mehran
قوانین ایجاد تاپیک در تالار
پاسخ با نقل قول
