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
| '-------------------------------FTPUpload---------------------------------------------
Function FTPUpload(sSite, sUsername, sPassword, sLocalFile, sRemotePath)
'This script is provided under the Creative Commons license located
'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
'be used for commercial purposes with out the expressed written consent
'of NateRice.com
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 willcheck 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 = """" & sRemotePath & """"
End If
End If
If InStr(sLocalFile, " ") > 0 Then
If Left(sLocalFile, 1) <> """" And Right(sLocalFile, 1) <> """" Then
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
Wscript.Sleep 1000
'Check results of transfer.
Set fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, _
FailIfNotExist, OpenAsDefault)
sResults = fFTPResults.ReadAll
fFTPResults.Close
oFTPScriptFSO.DeleteFile(sFTPTempFile)
'oFTPScriptFSO.DeleteFile (sFTPResults)
If InStr(sResults, "226-File successfully transferred") > 0 Then
'Call Parler_Succes
FTPUpload = True
ElseIf InStr(sResults, "File Not Found") > 0 Then
'Call Parler_Pas_de_Fichier
FTPUpload = "Error: File Not Found"
ElseIf InStr(sResults, "Login authentication failed") > 0 Then
'Call Parler_Login_authentication_Failed
FTPUpload = "Error: Login Failed."
Else
FTPUpload = "Error: Unknown."
End If
Set oFTPScriptFSO = Nothing
Set oFTPScriptShell = Nothing
End Function
'----------------------------Parler_Succes-----------------------
Sub Parler_Succes
Dim Voix
Set WshNetwork = WScript.CreateObject("WScript.Network")
NomMachine = WshNetwork.ComputerName
Set Voix = CreateObject("Sapi.SpVoice")
Voix.speak "Perfect! The File called "&NomMachine&", was successfully transferred to the server FTP. "
MsgBox "Parfait! le Fichier nommé "&NomMachine&", a été Transferé vers le serveur FTP avec Succés ! ",64,"Information"
Set Voix = Nothing
end sub
'---------------Parler_Login _authentication _Failed------------------
Sub Parler_Login_authentication_Failed
Dim Voix
Set WshNetwork = WScript.CreateObject("WScript.Network")
NomMachine = WshNetwork.ComputerName
Set Voix = CreateObject("Sapi.SpVoice")
Voix.speak "Oups! There is an error. The Login authentication failed on the Server FTP !"
MsgBox "Oups! il y a une erreur d'authentification du l'utilisteur sur le Serveur FTP !",16,"Erreur d'authentification du l'utilisteur sur le Serveur FTP !"
Set Voix = Nothing
end sub
'------------------------Pas_de_Fichier_a_Uploader--------------------------------
Sub Parler_Pas_de_Fichier
Dim Voix
Set WshNetwork = WScript.CreateObject("WScript.Network")
NomMachine = WshNetwork.ComputerName
Set Voix = CreateObject("Sapi.SpVoice")
Voix.speak "Oups! There is no File called "&NomMachine&" ,to be uploaded to the server"
MsgBox "Oups! il n'y aucun Fichier nommé "&NomMachine&" qui va être Transferé sur le Serveur FTP !",16,"Erreur d'authentification du l'utilisteur sur le Serveur FTP !"
Set Voix = Nothing
end sub |
