Télécharger un fichier d' un serveur ftp

Télécharger le projet
Commenter

Description

Ce Code permet d' abord d' enumérer les differents fichier présent sur un serveur FTP
et ensuite de les telecharger sur votre pc

Source / Exemple : 


Option Explicit

Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" _
    (ByVal Agent As String, ByVal access As Long, ByVal proxy As String, _
    ByVal bypass As String, ByVal flags As Long) As Long
Private Declare Function InternetConnect Lib "wininet" Alias "InternetConnectA" _
    (ByVal handle As Long, ByVal server As String, ByVal port As Long, _
    ByVal user As String, ByVal password As String, ByVal services As Long, _
    ByVal flags As Long, ByVal context As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet" (ByVal handle As Long) As Long

Const MAX_PATH = 260

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

Private Declare Function FtpFindFirstFile Lib "wininet" Alias "FtpFindFirstFileA" _
    (ByVal hFtpSession As Long, ByVal lpszSearchFile As String, _
    lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetFindNextFile Lib "wininet" Alias "InternetFindNextFileA" _
    (ByVal hFtpSession As Long, lpFindFileData As WIN32_FIND_DATA) As Boolean
Private Declare Function FtpSetCurrentDirectory Lib "wininet" Alias _
    "FtpSetCurrentDirectoryA" (ByVal handle As Long, ByVal directory As String) As Long
Private Declare Function FtpGetFile Lib "wininet" Alias "FtpGetFileA" _
    (ByVal handle As Long, ByVal remotefile As String, ByVal localfile As String, _
    ByVal ifexits As Long, ByVal attributes As Long, ByVal flags As Long, _
    ByVal context As Long) As Long

Const INTERNET_OPEN_TYPE_PRECONFIG As Long = 0
Const INTERNET_DEFAULT_PORT As Long = 21
Const INTERNET_INVALID_PORT_NUMBER As Long = 0
Const INTERNET_CONNECT_FLAG_PASSIVE As Long = &H80000000
Const INTERNET_SERVICE_FTP As Long = 1
Const FTP_TRANSFER_TYPE_ASCII As Long = 1
Const FTP_TRANSFER_TYPE_BINARY As Long = 2
Const FILE_ATTRIBUTE_NORMAL = &H80

Dim hNetConn As Long
Dim hFTPConn As Long
Dim sDir As String
Private Sub cbkb_Click()
    Dim fConn As Long
    Dim fData As WIN32_FIND_DATA
    Dim fResult As Boolean
    Dim stat As Long

    ' Choisir un emplacement  serveur     Select Case cbKB.ListIndex
        Case 0
            sDir = "developr/vb/kb"
        Case 1
            sDir = "developr/visual_c/kb"
        Case 2
            sDir = "deskapps/access/kb"
        Case 3
            sDir = "deskapps/excel/kb"
        Case 4
            sDir = "deskapps/word/kb"
    End Select
    
    If hNetConn Then
        ' Change le pointeur souris
        Screen.MousePointer = 11
        ' Créer une connection avec le serveur FTP
        hFTPConn = InternetConnect(hNetConn, "ftp.microsoft.com", _
            INTERNET_INVALID_PORT_NUMBER, vbNullString, vbNullString, _
            INTERNET_SERVICE_FTP, INTERNET_CONNECT_FLAG_PASSIVE, 0)
        If hFTPConn Then
            If sDir <> "" Then
                stat = FtpSetCurrentDirectory(hFTPConn, sDir)
            End If
            fConn = FtpFindFirstFile(hFTPConn, "*.*", fData, 0, 0)
            If fConn Then
                fResult = True
                ' effacer tous les éléments de lq liste
                lbFiles.Clear
                Do While fResult
                    ' ajout du nom du fichier à la liste                    lbFiles.AddItem fData.cFileName
                    ' Ajout de nom du fichier suivant
                    fResult = InternetFindNextFile(fConn, fData)
                Loop
            End If
        End If
        InternetCloseHandle (hFTPConn)
        ' Changement du pointeur souris à sa forme par défaut
        Screen.MousePointer = 0
    End If
End Sub

Private Sub cbRetrieve_Click()
    Dim i As Integer
    Dim stat As Long
    Dim transfer As Long

    ' éetermine le mode transfert
    If opASCII.Value Then
        transfer = FTP_TRANSFER_TYPE_ASCII
    Else
        transfer = FTP_TRANSFER_TYPE_BINARY
    End If

    If hNetConn Then
        '
        Screen.MousePointer = 11
        ' commence la connection au serveur FTP
        hFTPConn = InternetConnect(hNetConn, "ftp.microsoft.com", INTERNET_DEFAULT_PORT, _
            vbNullString, vbNullString, INTERNET_SERVICE_FTP, INTERNET_CONNECT_FLAG_PASSIVE, 0)
        If hFTPConn Then
            If sDir <> "" Then
                stat = FtpSetCurrentDirectory(hFTPConn, sDir)
            End If
        End If

        ' verifie si il y a selection d' au mons un fichier
        For i = 0 To lbFiles.ListCount - 1
            If lbFiles.Selected(i) Then
                If hFTPConn Then
                    ' téléchargement du fichier
                    stat = FtpGetFile(hFTPConn, lbFiles.List(i), _
                        tbCurDir.Text & "\" & lbFiles.List(i), 1, _
                        FILE_ATTRIBUTE_NORMAL, transfer, 0)
                End If
            End If
        Next i
        
        InternetCloseHandle (hFTPConn)
        '
        Screen.MousePointer = 0
    End If
End Sub

Private Sub Form_Load()
    'Ajout des sections

    cbKB.AddItem "Microsoft Visual Basic"
    cbKB.AddItem "Microsoft Visual C++"
    cbKB.AddItem "Microsoft Access"
    cbKB.AddItem "Microsoft Excel"
    cbKB.AddItem "Microsoft Word"
    
    ' initalisatione du  WININET API
    hNetConn = InternetOpen("FTP Example", INTERNET_OPEN_TYPE_PRECONFIG, _
        vbNullString, vbNullString, 0)

    ' initialization de l' emplacement de téléchargement
    tbCurDir = CurDir
End Sub

Private Sub Form_Unload(Cancel As Integer)
    InternetCloseHandle (hNetConn)
End Sub

Private Sub lbFiles_Click()
    If lbFiles.SelCount > 0 Then
        cbRetrieve.Enabled = True
    Else
        cbRetrieve.Enabled = False
    End If
End Sub
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (vbGuy)