Option Explicit
Public Const MAX_PATH = 260 ' 是由MFC定義的不要更改
Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Public Const INTERNET_OPEN_TYPE_DIRECT = 1
Public Const INTERNET_OPEN_TYPE_PROXY = 3
Public Const INTERNET_INVALID_PORT_NUMBER = 0
Public Const INTERNET_FLAG_PASSIVE = &H8000000 ' 被動模式
Public Const INTERNET_FLAG_PORT = &O0 ' 主動模式
Public Const INTERNET_SERVICE_FTP = 1
Public Const INTERNET_SERVICE_GOPHER = 2
Public Const INTERNET_SERVICE_HTTP = 3
Public Const ERROR_NO_MORE_FILES = 18
Public Const FTP_TRANSFER_TYPE_ASCII = &H1
Public Const FTP_TRANSFER_TYPE_BINARY = &H1
Public Const INTERNET_FLAG_RELOAD = &H80000000
Public Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Public Const INTERNET_FLAG_MULTIPART = &H200000
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
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 * MAX_PATH
cAlternate As String * 16 ' 是由MFC定義的不要更改
End Type
' 連接和初始化
' **********************************************************************************************************
Public 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
Public 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
Public Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer
' Ftp目錄操作命令
' **********************************************************************************************************
Public Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" _
(ByVal hFtpSession As Long, lpszCurrentDirectory As String, ByRef lpdwCurrentDirectory As Long) As Boolean
Public Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String) As Boolean
Public Declare Function FtpCreateDirectory Lib "wininet.dll" Alias "FtpCreateDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Public Declare Function FtpRemoveDirectory Lib "wininet.dll" Alias "FtpRemoveDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
' Ftp文件操作命令
' **********************************************************************************************************
' 查找文件或目錄
Public 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
' 查找下一個文件或目錄
Public Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _
(ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long
' 下載文件
Public 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
' 上傳文件
Public 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
' 刪除文件
Public Declare Function FtpDeleteFile Lib "wininet.dll" _
Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, _
ByVal lpszFileName As String) As Boolean
' 文件改名
Public Declare Function FtpRenameFile Lib "wininet.dll" _
Alias "FtpRenameFileA" (ByVal hFtpSession As Long, _
ByVal lpszExisting As String, ByVal lpszNew As String) As Boolean
Public Sub main()
On Error GoTo Ftp_Err
Dim bActiveSession As Boolean ' 用於標記當前是否有活動會話
Dim hOpen As Long ' 用於保存當前會話的句柄
Dim hConnection As Long ' 用於保存活動連接的句柄
Dim EnumItemNameBag As New Collection ' 用於保存Ftp目錄結構
Dim EnumItemAttributeBag As New Collection
' 開始 FTP 會話。
hOpen = InternetOpen("VB Wininet", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
If hOpen = 0 Then
ErrorOut Err.LastDllError, "InternetOpen"
GoTo Exit_Sub
End If
' 連接到 FTP 服務器。
Dim strServer As String, strUser As String, strPassword As String
Dim nFlag As Long
strServer = "127.0.0.1"
strUser = "test"
strPassword = "test"
nFlag = INTERNET_FLAG_PASSIVE
hConnection = InternetConnect(hOpen, strServer, INTERNET_INVALID_PORT_NUMBER, _
strUser, strPassword, INTERNET_SERVICE_FTP, nFlag, 0)
If hConnection = 0 Then
ErrorOut Err.LastDllError, "InternetConnect"
GoTo Exit_Sub
End If
bActiveSession = True
' 更改爲服務器上新的 FTP 目錄。
Dim strRemoteFolder As String
Dim bRet As Boolean
strRemoteFolder = "/"
bRet = FtpSetCurrentDirectory(hConnection, strRemoteFolder)
If bRet = False Then
ErrorOut Err.LastDllError, "FtpPutFile"
GoTo Exit_Sub
End If
' 檢查目錄是否存在
Dim pData As WIN32_FIND_DATA
Dim hFind As Long, nLastError As Long
strRemoteFolder = "test"
pData.cFileName = String(MAX_PATH, 0)
hFind = FtpFindFirstFile(hConnection, strRemoteFolder, pData, 0, 0) ' 查找第一個文件或目錄
If hFind = 0 Then
' 沒有找到
Err.Clear
' 創建目錄
bRet = FtpCreateDirectory(hConnection, strRemoteFolder)
If bRet = False Then
ErrorOut Err.LastDllError, "FtpPutFile"
GoTo Exit_Sub
End If
Else
' 已經存在
End If
' 改變目錄
strRemoteFolder = "test" ' 使用相對目錄和絕對目錄都可以
bRet = FtpSetCurrentDirectory(hConnection, strRemoteFolder)
If bRet = False Then
ErrorOut Err.LastDllError, "FtpPutFile"
GoTo Exit_Sub
End If
strRemoteFolder = ".." ' 使用相對目錄和絕對目錄都可以
bRet = FtpSetCurrentDirectory(hConnection, strRemoteFolder)
If bRet = False Then
ErrorOut Err.LastDllError, "FtpPutFile"
GoTo Exit_Sub
End If
' 目錄改名
' Dim strNewFolder As String
' strNewFolder = "TTT"
' bRet = FtpRenameFile(hConnection, strRemoteFolder, strNewFolder)
' If bRet = False Then
' ErrorOut Err.LastDllError, "FtpRenameFile"
' GoTo Exit_Sub
' End If
' 刪除目錄
strRemoteFolder = "test"
bRet = FtpRemoveDirectory(hConnection, strRemoteFolder)
If bRet = False Then
ErrorOut Err.LastDllError, "FtpRemoveDirectory"
GoTo Exit_Sub
End If
' 獲取 FTP 當前目錄內容
Dim strItem As String
hFind = FtpFindFirstFile(hConnection, "", pData, 0, 0) ' 查找第一個文件或目錄
nLastError = Err.LastDllError ' 沒有錯誤返回0
If hFind = 0 Then
If (nLastError = ERROR_NO_MORE_FILES) Then
MsgBox "This directory is empty!"
Else
ErrorOut nLastError, "FtpFindFirstFile"
End If
GoTo Exit_Sub
End If
strItem = Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0)))
EnumItemNameBag.Add strItem
' 查找 FTP 目錄中的下一個文件。
If hFind <> 0 Then bRet = True
Do While bRet
bRet = InternetFindNextFile(hFind, pData)
If bRet Then
strItem = Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0)))
EnumItemNameBag.Add strItem
End If
Loop
' 上傳文件
Dim strFileLocal As String, strFileRemote As String, dwType As Long
dwType = FTP_TRANSFER_TYPE_ASCII
strFileLocal = "d:/ftpTest.rar"
strFileRemote = "ftpTest.rar"
bRet = FtpPutFile(hConnection, strFileLocal, strFileRemote, dwType, 0)
If bRet = False Then
ErrorOut Err.LastDllError, "FtpPutFile"
GoTo Exit_Sub
End If
' 下載文件
strFileLocal = "c:/ftpTest.rar"
strFileRemote = "ftpTest.rar"
bRet = FtpGetFile(hConnection, strFileRemote, strFileLocal, False, _
INTERNET_FLAG_RELOAD, dwType, 0)
If bRet = False Then
ErrorOut Err.LastDllError, "FtpGetFile"
GoTo Exit_Sub
End If
' 文件改名
Dim strNewFile As String
strNewFile = "TTT.rar"
bRet = FtpRenameFile(hConnection, strFileRemote, strNewFile)
If bRet = False Then
ErrorOut Err.LastDllError, "FtpRenameFile"
GoTo Exit_Sub
End If
' 刪除文件
bRet = FtpDeleteFile(hConnection, strNewFile)
If bRet = False Then
ErrorOut Err.LastDllError, "FtpRemoveDirectory"
GoTo Exit_Sub
End If
Exit_Sub:
' 結束 FTP 會話。
If hConnection <> 0 Then InternetCloseHandle hConnection
hConnection = 0
bActiveSession = False
Exit Sub
Ftp_Err:
MsgBox Err.LastDllError, vbCritical, "Test Ftp Client by WinInet.dll"
GoTo Exit_Sub
End Sub
Function ErrorOut(dError As Long, szCallFunction As String)
Dim strErrInf As String
Select Case dError
Case 12014
strErrInf = "用戶名或密碼錯"
Case 12007
strErrInf = ""
Case 12003
strErrInf = "目錄操作錯誤"
Case 12110
strErrInf = "文件不存在"
End Select
MsgBox "錯誤編號:" & Str(dError) & vbCrLf & vbCrLf & strErrInf & vbCrLf & vbCrLf & szCallFunction, vbCritical, "WinINet FTP Client"
Err.Clear
End Function