FTP sous VBS pour test débit avec affichage du résultat

**hackoofr** · 07/06/2012, 16h19

Bon, je vous mets la version "Bêta" corrigée qui prend en compte les espaces dans les chemins des fichiers destiné pour l'upload

Alors maintenant, je vous invite vous et les autres chers membres à tester cette version avant de la déposer dans la section Téléchargements.
et s'il y a par hasard un BUG, Avertissez-moi ; Sinon

en masse

File2FTPUpload.hta :

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
<html> 
<head> 
<HTA:APPLICATION 
    ICON="explorer.exe"
    APPLICATIONNAME = "File2FTP Uploader © Hackoo © 2012" 
    BORDER="dialog"
    BORDERSTYLE="complex"
    CONTEXTMENU="no"
    SYSMENU="yes"
    MAXIMIZEBUTTON="no"
    SCROLL="no" 
>
<title>File2FTP Uploader © Hackoo © 2012</title> 
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1"> 
<style>
    body{
     filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=0, StartColorStr='#8ff2ff', EndColorStr='#008785');
    }
    Input,label,.btn{
        font-weight: bold;
        background-color:lightred;
    }
</style>
<script language="VBScript">
    Sub window_onload()
       CenterWindow 420, 615
    End Sub
 
    Sub CenterWindow(x,y)
        window.resizeTo x, y
        iLeft = window.screen.availWidth/2 - x/2
        itop = window.screen.availHeight/2 - y/2
        window.moveTo ileft, itop
    End Sub
 
Sub Upload() 
If file1.Value = "" Then 'Assurer que le fichier a uplodé n'est pas vide sinon on déclenche un message d'avertissement
MsgBox "ATTENTION ! ! ! ! ! !" & vbcr & "Le fichier à uploder n'existe pas ? " & vbcr & "Veuillez SVP choisir un fichier pour l'upload !",48,"Le Fichier à uploder n'existe pas ? "
End If
FTPUpload FTPServer.Value,FTPLOGIN.Value,Password.Value,file1.Value,DossierDistant.Value,sResults
End Sub
 
'-------------------------------FTPUpload---------------------------------------------
Function FTPUpload(sSite, sUsername, sPassword, sLocalFile, sRemotePath ,sResults)
  Const OpenAsDefault = -2
  Const FailIfNotExist = 0
  Const ForReading = 1
  Const ForWriting = 2
  Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")
  Set oFTPScriptShell = CreateObject("WScript.Shell")
 
  sRemotePath = Trim(sRemotePath)
  sLocalFile = Trim(sLocalFile)
 
  'Ici, nous allons vérifier si le chemin, contient des espaces. 
  'puis nous avons besoin d'ajouter des guillemets pour s'assurer qu'il passe correctement.
  If InStr(sRemotePath, " ") > 0 Then
    If Left(sRemotePath, 1) <> """" And Right(sRemotePath, 1) <> """" Then
      sRemotePath = qq(sRemotePath) 
    End If
  End If
 
  If InStr(sLocalFile, " ") > 0 Then
    If Left(sLocalFile, 1) <> """" And Right(sLocalFile, 1) <> """" Then
      sLocalFile = qq(sLocalFile) 
    End If
  End If
 
 'Assurer que la variable sRemotePath , Si elle est vide, on va la passer par un "\"
  If Len(sRemotePath) = 0 Then
    sRemotePath = "\"
  End If
 
  'construire un fichier de configuration pour passer les commandes ftp
  sFTPScript = sFTPScript & "USER " & sUsername & vbCRLF
  sFTPScript = sFTPScript & sPassword & vbCRLF
  sFTPScript = sFTPScript & "cd " & sRemotePath & vbCRLF
  sFTPScript = sFTPScript & "binary" & vbCRLF
  sFTPScript = sFTPScript & "prompt n" & vbCRLF
  sFTPScript = sFTPScript & "put " & sLocalFile & vbCRLF
  sFTPScript = sFTPScript & "quit" & vbCRLF & "quit" & vbCRLF & "quit" & vbCRLF
 
 
  sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")
  sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
  sFTPResults = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
 
  'Écrire les commandes ftp à passer dans un fichier temporaire.
  Set fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)
  fFTPScript.WriteLine(sFTPScript)
  fFTPScript.Close
  Set fFTPScript = Nothing 
 
  oFTPScriptShell.Run "%comspec% /c FTP -i -n -s:" & sFTPTempFile & " " & sSite & _
  " > " & sFTPResults,0,True
 
 
  'Lire le Resultat du Transfert
  Set fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, _
  FailIfNotExist, OpenAsDefault)
  sResults = fFTPResults.ReadAll
  txtBody.value = sResults
  fFTPResults.Close
 
 
If InStr(sResults, "226") > 0 Then
 FTPUpload = True    
Set objRegex = new RegExp
objRegex.Pattern = "226(.\w+.*)"
objRegex.Global = True
objRegex.IgnoreCase = True
Set Matches = objRegex.Execute(sResults)
For Each Match in Matches   
Result=objRegex.Replace(Match.Value,"$1")
    MsgBox " Le Fichier " &qq(file1.Value)& " a été uploadé avec succés !"& vbcr & Result,64,"Résultat du Transfert d'Upload !"
Next
  ElseIf InStr(sResults, "File Not Found") > 0 Then
 MsgBox "Erreur : Fichier Non Trouvé ?",16,"Erreur : Fichier Non Trouvé ?"
    FTPUpload = "Erreur : Fichier Non Trouvé ?"
  ElseIf InStr(sResults, "Login authentication failed") > 0 Then
    MsgBox "Login authentication a echoué !",16,"Login authentication failed !"
    FTPUpload = "Error: Login Failed."
  Else
    FTPUpload = "Error: Unknown."
    MsgBox "Erreur: Inconnu ?",16,"Erreur: Inconnu ?"
  End If
 
 oFTPScriptFSO.DeleteFile(sFTPTempFile)
 oFTPScriptFSO.DeleteFile (sFTPResults)
  Set oFTPScriptFSO = Nothing
  Set oFTPScriptShell = Nothing
End Function
 
Function qq(strIn) 'c'est une fonction très partique qui sert à ajouter "les doubles quotes dans une variable" 
    qq = Chr(34) & strIn & Chr(34)
End Function
</script> 
</head> 
 
<body>
<label for="FTPSERVER" style="width: 120; textalign: right;">FTP SERVER:</label><input type="text" id="FTPSERVER" name="FTPSERVER" value="ftp.membres.lycos.fr"><br /> 
    <label for="FTP LOGIN" style="width: 120; textalign: right;">FTP LOGIN:</label><input type="text" id="FTPLOGIN" name="FTPLOGIN" value="USER Identifiant"><br /> 
    <label for="FTP Password" style="width: 120; textalign: right;">FTP Password:</label><input type="password" id="password" name="password" value="Mot de Passe"><br />
    <label for="Dossier Distant" style="width: 120; textalign: right;">Dossier Distant:</label><input type="text" id="DossierDistant" name="DossierDistant" value="/"><br />
    <br>
    <label STYLE="filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=0, StartColorStr='#a1ff97', EndColorStr='#009f00')" for="file">Fichier à uploader</label><input type="file" STYLE="filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=0, StartColorStr='#a1ff97', EndColorStr='#009f00')" name="file1" id="file1" /><br><br>
    <center><label>Message Réponse du Serveur FTP :</label><br></center>
    <textarea STYLE="filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=0, StartColorStr='#a1ff97', EndColorStr='#009f00')" id="txtBody" rows="20" cols="45"></textarea><br><br>
    <center>
    <input STYLE="filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=0, StartColorStr='#a1ff97', EndColorStr='#009f00')" class="btn" type="Submit" value="Envoyer Via FTP" onClick="Upload()">
</body> 
</html>

**bolzardp** · 08/06/2012, 09h18

Je viens de tester ton script, cela fonctionne bien j'ai même droit au msgbox qui confirme le transfert réussi. Mais dans la fenêtre résultat il y a toujours le résultat sous cette forme :

226 Transfer complete.
23.72424.01quit
221 Goodbye.

Ne faudrait-il pas qu'il soit sous cette forme la :

226 Transfer complete.
temps 23.72s débit 424.01 ko/s
221 Goodbye.

J'ai essayé de faire un GET à la place du PUT et le script plante ?
En tout cas la gestion du serveur et du compte et mot de passe est vraiment Nickel

**hackoofr** · 08/06/2012, 09h41

Envoyé par bolzardp

Mais dans la fenêtre résultat il y a toujours le résultat sous cette forme :

Code :

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

1
2
3
226 Transfer complete.
23.72424.01quit
221 Goodbye.

Ne faudrait-il pas qu'il soit sous cette forme la :

Code :

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

1
2
3
226 Transfer complete.
temps 23.72s débit 424.01 ko/s
221 Goodbye.

La réponse que vous recevez ainsi est spécifique à votre serveur FTP , donc on ne peut pas la modifier à moins que si vous ajoutez quelques lignes de code pour extraire les données et les transformez en résultat souhaité, mais je crois que ceci peut-être déposé dans un autre sujet et dans une nouvelle discussion mais pour le moment je n'ai aucune idée.

**hackoofr** · 09/06/2012, 00h32

Le HTA est dans la section Téléchargement

FTP sous VBS pour test débit avec affichage du résultat

VBScript

Discussions similaires

Partager

Partager