Récupérer une liste de fichiers et l'affciher dans le programme en VB6

**avigeilpro** · 03/07/2006, 17h40

euh ... il est ou ton fichier zip ??

**Ribéry** · 03/07/2006, 18h21

voila. Preiens qd je peux l'enlever, j prefere pas trop laisser la source...

**avigeilpro** · 03/07/2006, 18h22

c ok

**avigeilpro** · 03/07/2006, 19h14

Bon, a quel endroit de ta feuille récupère tu la liste, et ou doit tu l'utiliser ? Parce que la ton prog il est assez conséquent et jme vois mal le décortiquer.

**Ribéry** · 03/07/2006, 20h32

C'est dans la form "Télécharge". A la fin du programme.

**Ribéry** · 03/07/2006, 20h33

Ah et je dois l'utiliser dans le controle "Fichiers".

**Ribéry** · 04/07/2006, 16h05

Rebonjour a tous,

J'ai utilisé un code que j'ai trouvé ds les FAQ relatives au controle INET:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Public Function ScanFolderFtp(Optional FolderPath As String = "", Optional Filename As String = "", Optional SubFold As Boolean = True) As Long
'-- Fonction récursive pour l'exploration des répertoires Ftp
 
    Dim StrPath() As String
    Dim subFolders As New Collection
    Dim i As Integer
 
    With Inet1
        .Execute , "DIR "
        WaitExecute Inet1
        StrPath = Split(Replace(StrScanFolderFtp, "/", "\"), vbCrLf)
        For i = 0 To UBound(StrPath) - 1
            '-- Affichage dans la listbox
            If InStr(1, StrPath(i), ".\") = 0 And Len(StrPath(i)) > 0 Then
                MiseJourFichiers.List1.AddItem AddSlash(FolderPath) & StrPath(i)
            End If
            '-- Remplir la collection des sous-dossiers du dossier en cours
            If Right(StrPath(i), 1) = "\" And InStr(1, StrPath(i), ".\") = 0 Then
                subFolders.Add Left(StrPath(i), Len(StrPath(i)) - 1)
            End If
        Next
        '-- Renvoie le nombre d'éléments du dossier en cours
        ScanFolderFtp = UBound(StrPath)
 
        '--Recherche dans les sous-dossiers
        If SubFold Then
            For i = 1 To subFolders.Count
                Debug.Print subFolders.Item(i)
                .Execute , "CD " & subFolders.Item(i)
                WaitExecute Inet1
                DoEvents
                If CancelAction Then Exit Function
                ScanFolderFtp = ScanFolderFtp + ScanFolderFtp(AddSlash(FolderPath) & subFolders.Item(i), , SubFold)
                .Execute , "CDUP"
                WaitExecute Inet1
            Next i
        End If
 
        '-- Vide la collection des sous-dossiers
        Set subFolders = Nothing
    End With
End Function

Ca c une partie du code et j'aimerais bien à partir de ca, effectuer une operation. En sélectionnant un nom de fichier, le déplacer dans une autre ListView qd on clique sur un bouton. Si qqun a une solution...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Private Sub ADroite_Click()
 
End Sub

(ca c le code du click sur le bouton pour info

**SfJ5Rpw8** · 04/07/2006, 16h17

et les 2 listView et le bouton sont sur la même form.?
de mémoire j'ai pas VB sous la main pour corriger les erreurs de syntaxes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
if list1.listIndex >= 0 then
  List2.AddItem List1.list(List1.ListIndex)
  List1.RemoveItem(List1.ListIndex)
 
endif

**Ribéry** · 04/07/2006, 16h23

Nickel ca marche. Et t as pas un petit truc vite fait pour interdire qu on mette deux fois le meme fichier ?

**Ribéry** · 04/07/2006, 16h28

Nan c'est bon desole j avais enlevé l option remove qd j ai testé. C bon

**Ribéry** · 04/07/2006, 16h51

J'ai un autre soucis. J'aimerais bien afficher une liste d'autres fichiers qui sont contenus dans la variable "ListeFichiersCréés". Auparavant j'arrivais à l'afficher dans une ListView mais la j'arrive pas dans la listBox.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
Private Sub AfficheInfoFichiers()
    Dim ItemX           As ListItem
    Dim Cpte            As Integer
    Dim ListeFichiersCréés As New clsListeObjet
 
    DoEvents
 
    'Constitution de la liste des fichiers déclarés
    '**********************************************
    ListeFichiersCréés.Populate mFichiers
 
    With ListeFichiersCréés
        If .Count Then
            'Il y a des modules déclarés
            '***************************
            For Cpte = 1 To .Count
            List2.AddItem ...
            Next Cpte
 
        End If
    End With
End Sub

**SfJ5Rpw8** · 04/07/2006, 17h11

ben cela dépend de ta classe .. clsListeObjet ... un truc du genre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
..
For Cpte = 0 To .Count
            List2.AddItem ListeFichiersCréés(cpte) 
 Next Cpte
...

... ou ListeFichiersCréés.List(cpte)

**Ribéry** · 05/07/2006, 09h06

Bonjour tout le monde,

Voila j'ai un soucis dans mon code. Le code permet de récupérer une liste de fichiers à partir d'un ftp. Il affiche cette liste dans List1 et si l'on clique sur le bouton "ADroite", il place la selection dans List2. Le pb c'est que si je recharge la liste de fichiers dans List1 et que je rajoute le même fichier, il se place aussi dans List2. Ce que j'aimerais c'est qu'il ne s'y place si les deux fichiers ont le meme nom....

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
 
 
Option Explicit
 
'***********************************************************************************
'*Contrôle : MiseJourFichiers                                                      *
'*Projet   : Configurateur                                                         *
'*Date     : 04/07/2006                                                            *
'*Auteur   :                                                         *
'***********************************************************************************
'*                                                                                 *
'*                                                                                 *
'*                                                                                 *
'***********************************************************************************
 
Private m_Création          As Boolean
Dim StrScanFolderFtp As String
Dim CancelAction As Boolean
 
Public Function AddSlash(ByVal SlashStr As String) As String
'-- Ajouter un "\" dans un path
    If Len(SlashStr) = 0 Then Exit Function
    If Right$(SlashStr, 1) <> "\" Then SlashStr = SlashStr & "\"
    AddSlash = SlashStr
End Function
 
Sub WaitExecute(InetCtl As Inet)
'-- Attendre la fin d'execution d'une instruction d'un controle Inet
    While InetCtl.StillExecuting
        DoEvents
    Wend
End Sub
Public Function ScanFolderFtp(Optional FolderPath As String = "", Optional Filename As String = "", Optional SubFold As Boolean = True) As Long
'-- Fonction récursive pour l'exploration des répertoires Ftp
 
    Dim StrPath() As String
    Dim subFolders As New Collection
    Dim i As Integer
 
    With Inet1
        .Execute , "DIR "
        WaitExecute Inet1
        StrPath = Split(Replace(StrScanFolderFtp, "/", "\"), vbCrLf)
        For i = 0 To UBound(StrPath) - 1
            '-- Affichage dans la listbox
            If InStr(1, StrPath(i), ".\") = 0 And Len(StrPath(i)) > 0 Then
                MiseJourFichiers.List1.AddItem AddSlash(FolderPath) & StrPath(i)
            End If
            '-- Remplir la collection des sous-dossiers du dossier en cours
            If Right(StrPath(i), 1) = "\" And InStr(1, StrPath(i), ".\") = 0 Then
                subFolders.Add Left(StrPath(i), Len(StrPath(i)) - 1)
            End If
        Next
        '-- Renvoie le nombre d'éléments du dossier en cours
        ScanFolderFtp = UBound(StrPath)
 
        '--Recherche dans les sous-dossiers
        If SubFold Then
            For i = 1 To subFolders.Count
                Debug.Print subFolders.Item(i)
                .Execute , "CD " & subFolders.Item(i)
                WaitExecute Inet1
                DoEvents
                If CancelAction Then Exit Function
                ScanFolderFtp = ScanFolderFtp + ScanFolderFtp(AddSlash(FolderPath) & subFolders.Item(i), , SubFold)
                .Execute , "CDUP"
                WaitExecute Inet1
            Next i
        End If
 
        '-- Vide la collection des sous-dossiers
        Set subFolders = Nothing
    End With
End Function
 
Private Sub Ajouter_Click(Index As Integer)
Dim FichPres As Boolean
Dim i As Integer
 
    FichPres = False
    If List1.ListIndex >= 0 Then
        For i = 0 To List2.ListCount - 1
            If List1.List(List1.ListIndex) = List2.List(i) Then
                FichPres = True  'Fichier présent dans la List2
            End If
        Next i
        If Not FichPres Then
            List2.AddItem List1.List(List1.ListIndex)
            List1.RemoveItem (List1.ListIndex)
        End If
 
    End If
 
    Load SaisieNouveau
    SaisieNouveau.InitSaisie mFichiers, 0, Trim("om")
    SaisieNouveau.Show vbModal, Me
 
End Sub
 
Private Sub Annuler_Click(Index As Integer)
    m_Création = False
    Unload Me
End Sub
 
 
Private Sub Supprime_Click()
If List2.ListIndex >= 0 Then
  List2.RemoveItem (List2.ListIndex)
End If
End Sub
 
Private Sub Command2_Click()
    With Inet1
    List1.Clear
        .AccessType = icDirect
        .Protocol = icFTP
        .URL = txtURL.Text
        .UserName = txtName.Text
        .Password = txtPassword.Text
        ScanFolderFtp
        .Execute , "CLOSE"
        WaitExecute Inet1
 
    End With
 
End Sub
 
Private Sub Form_Load()
    txtURL.Text =
    txtName.Text =
    txtPassword.Text =
    LoadResStrings Me
    AfficheInfoFichiers
End Sub
 
Private Sub Inet1_StateChanged(ByVal State As Integer)
' Récupère la réponse du serveur à l'aide de
' la méthode GetChunk lorsque State = 12.
 
    Dim vtData As Variant    ' Variable Data.
    Select Case State
    Case icError    ' 11
    ' En cas d'erreur, renvoie ResponseCode et
    ' ResponseInfo.
        vtData = Inet1.ResponseCode & ":" & _
                Inet1.ResponseInfo
    Case icResponseCompleted
        Dim strData As String
        Dim bDone As Boolean: bDone = False
 
        ' Lecture du premier segment
        vtData = Inet1.GetChunk(1024, icString)
        DoEvents
 
        ' Lecture des segments suivants
        Do While Not bDone
            strData = strData & vtData
            vtData = Inet1.GetChunk(1024, icString)
            DoEvents
 
            If Len(vtData) = 0 Then
                bDone = True
            End If
        Loop
        StrScanFolderFtp = strData
    End Select
 
End Sub
 
Private Sub AfficheInfoFichiers()
 
    Dim ItemX           As ListItem
    Dim Cpte            As Integer
    Dim ListeFichiersCréés As New clsListeObjet
 
    DoEvents
 
    'Constitution de la liste des fichiers déclarés
    '**********************************************
    ListeFichiersCréés.Populate mFichiers
 
    With ListeFichiersCréés
        If .Count Then
            'Il y a des modules déclarés
            '***************************
            For Cpte = 1 To .Count
                List2.AddItem (Item)
            Next Cpte
 
        End If
    End With
End Sub

Si qqun a une solution...

**Theocourant** · 05/07/2006, 09h32

Envoyé par Ribéry

Bonjour tout le monde,

Voila j'ai un soucis dans mon code. Le code permet de récupérer une liste de fichiers à partir d'un ftp. Il affiche cette liste dans List1 et si l'on clique sur le bouton "ADroite", il place la selection dans List2. Le pb c'est que si je recharge la liste de fichiers dans List1 et que je rajoute le même fichier, il se place aussi dans List2. Ce que j'aimerais c'est qu'il ne s'y place si les deux fichiers ont le meme nom....

Si qqun a une solution...

As-tu contrôlé la présence des fichiers de la List1 dans la List2 avent d'ajouter tout fichier à la List2 ?

Il faut parcourrir chaque élément à transférer de la List1 et le comparer avec l'ensemble des éléments de la List2 => boucles imbriquées ... je te laisse travailler sur la suite ...

+

Théo

**Ribéry** · 05/07/2006, 09h36

Ouais c ce que j'aimerais faire mais j sais pas comment faire...

**Theocourant** · 05/07/2006, 09h58

Re,

Donc pour ton code de la sub ADroite :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Sub ADroite_Click()
Dim FichPres As Boolean
 
    FichPres = False
    If List1.ListIndex >= 0 Then
        For i = 0 To List2.ListCount - 1
            If List1(List1.Index).Text = List2(i).Text Then
                FichPres = True  'Fichier présent dans la List2
            End If
        Next i
        If Not FichPres Then
            List2.AddItem List1.List(List1.ListIndex)
        End If
        List1.RemoveItem (List1.ListIndex)
    End If
End Sub

+

Théo

**Ribéry** · 05/07/2006, 10h09

J'ai des erreurs dans cette ligne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If List1(List1.Index).Text = List2(i).Text Then

L'erreur c'est "Nombre d'arguments incorrects"...

+

**Theocourant** · 05/07/2006, 10h18

Re,

Je viens de me rendre compte que tu as donné toutes les indications pour se connecter à ton ftp cible y compris les codes d'accès !!!!!!!!!!!!!!!!!!!!!!!!!!

Edite ton sujet et supprime les de toute urgence

Théo

**Ribéry** · 05/07/2006, 10h20

merde j'avais pas pensé

merci

**Theocourant** · 05/07/2006, 10h21

Envoyé par Ribéry

J'ai des erreurs dans cette ligne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If List1(List1.Index).Text = List2(i).Text Then

L'erreur c'est "Nombre d'arguments incorrects"...

+

Désolé erreur de ma part

Corrigé (normalement)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If List1(List1.Index) = List2(i) Then

+

Théo

Récupérer une liste de fichiers et l'affciher dans le programme en VB6

VB 6 et antérieur

Discussions similaires

Partager

Partager