WinInet.DLLを使用してFTPのGET（ダウンロード）とPUT（アップロード）を実現させるサンプルです。
'----------------------------------------------------------
' FTP GET
'----------------------------------------------------------
Function FtpGet(strFtpSvr As String, strUserID As String, strPassword As String, strRemoteFile As String, strLocalFile As String) As Boolean
Dim hInternet As Long
Dim hFTP As Long
Dim lngret As Long
Dim strErrText As String
FtpGet = True
On Error GoTo ErrHandler
hInternet = InternetOpen(vbNullString, _
INTERNET_OPEN_TYPE_PRECONFIG, _
vbNullString, _
vbNullString, _
0&)
If hInternet = 0 Then
strErrText = "InternetOpen:GetLastError=" & Err.LastDllError()
MsgBox strErrText, vbOKOnly + vbExclamation, App.Title & "<FtpGet>"
FtpGet = False
Exit Function
End If
hFTP = InternetConnect(hInternet, _
strFtpSvr, _
INTERNET_DEFAULT_FTP_PORT, _
strUserID, _
strPassword, _
INTERNET_SERVICE_FTP, _
0&, _
0&)
If hFTP = 0 Then
strErrText = "InternetConnect:GetLastError=" & Err.LastDllError()
MsgBox strErrText, vbOKOnly + vbExclamation, App.Title & "<FtpGet>"
FtpGet = False
Exit Function
End If
lngret = FtpGetFile(hFTP, _
strRemoteFile & vbNullChar, _
strLocalFile & vbNullChar, _
1&, _
0&, _
FTP_TRANSFER_TYPE_BINARY, _
0&)
lngret = InternetCloseHandle(hFTP)
lngret = InternetCloseHandle(hInternet)
Exit Function
ErrHandler:
FtpGet = False
MsgBox "<" & Err & ">" & Error(Err), vbOKOnly + vbExclamation, App.Title & "<FtpGet>"
End Function
'----------------------------------------------------------
' FTP PUT
'----------------------------------------------------------
Function FtpPut(strFtpSvr As String, strUserID As String, strPassword As String, strRemoteFile As String, strLocalFile As String) As Boolean
Dim hInternet As Long
Dim hFTP As Long
Dim lngret As Long
Dim strErrText As String
FtpPut = True
On Error GoTo ErrHandler
hInternet = InternetOpen(vbNullString, _
INTERNET_OPEN_TYPE_PRECONFIG, _
vbNullString, _
vbNullString, _
0&)
If hInternet = 0 Then
strErrText = "InternetOpen:GetLastError=" & Err.LastDllError()
MsgBox strErrText, vbOKOnly + vbExclamation, App.Title & "<FtpPut>"
FtpPut = False
Exit Function
End If
hFTP = InternetConnect(hInternet, _
strFtpSvr, _
INTERNET_DEFAULT_FTP_PORT, _
strUserID, _
strPassword, _
INTERNET_SERVICE_FTP, _
0&, _
0&)
If hFTP = 0 Then
strErrText = "InternetConnect:GetLastError=" & Err.LastDllError()
MsgBox strErrText, vbOKOnly + vbExclamation, App.Title & "<FtpPut>"
FtpPut = False
Exit Function
End If
lngret = FtpPutFile(hFTP, _
strLocalFile & vbNullChar, _
strRemoteFile & vbNullChar, _
FTP_TRANSFER_TYPE_BINARY, _
0&)
lngret = InternetCloseHandle(hFTP)
lngret = InternetCloseHandle(hInternet)
Exit Function
ErrHandler:
FtpPut = False
MsgBox "<" & Err & ">" & Error(Err), vbOKOnly + vbExclamation, App.Title & "<FtpPut>"
End Function
'-------------------------------------------------------
' Module
'-------------------------------------------------------
'API定数宣言
Public Const INTERNET_OPEN_TYPE_PRECONFIG As Long = 0& 'IEの設定に従い接続
Public Const INTERNET_OPEN_TYPE_DIRECT As Long = 1& '直接接続
Public Const INTERNET_OPEN_TYPE_PROXY As Long = 3& 'Proxy経由接続
Public Const INTERNET_DEFAULT_FTP_PORT As Long = 21& 'RFCで既定されたftpポート
Public Const INTERNET_DEFAULT_HTTP_PORT As Long = 80& 'RFCで既定されたhttpポート
Public Const INTERNET_DEFAULT_HTTPS_PORT As Long = 443& 'RFCで既定されたhttpsポート
Public Const INTERNET_SERVICE_FTP As Long = 1& 'ftpを指定
Public Const INTERNET_SERVICE_HTTP As Long = 3& 'http/httpsを指定
Public Const INTERNET_FLAG_PASSIVE As Long = &H8000000
Public Const INTERNET_FLAG_RELOAD As Long = &H80000000 'キャシュを使わない
Public Const FTP_TRANSFER_TYPE_ASCII As Long = &H1& 'Asciiモードで転送
Public Const FTP_TRANSFER_TYPE_BINARY As Long = &H2& 'Binaryモードで転送
'API宣言
Public Declare Function InternetOpen Lib "WinInet.DLL" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
Public Declare Function InternetConnect Lib "WinInet.DLL" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal lpszServerName As String, ByVal nServerPort As Long, ByVal lpszUserName As String, ByVal lpszPassword As String, ByVal dwService As Long, ByVal dwFlags As Long, ByVal dwContext As Long) 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 Long, ByVal dwLocalFlagsAndAttributes As Long, ByVal dwInternetFlags As Long, ByVal dwContext As Long) As Long
Public Declare Function FtpPutFile Lib "WinInet.DLL" Alias "FtpPutFileA" (ByVal hFtpSession As Long, ByVal lpszLocalFile As String, ByVal lpszNewRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Public Declare Function InternetCloseHandle Lib "WinInet.DLL" (ByVal hInternetSession As Long) As Long
Public Declare Function InternetGetLastResponseInfo Lib "WinInet.DLL" Alias "InternetGetLastResponseInfoA" (lpdwError As Long, lpszBuffer As Byte, lpdwBufferLength As Long) As Long
DownLoad vbtips103.lzh 3KB (VB6.0)