All source code is available in this email below, you do not need to access the web site to obtain the source code.
If you are not a paid subscriber, you must have signed up for our free trial at http://www.codeoftheweek.com. Our ezine is not an unsolicited message (in other words a spam email). Keep in mind that if you signed up for our free trial you can still receive a total of four issues at no cost to you. After you receive the four issues you will be notified about continuing your subscription.
If you do not wish to continue to receive this ezine, please email us at cancel@codeoftheweek.com
The source code in this issue is designed for Visual Basic 4.0 32-bit and above. It also requires the source code from issue #55 of Code of the Week.
If you have any questions about this issue, please email us at questions@codeoftheweek.com
This issue enhances the code introduced in issue number 54. It shows how to use the Microsoft WININET.DLL to retrieve a file from an FTP server. This version of cFTP provides a couple of events to return the transfer progress. It does not use the Microsoft Internet Controls, so there is one less file you have to worry about including with your application.
This class allows you to download a file from an FTP server very easily. We will be enhancing this class in the future with the ability to upload a file. If you have specific requests, please get them to us as soon as possible at requests@codeoftheweek.com
Basically to use this class you need to set a few properties and call one method.
Public ServerName As String Public SourceFilename As String Public DestinationFilename As String Public BinaryMode As Boolean Public BufferSize As Long Public ProxyServer As String
Public Sub DownloadWithStatus()
This is the method that actually connects to the server, changes to the appropriate directory and downloads a file. It will raise some errors if necessary, such as if the server can not be connected to or the file can not be found.
Public Event TransferProgress(lBytesRead As Long, _
curTotalBytes As Currency, _
curFileSize As Currency)
Public Event TransferComplete(curTotalBytes As Currency)
We use Currency variables since they are larger integers (sort of) and allows us to accurately show file sizes and transfer bytes greater than what a Long can contain (about 2 gigabytes). You will probably never FTP a 2 gigabyte file, but if you do this class will handle it correctly.
The TransferProgress event is fired periodically as the file is being transferred. It passes the number of bytes read in the last chunk of data (this will usually equal the BufferSize property), the number of bytes read so far, and the total bytes in the file being transferred (-1 if it was not able to determine that information). It provides enough information to show a progress bar or status information to the end user.
When the transfer is completed the TransferComplete event will be fired with the total number of bytes transferred as its sole parameter.
This example assumes you pasted this into a form that contains the following controls: txtServerName, txtSourceFile, txtDestFile as TextBox; optMode(0) and optMode(1) for selecting ASCII transfer or Binary Transfer as Option buttons, bar as ProgressBar, and lblStatus as Label. This sample will download the file entered in txtSourceFile from txtServerName and place it into txtDestFile. It will update a progress bar and a status label with the transfer progress.
This sample uses the SmartNumberFormat routine found in issue number 52 of Code of the Week.
Option Explicit
Dim WithEvents oFTP As cFTP ' Need to declare this WithEvents so we get notified of events.
Private Sub oFTP_TransferComplete(curTotalBytes As Currency)
lblStatus.Caption = "Transfer completed. Transferred " & SmartNumberFormat(CDbl(curTotalBytes), fsd_Bytes) & " bytes"
End Sub
Private Sub oFTP_TransferProgress(lBytesRead As Long, _
curTotalBytes As Currency, _
curFileSize As Currency)
If curFileSize <> -1 Then
bar.Min = 0
bar.Max = curFileSize
bar.Value = curTotalBytes
lblStatus = SmartNumberFormat(CDbl(curTotalBytes)) & " transferred so far of " & SmartNumberFormat(CDbl(curFileSize))
Else
lblStatus = curTotalBytes
End If
lblStatus.Refresh
End Sub
Private Sub cmdDownload_Click()
On Error GoTo Handler
' created this way since we use the WithEvents keyword
Set oFTP = New cFTP
oFTP.ServerName = txtServerName
oFTP.SourceFilename = txtSourceFile
oFTP.DestinationFilename = txtDestFile
oFTP.BinaryMode = optMode(1).Value
oFTP.DownloadWithStatus
Exit Sub
Handler:
MsgBox Err.Description
End Sub
Just paste this source code into a class module called cFTP and include it in your project.
'----------------------------------------------------------------------
'
' Module Name: cFTP
' Written By: C&D Programming Corp.
' Create Date: 8/98
' Copyright: Copyright 1998 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit
'============================================================
' WinInet API declarations
'============================================================
'
' Initializes an application's use of the Win32 Internet functions
'
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
'
' Reads from an Internet handle, in this case we are using it to
' read a file from an FTP server.
'
Private Declare Function InternetReadFile Lib "wininet.dll" _
(ByVal hFile As Long, ByVal sBuffer As String, _
ByVal lNumBytesToRead As Long, _
lNumberOfBytesRead As Long) As Boolean
'
' Closes a single Internet handle or a subtree of Internet handles.
'
Private Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer
'
' Opens a HTTP/FTP session for a given site.
'
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
'
' Retrieves a file using the FTP protocol
'
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
'
' Changes the directory on the remote server
'
Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" _
Alias "FtpSetCurrentDirectoryA" _
(ByVal hFtpSession As Long, _
ByVal lpszDirectory As String) As Boolean
'
' Used to open and FTP file and allow small chunks to be read/written
' so that status information can be provided to the user
'
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
' User agent constant.
Private Const scUserAgent = "vb5 wininet"
' Use registry access settings.
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PROXY = 3
' This is the type of service that you are connecting to
Private Const INTERNET_SERVICE_FTP = 1
Private Const INTERNET_SERVICE_GOPHER = 2
Private Const INTERNET_SERVICE_HTTP = 3
' These are the available FTP transfer types.
Private Const FTP_TRANSFER_TYPE_ASCII = &H1 ' one of these are wrong
Private Const FTP_TRANSFER_TYPE_BINARY = &H2
' Brings the data across the wire even if it locally cached.
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Private Const INTERNET_FLAG_MULTIPART = &H200000
' for use with the FtpOpenFile function
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
'============================================================
' declares for retrieving file information
'============================================================
Private Const ERROR_NO_MORE_FILES = 18
Private Const MAX_PATH = 260
Private Const NO_ERROR = 0
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As Currency ' This allows the right size variable
ftLastAccessTime As Currency ' and the best accuracy. It is easier
ftLastWriteTime As Currency ' then passing FILETIME. I first saw
nFileSizeHigh As Long ' this in the book Hardcore Visual Basic.
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
'
' This routine allows us to get the filesize for the FTP servers
' that support it.
'
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 Const INTERNET_INVALID_PORT_NUMBER = 0 ' used to get a port number in the
' InternetConnect call
Private Const INTERNET_FLAG_PASSIVE = &H8000000
'
' information to retrieve error codes and messages
'
Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" _
Alias "InternetGetLastResponseInfoA" ( _
lpdwError As Long, _
ByVal lpszBuffer As String, _
lpdwBufferLength As Long) As Boolean
'============================================================
' Error constants for the WinInet API
'============================================================
Private Const ERROR_INTERNET_OUT_OF_HANDLES = 12001
Private Const ERROR_INTERNET_TIMEOUT = 12002
Private Const ERROR_INTERNET_EXTENDED_ERROR = 12003
Private Const ERROR_INTERNET_INTERNAL_ERROR = 12004
Private Const ERROR_INTERNET_INVALID_URL = 12005
Private Const ERROR_INTERNET_UNRECOGNIZED_SCHEME = 12006
Private Const ERROR_INTERNET_NAME_NOT_RESOLVED = 12007
Private Const ERROR_INTERNET_PROTOCOL_NOT_FOUND = 12008
Private Const ERROR_INTERNET_INVALID_OPTION = 12009
Private Const ERROR_INTERNET_BAD_OPTION_LENGTH = 12010
Private Const ERROR_INTERNET_OPTION_NOT_SETTABLE = 12011
Private Const ERROR_INTERNET_SHUTDOWN = 12012
Private Const ERROR_INTERNET_INCORRECT_USER_NAME = 12013
Private Const ERROR_INTERNET_INCORRECT_PASSWORD = 12014
Private Const ERROR_INTERNET_LOGIN_FAILURE = 12015
Private Const ERROR_INTERNET_INVALID_OPERATION = 12016
Private Const ERROR_INTERNET_OPERATION_CANCELLED = 12017
Private Const ERROR_INTERNET_INCORRECT_HANDLE_TYPE = 12018
Private Const ERROR_INTERNET_INCORRECT_HANDLE_STATE = 12019
Private Const ERROR_INTERNET_NOT_PROXY_REQUEST = 12020
Private Const ERROR_INTERNET_REGISTRY_VALUE_NOT_FOUND = 12021
Private Const ERROR_INTERNET_BAD_REGISTRY_PARAMETER = 12022
Private Const ERROR_INTERNET_NO_DIRECT_ACCESS = 12023
Private Const ERROR_INTERNET_NO_CONTEXT = 12024
Private Const ERROR_INTERNET_NO_CALLBACK = 12025
Private Const ERROR_INTERNET_REQUEST_PENDING = 12026
Private Const ERROR_INTERNET_INCORRECT_FORMAT = 12027
Private Const ERROR_INTERNET_ITEM_NOT_FOUND = 12028
Private Const ERROR_INTERNET_CANNOT_CONNECT = 12029
Private Const ERROR_INTERNET_CONNECTION_ABORTED = 12030
Private Const ERROR_INTERNET_CONNECTION_RESET = 12031
Private Const ERROR_INTERNET_FORCE_RETRY = 12032
Private Const ERROR_INTERNET_INVALID_PROXY_REQUEST = 12033
Private Const ERROR_INTERNET_HANDLE_EXISTS = 12036
Private Const ERROR_INTERNET_SEC_CERT_DATE_INVALID = 12037
Private Const ERROR_INTERNET_SEC_CERT_CN_INVALID = 12038
Private Const ERROR_INTERNET_HTTP_TO_HTTPS_ON_REDIR = 12039
Private Const ERROR_INTERNET_HTTPS_TO_HTTP_ON_REDIR = 12040
Private Const ERROR_INTERNET_MIXED_SECURITY = 12041
Private Const ERROR_INTERNET_CHG_POST_IS_NON_SECURE = 12042
Private Const ERROR_INTERNET_POST_IS_NON_SECURE = 12043
Private Const ERROR_FTP_TRANSFER_IN_PROGRESS = 12110
Private Const ERROR_FTP_DROPPED = 12111
Private Const ERROR_GOPHER_PROTOCOL_ERROR = 12130
Private Const ERROR_GOPHER_NOT_FILE = 12131
Private Const ERROR_GOPHER_DATA_ERROR = 12132
Private Const ERROR_GOPHER_END_OF_DATA = 12133
Private Const ERROR_GOPHER_INVALID_LOCATOR = 12134
Private Const ERROR_GOPHER_INCORRECT_LOCATOR_TYPE = 12135
Private Const ERROR_GOPHER_NOT_GOPHER_PLUS = 12136
Private Const ERROR_GOPHER_ATTRIBUTE_NOT_FOUND = 12137
Private Const ERROR_GOPHER_UNKNOWN_LOCATOR = 12138
Private Const ERROR_HTTP_HEADER_NOT_FOUND = 12150
Private Const ERROR_HTTP_DOWNLEVEL_SERVER = 12151
Private Const ERROR_HTTP_INVALID_SERVER_RESPONSE = 12152
Private Const ERROR_HTTP_INVALID_HEADER = 12153
Private Const ERROR_HTTP_INVALID_QUERY_REQUEST = 12154
Private Const ERROR_HTTP_HEADER_ALREADY_EXISTS = 12155
Private Const ERROR_HTTP_REDIRECT_FAILED = 12156
Private Const ERROR_INTERNET_FIRST_ERROR = ERROR_INTERNET_OUT_OF_HANDLES
' add 50 just in case there are a few others Microsoft forgot to document.
Private Const ERROR_INTERNET_LAST_ERROR = ERROR_HTTP_REDIRECT_FAILED + 50
'============================================================
' Public variables
'============================================================
Public ProxyServer As String ' proxy server to use when creating a session
Public ServerName As String ' name of the server to connect to
Public SourceFilename As String ' full path/filename of the file being read when using
' the transferring files
Public DestinationFilename As String
' full path/filename of the file being saved when using
' the transferring files
Public Username As String ' username to use to connect to server
' these are optional if the FTP server
' accept anonymous connections
Public Password As String ' password to use to connect to server
Public PassiveMode As Boolean ' True uses passive FTP semantics
Public BinaryMode As Boolean ' True if the file should be transferred
' in binary mode, False if it should
' use ASCII mode
Public BufferSize As Long ' used in the OneStepDownloadWithStatus for
' setting the transfer buffer size
'============================================================
' Events raised by this class
'============================================================
' We use Currency variables since they are larger integers
' (sort of) and allows us to accurately show file sizes
' and transfer bytes greater than what a Long can contain
' (about 2 gigabytes)
Public Event TransferProgress(lBytesRead As Long, _
curTotalBytes As Currency, _
curFileSize As Currency)
Public Event TransferComplete(curTotalBytes As Currency)
'============================================================
' Private variables
'============================================================
Dim mhSession As Long ' handle to internet session
Dim mhConnection As Long ' handle to connection to server
'
' Initialize the communications session either by proxy server or
' direct connection. If it can not open the connection, raise
' an error.
'
Public Sub InitSession()
If Len(ProxyServer) <> 0 Then
mhSession = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PROXY, ProxyServer, vbNullString, 0)
Else
mhSession = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
End If
If mhSession = 0 Then
Err.Raise Err.LastDllError, "InitSession", ErrorMessage(Err.LastDllError)
End If
End Sub
'
' Connect to the FTP server. If the session was not initialized yet,
' call InitSession to start it. Otherwise open the connection and
' exit. Raise an error if not successful.
'
Public Sub ConnectToServer()
Dim lFlag As Long
On Error GoTo Handler
If mhSession = 0 Then
InitSession
End If
If mhConnection <> 0 Then
Exit Sub
End If
If PassiveMode Then
lFlag = INTERNET_FLAG_PASSIVE
Else
lFlag = 0
End If
mhConnection = InternetConnect(mhSession, ServerName, INTERNET_INVALID_PORT_NUMBER, _
Username, Password, INTERNET_SERVICE_FTP, lFlag, 0)
If mhConnection = 0 Then
Dim sErr As String
sErr = ErrorMessage(Err.LastDllError)
Err.Raise Err.LastDllError, "InternetConnect", sErr
End If
Exit Sub
Handler:
Err.Raise Err.Number, "ConnectToServer", ErrorMessage(Err.LastDllError)
End Sub
Public Sub DisconnectFromServer()
If mhConnection <> 0 Then
Call InternetCloseHandle(mhConnection)
mhConnection = 0
End If
End Sub
Public Sub TerminateSession()
If mhSession <> 0 Then
Call InternetCloseHandle(mhSession)
mhSession = 0
End If
End Sub
Public Sub Download()
Dim bRet As Boolean
Dim sFileRemote As String
Dim sDirRemote As String
Dim sFileLocal As String ' the local filename
Dim lDataType As Long ' data type to transfer the file with binary/ascii
Dim lPos As Long
On Error GoTo Handler
'
' Do some data validation on the source filename and
' the destination filename
'
If SourceFilename = "" Then
Err.Raise 5, "cInternet.DownloadFile", _
"You must specify a source filename, such as /public/filename.zip"
Exit Sub
End If
If Trim$(DestinationFilename) = "" Then
Err.Raise 5, "cInternet.DownloadFile", _
"You must specify a filename to store the downloaded data, such as c:\download\filename.zip"
Exit Sub
End If
'
' try to connect to server. If we can't connect, raise an error.
'
On Error Resume Next
ConnectToServer
If Err Then
Err.Raise 5, "DownloadFile", "Could not connect to server " & ServerName & ". Error was '" & Err.Description & "'"
Exit Sub
End If
On Error GoTo Handler
' break apart filename for passing to the FtpGetFile call
' we need to do this because the FtpGetFile call will not
' automatically change the directory on the ftp server. So,
' we first have to determine the directory and then do a
' remote change directory call to position the ftp server
' to the correct place. After this, we can successfully
' transfer the file.
sFileRemote = SourceFilename
lPos = FindLastOccurrence(sFileRemote, "/")
sDirRemote = Left(sFileRemote, lPos)
sFileRemote = Right(sFileRemote, Len(sFileRemote) - lPos)
sFileLocal = DestinationFilename
' change remote directory to sDirRemote
RemoteChangeDir sDirRemote
' set the data transfer mode
If BinaryMode Then
lDataType = FTP_TRANSFER_TYPE_BINARY
Else
lDataType = FTP_TRANSFER_TYPE_ASCII
End If
' get the file
bRet = FtpGetFile(mhConnection, sFileRemote, sFileLocal, False, _
INTERNET_FLAG_RELOAD, lDataType, 0&)
If Not bRet Then
DisconnectFromServer
TerminateSession
Else
Err.Raise Err.LastDllError, "FtpGetFile", ErrorMessage(Err.LastDllError)
End If
Exit Sub
Handler:
Err.Raise Err.Number, "OneStepDownload", Err.Description
End Sub
Private Sub RemoteChangeDir(sDir As String)
Dim bRet As Boolean
' if the directory is blank, let's assume they really mean the
' root directory
If sDir = "" Then sDir = "/"
bRet = FtpSetCurrentDirectory(mhConnection, sDir)
If bRet = False Then
Err.Raise Err.LastDllError, "RemoteChangeDir", ErrorMessage(Err.LastDllError)
End If
End Sub
Function InternetErrorMessage(dError As Long) As String
Dim sMsg As String
sMsg = ""
Select Case dError
Case ERROR_INTERNET_OUT_OF_HANDLES ' 12001
sMsg = "No more handles could be generated at this time."
Case ERROR_INTERNET_TIMEOUT ' 12002
sMsg = "The request has timed out."
Case ERROR_INTERNET_EXTENDED_ERROR ' 12003
sMsg = "An extended error was returned from the server. This is typically a string or buffer containing a verbose error message. Call InternetGetLastResponseInfo to retrieve the error text."
Case ERROR_INTERNET_INTERNAL_ERROR ' 12004
sMsg = "An internal error has occurred."
Case ERROR_INTERNET_INVALID_URL ' 12005
sMsg = "The URL is invalid."
Case ERROR_INTERNET_UNRECOGNIZED_SCHEME ' 12006
sMsg = "The URL scheme could not be recognized or is not supported."
Case ERROR_INTERNET_NAME_NOT_RESOLVED ' 12007
sMsg = "The server name could not be resolved."
Case ERROR_INTERNET_PROTOCOL_NOT_FOUND ' 12008
sMsg = "The requested protocol could not be located."
Case ERROR_INTERNET_INVALID_OPTION ' 12009
sMsg = "A request to InternetQueryOption or InternetSetOption specified an invalid option value."
Case ERROR_INTERNET_BAD_OPTION_LENGTH ' 12010
sMsg = "The length of an option supplied to InternetQueryOption or InternetSetOption is incorrect for the type of option specified."
Case ERROR_INTERNET_OPTION_NOT_SETTABLE ' 12011
sMsg = "The request option cannot be set, only queried."
Case ERROR_INTERNET_SHUTDOWN ' 12012
sMsg = "The Win32 Internet function support is being shut down or unloaded."
Case ERROR_INTERNET_INCORRECT_USER_NAME ' 12013
sMsg = "The request to connect and log on to an FTP server could not be completed because the supplied user name is incorrect."
Case ERROR_INTERNET_INCORRECT_PASSWORD ' 12014
sMsg = "The request to connect and log on to an FTP server could not be completed because the supplied password is incorrect."
Case ERROR_INTERNET_LOGIN_FAILURE ' 12015
sMsg = "The request to connect to and log on to an FTP server failed."
Case ERROR_INTERNET_INVALID_OPERATION ' 12016
sMsg = "The requested operation is invalid."
Case ERROR_INTERNET_OPERATION_CANCELLED ' 12017
sMsg = "The operation was canceled, usually because the handle on which the request was operating was closed before the operation completed."
Case ERROR_INTERNET_INCORRECT_HANDLE_TYPE ' 12018
sMsg = "The type of handle supplied is incorrect for this operation."
Case ERROR_INTERNET_INCORRECT_HANDLE_STATE ' 12019
sMsg = "The requested operation cannot be carried out because the handle supplied is not in the correct state."
Case ERROR_INTERNET_NOT_PROXY_REQUEST ' 12020
sMsg = "The request cannot be made via a proxy."
Case ERROR_INTERNET_REGISTRY_VALUE_NOT_FOUND ' 12021
sMsg = "A required registry value could not be located."
Case ERROR_INTERNET_BAD_REGISTRY_PARAMETER ' 12022
sMsg = "A required registry value was located but is an incorrect type or has an invalid value."
Case ERROR_INTERNET_NO_DIRECT_ACCESS ' 12023
sMsg = "Direct network access cannot be made at this time."
Case ERROR_INTERNET_NO_CONTEXT ' 12024
sMsg = "An asynchronous request could not be made because a zero context value was supplied."
Case ERROR_INTERNET_NO_CALLBACK ' 12025
sMsg = "An asynchronous request could not be made because a callback function has not been set."
Case ERROR_INTERNET_REQUEST_PENDING ' 12026
sMsg = "The required operation could not be completed because one or more requests are pending."
Case ERROR_INTERNET_INCORRECT_FORMAT ' 12027
sMsg = "The format of the request is invalid."
Case ERROR_INTERNET_ITEM_NOT_FOUND ' 12028
sMsg = "The requested item could not be located."
Case ERROR_INTERNET_CANNOT_CONNECT ' 12029
sMsg = "The attempt to connect to the server failed."
Case ERROR_INTERNET_CONNECTION_ABORTED ' 12030
sMsg = "The connection with the server has been terminated."
Case ERROR_INTERNET_CONNECTION_RESET ' 12031
sMsg = "The connection with the server has been reset."
Case ERROR_INTERNET_FORCE_RETRY ' 12032
sMsg = "Calls for the Win32 Internet function to redo the request."
Case ERROR_INTERNET_INVALID_PROXY_REQUEST ' 12033
sMsg = "Invalid Proxy request"
Case ERROR_INTERNET_HANDLE_EXISTS ' 12036
sMsg = "The request failed because the handle already exists."
Case ERROR_INTERNET_SEC_CERT_DATE_INVALID ' 12037
sMsg = "Security certifcate date is invalid"
Case ERROR_INTERNET_SEC_CERT_CN_INVALID ' 12038
sMsg = "Security certifcate CN is invalid"
Case ERROR_INTERNET_HTTP_TO_HTTPS_ON_REDIR ' 12039
sMsg = "HTTP to HTTPS on redirect"
Case ERROR_INTERNET_HTTPS_TO_HTTP_ON_REDIR ' 12040
sMsg = "HTTPS to HTTP on redirect"
Case ERROR_INTERNET_MIXED_SECURITY ' 12041
sMsg = "Indicates that the content is not entirely secure. Some of the content being viewed may have come from unsecured servers."
Case ERROR_INTERNET_CHG_POST_IS_NON_SECURE ' 12042
sMsg = "Change posting is non-secure"
Case ERROR_INTERNET_POST_IS_NON_SECURE ' 12043
sMsg = "Post is non-secure"
Case ERROR_FTP_TRANSFER_IN_PROGRESS ' 12110
sMsg = "The requested operation cannot be made on the FTP session handle because an operation is already in progress."
Case ERROR_FTP_DROPPED ' 12111
sMsg = "The FTP operation was not completed because the session was aborted."
Case ERROR_GOPHER_PROTOCOL_ERROR ' 12130
sMsg = "An error was detected while parsing data returned from the gopher server."
Case ERROR_GOPHER_NOT_FILE ' 12131
sMsg = "The request must be made for a file locator."
Case ERROR_GOPHER_DATA_ERROR ' 12132
sMsg = "An error was detected while receiving data from the gopher server."
Case ERROR_GOPHER_END_OF_DATA ' 12133
sMsg = "The end of the data has been reached."
Case ERROR_GOPHER_INVALID_LOCATOR ' 12134
sMsg = "The supplied locator is not valid."
Case ERROR_GOPHER_INCORRECT_LOCATOR_TYPE ' 12135
sMsg = "The type of the locator is not correct for this operation."
Case ERROR_GOPHER_NOT_GOPHER_PLUS ' 12136
sMsg = "The requested operation can only be made against a Gopher+ server or with a locator that specifies a Gopher+ operation."
Case ERROR_GOPHER_ATTRIBUTE_NOT_FOUND ' 12137
sMsg = "The requested attribute could not be located."
Case ERROR_GOPHER_UNKNOWN_LOCATOR ' 12138
sMsg = "The locator type is unknown."
Case ERROR_HTTP_HEADER_NOT_FOUND ' 12150
sMsg = "The requested header could not be located."
Case ERROR_HTTP_DOWNLEVEL_SERVER ' 12151
sMsg = "The server did not return any headers."
Case ERROR_HTTP_INVALID_SERVER_RESPONSE ' 12152
sMsg = "The server response could not be parsed."
Case ERROR_HTTP_INVALID_HEADER ' 12153
sMsg = "The supplied header is invalid."
Case ERROR_HTTP_INVALID_QUERY_REQUEST ' 12154
sMsg = "The request made to HttpQueryInfo is invalid."
Case ERROR_HTTP_HEADER_ALREADY_EXISTS ' 12155
sMsg = "The header could not be added because it already exists."
Case ERROR_HTTP_REDIRECT_FAILED ' 12156
sMsg = "HTTP redirect failed"
Case Else
sMsg = "Unknown error number " & dError
End Select
InternetErrorMessage = sMsg
End Function
Function ErrorMessage(dError As Long) As String
Dim lIntError As Long
Dim lLength As Long
Dim sBuffer As String
If dError = ERROR_INTERNET_EXTENDED_ERROR Then
InternetGetLastResponseInfo lIntError, vbNullString, lLength
sBuffer = String(lLength + 1, 0)
InternetGetLastResponseInfo lIntError, sBuffer, lLength
ErrorMessage = lIntError & " " & sBuffer
Else
If Err >= ERROR_INTERNET_FIRST_ERROR And _
Err <= ERROR_INTERNET_LAST_ERROR Then
sBuffer = InternetErrorMessage(dError)
Else
' if it is not an internet-related error, we should
' already have a description in err.description, so
' use it.
sBuffer = Err.Description
End If
' just in case we didn't get a description, let's at least
' return the error number to the user.
If sBuffer = "" Then
ErrorMessage = "Error number " & dError & " occurred."
Else
ErrorMessage = sBuffer
End If
End If
End Function
Private Sub Class_Initialize()
' default the FTP transfer buffer size to 2048
BufferSize = 2048
End Sub
Public Sub DownloadWithStatus()
Dim bRet As Boolean
Dim sFileRemote As String
Dim sDirRemote As String
Dim sFileLocal As String ' the local filename
Dim lDataType As Long ' data type to transfer the file with binary/ascii
Dim lPos As Long
On Error GoTo Handler
'
' Do some data validation on the source filename and
' the destination filename
'
If SourceFilename = "" Then
Err.Raise 5, "cInternet.DownloadFile", _
"You must specify a source filename, such as /public/filename.zip"
End If
If Trim$(DestinationFilename) = "" Then
Err.Raise 5, "cInternet.DownloadFile", _
"You must specify a filename to store the downloaded data, such as c:\download\filename.zip"
End If
'
' try to connect to server. If we can't connect, raise an error.
'
ConnectToServer
' break apart filename for passing to the FtpGetFile call
' we need to do this because the FtpGetFile call will not
' automatically change the directory on the ftp server. So,
' we first have to determine the directory and then do a
' remote change directory call to position the ftp server
' to the correct place. After this, we can successfully
' transfer the file.s
sFileRemote = SourceFilename
lPos = FindLastOccurrence(sFileRemote, "/")
sDirRemote = Left(sFileRemote, lPos)
sFileRemote = Right(sFileRemote, Len(sFileRemote) - lPos)
sFileLocal = DestinationFilename
' change remote directory to sDirRemote
RemoteChangeDir sDirRemote
' set the data transfer mode
If BinaryMode Then
lDataType = FTP_TRANSFER_TYPE_BINARY
Else
lDataType = FTP_TRANSFER_TYPE_ASCII
End If
Dim sData As String ' to get data from the net
Dim lNumberOfBytesRead As Long ' number of bytes read by the InternetReadFile routine
Dim curTotalBytes As Currency ' total number of bytes read for this call
Dim hFile As Long ' file handle to use in InternetReadFile
' this is a pointer to the remote file
Dim curFileSize As Currency ' to hold the filesize of the file about to
' be transferred
' retrieve the file size if possible, returns -1 if it can not be
' determined
curFileSize = FileSize
' open file and force it to be loaded from the network, even if it is
' already cached.
hFile = FtpOpenFile(mhConnection, SourceFilename, GENERIC_READ, _
lDataType Or INTERNET_FLAG_RELOAD, vbNull)
' init our counter and buffer
curTotalBytes = 0
sData = String(BufferSize, " ")
' loop until there is no more data to be read
Do
bRet = InternetReadFile(hFile, sData, BufferSize, _
lNumberOfBytesRead)
RaiseEvent TransferProgress(lNumberOfBytesRead, curTotalBytes, curFileSize)
curTotalBytes = curTotalBytes + lNumberOfBytesRead
Loop Until lNumberOfBytesRead = 0
RaiseEvent TransferComplete(curTotalBytes)
' close of file handle for FTP file
InternetCloseHandle hFile
If bRet Then
DisconnectFromServer
TerminateSession
Else
Err.Raise Err.LastDllError, "FtpGetFile", ErrorMessage(Err.LastDllError)
End If
Exit Sub
Handler:
If Err Then
Err.Raise 5, "DownloadFile", "Trying to download file from " & ServerName & "." & vbCrLf & vbCrLf & "Error Message: " & Err.Description
Exit Sub
End If
Err.Raise Err.Number, "OneStepDownload", Err.Description
End Sub
'
' We use currency as a workaround to the lack of a large integer in Visual
' Basic. The Currency data type has the range of –922,337,203,685,477.5808
' to 922,337,203,685,477.5807. This should handle any size file for at least
' the next couple of years
'
Public Property Get FileSize() As Currency
Dim lLastError As Long ' remembers the last DLL error
Dim hFind As Long ' handle used to retrieve data
Dim pFileData As WIN32_FIND_DATA ' file data that will be retrieved
Dim sFileRemote As String ' name of the remote filename
Dim sDirRemote As String ' name of the remote directory
Dim lPos As Long ' temp var used for positioning
On Error GoTo Handler
' if already connected it will use the existing connection otherwise
' it will create the connection
ConnectToServer
sDirRemote = ""
sFileRemote = SourceFilename
If InStr(sFileRemote, "/") > 0 Then
' break apart filename if there seems to be a path in it.
lPos = FindLastOccurrence(sFileRemote, "/")
sDirRemote = Left(sFileRemote, lPos)
sFileRemote = Right(sFileRemote, Len(sFileRemote) - lPos)
' change remote directory to sDirRemote
RemoteChangeDir sDirRemote
End If
' init filename for returning and then call function to try to
' find the file.
pFileData.cFileName = String(MAX_PATH, 0)
hFind = FtpFindFirstFile(mhConnection, sFileRemote, pFileData, 0, 0)
lLastError = Err.LastDllError
' if an error occurred getting the file (could mean the file does not
' exist).
If hFind = 0 Then
If (lLastError = ERROR_NO_MORE_FILES) Then
' file does not exit, so make the size 0
FileSize = -1
Else
Err.Raise 5, "FileSize", ErrorMessage(lLastError)
End If
Exit Property
Else
' the data returned in FtpFindFirstFile contains the file size in
' two long values (to allow for files larger than 2 gigabytes).
' This calculation will support extremely large files correctly.
' 2 ^ 32 (4294967296@) is the maximum value for a 4 byte unsigned
' integer
FileSize = CCur(pFileData.nFileSizeHigh) * CCur(2 ^ 32) + CCur(pFileData.nFileSizeLow)
End If
' we are done with the file search, so close the handle we used.
InternetCloseHandle hFind
Exit Property
Handler:
If Err Then
Err.Raise 5, "FileSize", "Trying to determine file size on " & ServerName & " for file " & SourceFilename & "." & vbCrLf & vbCrLf & "Error Message: " & Err.Description
Exit Property
End If
Err.Raise Err.Number, "FileSize", Err.Description
End Property
If you are interested in advertising in COTW please email us at sponsor@codeoftheweek.com Our rates are VERY reasonable, actually they are almost FREE. We reach over five thousand Visual Basic developers each week.
If you have any suggestions for topics you would like to see covered or questions about this issue, please email them to info@codeoftheweek.com or use online feedback form at http://www.codeoftheweek.com/feedback.html.
If you have any source code you would like to submit for possible inclusion in COTW, please fill out our online submission form at http://www.codeoftheweek.com/submission.html.
Thank you for trying Code of the Week for Visual Basic.
Your free trial expires after you receive your fourth issue. If you want to continue to receive Code of the Week you can get 52 issues of COTW for only $19.95. This is a full year of Visual Basic source code and information to help with all your development. So don't wait, subscribe now! The quickest way to subscribe is to jump to our online order form at http://www.codeoftheweek.com/order.html