FTP using 'wininet.dll'

FTP using 'wininet.dll'

There is another way to do FTP from VB application using 'wininet.dll'. This is a bit complex method than the previous one. We need to declare few dll procedures and constants to achieve this.

Before doing any FTP commands, internet session should be opened using 'InternetOpen' function, then using the session handle, internet connection will be opened using 'InternetConnect' function which will return a connection handle that will be used in all other FTP commands.

Following are the procedure and some constant declarations:

' Opens a HTTP/FTP session for a given site.
Public 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

' Closes a single Internet handle or a subtree of Internet handles.
Public Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer

' Initializes an application's use of the Win32 Internet functions
Public 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

' To down load a file from the FTP server
Public 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

' To up load a file from the FTP server
Public 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

' To change current directory in the remote server
Public Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean

' To get response information from the server
Public Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" ( _
    lpdwError As Long, _
    ByVal lpszBuffer As String, _
    lpdwBufferLength As Long) As Boolean

' Constant declarations
Public Const ERROR_INTERNET_EXTENDED_ERROR = 12003

' User agent constant.
Public Const scUserAgent = "vb wininet"

' Use registry access settings.
Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Public Const INTERNET_OPEN_TYPE_DIRECT = 1
Public Const INTERNET_OPEN_TYPE_PROXY = 3
Public Const INTERNET_INVALID_PORT_NUMBER = 0

Public Const FTP_TRANSFER_TYPE_BINARY = &H2
Public Const FTP_TRANSFER_TYPE_ASCII = &H1
Public Const INTERNET_FLAG_PASSIVE = &H8000000

' Brings the data across the wire even if it locally cached.
Public Const INTERNET_FLAG_RELOAD = &H80000000
Public Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Public Const INTERNET_FLAG_MULTIPART = &H200000

' Type of service to access.
Public Const INTERNET_SERVICE_FTP = 1
Public Const INTERNET_SERVICE_GOPHER = 2
Public Const INTERNET_SERVICE_HTTP = 3

Following function will download a file using the above procedures and constants, this function accepts 6 parameters for FTP server name, server directory, username, password, name of the file to be downloaded and the target file name in which the file to be stored.

Private Function DownLoadFile(sFTPSrvr As String, sDirName As String, sLogin As String, sPassword _
As String, sFn as String, sTarget as String) As Boolean

    Dim sMsgstr As String
    Dim sErrorStr As String
    Dim hOpen As Long, hConnection As Long
    Dim bRet As Boolean
    Dim nFlag As Long

    On Error GoTo DownLoaderror

    DownLoadFile = False

    '--Open session
    hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
    If hOpen = 0 Then
        sErrorStr = ErrorDisplay("InternetOpen")
        GoTo DownLoaderror
    End If

    nFlag = 0
    '--make connection with the host
    hConnection = InternetConnect(hOpen, sFTPSrvr, INTERNET_INVALID_PORT_NUMBER, sLogin, _
                        sPassword, INTERNET_SERVICE_FTP, nFlag, 0)
    If hConnection = 0 Then
        sErrorStr = ErrorDisplay("InternetConnect")
        GoTo DownLoaderror
    End If

    '--change the directory
    If sDirname <> "" Then
        bRet = FtpSetCurrentDirectory(hConnection, sDirname)
        If bRet = False Then
            sErrorStr = ErrorDisplay("FtpSetCurrentDirectory")
            GoTo DownLoaderror
        End If
    End If

    '--get file from host
    bRet = FtpGetFile(hConnection, sFn, sTarget, False, INTERNET_FLAG_RELOAD, _
              FTP_TRANSFER_TYPE_ASCII, 0)
    If bRet = False Then
        sErrorStr = ErrorDisplay("FtpGetFile")
        GoTo DownLoaderror
    End If

    '--close connection and session
    If hConnection Then InternetCloseHandle hConnection
    If hOpen Then InternetCloseHandle hOpen

DownLoadFile = True
Exit Function

DownLoaderror:
    DownLoadFile = False
    sMsgstr = "Error while down loading file " & sFn & " from the host " & sFTPSrvr & Chr(13)
    sMsgstr = sMsgstr & Chr(13) & "Error No: " & Err & " " & Error & Chr(13)
    sMsgstr = sMsgstr & Chr(13) & "Response from host:" & Chr(13) & sErrorStr
    MsgBox sMsgstr, vbExclamation, "Error"

    If hConnection Then InternetCloseHandle hConnection
    If hOpen Then InternetCloseHandle hOpen
    Exit Function
End Function

Following function will get the extended error message from the server.

Private Function ErrorDisplay(sCalledFunction As String) As String
    Dim dwIntError As Long, dwLength As Long
    Dim strBuffer As String

    'Invoke the function to find out the length of the error message
    InternetGetLastResponseInfo dwIntError, vbNullString, dwLength
    strBuffer = String(dwLength + 1, 0)

    'Invoke the function again to get the error message
    InternetGetLastResponseInfo dwIntError, strBuffer, dwLength
    ErrorDisplay = "Error in function:" & sCalledFunction & " " & dwIntError & " " & strBuffer
End Function

To upload a file the above 'DownLoadFile' function can be rewritten using 'FtpPutFile' dll function.
This function is 'UpLoadFile' which accepts 6 parameters for FTP server name, server directory, username, password, name of the file to be uploaded and the target file name in which the file to be stored.

Private Function UpLoadFile(sFTPSrvr As String, sDirName As String, sLogin As String, sPassword _
As String, sFn as String, sTarget as String) As Boolean

    Dim sMsgstr As String
    Dim sErrorStr As String
    Dim hOpen As Long, hConnection As Long
    Dim bRet As Boolean
    Dim nFlag As Long

    '--copy the file in host
    bRet = FtpPutFile(hConnection, sFn, sTarget, FTP_TRANSFER_TYPE_ASCII, 0)
    If bRet = False Then
        sErrorStr = ErrorDisplay("FtpPutFile")
        GoTo UpLoaderror
    End If

    '--close connection and session
    If hConnection Then InternetCloseHandle hConnection
    If hOpen Then InternetCloseHandle hOpen

DownLoadFile = True
Exit Function

    If hConnection Then InternetCloseHandle hConnection
    If hOpen Then InternetCloseHandle hOpen
    Exit Function
End Function