Source code for VB_ExecuteFTPCommands

Download

The source files for this module are listed below.  You can also download the module VB_ExecuteFTPCommands as a zip archive; this archive contains all the source files and documentation.

Description

The ExecuteFTPCommands VBScript provides easy FTP support for your VB Script files.

Information

This script uses the build-in command line FTP application found on most Windows PC's.  Two temporary files are created named "_tmpftpin.txt" and "_tmpftpout.txt" in the same folder as your script file; these files are also automatically erased after the FTP commands have been executed.

To execute FTP commands, you first have to build up a text string containing all the commands to execute.  This includes the codes to open a connection to the server and to log in.  Each command must start on a new line.  For the exact formatting and available commands, see the help for the FTP program supplied with your copy of Windows.  Use "ftp.exe -?" from a command line window (DOS box) for more information.  The total command string is written to file and passed as a command script to FTP.exe using the '-s' option.

Once you have build up the total command string, you pass it to the function ExecuteFTPCommands.  This function in turn returns you a string containing any errors it encountered.  These errors are taken over from the FTP output (FTP status codes bigger than 400), where each error is placed on a new line.

An example FTP script could be:

  Dim sFTPCommands
  sFTPCommands = "open ftp.myserver.com" + vbNewLine + _
                 "myusername" + vbNewLine + _
                 "mypassword" + vbNewLine + _
                 "binary" + vbNewLine + _
                 "cd wwwroot" + vbNewLine + _
                 "put ""file_a.html""" + vbNewLine + _
                 "quit"
  Dim sErrors
  sErrors = ExecuteFTPCommands(sFTPCommands)
  If sErrors <> "" Then
    Call MessageBox(sErrors)
  End If

Files

Each file belonging to this source code module is listed below.

ExecuteFTPCommands.vbs

'*******************************************************************************
'
' Version: 1
' Author:  Carl Colijn, TwoLogs
' Contact: c.colijn@twologs.com
' Source:  http://www.twologs.com/en/resources/sourcecode.asp
'
' This code is freely distributable, as long as this comment remains intact.
' If you find this source useful, you may use this code in your own projects
' free of charge, but some acknowledgement to the author of this code is always
' appreciated :)
' The source is however distributed 'as is' without waranty and/or support, and
' may not be fit for each and every application.  Use it at your own discretion
' and at your own risk.
' The source already has undergone testing.  This doesn't mean however that all
' bugs are removed from this piece of code.  If you find one of them, please
' contact me about it.  I can however not guarantee when and if the bug will be
' fixed.
'
' More information about this module can be found in the accompanying HTML file.
'
'*******************************************************************************

' Executes the given FTP commands
' Returns any possible error string
Function ExecuteFTPCommands(sCommands)
  ' Determine where the temporary files will go
  Dim oFSO
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  Dim sStoreFolder
  sStoreFolder = oFSO.GetParentFolderName(WScript.ScriptFullName)
  Dim sInputFile
  sInputFile = sStoreFolder + "\_tmpftpin.txt"
  Dim sOutputFile
  sOutputFile = sStoreFolder + "\_tmpftpout.txt"

  ' Create the input file
  Dim oInputFile
  Set oInputFile = oFSO.CreateTextFile(sInputFile, True)
  Call oInputFile.Write(sCommands)
  Call oInputFile.Close

  ' Execute the FTP command file
  Dim bErrors
  bErrors = False
  Dim sErrors
  sErrors = ""
  Dim oShell
  Set oShell = CreateObject("WScript.Shell")
  Dim eFTPResult
  eFTPResult = oShell.Run( _
    "cmd /c ftp -s:""" + sInputFile + """ > """ + sOutputFile + """", _
    1, _
    True _
  )
  If eFTPResult <> 0 Then
    ' Error -> note
    bErrors = True
    sErrors = "There was an error starting the FTP commands"
  Else
    ' Done -> get the result
    Dim oOutputFile
    Set oOutputFile = oFSO.OpenTextFile(sOutputFile, 1)
    Dim sCommand
    sCommand = ""
    Do While Not oOutputFile.AtEndOfStream
      Dim sNextLine
      sNextLine = Trim(oOutputFile.ReadLine())
      Dim nServerCode
      nServerCode = Left(sNextLine, 3)
      If IsNumeric(nServerCode) Then
        sCommand = sCommand + vbNewLine + sNextLine
        If nServerCode >= 400 Then
          bErrors = True
          sErrors = sErrors + vbNewLine + sCommand
        End If
      Else
        sCommand = sNextLine
      End If
    Loop
    Call oOutputFile.Close

    ' Look if errors occured
    If bErrors Then
      ' Yes -> prepend the cause
      sErrors = "There was an error executing the FTP commands;" + sErrors
    End If
  End If

  ' Kill any temporary files
  On Error Resume Next
  Call oFSO.DeleteFile(sInputFile, True)
  Call oFSO.DeleteFile(sOutputFile, True)
  On Error Goto 0

  ' And return any possible error condition
  ExecuteFTPCommands = sErrors
End Function