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
| Function ListeFtpFile(stServ As String, stLogin As String, stPass As String, _
stRepFtp As String, Optional stFiltre As String) As Boolean
' Cette fonction liste les fichiers sur un serveur FTP.
' stServ contient le nom ou l'adresse IP du serveur FTP
' stLogin est le login à utiliser
' stPass est le mot de passe associé au login
' stRepFtp est le répertoire FTP ou s'effectuera la recherche
' stFiltre est le nom du fichier qui sera effacé du serveur
' La fonction retourne Vrai si le listage à réussi, sinon Faux.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Dim HwndConnect As Long
Dim HwndOpen As Long
Dim inRes As Integer
Dim strFile As String
Dim zErreur
'""""""""
Dim strTmp As String
pData.cFileName = String(MAX_PATH, 0)
'""""""""""""""""""""""
On Error GoTo GestErreur
If stFiltre = "" Then stFiltre = "*.*"
'Ouvre internet
HwndOpen = InternetOpen("ListeFtpFile", 1, vbNullString, vbNullString, 0)
If HwndOpen Then
AjoutMess ("Connection ... ")
'Connection au site ftp
HwndConnect = InternetConnect(HwndOpen, stServ, 21, stLogin, _
stPass, 1, 0, 0)
If HwndConnect Then
AjoutMess ("Connecté au serveur: " & stServ)
If stRepFtp = "/" Then GoTo Racine
'Changer le repertoire ftp
If FtpSetCurrentDirectory(HwndConnect, stRepFtp) Then
AjoutMess ("Répertoire courant : " & stRepFtp)
Racine:
'Liste les fichiers présents sur le site
AjoutMess ("Recherche des fichiers: ")
hFind = FtpFindFirstFile(HwndConnect, stFiltre, pData, INTERNET_FLAG_RELOAD, 0)
If hFind = 0 Then GoTo zerofichier
If hFind Then
If hFind > 0 And CBool(pData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = False Then
strTmp = Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
AjoutMess (strTmp)
ListeFtpFile = True
End If
Do
lRet = InternetFindNextFile(hFind, pData)
If lRet = 0 Then: Exit Do
If lRet > 0 And CBool(pData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = False Then
strTmp = Left(pData.cFileName, InStr(1, pData.cFileName, _
String(1, 0), vbBinaryCompare) - 1)
AjoutMess (strTmp)
ListeFtpFile = True
End If
Loop
End If
Else
AjoutMess ("Impossible de se positionner sur le répertoire " & stRepFtp)
GoTo GestErreur
End If
Else
AjoutMess ("Impossible d'établir la connexion avec le SERVEUR")
GoTo GestErreur
End If
Else
AjoutMess ("Impossible d'ouvrir la connexion INTERNET")
GoTo GestErreur
End If
GoTo FinNormale
zerofichier:
'Pas de fichier
If Err.Number = 92 Then
AjoutMess (" Erreur : PAS DE FICHIER SUR LE SITE FTP ")
End If
GestErreur:
zErreur = ShowError
AjoutMess ("Impossible de générer la liste :" & zErreur)
ListeFtpFile = False
FinNormale:
AjoutMess ("Déconnection...")
' Libération du pointeur
inRes = InternetCloseHandle(HwndConnect)
InternetCloseHandle HwndOpen 'Ferme internet
End Function |
FTP Wininet lister les fichiers AS 400
Répondre avec citation
Envoyé par patoucib
Partager