Lister les fichiers d'un serveur FTP en boucle

Version imprimable

Bonjour,

Je veux surveiller le trafique de fichier sur un serveur ftp. J'ai un script qui me liste les fichiers sur ce serveur puis qui se met en pause 10 minutes, liste de nouveau les fichiers, se met en pause, etc. Le problème c'est que la méthode que j'utilise me renvoie toujours la même liste de fichier, même si celle-ci a effectivement changé.

Voici la fonction qui me renvoie la liste de fichiers :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Private Function ftpList(strFTPlocation, strUser, strPassword) Dim myShell Dim strConnect set ftpList = nothing Set myShell = CreateObject("Shell.Application") If strUser <> "" Then strConnect = strUser & ":" & strPassword & "@" Set ftpList = myShell.Namespace("FTP://" & strConnect & strFTPlocation).Items ''''' debugFileList ftpList ''''' set myShell = Nothing End Function
Pour voir la mise à jour de cette liste, il faut que j'arrete mon script puis que je le relance... Ne voulant pas utiliser de planificateur de tâche pour lancer régulièrement ce script, je suis un peu coincé.

Une idée ?

Un peu l'équivalent de ce que tu as fait mais qui tourne en continu.
Si tu ne réponds pas à temps au message , il sera affiché en continu et tu seras obligé de l'arrêter par le bouton "Annuler":

Code:

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
  t0 = Second(Now)
 Do
   t1 = Second(Now)
   Call ftpList
   If Duration(t0, t1) Then 
      Pause 2
      t0 = Second(Now) - 5
   End If
 Loop
Private Function ftpList()
    Dim myShell
    'Dim ftpList
 
    set ftpList = nothing
    strConnect = "ftp.symantec.com/public/english_us_canada/antivirus_definitions/norton_antivirus/"
    Set myShell = CreateObject("Shell.Application")
    'If strUser <> "" Then strConnect = strUser & ":" & strPassword & "@"
    Set ftpList = myShell.Namespace("FTP://" & strConnect).Items
    '''''
    debugFileList ftpList
    '''''
    set myShell = Nothing
 
End Function
'====================
Private Sub debugFileList(myListe)
    For Each F In myListe
       s = s & f.Name & vbnewline
    next
    MsgBoxPlus S, "", "Lister les fichiers FTP",900
End Sub
'====================
Private Function MsgBoxPlus(Msg, btnType, sTitle, MaxnumCharToDisplay)
    Dim nbMessages, Compt, RetMsg(500), I, K, NumRC, tmp
    'Si l'erreur "Indice en dehors de la plage 'I'" se produit, il faut
    ' augmenter la taille de RetMsg(50) et mettre par exemple RetMsg(100)   
    If sTitle = "" Then sTitle = Wscript.ScriptName
    NumRC = Ubound(Split(Msg, vbCrLf))-2
    nbMessages = Round((Len(Msg)-2*NumRC)/MaxnumCharToDisplay + 0.4)-1
    If btnType = "" Then btnType = vbYesNoCancel Or vbOkOnly
    If MaxnumCharToDisplay > 800 Then MaxnumCharToDisplay = 800
    I = 0
    For K = Lbound(Split(Msg, vbCrLf)) To Ubound(Split(Msg, vbCrLf)) 
       RetMsg(i) = RetMsg(i) & Split(Msg, vbCrLf)(K) & vbCrLf
         If Len(RetMsg(i)) >= MaxnumCharToDisplay Then 
            I =I + 1
         End If
    Next 
    tmp = 0 
    For Compt = 0 To nbMessages
       If RetMsg(Compt) = "" Then tmp = tmp + 1 ' cherche le nombre de messages vides
    Next
    tmp = tmp - 1 ' Il y a un message vide en trop, on l'enlève
    For Compt = 0 To nbMessages
       If RetMsg(Compt) <> "" Then
          ' Si le nombre de messages est important, on peut arrêter le script avec "Annuler"
          dim Reponse
          Reponse = MsgBox(RetMsg(Compt),btnType , sTitle)
          If Reponse = vbCancel Then ' On quit Wscript          
             WScript.Quit 0
          ElseIf Reponse = vbNo Then ' On sort de la fonction
             Exit Function
          Else
            'OK = continue l'affichage des messages
          End If
        End If
    Next
End Function
'===================
 Function Duration(t0,t1)
     t1 = Second(Now)
     Duration = Abs(t0-t1) >= 20
 End Function
'=========================
 Sub Pause(intMinute)
    WScript.Sleep intMinute*60000
 End Sub

Je n'ai pas tenu compte du nom et du mot de passe puisque je n'en ai pas besoin pour le serveur de l'exemple.
Il y a certes quelque chose à faire pour fignoler ce script que j'ai codé à la hâte.

13/08/2015, 09h58
GroMoche

Merci pour la réponse!

Je ne vois pas bien ce qui change par rapport à mon script et donc ce qui va permettre que la liste renvoyée par la fonction soit à jour... Je n'ai peut être pas été très clair, mais mon problème n'est pas de faire boucler le script, mais plutôt que la liste que me renvoie la boucle soit à jour. En effet, itération après itération, la liste renvoyée par mon script reste invariablement la même alors qu'il y a des modifications sur le serveur. Il est là mon problème.
13/08/2015, 17h12
l_autodidacte

Est-ce les fichiers et/ou dossiers sur le serveurs changent en nom et nombre ou simplement la date d'upload qui change ?
Si c'est ce dernier cas, il faut alors voir du côté de la propriété ModifyDate de chaque élément de la collection Items.

J'ai envoyé à cet effet une contribution qui pourrait te rendre service (mais à adapter pour obtenir le résultat escompté)
14/08/2015, 09h53
GroMoche

C'est de nouveaux fichiers qui sont déposés, traités et archivés. Régulièrement, une des 3 actions ne se déroule pas comme prévu.

Mon problème vient du fait que le "namespace" me renvoie toujours les mêmes informations tant que le script tourne. Si je l'arrete et le relance, les informations sont bien mises à jour.

:(

La solution serait simple si on utilise un second script qui lance le script principal à intervalles réguliers et qui s'arrête lui-même si une condition lui est ajoutée:

Code:

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
Option Explicit 
 
    Dim WS, strCommand, HrDebut,HrFin
 
    Set WS = CreateObject("Wscript.Shell") 
    strCommand = ".\ftpList.vbs" ' Mettre ici le nom du fichier script
    HrDebut = Now
    Do
      ' Dans ce cas, le fichier script(ftpList.vbs) devra être modifié pour qu'il
      ' s'exécute une seule fois puisqu'il sera lancé auto
      WS.Run strCommand, 0, True
      ' fait une pause de 10 minutes
      Pause 1  ' Pour le test, j'ai choisi 1mn
      HrFin = Now
      ' Le script tournera pendant 10 heures si la condition suivante est maintenue
      ' sinon on la remplace par Loop
      ' Ou encore en introduisant une invite pour continuer ou arrêter :
      '++++++++++++++++++++++++++
        If DateDiff("n", HrDebut,HrFin) >= 2 Then ' ici mettre la valeur voulue en minutes
           'ou en heures en remplaçant "n" par "h" dans la ligne précédente et dans Loop Until
           Dim Reponse
           Reponse = MsgBox("Arrêter le script ou non ?", vbYesNo,"Quel est votre choix")
           If Reponse = vbYes Then    
              Exit Do
              WScript.Quit 0
           End If
        End If
       '++++++++++++++++++++++++++
    Loop Until DateDiff("n", HrDebut,HrFin) >=10 
'========================
Sub Pause(intMinute)
    WScript.Sleep intMinute*60000
 End Sub

Avec le script que j'ai envoyé avant mais un peu modifié(donne entre autres la taille du fichier), on aura :

Code:

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
   Call ftpList
 
Private Function ftpList()
    Dim myShell
    set ftpList = nothing
    strConnect = "ftp.symantec.com/public/english_us_canada/antivirus_definitions/norton_antivirus/"
    Set myShell = CreateObject("Shell.Application")
    'If strUser <> "" Then strConnect = strUser & ":" & strPassword & "@"
    Set ftpList = myShell.Namespace("FTP://" & strConnect).Items
    '''''
    debugFileList ftpList
    '''''
    set myShell = Nothing
 
End Function
'====================
Private Sub debugFileList(myListe)
    dim spc
    For Each F In myListe
       s = s & f.Name & String((35-Len(f.name))/6,vbTab) & " Size = " & Convert(F.Size) _
       & String((12-Len(Convert(F.Size)))/4,vbTab) & "  Modification : " & f.ModifyDate & vbnewline
    next
    MsgBoxPlus S, "", "Lister les fichiers FTP",900
End Sub
'====================
Private Function MsgBoxPlus(Msg, btnType, sTitle, MaxnumCharToDisplay)
    Dim nbMessages, Compt, RetMsg(500), I, K, NumRC, tmp
 
    If sTitle = "" Then sTitle = Wscript.ScriptName
    NumRC = Ubound(Split(Msg, vbCrLf))-2
    nbMessages = Round((Len(Msg)-2*NumRC)/MaxnumCharToDisplay + 0.4)-1
    If btnType = "" Then btnType = vbYesNoCancel Or vbOkOnly
    If MaxnumCharToDisplay > 800 Then MaxnumCharToDisplay = 800
    I = 0
    For K = Lbound(Split(Msg, vbCrLf)) To Ubound(Split(Msg, vbCrLf)) 
       RetMsg(i) = RetMsg(i) & Split(Msg, vbCrLf)(K) & vbCrLf
         If Len(RetMsg(i)) >= MaxnumCharToDisplay Then 
            I =I + 1
         End If
    Next 
    tmp = 0 
    For Compt = 0 To nbMessages
       If RetMsg(Compt) = "" Then tmp = tmp + 1 ' cherche le nombre de messages vides
    Next
    tmp = tmp - 1 ' Il y a un message vide en trop, on l'enlève
    For Compt = 0 To nbMessages
       If RetMsg(Compt) <> "" Then
          ' Si le nombre de messages est important, on peut arrêter le script avec "Annuler"
          dim Reponse
          Reponse = MsgBox(RetMsg(Compt),btnType , sTitle)
          If Reponse = vbCancel Then ' On quit Wscript          
             WScript.Quit 0
          ElseIf Reponse = vbNo Then ' On sort de la fonction
             Exit Function
          Else
            'OK = continue l'affichage des messages
          End If
        End If
    Next
End Function
'===================
 Public Function Convert(Sz)
   Dim SizePlus
    If Sz < 1024 Then
       SizePlus = CStr(Sz) + " Oct"
    ElseIf Sz >= 1024 And Sz < 819200 Then
       SizePlus = CStr(FormatNumber((Sz / 1024), 2)) + " Ko"
    ElseIf Sz >= 8912 And Sz < 1027604480 Then 
       Sz = Sz / 1024
       SizePlus = CStr(FormatNumber(Sz / 1024, 2)) + " Mo"
    ElseIf Sz >= 1027604480 Then 
       Sz = Sz / 1024
       Sz = Sz / 1024
       SizePlus = CStr(FormatNumber(Sz / 1024, 2)) + " Go"
    End If
    Convert = SizePlus
End Function