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
| <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()
'MsgBox FTPSERVER.Value &vbCr& FTPLOGIN.Value &vbCr& Password.Value &vbCr& DossierDistant.Value &vbCr& qq(file1.Value)
If file1.Value = "" Then
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
'MsgBox qq(file1.Value)
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)
'----------Path Checks---------
'Here we will check the path, if it contains
'spaces then we need to add quotes to ensure
'it parses correctly.
If InStr(sRemotePath, " ") > 0 Then
If Left(sRemotePath, 1) <> """" And Right(sRemotePath, 1) <> """" Then
sRemotePath = qq(sRemotePath) '"""" & sRemotePath & """"
End If
End If
If InStr(sLocalFile, " ") > 0 Then
If Left(sLocalFile, 1) <> """" And Right(sLocalFile, 1) <> """" Then
sLocalFile = qq(sLocalFile) '"""" & sLocalFile & """"
End If
End If
'Check to ensure that a remote path was
'passed. If it's blank then pass a "\"
If Len(sRemotePath) = 0 Then
'Please note that no premptive checking of the
'remote path is done. If it does not exist for some
'reason. Unexpected results may occur.
sRemotePath = "\"
End If
'Check the local path and file to ensure
'that either the a file that exists was
'passed or a wildcard was passed.
If InStr(sLocalFile, "*") Then
If InStr(sLocalFile, " ") Then
FTPUpload = "Error: Wildcard uploads do not work if the path contains a " & _
"space." & vbCRLF
FTPUpload = FTPUpload & "This is a limitation of the Microsoft FTP client."
Exit Function
End If
ElseIf Len(sLocalFile) = 0 Or Not oFTPScriptFSO.FileExists(sLocalFile) Then
'nothing to upload
FTPUpload = "Error: File Not Found."
Exit Function
End If
'--------END Path Checks---------
'build input file for ftp command
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
'Write the input file for the ftp command
'to a temporary file.
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-File successfully transferred") > 0 Then
FTPUpload = True
Set objRegex = new RegExp
objRegex.Pattern = "ftp :(.\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)& " de Taille" & Result,64,"Résultat du Transfert d'Upload !"
Next
ElseIf InStr(sResults, "File Not Found") > 0 Then
MsgBox "Error: File Not Found",16,"Error: File Not Found"
FTPUpload = "Error: File Not Found"
ElseIf InStr(sResults, "Login authentication failed") > 0 Then
MsgBox "Login authentication failed",16,"Login authentication failed"
FTPUpload = "Error: Login Failed."
Else
FTPUpload = "Error: Unknown."
MsgBox "Erreur: Inconnu ?",16,"Erreur: Inconnu ?"
End If
fFTPResults.Close
oFTPScriptFSO.DeleteFile(sFTPTempFile)
oFTPScriptFSO.DeleteFile (sFTPResults)
Set oFTPScriptFSO = Nothing
Set oFTPScriptShell = Nothing
End Function
Function qq(strIn)
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> |
FTP sous VBS pour test débit avec affichage du résultat
Répondre avec citation
)
Envoyé par bolzardp
: 
je suis vraiment un 
c'est un bon exercice et un peu 
j’attends vos modifications 
Partager