Search this blog ...

Wednesday, June 9, 2010

VBScript FTP Upload Sample (leverages Windows FTP client)

Save the following as upload.vbs and execute

'------------------------------------------------------------------------------
Const appName = "FTP Upload Utility"
'------------------------------------------------------------------------------

Const defaultHostname = "ftp.example.com"
Const defaultPort = 21
Const defaultUsername = "mshannon"
Const defaultPassword = "welcome1"
Const defaultRemoteDir = "/home/mshannon"

' set this var to the fully qualified path of a local file to prevent file
' selection dialog from being displayed
defaultFile = ""
' defaultFile = "C:\Documents and Settings\Administrator\Desktop\SecurityFilter.zip"

' if useDefaultsExclusively = True, the default values above will be leveraged
' as-is, meaning no override options will be prompted for.
Const useDefaultsExclusively = False
' Const useDefaultsExclusively = True

' if skipConfirmation = True, the upload will be attempted without requesting
' confirmation to commence.
Const skipConfirmation = False
' Const skipConfirmation = True

'------------------------------------------------------------------------------

Set shell = CreateObject( "WScript.Shell" )
defaultLocalDir = shell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop"
Set shell = Nothing

hostname = GetNonEmptyValue(useDefaultsExclusively, defaultHostname, _
  "Enter FTP server remote hostname:", "Hostname")

port = GetNonEmptyValue(useDefaultsExclusively, defaultPort, _
  "Enter FTP server remote port:", "Port")

username = GetNonEmptyValue(useDefaultsExclusively, defaultUsername, _
  "Enter username:", "Username")

password = GetNonEmptyValue(useDefaultsExclusively, defaultPassword, _
  "Enter password:", "Password")

If Len(defaultFile) > 0 Then
  file = defaultFile
Else
  file = ChooseFile(defaultLocalDir)
  TestNotEmpty file, "Upload File"
End If

Set fso = CreateObject("Scripting.FileSystemObject")
localFile = fso.getFileName(file)
localDir = fso.getParentFolderName(file)
Set fso = Nothing

remoteDir = GetNonEmptyValue(useDefaultsExclusively, defaultRemoteDir, _
  "Remote upload directory:", "Remote Directory")

Msg = "You have requested to upload " & localFile & " to ftp://" & _
  username & "@" & hostname & ":" & port & remoteDir & _
  vbCRLF & _
  vbCRLF & "Note - This may take quite some time!" & _
  vbCRLF & _
  vbCRLF & "Click OK to start upload."

' VB appears to evaluate all the "OR" conditions when using if t1 OR t2 then ...
' hence, it does not stop testing the conditions after the first condition
' it detects is true. Thus the silly logic below...
If skipConfirmation Then
  Upload hostname, port, username, password, localFile, localDir, remoteDir
ElseIf vbOK = MsgBox(Msg, vbOKCancel, appName) Then
  Upload hostname, port, username, password, localFile, localDir, remoteDir
End If

'------------------------------------------------------------------------------

Function GetNonEmptyValue(useDefaultExclusively, defaultValue, prompt, dialogTitle)

  If useDefaultExclusively Then
    value = defaultValue
  Else
    value = InputBox(prompt, dialogTitle, defaultValue)
  End If

  TestNotEmpty value, dialogTitle
  GetNonEmptyValue = value
End Function

'------------------------------------------------------------------------------

Sub TestNotEmpty(value, description)
  If Len(value) = 0 Then
    MsgBox "ERROR: No value provided for " & description, vbExclamation, appName
    wscript.quit
  End If
End Sub

'------------------------------------------------------------------------------

Function ChooseFile(initialDir)
  Set cd = CreateObject("UserAccounts.CommonDialog")

  cd.InitialDir = initialDir
  cd.Filter = "ZIP files|*.zip|Text Documents|*.txt|Shell Scripts|*.*sh|All Files|*.*"
  ' filter index 4 would show all files by default
  ' filter index 1 would should zip files by default
  cd.FilterIndex = 1
  If cd.ShowOpen = True Then
    ChooseFile = cd.FileName
  Else
    ChooseFile = ""
  End If
  Set cd = Nothing
End Function

'------------------------------------------------------------------------------

Sub Upload(hostname, port, username, password, localFile, localDir, remoteDir)

  Set shell = CreateObject("WScript.Shell")
  Set fso = CreateObject("Scripting.FileSystemObject")

  tempDir = shell.ExpandEnvironmentStrings("%TEMP%")
  ' temporary script file supplied to Windows FTP client
  scriptFile = tempDir & "\" & fso.GetTempName
  ' temporary file to store standard output from Windows FTP client
  outputFile = tempDir & "\" & fso.GetTempName

  'input script
  script = script & "lcd " & """" & localDir & """" & vbCRLF
  script = script & "open " & hostname & " " & port & vbCRLF
  script = script & "user " & username & vbCRLF
  script = script & password & vbCRLF
  script = script & "cd " & """" & remoteDir & """" & vbCRLF
  script = script & "binary" & vbCRLF
  script = script & "prompt n" & vbCRLF
  script = script & "put " & """" & localFile & """" & vbCRLF
  script = script & "quit" & vbCRLF

  Set textFile = fso.CreateTextFile(scriptFile, True)
  textFile.WriteLine(script)
  textFile.Close
  Set textFile = Nothing

  ' bWaitOnReturn set to TRUE - indicating script should wait for the program
  ' to finish executing before continuing to the next statement
  shell.Run "%comspec% /c FTP -n -s:" & scriptFile & " > " & outputFile, 0, TRUE
  Wscript.Sleep 500
  ' open standard output temp file read only, failing if not present
  Set textFile = fso.OpenTextFile(outputFile, 1, 0, -2)
  results = textFile.ReadAll
  textFile.Close
  Set textFile = Nothing
  If InStr(results, "550") > 0 And InStr(results, "226") Then
    fso.DeleteFile(scriptFile)
    fso.DeleteFile(outputFile)
    Msg ="WARNING: Could not change to destination directory on host!" & _
      vbCRLF & "File however appears to have been uploaded to default " & _
      "FTP directory associated with user on host."
    MsgBox Msg, vbExclamation, appName

  ElseIf InStr(results, "226") > 0 Then
    MsgBox "File Uploaded Successfully.", vbInformation, appName
    fso.DeleteFile(scriptFile)
    fso.DeleteFile(outputFile)
  Else
    If InStr(results, "530") > 0 Then
      Msg ="ERROR: Invalid Username/Password"
    ElseIf InStr(results, "550") > 0 Then
      Msg ="ERROR: Could not change to destination directory on host"
    ElseIf InStr(results, "553") > 0 Then
      Msg ="ERROR: Could not create file on host"
    ElseIf InStr(results, "Unknown host") > 0 Then
      Msg ="ERROR: Unknown host"
    ElseIf InStr(results, "File not found") > 0 Then
      Msg ="ERROR: Local File Not Found"
    Else
      Msg ="An ERROR may have occurred."
    End If

    Msg = Msg & _
      vbCRLF & "Script file leveraged: " & scriptFile & _
      vbCRLF & "FTP Output file: " & outputFile & _
      vbCRLF & _
      vbCRLF & "Ensure the above files are manually deleted, as they may " & _
     "contain sensitive information!"
    ' Wscript.Echo Msg
    MsgBox Msg, vbCritical, appName
  End If
  Set shell = Nothing
  Set fso = Nothing

End Sub

1 comment:

  1. A great snippet of code, thanks for posting this. A great example of how to upload a file without the use of any third party software.

    ReplyDelete