FTP Upload and FTP Download with VBScript

While googling around the other day I noticed that lots of people are searching for a way to FTP files with VBScript. After looking for a while at the solutions to do this, it was clear that no real easy, free way of FTP uploading and downloading files was currently available. There are downloadable components that would present a programable API. But these are costly, and you’d have to install them. So seeing the need I decided to whip up a couple of functions that would preform some basic uploading and downloading.

Pretty straight forward, you have to supply the credentials to connect to the machine, the IP address or DNS name for the machine and then the source and destination locations. Example of syntax:

Wscript.Echo FTPDownload(“192.168.1.1”, “domain\user”, “password”, “C:\”, “\”, “*”)

When using the download function, if you don’t specify a location it will default to the working directory of the script. If for some reason there is a problem transferring the file the functions will return the error message. If they are successful, they will return “true”.

Update 11-30-2007: I just made some corrections to this per the suggestions of some emails and comments I received. I retested this script, since it’s been quite some time since I’ve had the chance to use it, and it’s working like a charm. Please continue to report any issues you might have and thank you for your feedback.

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 -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 Transfer complete.") > 0 Then 
    FTPUpload = True 
  ElseIf InStr(sResults, "File not found") > 0 Then 
    FTPUpload = "Error: File Not Found" 
  ElseIf InStr(sResults, "cannot log in.") > 0 Then 
    FTPUpload = "Error: Login Failed." 
  Else 
    FTPUpload = "Error: Unknown." 
  End If 
 
  Set oFTPScriptFSO = Nothing 
  Set oFTPScriptShell = Nothing 
End Function 
 
Function FTPDownload(sSite, sUsername, sPassword, sLocalPath, sRemotePath, _  
         sRemoteFile)  
  '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)  
  sLocalPath = Trim(sLocalPath)  
    
  '----------Path Checks---------  
  'Here we will check the remote 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 
    
  '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 
    
  'If the local path was blank. Pass the current  
  'working direcory.  
  If Len(sLocalPath) = 0 Then 
    sLocalpath = oFTPScriptShell.CurrentDirectory  
  End If 
    
  If Not oFTPScriptFSO.FolderExists(sLocalPath) Then 
    'destination not found  
    FTPDownload = "Error: Local Folder Not Found." 
    Exit Function 
  End If 
    
  sOriginalWorkingDirectory = oFTPScriptShell.CurrentDirectory  
  oFTPScriptShell.CurrentDirectory = sLocalPath  
  '--------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 & "mget " & sRemoteFile & 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 -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 Transfer complete.") > 0 Then 
    FTPDownload = True 
  ElseIf InStr(sResults, "File not found") > 0 Then 
    FTPDownload = "Error: File Not Found" 
  ElseIf InStr(sResults, "cannot log in.") > 0 Then 
    FTPDownload = "Error: Login Failed." 
  Else 
    FTPDownload = "Error: Unknown." 
  End If 
    
  Set oFTPScriptFSO = Nothing 
  Set oFTPScriptShell = Nothing 
End Function 
'Option Explicit  
'const progname="FTP upload script by Richard Finegold"  
'const url = "ftp://ftp.myftpsite.com"  
'const rdir = "mydir"  
'const user = "anonymous"  
'const pass = "myname@mymailsite.com"  
 
'This is an example of ftp'ing without calling the external "FTP" command  
'It uses InetCtrls.Inet.1 instead  
'Included is a "hint" for simple downloading  
 
'Sources:  
'http://msdn.microsoft.com/library/partbook/ipwvb5/loggingontoftpserver.htm  
'http://msdn.microsoft.com/library/partbook/egvb6/addinginternettransfercontrol.htm  
'http://cwashington.netreach.net/ - search on "ftp" - inspiration only!  
 
'Insist on arguments  
dim objArgs  
Set objArgs = Wscript.Arguments  
If 0=objArgs.Count Then 
   MsgBox "No files selected for operation!", vbOkOnly + vbCritical, progname  
   WScript.Quit  
End If 
 
 
'Force console mode - csforce.vbs (with some reorganization for efficiency)  
dim i  
if right(ucase(wscript.FullName),11)="WSCRIPT.EXE" then  
  dim args, y  
  For i = 0 to objArgs.Count - 1  
    args = args + " " + objArgs(i)  
  Next 
  Set y = WScript.CreateObject("WScript.Shell")  
  y.Run "cscript.exe " & wscript.ScriptFullName + " " + args, 1  
  wscript.quit  
end if  
 
 
'Do actual work  
dim fso, ftpo  
set fso = WScript.CreateObject("Scripting.FileSystemObject")  
set ftpo = WScript.CreateObject("InetCtls.Inet.1")     'Msinet.ocx  
ftpo.URL = url  
ftpo.UserName = user  
ftpo.Password = pass  
WScript.Echo "Connecting..." 
ftpo.Execute , "CD " & rdir  
do  
'     WScript.Echo "."  
     WScript.Sleep 100     'This can take a while loop while ftpo.StillExecuting  
 
 
for i = 0 to objArgs.Count - 1  
     dim sLFile  
     sLFile = objArgs(i)  
 
     if (fso.FileExists(sLFile)) then  
          WScript.Echo "Uploading " & sLFile & " as " & FSO.GetFileName(sLFile) & " " 
          ftpo.Execute , "Put " & sLFile & " " & FSO.GetFileName(sLFile)  
          'ftpo.Execute , "Get " & sRemoteFile & " C:\" & sLFile  
          do  
          'WScript.Echo "."  
               WScript.Sleep 100     'This can take a while  
          loop while ftpo.StillExecuting  
     else  
          MsgBox Chr(34) & sLFile & Chr(34) & " does not exist!", _  
           vbOkOnly, progname  
     end if  
next  
WScript.Echo "Closing" 
ftpo.Execute , "Close" 
WScript.Echo "Done!" 

发表评论