??? 又有幾天沒發新貼了，剛才有點閑瑕，便隨手寫了一個使用FTP上傳和下載文件的類。

??? 類代碼如下：

Option Explicit'* ******************************************************* * '* 模塊名稱：FTP.cls '* 模塊功能：使用wininet API進行FTP操作 '* 作者：lyserver '* 聯系方式：http://blog.csdn.net/lyserver '* ******************************************************* * Private Type WIN32_FIND_DATAdwFileAttributes As LongftCreationTime(1) As LongftLastAccessTime(1) As LongftLastWriteTime(1) As LongnFileSizeHigh As LongnFileSizeLow As LongdwReserved0 As LongdwReserved1 As LongcFileName As String * 260cAlternate As String * 14 End Type Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUsername As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer Private Declare Function FtpCreateDirectory Lib "wininet.dll" Alias "FtpCreateDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String) As Boolean Private Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String, lpdwCurrentDirectory As Long) As Boolean Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" (ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hFtpSession As Long, ByVal lpszLocalFile As String, ByVal lpszRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean Private Declare Function FtpRemoveDirectory Lib "wininet.dll" Alias "FtpRemoveDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Long Private Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" (ByVal hFtpSession As Long, ByVal lpszExisting As String, ByVal lpszNew As String) As Boolean Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" (ByVal hFtpSession As Long, ByVal lpszSearchFile As String, lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As Long Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long Private Declare Function InternetGetConnectedState Lib "wininet.dll" (lpdwFlags As Long, ByVal dwReserved As Long) As Long Private Declare Function GetLastError Lib "kernel32" () As Long Private Const INTERNET_OPEN_TYPE_DIRECT = 1 Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000 Private Const INTERNET_FLAG_PASSIVE = &H8000000 Private Const INTERNET_FLAG_ASYNC = &H10000000 Private Const INTERNET_FLAG_EXISTING_CONNECT = &H20000000 Private Const INTERNET_FLAG_RELOAD = &H80000000 Private Const INTERNET_SERVICE_FTP = 1 Private Const INTERNET_SERVICE_HTTP = 3 Private Const INTERNET_CONNECTION_MODEM = &H1 Private Const INTERNET_CONNECTION_LAN = &H2 Private Const INTERNET_CONNECTION_PROXY = &H4 Private Const FTP_TRANSFER_TYPE_ASCII = 1 Private Const FTP_TRANSFER_TYPE_BINARY = 2 Private Const ERROR_NO_MORE_FILES = 18& Private Const ERROR_INTERNET_EXTENDED_ERROR = 12003 Private Type SYSTEMTIMEwYear As IntegerwMonth As IntegerwDayOfWeek As IntegerwDay As IntegerwHour As IntegerwMinute As IntegerwSecond As IntegerwMilliseconds As Integer End Type Private Declare Function FileTimeToSystemTime Lib "kernel32" (ByRef lpFileTime As Long, lpSystemTime As SYSTEMTIME) As LongPublic Event EnumFileProc(FileName As String, Attr As VbFileAttribute, Size As Long, Create As String, Modify As String, Cancel As Boolean)Dim m_hInternet As Long, m_hConnect As Long, m_Cancel As BooleanPrivate Sub Class_Initialize()m_hInternet = InternetOpen("FTP Appliction", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, INTERNET_FLAG_NO_CACHE_WRITE) End SubPrivate Sub Class_Terminate()If m_hConnect <> 0 Then InternetCloseHandle m_hConnectInternetCloseHandle m_hInternet End SubPublic Function Login(Server As String, Optional Port As Integer = 21, Optional UserName As String = "anonymous", Optional Password = "") As BooleanIf m_hInternet = 0 Then Exit FunctionIf m_hConnect <> 0 Then Logoutm_hConnect = InternetConnect(m_hInternet, Server, Port, UserName, Password, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE Or INTERNET_FLAG_EXISTING_CONNECT, 0)Login = (m_hConnect <> 0) End FunctionPublic Function Logout() As BooleanIf m_hConnect <> 0 ThenInternetCloseHandle m_hConnectm_hConnect = 0Logout = TrueEnd If End FunctionPublic Function GetDirectory() As StringDim strPath As String, nLen As LongIf m_hConnect = 0 Then Exit FunctionnLen = 260strPath = String(nLen, vbNullChar)FtpGetCurrentDirectory m_hConnect, strPath, nLenGetDirectory = Left(strPath, InStr(strPath, vbNullChar) - 1) End FunctionPublic Function SetDirectory(ByVal FtpPath As String) As BooleanIf m_hConnect = 0 Then Exit FunctionFtpSetCurrentDirectory m_hConnect, FtpPathSetDirectory = (GetLastError <> ERROR_INTERNET_EXTENDED_ERROR) End FunctionPublic Function CreateDirectory(ByVal FtpPath As String) As BooleanFtpCreateDirectory m_hConnect, FtpPathCreateDirectory = (GetLastError <> ERROR_INTERNET_EXTENDED_ERROR) End FunctionPublic Function DeleteDirectory(ByVal FtpPath As String) As BooleanFtpRemoveDirectory m_hConnect, FtpPathDeleteDirectory = (GetLastError <> ERROR_INTERNET_EXTENDED_ERROR) End FunctionPublic Sub EnumFile(ByVal strPath As String, Optional ByVal LookInSubPath As Boolean)Static strOldPath As StringDim wfd As WIN32_FIND_DATADim hFind As Long, i As LongDim strFile As String, strSubPath As VariantDim CreateTime As String, ModifyTime As String, SysTm As SYSTEMTIMEstrPath = Replace(strPath, "/", "/")If Right(strPath, 1) <> "/" Then strPath = strPath & "/"hFind = FtpFindFirstFile(m_hConnect, strPath, wfd, INTERNET_FLAG_RELOAD, 0)Do While GetLastError() <> ERROR_NO_MORE_FILESstrFile = strPath & Left(wfd.cFileName, InStr(wfd.cFileName, vbNullChar) - 1)FileTimeToSystemTime wfd.ftCreationTime(0), SysTmCreateTime = DateSerial(SysTm.wYear, SysTm.wMonth, SysTm.wDay) & " " & TimeSerial(SysTm.wHour, SysTm.wMinute, SysTm.wSecond)FileTimeToSystemTime wfd.ftLastWriteTime(0), SysTmModifyTime = DateSerial(SysTm.wYear, SysTm.wMonth, SysTm.wDay) & " " & TimeSerial(SysTm.wHour, SysTm.wMinute, SysTm.wSecond)If (wfd.dwFileAttributes Or vbDirectory) = wfd.dwFileAttributes ThenRaiseEvent EnumFileProc(strFile, wfd.dwFileAttributes, -1, CreateTime, ModifyTime, m_Cancel)If LookInSubPath Then strSubPath = strSubPath & strFile & vbNullCharElseRaiseEvent EnumFileProc(strFile, wfd.dwFileAttributes, wfd.nFileSizeLow, CreateTime, ModifyTime, m_Cancel)End IfIf InternetFindNextFile(hFind, wfd) = 0 Or m_Cancel Then Exit DoLoopInternetCloseHandle hFindIf LookInSubPath = False Or Len(strPath) = 0 Then Exit SubstrSubPath = Split(strSubPath, vbNullChar)For i = 0 To UBound(strSubPath) - 1EnumFile strSubPath(i), TrueNext End SubPublic Function Rename(ByVal FtpOldName As String, ByVal FtpNewName As String) As BooleanFtpRenameFile m_hConnect, FtpOldName, FtpNewNameRename = (GetLastError <> ERROR_INTERNET_EXTENDED_ERROR) End FunctionPublic Function DeleteFile(ByVal FtpFile As String) As BooleanFtpDeleteFile m_hConnect, FtpFileDeleteFile = (GetLastError <> ERROR_INTERNET_EXTENDED_ERROR) End FunctionPublic Function UpFile(ByVal LocalFile As String, Optional ByVal FtpFile As String) As BooleanIf m_hConnect = 0 Then Exit FunctionIf Len(Dir(LocalFile)) = 0 Or Left(Dir(LocalFile), 1) = "." Then Exit FunctionIf Len(FtpFile) = 0 ThenIf InStr(LocalFile, "/") = 0 ThenFtpFile = LocalFileElseFtpFile = StrReverse(LocalFile)FtpFile = StrReverse(Left(FtpFile, InStr(FtpFile, "/") - 1))End IfEnd IfFtpPutFile m_hConnect, LocalFile, FtpFile, 1, 0UpFile = (GetLastError <> ERROR_INTERNET_EXTENDED_ERROR) End FunctionPublic Function DownFile(ByVal FtpFile As String, Optional ByVal LocalFile As String) As BooleanIf m_hConnect = 0 Then Exit FunctionIf Len(LocalFile) = 0 ThenIf InStr(FtpFile, "/") = 0 ThenLocalFile = FtpFileElseLocalFile = StrReverse(FtpFile)LocalFile = StrReverse(Left(LocalFile, InStr(LocalFile, "/") - 1))End IfEnd IfFtpGetFile m_hConnect, FtpFile, LocalFile, False, FILE_ATTRIBUTE_ARCHIVE, FTP_TRANSFER_TYPE_BINARY, 0DownFile = (GetLastError <> ERROR_INTERNET_EXTENDED_ERROR) End Function

??? 調用代碼如下：

Option ExplicitDim WithEvents objFtpClient As Ftp Private Sub Form_Load()Dim i As Long, s() As StringSet objFtpClient = New FtpobjFtpClient.Login "123.8.254.101"objFtpClient.EnumFile "/", True End SubPrivate Sub Form_Unload(Cancel As Integer)objFtpClient.LogoutSet objFtpClient = Nothing End SubPrivate Sub objFtpClient_EnumFileProc(FileName As String, Attr As VbFileAttribute, Size As Long, Create As String, Modify As String, Cancel As Boolean)If (Attr Or vbDirectory) = Attr ThenDebug.Print Format(Modify, "yyyy-mm-dd hh:nn:ss"), "<DIR>", , FileNameElseDebug.Print Format(Modify, "yyyy-mm-dd hh:nn:ss"), , Size, FileNameEnd If End Sub

總結

以上是生活随笔為你收集整理的使用API进行FTP文件上传和下载的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。