VB FTP操作类(可上传、下载、创建文件夹等等)

最新推荐文章于 2024-05-11 00:23:23 发布

miaozk2006

最新推荐文章于 2024-05-11 00:23:23 发布

阅读量1.7k

点赞数

本文链接：https://blog.csdn.net/miaozk2006/article/details/82416999

版权

可实现FTP上传下载,建文件夹等功能,从网上找了一个类,对其进行修改和功能补充,正常使用,非常方便.

切记在使用FtpFindFirstFile 函数查找相应的文件或文件夹后,要使用InternetCloseHandle关闭查找的句柄,否则再次查找的话,会查找不到任何信息.

代码另存为FTP.cls 代码

Option Explicit
'Copyright Graham Daly December 2001

' ---------------------------------------------------------
' ------------------- API Functions --------------------
' ---------------------------------------------------------

'File time information
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

'File information
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 260
cAlternate As String * 14
End Type

'Wininet.dll API's
Private Declare Function FtpFindFirstFile& Lib "wininet.dll" _
Alias "FtpFindFirstFileA" _
(ByVal hOutboundSession&, _
ByVal lpszSearchFile$, _
lpFindFileData As WIN32_FIND_DATA, _
ByVal dwFlags&, _
ByVal dwContent&)

Private Declare Function InternetFindNextFile& Lib "wininet.dll" _
Alias "InternetFindNextFileA" _
(ByVal hFind&, _
lpvFindData As WIN32_FIND_DATA)

Private Declare Function FtpGetFile Lib "wininet.dll" _
Alias "FtpGetFileA" _
(ByVal hOutboundSession&, _
ByVal lpszRemoteFile$, _
ByVal lpszNewFile$, _
ByVal fFailIfExists As Boolean, _
ByVal dwFlagsAndAttributes&, _
ByVal dwFlags&, _
ByVal dwContext&) As Boolean

Private Declare Function FtpPutFile Lib "wininet.dll" _
Alias "FtpPutFileA" _
(ByVal hOutboundSession&, _
ByVal lpszLocalFile$, _
ByVal lpszRemoteFile$, _
ByVal dwFlags&, _
ByVal dwContext&) As Boolean

Private Declare Function FtpRenameFile Lib "wininet.dll" _
Alias "FtpRenameFileA" _
(ByVal hOutboundSession&, _
ByVal sExistingName$, _
ByVal sNewName$) As Boolean

Private Declare Function FtpDeleteFile Lib "wininet.dll" _
Alias "FtpDeleteFileA" _
(ByVal hOutboundSession&, _
ByVal lpszFileName$) As Boolean

Private Declare Function FtpGetCurrentDirectory& Lib "wininet.dll" _
Alias "FtpGetCurrentDirectoryA" _
(ByVal hConnect&, _
ByVal lpszCurrentDirectory$, _
lpdwCurrentDirectory&)

Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" _
Alias "FtpSetCurrentDirectoryA" _
(ByVal hOutboundSession&, _
ByVal lpszDirectory$) As Boolean

Private Declare Function InternetConnect& Lib "wininet.dll" _
Alias "InternetConnectA" _
(ByVal hInternetSession&, _
ByVal sServerName$, _
ByVal nServerPort%, _
ByVal sUsername$, _
ByVal sPassword$, _
ByVal lService&, _
ByVal lFlags&, _
ByVal lContext&)

Private Declare Function FtpCreateDirectory Lib "wininet.dll" _
Alias "FtpCreateDirectoryA" _
(ByVal hFtpSession&, _
ByVal lpszDirectory$) As Boolean

Private Declare Function InternetOpen& Lib "wininet.dll" _
Alias "InternetOpenA" _
(ByVal sAgent$, _
ByVal lAccessType&, _
ByVal sProxyName$, _
ByVal sProxyBypass$, _
ByVal lFlags&)

Private Declare Function InternetCloseHandle& Lib "wininet.dll" _
(ByVal hInet&)

Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" _
Alias "InternetGetLastResponseInfoA" _
(lpdwError&, _
ByVal lpszBuffer$, _
lpdwBufferLength&) As Boolean

' ---------------------------------------------------------
' ---------------- Module-level Constants -----------------
' ---------------------------------------------------------

Private Const FAILURE& = 0
Private Const SUCCESS& = 1

'Error messages
Private Const ERR_CHANGE_DIR$ = "Cannot change directory to <%s>. It either doesn't exist, or is protected"
Private Const ERR_CONNECT_ERROR$ = "Cannot connect to FTP server <%s> using User and Password Parameters"
Private Const ERR_ALREADY_CONNECTED$ = "Cannot change property while connected to FTP server"
Private Const ERR_NO_CONNECTION$ = "Cannot connect to FTP server"
Private Const ERR_DOWNLOAD$ = "Cannot get file <%s> from FTP server"
Private Const ERR_RENAME$ = "Cannot rename file <%s>"
Private Const ERR_DELETE$ = "Cannot delete file <%s> from FTP server"
Private Const ERR_CRITICAL$ = "Cannot get connection to WinInet.dll!"
Private Const ERR_CREATEDIRECOTRY$ = "Cannot CreateDirectory <%s> to FTP server"

'Type of service to access
Private Const INTERNET_SERVICE_FTP = 1

'Flags
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Private Const INTERNET_FLAG_MULTIPART = &H200000
Private Const INTERNET_FLAG_PASSIVE = &H8000000
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Private Const INTERNET_FLAG_EXISTING_CONNECT = &H20000000

'File Transfer modes
Private Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Private Const FTP_TRANSFER_TYPE_ASCII = &H1
Private Const FTP_TRANSFER_TYPE_BINARY = &H2

'Other
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INET_SESSION_NAME$ = "ICB FTP Sesh"
Private Const ERROR_INTERNET_EXTENDED_ERROR = 12003
Private Const NO_CONNECTION& = FAILURE&
Private Const FWDSLASH$ = "/"
Private Const BACKSLASH$ = "\"

' ---------------------------------------------------------
' ---------------- Module-level Variables -----------------
' ---------------------------------------------------------

'Our INET handle
Private m_hInet&

'Our FTP connection Handle
Private m_hSession&

'Standard FTP properties
Private m_HostAddr$
Private m_HostPort&
Private m_User$
Private m_Password$
Private m_Dir$

' ---------------------------------------------------------
' ------------------ User-defined Types -------------------
' ---------------------------------------------------------

Public Enum FtpError
ERR_CANNOT_CONNECT = vbObjectError + 2001
ERR_NO_DIR_CHANGE = vbObjectError + 2002
ERR_CANNOT_RENAME = vbObjectError + 2003
ERR_CANNOT_DELETE = vbObjectError + 2004
ERR_NOT_CONNECTED_TO_SITE = vbObjectError + 2005
ERR_CANNOT_GET_FILE = vbObjectError + 2006
ERR_INVALID_PROPERTY = vbObjectError + 2007
ERR_FATAL = vbObjectError + 2008
ERR_CANNNOT_CREATEDIRECTORY = vbObjectError + 2009
End Enum

'File Transfer types
Public Enum FileTransferType
fttUnknown = FTP_TRANSFER_TYPE_UNKNOWN
fttAscii = FTP_TRANSFER_TYPE_ASCII
fttBinary = FTP_TRANSFER_TYPE_BINARY
End Enum
'________________________________________________________________________

Private Sub Class_Initialize()

'Initialise variables
m_hSession& = NO_CONNECTION&
m_hInet& = NO_CONNECTION&
m_HostAddr$ = vbNullString
m_HostPort& = FAILURE&
m_User$ = vbNullString
m_Password$ = vbNullString
m_Dir$ = vbNullString

End Sub
'________________________________________________________________________

Private Sub Class_Terminate()

'Kill off connection
If m_hSession& Then InternetCloseHandle m_hSession&

'Kill off API Handle
If m_hInet& Then InternetCloseHandle m_hInet&

m_hSession& = NO_CONNECTION&
m_hInet& = NO_CONNECTION&

End Sub
'________________________________________________________________________

' ---------------------------------------------------------
' ------------------- Class Properties --------------------
' ---------------------------------------------------------

Public Property Let Host(ByVal HostAddr$)
'Set the host address - only if un-connected

If m_hSession& = NO_CONNECTION& Then
m_HostAddr$ = HostAddr$
Else
Err.Raise ERR_INVALID_PROPERTY, "clsFTP:Host [Let]", ERR_ALREADY_CONNECTED$
End If