Created
July 26, 2016 17:47
-
-
Save drewchapin/b1f80934fa8ce8bcd03668eec95be191 to your computer and use it in GitHub Desktop.
VB6 Class Module for FTP access.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
'' dcftp - Visual BASIC FTP class module based on WinInet API | |
'' | |
'' Author: Drew Chapin | |
'' Date: 2012-10-29 | |
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
Option Explicit | |
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
' WinInet API - Constants | |
Private Const MAX_PATH = 260 | |
Private Const NO_ERROR = 0 | |
Private Const FILE_ATTRIBUTE_READONLY = &H1 | |
Private Const FILE_ATTRIBUTE_HIDDEN = &H2 | |
Private Const FILE_ATTRIBUTE_SYSTEM = &H4 | |
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10 | |
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20 | |
Private Const FILE_ATTRIBUTE_NORMAL = &H80 | |
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100 | |
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800 | |
Private Const FILE_ATTRIBUTE_OFFLINE = &H1000 | |
Private Const FTP_TRANSFER_TYPE_ASCII = &H1 | |
Private Const FTP_TRANSFER_TYPE_BINARY = &H2 | |
Private Const ERROR_NO_MORE_FILES = 18 | |
Private Const INTERNET_FLAG_PASSIVE = &H8000000 | |
Private Const INTERNET_FLAG_ASYNC = &H10000000 | |
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0 | |
Private Const INTERNET_OPEN_TYPE_DIRECT = 1 | |
Private Const INTERNET_OPEN_TYPE_PROXY = 3 | |
Private Const INTERNET_INVALID_PORT_NUMBER = 0 | |
Private Const INTERNET_DEFAULT_FTP_PORT = 21 | |
Private Const INTERNET_OPTION_CONNECT_TIMEOUT = 2 | |
Private Const INTERNET_OPTION_RECEIVE_TIMEOUT = 6 | |
Private Const INTERNET_OPTION_SEND_TIMEOUT = 5 | |
Private Const INTERNET_OPTION_USERNAME = 28 | |
Private Const INTERNET_OPTION_PASSWORD = 29 | |
Private Const INTERNET_OPTION_PROXY_USERNAME = 43 | |
Private Const INTERNET_OPTION_PROXY_PASSWORD = 44 | |
Private Const INTERNET_SERVICE_FTP = 1 | |
Private Const INTERNET_FLAG_TRANSFER_BINARY = FTP_TRANSFER_TYPE_BINARY | |
Private Const GENERIC_READ = &H80000000 | |
Private Const GENERIC_WRITE = &H40000000 | |
Private Const INTERNET_ERROR_BASE = 12000 | |
Private Const ERROR_INTERNET_OUT_OF_HANDLES = (INTERNET_ERROR_BASE + 1) | |
Private Const ERROR_INTERNET_TIMEOUT = (INTERNET_ERROR_BASE + 2) | |
Private Const ERROR_INTERNET_EXTENDED_ERROR = (INTERNET_ERROR_BASE + 3) | |
Private Const ERROR_INTERNET_INTERNAL_ERROR = (INTERNET_ERROR_BASE + 4) | |
Private Const ERROR_INTERNET_INVALID_URL = (INTERNET_ERROR_BASE + 5) | |
Private Const ERROR_INTERNET_UNRECOGNIZED_SCHEME = (INTERNET_ERROR_BASE + 6) | |
Private Const ERROR_INTERNET_NAME_NOT_RESOLVED = (INTERNET_ERROR_BASE + 7) | |
Private Const ERROR_INTERNET_PROTOCOL_NOT_FOUND = (INTERNET_ERROR_BASE + 8) | |
Private Const ERROR_INTERNET_INVALID_OPTION = (INTERNET_ERROR_BASE + 9) | |
Private Const ERROR_INTERNET_BAD_OPTION_LENGTH = (INTERNET_ERROR_BASE + 10) | |
Private Const ERROR_INTERNET_OPTION_NOT_SETTABLE = (INTERNET_ERROR_BASE + 11) | |
Private Const ERROR_INTERNET_SHUTDOWN = (INTERNET_ERROR_BASE + 12) | |
Private Const ERROR_INTERNET_INCORRECT_USER_NAME = (INTERNET_ERROR_BASE + 13) | |
Private Const ERROR_INTERNET_INCORRECT_PASSWORD = (INTERNET_ERROR_BASE + 14) | |
Private Const ERROR_INTERNET_LOGIN_FAILURE = (INTERNET_ERROR_BASE + 15) | |
Private Const ERROR_INTERNET_INVALID_OPERATION = (INTERNET_ERROR_BASE + 16) | |
Private Const ERROR_INTERNET_OPERATION_CANCELLED = (INTERNET_ERROR_BASE + 17) | |
Private Const ERROR_INTERNET_INCORRECT_HANDLE_TYPE = (INTERNET_ERROR_BASE + 18) | |
Private Const ERROR_INTERNET_INCORRECT_HANDLE_STATE = (INTERNET_ERROR_BASE + 19) | |
Private Const ERROR_INTERNET_NOT_PROXY_REQUEST = (INTERNET_ERROR_BASE + 20) | |
Private Const ERROR_INTERNET_REGISTRY_VALUE_NOT_FOUND = (INTERNET_ERROR_BASE + 21) | |
Private Const ERROR_INTERNET_BAD_REGISTRY_PARAMETER = (INTERNET_ERROR_BASE + 22) | |
Private Const ERROR_INTERNET_NO_DIRECT_ACCESS = (INTERNET_ERROR_BASE + 23) | |
Private Const ERROR_INTERNET_NO_CONTEXT = (INTERNET_ERROR_BASE + 24) | |
Private Const ERROR_INTERNET_NO_CALLBACK = (INTERNET_ERROR_BASE + 25) | |
Private Const ERROR_INTERNET_REQUEST_PENDING = (INTERNET_ERROR_BASE + 26) | |
Private Const ERROR_INTERNET_INCORRECT_FORMAT = (INTERNET_ERROR_BASE + 27) | |
Private Const ERROR_INTERNET_ITEM_NOT_FOUND = (INTERNET_ERROR_BASE + 28) | |
Private Const ERROR_INTERNET_CANNOT_CONNECT = (INTERNET_ERROR_BASE + 29) | |
Private Const ERROR_INTERNET_CONNECTION_ABORTED = (INTERNET_ERROR_BASE + 30) | |
Private Const ERROR_INTERNET_CONNECTION_RESET = (INTERNET_ERROR_BASE + 31) | |
Private Const ERROR_INTERNET_FORCE_RETRY = (INTERNET_ERROR_BASE + 32) | |
Private Const ERROR_INTERNET_INVALID_PROXY_REQUEST = (INTERNET_ERROR_BASE + 33) | |
Private Const ERROR_INTERNET_NEED_UI = (INTERNET_ERROR_BASE + 34) | |
Private Const ERROR_INTERNET_HANDLE_EXISTS = (INTERNET_ERROR_BASE + 36) | |
Private Const ERROR_INTERNET_SEC_CERT_DATE_INVALID = (INTERNET_ERROR_BASE + 37) | |
Private Const ERROR_INTERNET_SEC_CERT_CN_INVALID = (INTERNET_ERROR_BASE + 38) | |
Private Const ERROR_INTERNET_HTTP_TO_HTTPS_ON_REDIR = (INTERNET_ERROR_BASE + 39) | |
Private Const ERROR_INTERNET_HTTPS_TO_HTTP_ON_REDIR = (INTERNET_ERROR_BASE + 40) | |
Private Const ERROR_INTERNET_MIXED_SECURITY = (INTERNET_ERROR_BASE + 41) | |
Private Const ERROR_INTERNET_CHG_POST_IS_NON_SECURE = (INTERNET_ERROR_BASE + 42) | |
Private Const ERROR_INTERNET_POST_IS_NON_SECURE = (INTERNET_ERROR_BASE + 43) | |
Private Const ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED = (INTERNET_ERROR_BASE + 44) | |
Private Const ERROR_INTERNET_INVALID_CA = (INTERNET_ERROR_BASE + 45) | |
Private Const ERROR_INTERNET_CLIENT_AUTH_NOT_SETUP = (INTERNET_ERROR_BASE + 46) | |
Private Const ERROR_INTERNET_ASYNC_THREAD_FAILED = (INTERNET_ERROR_BASE + 47) | |
Private Const ERROR_INTERNET_REDIRECT_SCHEME_CHANGE = (INTERNET_ERROR_BASE + 48) | |
Private Const ERROR_INTERNET_DIALOG_PENDING = (INTERNET_ERROR_BASE + 49) | |
Private Const ERROR_INTERNET_RETRY_DIALOG = (INTERNET_ERROR_BASE + 50) | |
Private Const ERROR_INTERNET_HTTPS_HTTP_SUBMIT_REDIR = (INTERNET_ERROR_BASE + 52) | |
Private Const ERROR_INTERNET_INSERT_CDROM = (INTERNET_ERROR_BASE + 53) | |
Private Const ERROR_FTP_TRANSFER_IN_PROGRESS = (INTERNET_ERROR_BASE + 110) | |
Private Const ERROR_FTP_DROPPED = (INTERNET_ERROR_BASE + 111) | |
Private Const ERROR_FTP_NO_PASSIVE_MODE = (INTERNET_ERROR_BASE + 112) | |
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
' WinInet API - Types | |
Private Type FILETIME | |
dwLowDateTime As Long | |
dwHighDateTime As Long | |
End Type | |
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 * MAX_PATH | |
cAlternate As String * 14 | |
End Type | |
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
' WinInet API - Declares | |
Private Declare Function InternetReadFile Lib "WININET.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer | |
Private Declare Function InternetFindNextFile Lib "WININET.dll" Alias "InternetFindNextFileA" (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long | |
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 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 FtpSetCurrentDirectory Lib "WININET.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean | |
Private Declare Function FtpGetCurrentDirectory Lib "WININET.dll" Alias "FtpGetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String, ByRef lpdwCurrentDirectory As Long) As Boolean | |
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 InternetGetLastResponseInfo Lib "WININET.dll" Alias "InternetGetLastResponseInfoA" (lpdwError As Long, ByVal lpszBuffer As String, lpdwBufferLength As Long) As Boolean | |
Private Declare Function InternetWriteFile Lib "WININET.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumberOfBytesToRead As Long, lNumberOfBytesRead As Long) As Integer | |
Private Declare Function FtpOpenFile Lib "WININET.dll" Alias "FtpOpenFileA" (ByVal hFtpSession As Long, ByVal sFileName As String, ByVal lAccess As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long | |
Private Declare Function FtpDeleteFile Lib "WININET.dll" Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean | |
Private Declare Function InternetSetOption Lib "WININET.dll" Alias "InternetSetOptionA" (ByVal hInternet As Long, ByVal lOption As Long, ByRef sBuffer As Any, ByVal lBufferLength As Long) As Integer | |
Private Declare Function InternetSetOptionStr Lib "WININET.dll" Alias "InternetSetOptionA" (ByVal hInternet As Long, ByVal lOption As Long, ByVal sBuffer As String, ByVal lBufferLength As Long) As Integer | |
Private Declare Function InternetCloseHandle Lib "WININET.dll" (ByVal hInet As Long) As Integer | |
Private Declare Function InternetQueryOption Lib "WININET.dll" Alias "InternetQueryOptionA" (ByVal hInternet As Long, ByVal lOption As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long) As Integer | |
Private Declare Function InternetSetStatusCallback Lib "WININET.dll" (ByVal hInternetSession As Long, ByVal lpfnInternetCallback As Long) As Long | |
Event StatusChanged() | |
Public Enum ConnectionMode | |
dcftpActive = 0 | |
dcftpPassive = INTERNET_FLAG_PASSIVE | |
End Enum | |
Public Enum TransferMode | |
dcftpBinary = FTP_TRANSFER_TYPE_BINARY | |
dcftpASCII = FTP_TRANSFER_TYPE_ASCII | |
End Enum | |
Public Enum AccessMode | |
dcftpRead = GENERIC_READ | |
dcftpWrite = GENERIC_WRITE | |
End Enum | |
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
' dcftp - Member variables | |
Private hInet As Long | |
Private hFtp As Long | |
Private hFile As Long | |
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
' dcftp - Member functions | |
Public Function Connect(ByVal server As String, Optional port As Integer = INTERNET_DEFAULT_FTP_PORT, Optional username As String = vbNullString, Optional password As String = vbNullString, Optional connection_mode As ConnectionMode = dcftpActive) | |
CloseFile | |
Disconnect | |
hInet = InternetOpen(0, INTERNET_OPEN_TYPE_PRECONFIG, 0, 0, 0) | |
If 0 = hInet Then | |
Connect = False | |
Exit Function | |
End If | |
hFtp = InternetConnect(hInet, server, port, username, password, INTERNET_SERVICE_FTP, connection_mode, 0) | |
If 0 = hFtp Then | |
Disconnect | |
Connect = False | |
Exit Function | |
End If | |
Connect = True | |
End Function | |
Public Function OpenFile(ByVal remote_file As String, ByVal access_mode As AccessMode, Optional transfer_mode As TransferMode = dcftpASCII) As Boolean | |
CloseFile | |
hFile = FtpOpenFile(hFtp, remote_file, access_mode, transfer_mode, 0) | |
OpenFile = hFile <> 0 | |
End Function | |
Public Function ReadFile(ByRef data() As Byte, ByRef bytes_read As Long) As Boolean | |
ReadFile = InternetReadFile(hFile, LBound(data), UBound(data) - LBound(data) + 1, bytes_read) | |
End Function | |
Public Function GetFile(ByVal remote_file As String, ByVal local_file As String, Optional ByVal overwrite As Boolean = True) As Boolean | |
GetFile = FtpGetFile(hFtp, remote_file, local_file, Not overwrite, 0, FTP_TRANSFER_TYPE_BINARY, 0) | |
End Function | |
Public Function IsFileOpen() As Boolean | |
IsFileOpen = hFile <> 0 | |
End Function | |
Public Function IsConnected() As Boolean | |
IsConnected = hInet <> 0 And hFtp <> 0 | |
End Function | |
Public Sub CloseFile() | |
If IsFileOpen Then InternetCloseHandle hFile | |
End Sub | |
Public Sub Disconnect() | |
CloseFile | |
If hFtp <> 0 Then InternetCloseHandle hFtp | |
If hInet <> 0 Then InternetCloseHandle hInet | |
End Sub | |
Public Function SetStatusCallback(ByVal cb As Long) | |
InternetSetStatusCallback hFtp, cb | |
End Function | |
Public Function GetLastResponse() As String | |
Dim buffer As String, dwError As Long, dwSize As Long | |
dwSize = 1024 | |
buffer = Space(dwSize) | |
InternetGetLastResponseInfo dwError, buffer, dwSize | |
GetLastResponse = Left(buffer, dwSize) | |
End Function | |
Private Sub Class_Initialize() | |
hInet = 0 | |
hFtp = 0 | |
hFile = 0 | |
End Sub | |
Private Sub Class_Terminate() | |
Disconnect | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment