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 email@example.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 firstname.lastname@example.org
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 email@example.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 firstname.lastname@example.org '---------------------------------------------------------------------- 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 email@example.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 firstname.lastname@example.org 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