功能很多，非常的好用，感谢这位高手啊。 本来是C#的我弄成VB的了。
[code=VB.NET]
Imports System.Collections.Generic
Imports System.Text
Imports System.Net
Imports System.IO
Imports System.Globalization
Imports System.Text.RegularExpressions
Imports System.ComponentModel
Namespace System.Net.Ftp
#Region "文件信息结构"
Public Structure FileStruct
Public Flags As String
Public Owner As String
Public Group As String
Public IsDirectory As Boolean
Public CreateTime As DateTime
Public Name As String
End Structure
Public Enum FileListStyle
UnixStyle
WindowsStyle
Unknown
End Enum
#End Region
Public Class clsFTP
#Region "属性信息"
''' FTP请求对象
Private Request As FtpWebRequest = Nothing
''' FTP响应对象
Private Response As FtpWebResponse = Nothing
''' FTP服务器地址
Private _Uri As Uri
''' FTP服务器地址
Public Property Uri() As Uri
Get
If _DirectoryPath = "/" Then
Return _Uri
Else
Dim strUri As String = _Uri.ToString()
If strUri.EndsWith("/") Then
strUri = strUri.Substring(0, strUri.Length - 1)
End If
Return New Uri(strUri + Me.DirectoryPath)
End If
End Get
Set(ByVal value As Uri)
If value.Scheme <> Uri.UriSchemeFtp Then
Throw New Exception("Ftp 地址格式错误!")
End If
_Uri = New Uri(value.GetLeftPart(UriPartial.Authority))
_DirectoryPath = value.AbsolutePath
If Not _DirectoryPath.EndsWith("/") Then
_DirectoryPath += "/"
End If
End Set
End Property
''' 当前工作目录
Private _DirectoryPath As String
''' 当前工作目录
Public Property DirectoryPath() As String
Get
Return _DirectoryPath
End Get
Set(ByVal value As String)
_DirectoryPath = value
End Set
End Property
''' FTP登录用户
Private _UserName As String
''' FTP登录用户
Public Property UserName() As String
Get
Return _UserName
End Get
Set(ByVal value As String)
_UserName = value
End Set
End Property
''' 错误信息
Private _ErrorMsg As String
''' 错误信息
Public Property ErrorMsg() As String
Get
Return _ErrorMsg
End Get
Set(ByVal value As String)
_ErrorMsg = value
End Set
End Property
''' FTP登录密码
Private _Password As String
''' FTP登录密码
Public Property Password() As String
Get
Return _Password
End Get
Set(ByVal value As String)
_Password = value
End Set
End Property
''' 连接FTP服务器的代理服务
Private _Proxy As WebProxy = Nothing
''' 连接FTP服务器的代理服务
Public Property Proxy() As WebProxy
Get
Return _Proxy
End Get
Set(ByVal value As WebProxy)
_Proxy = value
End Set
End Property
''' 是否需要删除临时文件
Private _isDeleteTempFile As Boolean = False
''' 异步上传所临时生成的文件
Private _UploadTempFile As String = ""
#End Region
#Region "事件"
Public Delegate Sub De_DownloadProgressChanged(ByVal sender As Object, ByVal e As DownloadProgressChangedEventArgs)
Public Delegate Sub De_DownloadDataCompleted(ByVal sender As Object, ByVal e As AsyncCompletedEventArgs)
Public Delegate Sub De_UploadProgressChanged(ByVal sender As Object, ByVal e As UploadProgressChangedEventArgs)
Public Delegate Sub De_UploadFileCompleted(ByVal sender As Object, ByVal e As UploadFileCompletedEventArgs)
''' 异步下载进度发生改变触发的事件
Public Event DownloadProgressChanged As De_DownloadProgressChanged
''' 异步下载文件完成之后触发的事件
Public Event DownloadDataCompleted As De_DownloadDataCompleted
''' 异步上传进度发生改变触发的事件
Public Event UploadProgressChanged As De_UploadProgressChanged
''' 异步上传文件完成之后触发的事件
Public Event UploadFileCompleted As De_UploadFileCompleted
#End Region
#Region "构造析构函数"
''' 构造函数
''' <param name="FtpUri">FTP地址</param>
''' <param name="strUserName">登录用户名</param>
''' <param name="strPassword">登录密码</param>
Public Sub New(ByVal FtpUri As Uri, ByVal strUserName As String, ByVal strPassword As String)
Me._Uri = New Uri(FtpUri.GetLeftPart(UriPartial.Authority))
_DirectoryPath = FtpUri.AbsolutePath
If Not _DirectoryPath.EndsWith("/") Then
_DirectoryPath += "/"
End If
Me._UserName = strUserName
Me._Password = strPassword
Me._Proxy = Nothing
End Sub
''' <summary>
''' 构造函数
''' </summary>
''' <param name="FtpUri">FTP地址</param>
''' <param name="strUserName">登录用户名</param>
''' <param name="strPassword">登录密码</param>
''' <param name="objProxy">连接代理</param>
Public Sub New(ByVal FtpUri As Uri, ByVal strUserName As String, ByVal strPassword As String, ByVal objProxy As WebProxy)
Me._Uri = New Uri(FtpUri.GetLeftPart(UriPartial.Authority))
_DirectoryPath = FtpUri.AbsolutePath
If Not _DirectoryPath.EndsWith("/") Then
_DirectoryPath += "/"
End If
Me._UserName = strUserName
Me._Password = strPassword
Me._Proxy = objProxy
End Sub
''' <summary>
''' 构造函数
''' </summary>
Public Sub New()
Me._UserName = "anonymous"
'匿名用户
Me._Password = "@anonymous"
Me._Uri = Nothing
Me._Proxy = Nothing
End Sub
''' <summary>
''' 析构函数
''' </summary>
Protected Overrides Sub Finalize()
Try
If Response IsNot Nothing Then
Response.Close()
Response = Nothing
End If
If Request IsNot Nothing Then
Request.Abort()
Request = Nothing
End If
Finally
MyBase.Finalize()
End Try
End Sub
#End Region
#Region "建立连接"
''' <summary>
''' 建立FTP链接,返回响应对象
''' </summary>
''' <param name="uri">FTP地址</param>
''' <param name="FtpMathod">操作命令</param>
Private Function Open(ByVal uri As Uri, ByVal FtpMathod As String) As FtpWebResponse
Try
Request = DirectCast(WebRequest.Create(uri), FtpWebRequest)
Request.Method = FtpMathod
Request.UseBinary = True
Request.Credentials = New NetworkCredential(Me.UserName, Me.Password)
If Me.Proxy IsNot Nothing Then
Request.Proxy = Me.Proxy
End If
Return DirectCast(Request.GetResponse(), FtpWebResponse)
Catch ep As Exception
ErrorMsg = ep.ToString()
Throw ep
End Try
End Function
''' <summary>
''' 建立FTP链接,返回请求对象
''' </summary>
''' <param name="uri">FTP地址</param>
''' <param name="FtpMathod">操作命令</param>
Private Function OpenRequest(ByVal uri As Uri, ByVal FtpMathod As String) As FtpWebRequest
Try
Request = DirectCast(WebRequest.Create(uri), FtpWebRequest)
Request.Method = FtpMathod
Request.UseBinary = True
Request.Credentials = New NetworkCredential(Me.UserName, Me.Password)
If Me.Proxy IsNot Nothing Then
Request.Proxy = Me.Proxy
End If
Return Request
Catch ep As Exception
ErrorMsg = ep.ToString()
Throw ep
End Try
End Function
#End Region
#Region "下载文件"
''' <summary>
''' 从FTP服务器下载文件，使用与远程文件同名的文件名来保存文件
''' </summary>
''' <param name="RemoteFileName">远程文件名</param>
''' <param name="LocalPath">本地路径</param>
Public Function DownloadFile(ByVal RemoteFileName As String, ByVal LocalPath As String) As Boolean
Return DownloadFile(RemoteFileName, LocalPath, RemoteFileName)
End Function
''' <summary>
''' 从FTP服务器下载文件，指定本地路径和本地文件名
''' </summary>
''' <param name="RemoteFileName">远程文件名</param>
''' <param name="LocalPath">保存文件的本地路径,后面带有"/"</param>
''' <param name="LocalFileName">保存本地的文件名</param>
Public Function DownloadFile(ByVal RemoteFileName As String, ByVal LocalPath As String, ByVal LocalFileName As String) As Boolean
Dim bt As Byte() = Nothing
Try
If Not IsValidFileChars(RemoteFileName) OrElse Not IsValidFileChars(LocalFileName) OrElse Not IsValidPathChars(LocalPath) Then
Throw New Exception("非法文件名或目录名!")
End If
If Not Directory.Exists(LocalPath) Then
Throw New Exception("本地文件路径不存在!")
End If
Dim LocalFullPath As String = Path.Combine(LocalPath, LocalFileName)
If File.Exists(LocalFullPath) Then
Throw New Exception("当前路径下已经存在同名文件！")
End If
bt = DownloadFile(RemoteFileName)
If bt IsNot Nothing Then
Dim stream As New FileStream(LocalFullPath, FileMode.Create)
stream.Write(bt, 0, bt.Length)
stream.Flush()
stream.Close()
Return True
Else
Return False
End If
Catch ep As Exception
ErrorMsg = ep.ToString()
Throw ep
End Try
End Function
''' <summary>
''' 从FTP服务器下载文件，返回文件二进制数据
''' </summary>
''' <param name="RemoteFileName">远程文件名</param>
Public Function DownloadFile(ByVal RemoteFileName As String) As Byte()
Try
If Not IsValidFileChars(RemoteFileName) Then
Throw New Exception("非法文件名或目录名!")
End If
Response = Open(New Uri(Me.Uri.ToString() + RemoteFileName), WebRequestMethods.Ftp.DownloadFile)
Dim Reader As Stream = Response.GetResponseStream()
Dim mem As New MemoryStream(1024 * 500)
Dim buffer As Byte() = New Byte(1023) {}
Dim bytesRead As Integer = 0
Dim TotalByteRead As Integer = 0
While True
bytesRead = Reader.Read(buffer, 0, buffer.Length)
TotalByteRead += bytesRead
If bytesRead = 0 Then
Exit While
End If
mem.Write(buffer, 0, bytesRead)
End While
If mem.Length > 0 Then
Return mem.ToArray()
Else
Return Nothing
End If
Catch ep As Exception
ErrorMsg = ep.ToString()
Throw ep
End Try
End Function
#End Region
#Region "异步下载文件"
''' <summary>
''' 从FTP服务器异步下载文件，指定本地路径和本地文件名
''' </summary>
''' <param name="RemoteFileName">远程文件名</param>
''' <param name="LocalPath">保存文件的本地路径,后面带有"/"</param>
''' <param name="LocalFileName">保存本地的文件名</param>
Public Sub DownloadFileAsync(ByVal RemoteFileName As String, ByVal LocalPath As String, ByVal LocalFileName As String)
Dim bt As Byte() = Nothing
Try
If Not IsValidFileChars(RemoteFileName) OrElse Not IsValidFileChars(LocalFileName) OrElse Not IsValidPathChars(LocalPath) Then
Throw New Exception("非法文件名或目录名!")
End If
If Not Directory.Exists(LocalPath) Then
Throw New Exception("本地文件路径不存在!")
End If
Dim LocalFullPath As String = Path.Combine(LocalPath, LocalFileName)
If File.Exists(LocalFullPath) Then
Throw New Exception("当前路径下已经存在同名文件！")
End If
DownloadFileAsync(RemoteFileName, LocalFullPath)
Catch ep As Exception
ErrorMsg = ep.ToString()
Throw ep
End Try
End Sub
''' <summary>
''' 从FTP服务器异步下载文件，指定本地完整路径文件名
''' </summary>
''' <param name="RemoteFileName">远程文件名</param>
''' <param name="LocalFullPath">本地完整路径文件名</param>
Public Sub DownloadFileAsync(ByVal RemoteFileName As String, ByVal LocalFullPath As String)
Try
If Not IsValidFileChars(RemoteFileName) Then
Throw New Exception("非法文件名或目录名!")
End If
If File.Exists(LocalFullPath) Then
Throw New Exception("当前路径下已经存在同名文件！")
End If
Dim client As New MyWebClient()
AddHandler client.DownloadProgressChanged, AddressOf client_DownloadProgressChanged
AddHandler client.DownloadFileCompleted, AddressOf client_DownloadFileCompleted
client.Credentials = New NetworkCredential(Me.UserName, Me.Password)
If Me.Proxy IsNot Nothing Then
client.Proxy = Me.Proxy
End If
client.DownloadFileAsync(New Uri(Me.Uri.ToString() + RemoteFileName), LocalFullPath)
Catch ep As Exception
ErrorMsg = ep.ToString()
Throw ep
End Try
End Sub
''' <summary>
''' 异步下载文件完成之后触发的事件
''' </summary>
''' <param name="sender">下载对象</param>
''' <param name="e">数据信息对象</param>
Private Sub client_DownloadFileCompleted(ByVal sender As Object, ByVal e As AsyncCompletedEventArgs)
RaiseEvent DownloadDataCompleted(sender, e)
End Sub
''' <summary>
''' 异步下载进度发生改变触发的事件
''' </summary>
''' <param name="sender">下载对象</param>
''' <param name="e">进度信息对象</param>
Private Sub client_DownloadProgressChanged(ByVal sender As Object, ByVal e As DownloadProgressChangedEventArgs)
RaiseEvent DownloadProgressChanged(sender, e)
End Sub
#End Region
#Region "上传文件"
''' <summary>
''' 上传文件到FTP服务器
''' </summary>
''' <param name="LocalFullPath">本地带有完整路径的文件名</param>
Public Function UploadFile(ByVal LocalFullPath As String) As Boolean
Return UploadFile(LocalFullPath, Path.GetFileName(LocalFullPath), False)
End Function
''' <summary>
''' 上传文件到FTP服务器
''' </summary>
''' <param name="LocalFullPath">本地带有完整路径的文件</param>
''' <param name="OverWriteRemoteFile">是否覆盖远程服务器上面同名的文件</param>
Public Function UploadFile(ByVal LocalFullPath As String, ByVal OverWriteRemoteFile As Boolean) As Boolean
Return UploadFile(LocalFullPath, Path.GetFileName(LocalFullPath), OverWriteRemoteFile)
End Function
''' <summary>
''' 上传文件到FTP服务器
''' </summary>
''' <param name="LocalFullPath">本地带有完整路径的文件</param>
''' <param name="RemoteFileName">要在FTP服务器上面保存文件名</param>
Public Function UploadFile(ByVal LocalFullPath As String, ByVal RemoteFileName As String) As Boolean
Return UploadFile(LocalFullPath, RemoteFileName, False)
End Function
''' <summary>
''' 上传文件到FTP服务器
''' </summary>
''' <param name="LocalFullPath">本地带有完整路径的文件名</param>
''' <param name="RemoteFileName">要在FTP服务器上面保存文件名</param>
''' <param name="OverWriteRemoteFile">是否覆盖远程服务器上面同名的文件</param>
Public Function UploadFile(ByVal LocalFullPath As String, ByVal RemoteFileName As String, ByVal OverWriteRemoteFile As Boolean) As Boolean
Try
If Not IsValidFileChars(RemoteFileName) OrElse Not IsValidFileChars(Path.GetFileName(LocalFullPath)) OrElse Not IsValidPathChars(Path.GetDirectoryName(LocalFullPath)) Then
Throw New Exception("非法文件名或目录名!")
End If
If File.Exists(LocalFullPath) Then
Dim Stream As New FileStream(LocalFullPath, FileMode.Open, FileAccess.Read)
Dim bt As Byte() = New Byte(Stream.Length - 1) {}
Stream.Read(bt, 0, DirectCast(Stream.Length, Long))
'注意，因为Int32的最大限制，最大上传文件只能是大约2G多一点
Stream.Close()
Return UploadFile(bt, RemoteFileName, OverWriteRemoteFile)
Else
Throw New Exception("本地文件不存在!")
End If
Catch ep As Exception
ErrorMsg = ep.ToString()
Throw ep
End Try
End Function
''' <summary>
''' 上传文件到FTP服务器
''' </summary>
''' <param name="FileBytes">上传的二进制数据</param>
''' <param name="RemoteFileName">要在FTP服务器上面保存文件名</param>
Public Function UploadFile(ByVal FileBytes As Byte(), ByVal RemoteFileName As String) As Boolean
If Not IsValidFileChars(RemoteFileName) Then
Throw New Exception("非法文件名或目录名!")
End If
Return UploadFile(FileBytes, RemoteFileName, False)
End Function
''' <summary>
''' 上传文件到FTP服务器
''' </summary>
''' <param name="FileBytes">文件二进制内容</param>
''' <param name="RemoteFileName">要在FTP服务器上面保存文件名</param>
''' <param name="OverWriteRemoteFile">是否覆盖远程服务器上面同名的文件</param>
Public Function UploadFile(ByVal FileBytes As Byte(), ByVal RemoteFileName As String, ByVal OverWriteRemoteFile As Boolean) As Boolean
Try
If Not IsValidFileChars(RemoteFileName) Then
Throw New Exception("非法文件名！")
End If
If Not OverWriteRemoteFile AndAlso FileExist(RemoteFileName) Then
Throw New Exception("FTP服务上面已经存在同名文件！")
End If
Response = Open(New Uri(Me.Uri.ToString() + RemoteFileName), WebRequestMethods.Ftp.UploadFile)
Dim requestStream As Stream = Request.GetRequestStream()
Dim mem As New MemoryStream(FileBytes)
Dim buffer As Byte() = New Byte(1023) {}
Dim bytesRead As Integer = 0
Dim TotalRead As Integer = 0
While True
bytesRead = mem.Read(buffer, 0, buffer.Length)
If bytesRead = 0 Then
Exit While
End If
TotalRead += bytesRead
requestStream.Write(buffer, 0, bytesRead)
End While
requestStream.Close()
Response = DirectCast(Request.GetResponse(), FtpWebResponse)
mem.Close()
mem.Dispose()
FileBytes = Nothing
Return True
Catch ep As Exception
ErrorMsg = ep.ToString()
Throw ep
End Try
End Function
#End Region
#Region "异步上传文件"
''' <summary>
''' 异步上传文件到FTP服务器
''' </summary>
''' <param name="LocalFullPath">本地带有完整路径的文件名</param>
Public Sub UploadFileAsync(ByVal LocalFullPath As String)
UploadFileAsync(LocalFullPath, Path.GetFileName(LocalFullPath), False)
End Sub
''' <summary>
''' 异步上传文件到FTP服务器
''' </summary>
''' <param name="LocalFullPath">本地带有完整路径的文件</param>
''' <param name="OverWriteRemoteFile">是否覆盖远程服务器上面同名的文件</param>
Public Sub UploadFileAsync(ByVal LocalFullPath As String, ByVal OverWriteRemoteFile As Boolean)
UploadFileAsync(LocalFullPath, Path.GetFileName(LocalFullPath), OverWriteRemoteFile)
End Sub
''' <summary>
''' 异步上传文件到FTP服务器
''' </summary>
''' <param name="LocalFullPath">本地带有完整路径的文件</param>
''' <param name="RemoteFileName">要在FTP服务器上面保存文件名</param>
Public Sub UploadFileAsync(ByVal LocalFullPath As String, ByVal RemoteFileName As String)
UploadFileAsync(LocalFullPath, RemoteFileName, False)
End Sub
''' <summary>
''' 异步上传文件到FTP服务器
''' </summary>
''' <param name="LocalFullPath">本地带有完整路径的文件名</param>
''' <param name="RemoteFileName">要在FTP服务器上面保存文件名</param>
''' <param name="OverWriteRemoteFile">是否覆盖远程服务器上面同名的文件</param>
Public Sub UploadFileAsync(ByVal LocalFullPath As String, ByVal RemoteFileName As String, ByVal OverWriteRemoteFile As Boolean)
Try
If Not IsValidFileChars(RemoteFileName) OrElse Not IsValidFileChars(Path.GetFileName(LocalFullPath)) OrElse Not IsValidPathChars(Path.GetDirectoryName(LocalFullPath)) Then
Throw New Exception("非法文件名或目录名!")
End If
If Not OverWriteRemoteFile AndAlso FileExist(RemoteFileName) Then
Throw New Exception("FTP服务上面已经存在同名文件！")
End If
If File.Exists(LocalFullPath) Then
Dim client As New MyWebClient()
AddHandler client.UploadProgressChanged, AddressOf client_UploadProgressChanged
AddHandler client.UploadFileCompleted, AddressOf client_UploadFileCompleted
client.Credentials = New NetworkCredential(Me.UserName, Me.Password)
If Me.Proxy IsNot Nothing Then
client.Proxy = Me.Proxy
End If
client.UploadFileAsync(New Uri(Me.Uri.ToString() + RemoteFileName), LocalFullPath)
Else
Throw New Exception("本地文件不存在!")
End If
Catch ep As Exception
ErrorMsg = ep.ToString()
Throw ep
End Try
End Sub
''' <summary>
''' 异步上传文件到FTP服务器
''' </summary>
''' <param name="FileBytes">上传的二进制数据</param>
''' <param name="RemoteFileName">要在FTP服务器上面保存文件名</param>
Public Sub UploadFileAsync(ByVal FileBytes As Byte(), ByVal RemoteFileName As String)
If Not IsValidFileChars(RemoteFileName) Then
Throw New Exception("非法文件名或目录名!")
End If
UploadFileAsync(FileBytes, RemoteFileName, False)
End Sub
''' <summary>
''' 异步上传文件到FTP服务器
''' </summary>
''' <param name="FileBytes">文件二进制内容</param>
''' <param name="RemoteFileName">要在FTP服务器上面保存文件名</param>
''' <param name="OverWriteRemoteFile">是否覆盖远程服务器上面同名的文件</param>
Public Sub UploadFileAsync(ByVal FileBytes As Byte(), ByVal RemoteFileName As String, ByVal OverWriteRemoteFile As Boolean)
Try
If Not IsValidFileChars(RemoteFileName) Then
Throw New Exception("非法文件名！")
End If
If Not OverWriteRemoteFile AndAlso FileExist(RemoteFileName) Then
Throw New Exception("FTP服务上面已经存在同名文件！")
End If
Dim TempPath As String = Environment.GetFolderPath(Environment.SpecialFolder.Templates)
If Not TempPath.EndsWith("/") Then
TempPath += "/"
End If
Dim TempFile As String = TempPath + Path.GetRandomFileName()
TempFile = Path.ChangeExtension(TempFile, Path.GetExtension(RemoteFileName))
Dim Stream As New FileStream(TempFile, FileMode.CreateNew, FileAccess.Write)
Stream.Write(FileBytes, 0, FileBytes.Length)
'注意，因为Int32的最大限制，最大上传文件只能是大约2G多一点
Stream.Flush()
Stream.Close()
Stream.Dispose()
_isDeleteTempFile = True
_UploadTempFile = TempFile
FileBytes = Nothing
UploadFileAsync(TempFile, RemoteFileName, OverWriteRemoteFile)
Catch ep As Exception
ErrorMsg = ep.ToString()
Throw ep
End Try
End Sub
''' <summary>
''' 异步上传文件完成之后触发的事件
''' </summary>
''' <param name="sender">下载对象</param>
''' <param name="e">数据信息对象</param>
Private Sub client_UploadFileCompleted(ByVal sender As Object, ByVal e As UploadFileCompletedEventArgs)
If _isDeleteTempFile Then
If File.Exists(_UploadTempFile) Then
File.SetAttributes(_UploadTempFile, FileAttributes.Normal)
File.Delete(_UploadTempFile)
End If
_isDeleteTempFile = False
End If
RaiseEvent UploadFileCompleted(sender, e)
End Sub
''' <summary>
''' 异步上传进度发生改变触发的事件
''' </summary>
''' <param name="sender">下载对象</param>
''' <param name="e">进度信息对象</param>
Private Sub client_UploadProgressChanged(ByVal sender As Object, ByVal e As UploadProgressChangedEventArgs)
RaiseEvent UploadProgressChanged(sender, e)
End Sub
#End Region
#Region "列出目录文件信息"
''' <summary>
''' 列出FTP服务器上面当前目录的所有文件和目录
''' </summary>
Public Function ListFilesAndDirectories() As FileStruct()
Response = Open(Me.Uri, WebRequestMethods.Ftp.ListDirectoryDetails)
Dim stream As New StreamReader(Response.GetResponseStream(), Encoding.[Default])
Dim Datastring As String = stream.ReadToEnd()
Dim list As FileStruct() = GetList(Datastring)
Return list
End Function
''' <summary>
''' 列出FTP服务器上面当前目录的所有文件
''' </summary>
Public Function ListFiles() As FileStruct()
Dim listAll As FileStruct() = ListFilesAndDirectories()
Dim listFile As New List(Of FileStruct)()
For Each file As FileStruct In listAll
If Not file.IsDirectory Then
listFile.Add(file)
End If
Next
Return listFile.ToArray()
End Function
''' <summary>
''' 列出FTP服务器上面当前目录的所有的目录
''' </summary>
Public Function ListDirectories() As FileStruct()
Dim listAll As FileStruct() = ListFilesAndDirectories()
Dim listDirectory As New List(Of FileStruct)()
For Each file As FileStruct In listAll
If file.IsDirectory Then
listDirectory.Add(file)
End If
Next
Return listDirectory.ToArray()
End Function
''' <summary>
''' 获得文件和目录列表
''' </summary>
''' <param name="datastring">FTP返回的列表字符信息</param>
Private Function GetList(ByVal datastring As String) As FileStruct()
Dim myListArray As New List(Of FileStruct)()
Dim dataRecords As String() = datastring.Split(ControlChars.Lf)
Dim _directoryListStyle As FileListStyle = GuessFileListStyle(dataRecords)
For Each s As String In dataRecords
If _directoryListStyle <> FileListStyle.Unknown AndAlso s <> "" Then
Dim f As New FileStruct()
f.Name = ".."
Select Case _directoryListStyle
Case FileListStyle.UnixStyle
f = ParseFileStructFromUnixStyleRecord(s)
Exit Select
Case FileListStyle.WindowsStyle
f = ParseFileStructFromWindowsStyleRecord(s)
Exit Select
End Select
If Not (f.Name = "." OrElse f.Name = "..") Then
myListArray.Add(f)
End If
End If
Next
Return myListArray.ToArray()
End Function
''' <summary>
''' 从Windows格式中返回文件信息
''' </summary>
''' <param name="Record">文件信息</param>
Private Function ParseFileStructFromWindowsStyleRecord(ByVal Record As String) As FileStruct
Dim f As New FileStruct()
Dim processstr As String = Record.Trim()
Dim dateStr As String = processstr.Substring(0, 8)
processstr = (processstr.Substring(8, processstr.Length - 8)).Trim()
Dim timeStr As String = processstr.Substring(0, 7)
processstr = (processstr.Substring(7, processstr.Length - 7)).Trim()
Dim myDTFI As DateTimeFormatInfo = New CultureInfo("en-US", False).DateTimeFormat
myDTFI.ShortTimePattern = "t"
f.CreateTime = DateTime.Parse((dateStr & " ") + timeStr, myDTFI)
If processstr.Substring(0, 5) = "<DIR>" Then
f.IsDirectory = True
processstr = (processstr.Substring(5, processstr.Length - 5)).Trim()
Else
Dim strs As String() = processstr.Split(New Char() {" "c}, StringSplitOptions.RemoveEmptyEntries)
' true);
processstr = strs(1)
f.IsDirectory = False
End If
f.Name = processstr
Return f
End Function
''' <summary>
''' 判断文件列表的方式Window方式还是Unix方式
''' </summary>
''' <param name="recordList">文件信息列表</param>
Private Function GuessFileListStyle(ByVal recordList As String()) As FileListStyle
For Each s As String In recordList
If s.Length > 10 AndAlso Regex.IsMatch(s.Substring(0, 10), "(-|d)(-|r)(-|w)(-|x)(-|r)(-|w)(-|x)(-|r)(-|w)(-|x)") Then
Return FileListStyle.UnixStyle
ElseIf s.Length > 8 AndAlso Regex.IsMatch(s.Substring(0, 8), "[0-9][0-9]-[0-9][0-9]-[0-9][0-9]") Then
Return FileListStyle.WindowsStyle
End If
Next
Return FileListStyle.Unknown
End Function
''' <summary>
''' 从Unix格式中返回文件信息
''' </summary>
''' <param name="Record">文件信息</param>
Private Function ParseFileStructFromUnixStyleRecord(ByVal Record As String) As FileStruct
Dim f As New FileStruct()
Dim processstr As String = Record.Trim()
f.Flags = processstr.Substring(0, 10)
f.IsDirectory = (f.Flags(0) = "d"c)
processstr = (processstr.Substring(11)).Trim()
_cutSubstringFromStringWithTrim(processstr, " "c, 0)
'跳过一部分
f.Owner = _cutSubstringFromStringWithTrim(processstr, " "c, 0)
f.Group = _cutSubstringFromStringWithTrim(processstr, " "c, 0)
_cutSubstringFromStringWithTrim(processstr, " "c, 0)
'跳过一部分
Dim yearOrTime As String = processstr.Split(New Char() {" "c}, StringSplitOptions.RemoveEmptyEntries)(2)
If yearOrTime.IndexOf(":") >= 0 Then
'time
processstr = processstr.Replace(yearOrTime, DateTime.Now.Year.ToString())
End If
f.CreateTime = DateTime.Parse(_cutSubstringFromStringWithTrim(processstr, " "c, 8))
f.Name = processstr
'最后就是名称
Return f
End Function
''' <summary>
''' 按照一定的规则进行字符串截取
''' </summary>
''' <param name="s">截取的字符串</param>
''' <param name="c">查找的字符</param>
''' <param name="startIndex">查找的位置</param>
Private Function _cutSubstringFromStringWithTrim(ByRef s As String, ByVal c As Char, ByVal startIndex As Integer) As String
Dim pos1 As Integer = s.IndexOf(c, startIndex)
Dim retString As String = s.Substring(0, pos1)
s = (s.Substring(pos1)).Trim()
Return retString
End Function
#End Region
#Region "目录或文件存在的判断"
''' <summary>
''' 判断当前目录下指定的子目录是否存在
''' </summary>
''' <param name="RemoteDirectoryName">指定的目录名</param>
Public Function DirectoryExist(ByVal RemoteDirectoryName As String) As Boolean
Try
If Not IsValidPathChars(RemoteDirectoryName) Then
Throw New Exception("目录名非法！")
End If
Dim listDir As FileStruct() = ListDirectories()
For Each dir As FileStruct In listDir
If dir.Name = RemoteDirectoryName Then
Return True
End If
Next
Return False
Catch ep As Exception
ErrorMsg = ep.ToString()
Throw ep
End Try
End Function
''' <summary>
''' 判断一个远程文件是否存在服务器当前目录下面
''' </summary>
''' <param name="RemoteFileName">远程文件名</param>
Public Function FileExist(ByVal RemoteFileName As String) As Boolean
Try
If Not IsValidFileChars(RemoteFileName) Then
Throw New Exception("文件名非法！")
End If
Dim listFile As FileStruct() = ListFiles()
For Each file As FileStruct In listFile
If file.Name = RemoteFileName Then
Return True
End If
Next
Return False
Catch ep As Exception
ErrorMsg = ep.ToString()
Throw ep
End Try
End Function
#End Region
#Region "删除文件"
''' <summary>
''' 从FTP服务器上面删除一个文件
''' </summary>
''' <param name="RemoteFileName">远程文件名</param>
Public Sub DeleteFile(ByVal RemoteFileName As String)
Try
If Not IsValidFileChars(RemoteFileName) Then
Throw New Exception("文件名非法！")
End If
Response = Open(New Uri(Me.Uri.ToString() + RemoteFileName), WebRequestMethods.Ftp.DeleteFile)
Catch ep As Exception
ErrorMsg = ep.ToString()
Throw ep
End Try
End Sub
#End Region
#Region "重命名文件"
''' <summary>
''' 更改一个文件的名称或一个目录的名称
''' </summary>
''' <param name="RemoteFileName">原始文件或目录名称</param>
''' <param name="NewFileName">新的文件或目录的名称</param>
Public Function ReName(ByVal RemoteFileName As String, ByVal NewFileName As String) As Boolean
Try
If Not IsValidFileChars(RemoteFileName) OrElse Not IsValidFileChars(NewFileName) Then
Throw New Exception("文件名非法！")
End If
If RemoteFileName = NewFileName Then
Return True
End If
If FileExist(RemoteFileName) Then
Request = OpenRequest(New Uri(Me.Uri.ToString() + RemoteFileName), WebRequestMethods.Ftp.Rename)
Request.RenameTo = NewFileName
Response = DirectCast(Request.GetResponse(), FtpWebResponse)
Else
Throw New Exception("文件在服务器上不存在！")
End If
Return True
Catch ep As Exception
ErrorMsg = ep.ToString()
Throw ep
End Try
End Function
#End Region
#Region "拷贝、移动文件"
''' <summary>
''' 把当前目录下面的一个文件拷贝到服务器上面另外的目录中，注意，拷贝文件之后，当前工作目录还是文件原来所在的目录
''' </summary>
''' <param name="RemoteFile">当前目录下的文件名</param>
''' <param name="DirectoryName">新目录名称。
''' 说明：如果新目录是当前目录的子目录，则直接指定子目录。如: SubDirectory1/SubDirectory2 ；
''' 如果新目录不是当前目录的子目录，则必须从根目录一级一级的指定。如： ./NewDirectory/SubDirectory1/SubDirectory2
''' </param>
''' <returns></returns>
Public Function CopyFileToAnotherDirectory(ByVal RemoteFile As String, ByVal DirectoryName As String) As Boolean
Dim CurrentWorkDir As String = Me.DirectoryPath
Try
Dim bt As Byte() = DownloadFile(RemoteFile)
GotoDirectory(DirectoryName)
Dim Success As Boolean = UploadFile(bt, RemoteFile, False)
Me.DirectoryPath = CurrentWorkDir
Return Success
Catch ep As Exception
Me.DirectoryPath = CurrentWorkDir
ErrorMsg = ep.ToString()
Throw ep
End Try
End Function
''' <summary>
''' 把当前目录下面的一个文件移动到服务器上面另外的目录中，注意，移动文件之后，当前工作目录还是文件原来所在的目录
''' </summary>
''' <param name="RemoteFile">当前目录下的文件名</param>
''' <param name="DirectoryName">新目录名称。
''' 说明：如果新目录是当前目录的子目录，则直接指定子目录。如: SubDirectory1/SubDirectory2 ；
''' 如果新目录不是当前目录的子目录，则必须从根目录一级一级的指定。如： ./NewDirectory/SubDirectory1/SubDirectory2
''' </param>
''' <returns></returns>
Public Function MoveFileToAnotherDirectory(ByVal RemoteFile As String, ByVal DirectoryName As String) As Boolean
Dim CurrentWorkDir As String = Me.DirectoryPath
Try
If DirectoryName = "" Then
Return False
End If
If Not DirectoryName.StartsWith("/") Then
DirectoryName = "/" & DirectoryName
End If
If Not DirectoryName.EndsWith("/") Then
DirectoryName += "/"
End If
Dim Success As Boolean = ReName(RemoteFile, DirectoryName + RemoteFile)
Me.DirectoryPath = CurrentWorkDir
Return Success
Catch ep As Exception
Me.DirectoryPath = CurrentWorkDir
ErrorMsg = ep.ToString()
Throw ep
End Try
End Function
#End Region
#Region "建立、删除子目录"
''' <summary>
''' 在FTP服务器上当前工作目录建立一个子目录
''' </summary>
''' <param name="DirectoryName">子目录名称</param>
Public Function MakeDirectory(ByVal DirectoryName As String) As Boolean
Try
If Not IsValidPathChars(DirectoryName) Then
Throw New Exception("目录名非法！")
End If
If DirectoryExist(DirectoryName) Then
Throw New Exception("服务器上面已经存在同名的文件名或目录名！")
End If
Response = Open(New Uri(Me.Uri.ToString() + DirectoryName), WebRequestMethods.Ftp.MakeDirectory)
Return True
Catch ep As Exception
ErrorMsg = ep.ToString()
Throw ep
End Try
End Function
''' <summary>
''' 从当前工作目录中删除一个子目录
''' </summary>
''' <param name="DirectoryName">子目录名称</param>
Public Function RemoveDirectory(ByVal DirectoryName As String) As Boolean
Try
If Not IsValidPathChars(DirectoryName) Then
Throw New Exception("目录名非法！")
End If
If Not DirectoryExist(DirectoryName) Then
Throw New Exception("服务器上面不存在指定的文件名或目录名！")
End If
Response = Open(New Uri(Me.Uri.ToString() + DirectoryName), WebRequestMethods.Ftp.RemoveDirectory)
Return True
Catch ep As Exception
ErrorMsg = ep.ToString()
Throw ep
End Try
End Function
#End Region
#Region "文件、目录名称有效性判断"
''' <summary>
''' 判断目录名中字符是否合法
''' </summary>
''' <param name="DirectoryName">目录名称</param>
Public Function IsValidPathChars(ByVal DirectoryName As String) As Boolean
Dim invalidPathChars As Char() = Path.GetInvalidPathChars()
Dim DirChar As Char() = DirectoryName.ToCharArray()
For Each C As Char In DirChar
If Array.BinarySearch(invalidPathChars, C) >= 0 Then
Return False
End If
Next
Return True
End Function
''' <summary>
''' 判断文件名中字符是否合法
''' </summary>
''' <param name="FileName">文件名称</param>
Public Function IsValidFileChars(ByVal FileName As String) As Boolean
Dim invalidFileChars As Char() = Path.GetInvalidFileNameChars()
Dim NameChar As Char() = FileName.ToCharArray()
For Each C As Char In NameChar
If Array.BinarySearch(invalidFileChars, C) >= 0 Then
Return False
End If
Next
Return True
End Function
#End Region
#Region "目录切换操作"
''' <summary>
''' 进入一个目录
''' </summary>
''' <param name="DirectoryName">
''' 新目录的名字。
''' 说明：如果新目录是当前目录的子目录，则直接指定子目录。如: SubDirectory1/SubDirectory2 ；
''' 如果新目录不是当前目录的子目录，则必须从根目录一级一级的指定。如： ./NewDirectory/SubDirectory1/SubDirectory2
''' </param>
Public Function GotoDirectory(ByVal DirectoryName As String) As Boolean
Dim CurrentWorkPath As String = Me.DirectoryPath
Try
DirectoryName = DirectoryName.Replace("/", "/")
Dim DirectoryNames As String() = DirectoryName.Split(New Char() {"/"c})
If DirectoryNames(0) = "." Then
Me.DirectoryPath = "/"
If DirectoryNames.Length = 1 Then
Return True
End If
Array.Clear(DirectoryNames, 0, 1)
End If
Dim Success As Boolean = False
For Each dir As String In DirectoryNames
If dir IsNot Nothing Then
Success = EnterOneSubDirectory(dir)
If Not Success Then
Me.DirectoryPath = CurrentWorkPath
Return False
End If
End If
Next
Return Success
Catch ep As Exception
Me.DirectoryPath = CurrentWorkPath
ErrorMsg = ep.ToString()
Throw ep
End Try
End Function
''' <summary>
''' 从当前工作目录进入一个子目录
''' </summary>
''' <param name="DirectoryName">子目录名称</param>
Private Function EnterOneSubDirectory(ByVal DirectoryName As String) As Boolean
Try
If DirectoryName.IndexOf("/") >= 0 OrElse Not IsValidPathChars(DirectoryName) Then
Throw New Exception("目录名非法!")
End If
If DirectoryName.Length > 0 AndAlso DirectoryExist(DirectoryName) Then
If Not DirectoryName.EndsWith("/") Then
DirectoryName += "/"
End If
_DirectoryPath += DirectoryName
Return True
Else
Return False
End If
Catch ep As Exception
ErrorMsg = ep.ToString()
Throw ep
End Try
End Function
''' <summary>
''' 从当前工作目录往上一级目录
''' </summary>
Public Function ComeoutDirectory() As Boolean
If _DirectoryPath = "/" Then
ErrorMsg = "当前目录已经是根目录！"
Throw New Exception("当前目录已经是根目录！")
End If
Dim sp As Char() = New Char(0) {"/"c}
Dim strDir As String() = _DirectoryPath.Split(sp, StringSplitOptions.RemoveEmptyEntries)
If strDir.Length = 1 Then
_DirectoryPath = "/"
Else
_DirectoryPath = [String].Join("/", strDir, 0, strDir.Length - 1)
End If
Return True
End Function
#End Region
#Region "重载WebClient，支持FTP进度"
Friend Class MyWebClient
Inherits WebClient
Protected Overloads Overrides Function GetWebRequest(ByVal address As Uri) As WebRequest
Dim req As FtpWebRequest = DirectCast(MyBase.GetWebRequest(address), FtpWebRequest)
req.UsePassive = False
Return req
End Function
End Class
#End Region
End Class
End Namespace
[/code]
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
