Accès FTP et Internet (Fonctions API)

Pour commencer, l'API Windows standard :
 

Option Compare Database
Option Explicit

'/
'/ A placer dans la partie déclarative
'/
Public Const NO_ERROR = 0
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Public Const FILE_ATTRIBUTE_OFFLINE = &H1000
Public Const FORMAT_MESSAGE_FROM_HMODULE = &H800
Public Const INTERNET_INVALID_PORT_NUMBER = 0
Public Const ERROR_NO_MORE_FILES = 18

Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Const FTP_TRANSFER_TYPE_ASCII = &H1
Const FTP_TRANSFER_TYPE_BINARY = &H2
Const INTERNET_DEFAULT_FTP_PORT = 21
Const INTERNET_SERVICE_FTP = 1
Const INTERNET_FLAG_RELOAD = &H80000000
Const INTERNET_FLAG_PASSIVE = &H8000000
Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Const INTERNET_OPEN_TYPE_DIRECT = 1
Const INTERNET_OPEN_TYPE_PROXY = 3
Const INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4
Const MAX_PATH = 260
Const PassiveConnection As Boolean = True

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

Public Declare Function InternetCloseHandle Lib "wininet" _
                        (ByRef hInet As Long) As Long
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
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
Public Declare Function InternetOpenUrl Lib "wininet.dll" _
                        Alias "InternetOpenUrlA" _
                        (ByVal hInternet As Long, _
                        ByVal lpszUrl As String, _
                        ByVal lpszHeaders As String, _
                        ByVal dwHeadersLength As Long, _
                        ByVal dwFlags As Long, _
                        ByVal dwContext As Long) As Long
Public Declare Function InternetReadFile Lib "wininet.dll" _
                        (ByVal hFtpSession As Long, _
                        ByVal strBuffer As String, _
                        ByVal lngLengthBuffer As Long, _
                        lngBytesRead As Long) As Boolean
Public Declare Function InternetWriteFile Lib "wininet.dll" _
                        (ByVal hFile As Long, _
                        ByRef sBuffer As Byte, _
                        ByVal lNumBytesToWrite As Long, _
                        dwNumberOfBytesWritten As Long) As Integer
Public Declare Function FtpSetCurrentDirectory Lib "wininet.dll" _
                        Alias "FtpSetCurrentDirectoryA" _
                        (ByVal hFtpSession As Long, _
                        ByVal lpszDirectory As String) As Boolean
Public Declare Function FtpGetCurrentDirectory Lib "wininet.dll" _
                        Alias "FtpGetCurrentDirectoryA" _
                        (ByVal hFtpSession As Long, _
                        ByVal lpszCurrentDirectory As String, _
                        lpdwCurrentDirectory As Long) As Long
Public Declare Function FtpCreateDirectory Lib "wininet.dll" _
                        Alias "FtpCreateDirectoryA" _
                        (ByVal hFtpSession As Long, _
                        ByVal lpszDirectory As String) As Boolean
Public Declare Function FtpRemoveDirectory Lib "wininet.dll" _
                        Alias "FtpRemoveDirectoryA" _
                        (ByVal hFtpSession As Long, _
                        ByVal lpszDirectory As String) As Boolean
Public Declare Function FTPDeleteFile Lib "wininet.dll" _
                        Alias "FtpDeleteFileA" _
                        (ByVal hFtpSession As Long, _
                        ByVal lpszFileName As String) As Boolean
Public Declare Function FtpRenameFile Lib "wininet.dll" _
                        Alias "FtpRenameFileA" _
                        (ByVal hFtpSession As Long, _
                        ByVal lpszExisting As String, _
                        ByVal lpszNew As String) As Boolean
Public Declare Function FtpGetFile Lib "wininet.dll" _
                        Alias "FtpGetFileA" _
                        (ByVal hConnect As Long, _
                        ByVal lpszRemoteFile As String, _
                        ByVal lpszNewFile As String, _
                        ByVal fFailIfExists As Long, _
                        ByVal dwFlagsAndAttributes As Long, _
                        ByVal dwFlags As Long, _
                        ByRef dwContext As Long) As Boolean
Public Declare Function FtpPutFile Lib "wininet.dll" _
                        Alias "FtpPutFileA" _
                        (ByVal hConnect As Long, _
                        ByVal lpszLocalFile As String, _
                        ByVal lpszNewRemoteFile As String, _
                        ByVal dwFlags As Long, _
                        ByVal dwContext As Long) As Boolean
Public Declare Function FtpOpenFile Lib "wininet.dll" _
                        Alias "FtpOpenFileA" _
                        (ByVal hFtpSession As Long, _
                        ByVal sBuff As String, _
                        ByVal Access As Long, _
                        ByVal Flags As Long, _
                        ByVal Context As Long) As Long
Public Declare Function InternetGetLastResponseInfo Lib "wininet.dll" _
                        Alias "InternetGetLastResponseInfoA" _
                        (lpdwError As Long, _
                        ByVal lpszBuffer As String, _
                        lpdwBufferLength As Long) As Boolean
Public 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
Public Declare Function InternetFindNextFile Lib "wininet.dll" _
                        Alias "InternetFindNextFileA" _
                        (ByVal hFind As Long, _
                        lpvFindData As WIN32_FIND_DATA) As Long

Dim hConnection As Long
Dim hOpen As Long
Dim sOrgPath As String
Dim pData As WIN32_FIND_DATA
Dim hFile As Long
Dim hFind As Long
Dim lRet As Long

Quelques petits exemples d'utilisations :

NB : Je n'assure pas de support en cas d'anomalies de fonctionnement !!

Lire le contenu d'une page WEB en accès HTTP

Function fReadInURL(strURL As String, _
                    Optional LenBuf As Long = 50000) As String
    Dim sBuffer As String
    sBuffer = Space(LenBuf)
    hOpen = InternetOpen("HTTPTest", 1, vbNullString, vbNullString, 0)
    hFile = InternetOpenUrl(hOpen, strURL, vbNullString, ByVal 0&, _
                            INTERNET_FLAG_RELOAD, ByVal 0&)
    InternetReadFile hFile, sBuffer, Len(sBuffer), lRet
    InternetCloseHandle hFile
    InternetCloseHandle hOpen
    fReadInURL = sBuffer
End Function

Ouvrir une session FTP

Call FTPConnect("ftp.domaine.com", "login", "password")

Public Sub FTPConnect(ftpAddress As String, _
                      ftpLogin As String, _
                      ftpPassword As String)
    hOpen = InternetOpen("SessionFTP", _
                         INTERNET_OPEN_TYPE_PRECONFIG, _
                         vbNullString, vbNullString, 0)
    hConnection = InternetConnect(hOpen, ftpAddress, _
                                  INTERNET_DEFAULT_FTP_PORT, _
                                  ftpLogin, ftpPassword, _
                                  INTERNET_SERVICE_FTP, _
                                  IIf(PassiveConnection, INTERNET_FLAG_PASSIVE, 0), 0)
End Sub

Obtenir le nom du dossier distant en cours

Public Function GetRemoteDirectory() As String
    Dim strBuffer As String
    strBuffer = String(MAX_PATH - 1, " ")
    If FtpGetCurrentDirectory(hConnection, strBuffer, MAX_PATH) <> 0 Then
        GetRemoteDirectory = Left(strBuffer, MAX_PATH)
    End If
End Function

Changer de répertoire distant

Public Sub SetRemoteDirectory(RemoteDirectory As String)
    lRet = FtpSetCurrentDirectory(hConnection, RemoteDirectory)
End Sub

Lister les fichiers présents dans un dossier distant

Public Function EnumDirectory() As String
    Dim strTmp As String
    pData.cFileName = String(MAX_PATH, 0)
    hFind = FtpFindFirstFile(hConnection, "*.*", pData, 0, 0)
    If hFind = 0 Then
        EnumDirectory = "Operation failed"
        Exit Function
    End If
    EnumDirectory = Left(pData.cFileName, _
                         InStr(1, pData.cFileName, _
                               String(1, 0), vbBinaryCompare) - 1)
    Do
        pData.cFileName = String(MAX_PATH, 0)
        hFind = InternetFindNextFile(hFind, pData)
        If hFind = 0 Then: Exit Do
        strTmp = Left(pData.cFileName, _
                      InStr(1, pData.cFileName, _
                            String(1, 0), vbBinaryCompare) - 1)
        EnumDirectory = EnumDirectory & ";" & strTmp
    Loop
End Function

Télécharger un fichier distant depuis le FTP

Public Sub DownloadRemoteFileFTP(strFileName As String, _
                                 strLocalPath As String)
    If Right(strLocalPath, 1) <> "" Then: strLocalPath = strLocalPath & ""
    lRet = FtpGetFile(hConnection, strFileName, _
                      strLocalPath & strFileName, 0, 0, 1, 0)
    If lRet = 0 Then
        MsgBox "Le fichier " & strFileName & _
               " n'a pas été trouvé ou le dossier " & _
               strLocalPath & " n'existe pas."
    Else
        MsgBox "Le fichier " & strLocalPath & strFileName & _
               " a été enregistré"
    End If
End Sub

Supprimer un fichier distant

Public Sub FTPDeleteRemoteFile(strFile As String, Optional strFolder = "")
    lRet = FTPDeleteFile(hConnection, strFolder & "" & strFile)
End Sub

Télécharger un fichier local vers le FTP

Public Sub UploadLocalFile(strPathFileName As String, Optional strRemoteFolder = "")
    Dim strFileName As String
    strFileName = Right(strPathFileName, _
                        Len(strPathFileName) - _
                        InStrRev(strPathFileName, _
                                 "", -1, vbTextCompare))
    lRet = FtpPutFile(hConnection, strPathFileName, _
                      strRemoteFolder & "" & strFileName, 1, 0)
End Sub

Obtenir la dernière erreur rencontrée

Sub ShowError()
    Dim lErr As Long, sErr As String, LenBuf As Long
    'get the required buffer size
    InternetGetLastResponseInfo lErr, sErr, LenBuf
    'create a buffer
    sErr = String(LenBuf, 0)
    'retrieve the last response info
    InternetGetLastResponseInfo lErr, sErr, LenBuf
    'show the last response info
    MsgBox "Error " + CStr(lErr) + ": " + sErr, vbOKOnly + vbCritical
End Sub

Fermer la session FTPOn rajoutera systématiquement ces deux lignes de code à la fin du programme :
 

    InternetCloseHandle hConnection
    InternetCloseHandle hOpen

Autres possibilités offertes par cette API :

• Ecrire dans un fichier (InternetWriteFile)
• Créer un dossier distant (FtpCreateDirectory)
• Supprimer un dossier distant (FtpRemoveDirectory)
• Renommer un fichier (FtpRenameFile)