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.
If you have any questions about this issue, please email us at questions@codeoftheweek.com
This issue shows how to use the Microsoft WININET.DLL to retrieve a file from an FTP server. 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 next issue or two. 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 four properties and call one method. The additional properties of this class will be discussed in the next issue. We've included the basics to get you started.
Public ServerName As String Public SourceFilename As String Public DestinationFilename As String Public BinaryMode As Boolean
Public Sub OneStepDownload()
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.
Private Sub cmdDownload_Click() Dim ftp As New cFTP On Error GoTo Handler ftp.ServerName = "www.microsoft.com" ftp.SourceFilename = "/pub/testfile.exe" ftp.DestinationFilename = "c:\test.exe" ftp.BinaryMode = True ftp.OneStepDownload Exit Sub Handler: MsgBox Err.Description End Sub
Just paste this source code into a module called basDates 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 ' ' 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 ' ' 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 ' 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 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 ' No more handles could be generated at this time. Private Const ERROR_INTERNET_OUT_OF_HANDLES = 12001 ' The request has timed out. Private Const ERROR_INTERNET_TIMEOUT = 12002 ' 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. Private Const ERROR_INTERNET_EXTENDED_ERROR = 12003 ' An internal error has occurred. Private Const ERROR_INTERNET_INTERNAL_ERROR = 12004 ' The URL is invalid. Private Const ERROR_INTERNET_INVALID_URL = 12005 ' The URL scheme could not be recognized or is not supported. Private Const ERROR_INTERNET_UNRECOGNIZED_SCHEME = 12006 ' The server name could not be resolved. Private Const ERROR_INTERNET_NAME_NOT_RESOLVED = 12007 ' The requested protocol could not be located. Private Const ERROR_INTERNET_PROTOCOL_NOT_FOUND = 12008 ' A request to InternetQueryOption or InternetSetOption specified an invalid option value. Private Const ERROR_INTERNET_INVALID_OPTION = 12009 ' The length of an option supplied to InternetQueryOption or InternetSetOption is incorrect for the type of option specified. Private Const ERROR_INTERNET_BAD_OPTION_LENGTH = 12010 ' The request option cannot be set, only queried. Private Const ERROR_INTERNET_OPTION_NOT_SETTABLE = 12011 ' The Win32 Internet function support is being shut down or unloaded. Private Const ERROR_INTERNET_SHUTDOWN = 12012 ' The request to connect and log on to an FTP server could not be completed because the supplied user name is incorrect. Private Const ERROR_INTERNET_INCORRECT_USER_NAME = 12013 ' The request to connect and log on to an FTP server could not be completed because the supplied password is incorrect. Private Const ERROR_INTERNET_INCORRECT_PASSWORD = 12014 ' The request to connect to and log on to an FTP server failed. Private Const ERROR_INTERNET_LOGIN_FAILURE = 12015 ' The requested operation is invalid. Private Const ERROR_INTERNET_INVALID_OPERATION = 12016 ' The operation was canceled, usually because the handle on which the request was operating was closed before the operation completed. Private Const ERROR_INTERNET_OPERATION_CANCELLED = 12017 ' The type of handle supplied is incorrect for this operation. Private Const ERROR_INTERNET_INCORRECT_HANDLE_TYPE = 12018 ' The requested operation cannot be carried out because the handle supplied is not in the correct state. Private Const ERROR_INTERNET_INCORRECT_HANDLE_STATE = 12019 ' The request cannot be made via a proxy. Private Const ERROR_INTERNET_NOT_PROXY_REQUEST = 12020 ' A required registry value could not be located. Private Const ERROR_INTERNET_REGISTRY_VALUE_NOT_FOUND = 12021 ' A required registry value was located but is an incorrect type or has an invalid value. Private Const ERROR_INTERNET_BAD_REGISTRY_PARAMETER = 12022 ' Direct network access cannot be made at this time. Private Const ERROR_INTERNET_NO_DIRECT_ACCESS = 12023 ' An asynchronous request could not be made because a zero context value was supplied. Private Const ERROR_INTERNET_NO_CONTEXT = 12024 ' An asynchronous request could not be made because a callback function has not been set. Private Const ERROR_INTERNET_NO_CALLBACK = 12025 ' The required operation could not be completed because one or more requests are pending. Private Const ERROR_INTERNET_REQUEST_PENDING = 12026 ' The format of the request is invalid. Private Const ERROR_INTERNET_INCORRECT_FORMAT = 12027 ' The requested item could not be located. Private Const ERROR_INTERNET_ITEM_NOT_FOUND = 12028 ' The attempt to connect to the server failed. Private Const ERROR_INTERNET_CANNOT_CONNECT = 12029 ' The connection with the server has been terminated. Private Const ERROR_INTERNET_CONNECTION_ABORTED = 12030 ' The connection with the server has been reset. Private Const ERROR_INTERNET_CONNECTION_RESET = 12031 ' Calls for the Win32 Internet function to redo the request. Private Const ERROR_INTERNET_FORCE_RETRY = 12032 ' Invalid Proxy request Private Const ERROR_INTERNET_INVALID_PROXY_REQUEST = 12033 ' The request failed because the handle already exists. Private Const ERROR_INTERNET_HANDLE_EXISTS = 12036 ' Security certifcate date is invalid Private Const ERROR_INTERNET_SEC_CERT_DATE_INVALID = 12037 ' Security certifcate CN is invalid Private Const ERROR_INTERNET_SEC_CERT_CN_INVALID = 12038 ' HTTP to HTTPS on redirect Private Const ERROR_INTERNET_HTTP_TO_HTTPS_ON_REDIR = 12039 ' HTTPS to HTTP on redirect Private Const ERROR_INTERNET_HTTPS_TO_HTTP_ON_REDIR = 12040 ' Indicates that the content is not entirely secure. Some of the content being viewed may have come from unsecured servers. Private Const ERROR_INTERNET_MIXED_SECURITY = 12041 ' Change posting is non-secure Private Const ERROR_INTERNET_CHG_POST_IS_NON_SECURE = 12042 ' Post is non-secure Private Const ERROR_INTERNET_POST_IS_NON_SECURE = 12043 ' The requested operation cannot be made on the FTP session handle because an operation is already in progress. Private Const ERROR_FTP_TRANSFER_IN_PROGRESS = 12110 ' The FTP operation was not completed because the session was aborted. Private Const ERROR_FTP_DROPPED = 12111 ' An error was detected while parsing data returned from the gopher server. Private Const ERROR_GOPHER_PROTOCOL_ERROR = 12130 ' The request must be made for a file locator. Private Const ERROR_GOPHER_NOT_FILE = 12131 ' An error was detected while receiving data from the gopher server. Private Const ERROR_GOPHER_DATA_ERROR = 12132 ' The end of the data has been reached. Private Const ERROR_GOPHER_END_OF_DATA = 12133 ' The supplied locator is not valid. Private Const ERROR_GOPHER_INVALID_LOCATOR = 12134 ' The type of the locator is not correct for this operation. Private Const ERROR_GOPHER_INCORRECT_LOCATOR_TYPE = 12135 ' The requested operation can only be made against a Gopher+ server or with a locator that specifies a Gopher+ operation. Private Const ERROR_GOPHER_NOT_GOPHER_PLUS = 12136 ' The requested attribute could not be located. Private Const ERROR_GOPHER_ATTRIBUTE_NOT_FOUND = 12137 ' The locator type is unknown. Private Const ERROR_GOPHER_UNKNOWN_LOCATOR = 12138 ' The requested header could not be located. Private Const ERROR_HTTP_HEADER_NOT_FOUND = 12150 ' The server did not return any headers. Private Const ERROR_HTTP_DOWNLEVEL_SERVER = 12151 ' The server response could not be parsed. Private Const ERROR_HTTP_INVALID_SERVER_RESPONSE = 12152 ' The supplied header is invalid. Private Const ERROR_HTTP_INVALID_HEADER = 12153 ' The request made to HttpQueryInfo is invalid. Private Const ERROR_HTTP_INVALID_QUERY_REQUEST = 12154 ' The header could not be added because it already exists. Private Const ERROR_HTTP_HEADER_ALREADY_EXISTS = 12155 ' HTTP redirect failed Private Const ERROR_HTTP_REDIRECT_FAILED = 12156 ' ' Public variables ' Public ProxyServer As String Public ServerName As String Public SourceFilename As String Public DestinationFilename As String Public Username As String Public Password As String Public PassiveMode As Boolean Public BinaryMode As Boolean Dim mhOpen As Long Dim mhConnection As Long Public Sub InitSession() If Len(ProxyServer) <> 0 Then mhOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PROXY, ProxyServer, vbNullString, 0) Else mhOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0) End If If mhOpen = 0 Then Err.Raise Err.LastDllError, "InitSession", ErrorMessage(Err.LastDllError) End If End Sub Public Sub ConnectToServer() Dim lFlag As Long If mhOpen = 0 Then On Error Resume Next InitSession If Err Then Err.Raise Err.Number, "ConnectToServer", Err.Description End If End If If PassiveMode Then lFlag = INTERNET_FLAG_PASSIVE Else lFlag = 0 End If mhConnection = InternetConnect(mhOpen, 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 End Sub Public Sub DisconnectFromServer() If mhConnection <> 0 Then Call InternetCloseHandle(mhConnection) mhConnection = 0 End If End Sub Public Sub TerminateSession() If mhOpen <> 0 Then Call InternetCloseHandle(mhOpen) mhOpen = 0 End If End Sub Public Sub OneStepDownload() 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 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 ' we will include better error handling in the next issue. ErrorMessage = "Error number " & dError & " occurred." End If End Function
That concludes this issue of COTW. We hope you find the source code useful in your development.
The below describes the ways you can supply us some feedback about COTW. We would like to see our members help mold COTW into the best Visual Basic source code resource available. But to do that we need your feedback about what you like and what you do not like about COTW.
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