I used the samples provided with the SmartFTP FTP library download and made modifications to them. The files I used are
Uploadfile.wsf
Favorite - smartftp.com.vbs (ScriptA)
Shared.vbs (ScriptB)
I appreciate your help.
<?xml version="1.0"?>
<package>
<job>
<reference object="sfFTPLib.FTPConnectionSTA"/>
<script language="VBScript" src="ScriptA.vbs"/>
<script language="VBScript" src="ScriptB.vbs"/>
<script language="VBScript">
<![CDATA[
'///////////////////////////////////////////////////////////////////////////////////
'//
'// UploadFile v1.0 (8. November 2004)
'//
'// Purpose:
'// Uploads multiple files from your local computer to the remote server.
'//
'// Returns:
'// 0 on success
'// 1 on error (connect)
'// 2 on download
'//
'// Limitations:
'// No retries
'// No option to set file time (MDTM) of uploaded files
'//
'// Copyright © 2004 by SmartFTP.com
'//
'///////////////////////////////////////////////////////////////////////////////////
Option Explicit
'Globals
Dim g_objFTP
Dim g_objFS
Dim nReturn ' script return value
'///////////////////////////////////////////////////////////////////////////////////
'// Application Settings
' Global const
Const g_cDebug = 1 ' debug level. 0=disable, 1=enable. see Trace() in shared.vbs
' Local const
Const cResume = true ' true=resume, false=overwrite
' File List (index 0 = remote file, index 1 = local file)
Dim arrFiles(1, 1) ' 2 files
' FIXME: . only for testing purpose.
arrFiles(0, 0) = "test.txt"
arrFiles(0, 1) = "/aa12345/test.txt"
' FIXME: . only for testing purpose.
'arrFiles(1, 0) = ".test.txt" ' . = current working directory
'arrFiles(1 ,1) = "/SmartFTP/License.txt"
' Note: see below for FTP settings
'///////////////////////////////////////////////////////////////////////////////////
'// Entry
nReturn = 0
Set g_objFTP = CreateObject("sfFTPLib.FTPConnectionSTA")
'///////////////////////////////////////////////////////////////////////////////////
'// FTP Settings
Call InitFTPSettings(g_objFTP)
' logging
g_objFTP.LogFile = ".LogUploadFile.log"
'///////////////////////////////////////////////////////////////////////////////////
'// Operation
Set g_objFS = CreateObject("Scripting.FileSystemObject")
' Connect
Dim result
result = g_objFTP.Connect()
If result = ftpErrorSuccess Then
' Call Trace("Connected")
Dim bError : bError = false
Dim i
For i=0 To ubound(arrFiles)
'
Dim bRet
bRet = UploadFile(g_objFTP, arrFiles(i,0), arrFiles(i,1), cResume)
If Not bRet Then
' Ignore and continue
bError = true
End If
Next
' if an error occured set script return value
If bError Then
nReturn = 2
End If
' Disconnect
result = g_objFTP.Disconnect()
' Call Trace("Disconnected.")
Else
If result = ftpErrorLicense Then
Call Trace("Please acquire a license from
https://www.smartftp.com")
Else
Call Trace("Connection failed. Error = " & result)
End If
nReturn = 1
End If
' Cleanup
Set g_objFTP = Nothing
Set g_objFS = Nothing
WScript.Quit(nReturn)
]]>
</script>
</job>
</package>
ScriptA
'///////////////////////////////////////////////////////////////////////////////////
'// FTP Settings
Sub InitFTPSettings(objFTP)
objFTP.Host = "host.com"
objFTP.Username = "username"
objFTP.Password = "password"
objFTP.HidePassword = true
objFTP.Port = 12345
objFTP.Protocol = ftpProtocolSSLExplicit ' ftpProtocolSSLExplicit for SSL Explicit
objFTP.Passive = true
objFTP.MLST = true ' Use MLST if available
objFTP.DataTransferMode = ftpDataTransferModeStream ' ftpTransferModeZ for zlib compression
objFTP.DataTransferType = 1 ' ASCII. ASCII mode is not recommended.
objFTP.DataProtection = ftpDataProtectionPrivate ' Private (Secure), Clear (Unsecure)
' Proxy Settings (SOCKS, HTTP)
objFTP.ProxyType = ftpProxyTypeNone
objFTP.ProxyHost = ""
objFTP.ProxyPort = 8080
objFTP.ProxyUsername = ""
objFTP.ProxyPassword = ""
objFTP.ProxyAuthentication = false
' FTP Proxy Settings
objFTP.FTPProxyType = ftpFTPProxyTypeNone
objFTP.FTPProxyHost = ""
objFTP.FTPProxyPort = 12345
objFTP.FTPProxyUsername = ""
objFTP.FTPProxyPassword = ""
objFTP.FTPProxyAuthentication = false
objFTP.Client = "Host.com Script"
' Performance
'objFTP.FileBufferSize = 32768
'objFTP.SendBufferSize = 2048
'objFTP.ReceiveBufferSize = 8192
End Sub
ScriptB
'///////////////////////////////////////////////////////////////////////////////////
'//
'// Shared.vbs v1.1 (5. July 2005)
'//
'// Purpose:
'// Contains helper functions for the samples.
'//
'// External dependencies:
'// g_objFS : Scripting.FileSystemObject object
'// g_cDebug : debug flag (1=enable, 2=disable)
'//
'// Copyright © 2004 - 2005 by SmartFTP.com
'//
'///////////////////////////////////////////////////////////////////////////////////
Option Explicit
'///////////////////////////////////////////////////////////////////////////////////
'// Trace
'//
'// enable/disable with g_cDebug flag
Sub Trace(strMsg)
If g_cDebug = 1 Then
WScript.Echo strMsg & vbCrLf
End If
End Sub
'///////////////////////////////////////////////////////////////////////////////////
'// DownloadDirectory
'//
'// strRemoteFolder: Path to remote folder e.g. /ce262700
'// strLocalFolder : Path to local folder e.g. ce262700
'//
'// Returns: true on sucess, false otherwise
'//
Function DownloadDirectory(objFTP, strRemoteFolder, strLocalFolder, bResume)
Dim bRet : bRet = false
If LocalCreateDirectory(strLocalFolder) Then
'
' ChangeDirectory
If ChangeDirectory(objFTP, strRemoteFolder) Then
'
bRet = true
' Read Directory
result = g_objFTP.ReadDirectory()
If result = ftpErrorSuccess Then
'
Dim objDirectory
Set objDirectory = objFTP.Directory
Dim FTPFile
For Each FTPFile In objDirectory
'
If FTPFile.Name <> "." And FTPFile.Name <> ".." Then
'
If FTPFile.Type = ftpItemTypeFile Then
'
Dim strRemoteFile : strRemoteFile = UnixBuildPath(strRemoteFolder, FTPFile.Name)
Dim strLocalFile : strLocalFile = g_objFS.BuildPath(strLocalFolder, FTPFile.Name)
bRet = DownloadFile(objFTP, strRemoteFile, strLocalFile, bResume)
If Not bRet Then
Call Trace("Failed to download " & strRemoteFile & ".")
' ignore error. continue
bRet = true
End If
ElseIf FTPFile.Type = ftpItemTypeFolder Then
'
Dim strNewRemoteFolder : strNewRemoteFolder = UnixBuildPath(strRemoteFolder, FTPFile.Name)
Dim strNewLocalFolder : strNewLocalFolder = g_objFS.BuildPath(strLocalFolder, FTPFile.Name)
bRet= DownloadDirectory(objFTP, strNewRemoteFolder, strNewLocalFolder, bResume)
If Not bRet Then
Call Trace("Failed to download " & strNewRemoteFolder & ".")
' ignore error. continue
bRet = true
End If
ElseIf FTPFile.Type = ftpItemTypeLink Then
' we ignore links
End If
End If
Next
Set objDirectory = Nothing
Else
Call Trace("Read directory failed. Error = " & result)
End If
Else
Call Trace("Change directory to " & strRemoteFolder & " failed.")
End If
End If
' set return value
DownloadDirectory = bRet
End Function
'///////////////////////////////////////////////////////////////////////////////////
'// DownloadFile
'//
'// strRemoteFile : Path to remote file e.g. /ce262700/
'// strLocalFile : Path to local folder e.g. ce262700History.txt
'//
'// Returns: true on sucess, false otherwise
'//
Function DownloadFile(objFTP, strRemoteFile, strLocalFile, bResume)
Dim bRet : bRet = false
Dim strLocalFolder: strLocalFolder = PathRemoveFileSpec(strLocalFile)
If LocalCreateDirectory(strLocalFolder) Then
'
Dim strFile : strFile = UnixPathGetLast(strRemoteFile)
Dim strPath : strPath = UnixPathRemoveFileSpec(strRemoteFile)
If ChangeDirectory(objFTP, strPath) Then
'
Dim nRestart : nRestart = 0 ' overwrite by default
Dim bSkip : bSkip = false ' don't skip, unless equal size
If bResume Then
' Get Remote File Size
result = objFTP.GetFileSize(strFile)
If result = ftpErrorSuccess Then
'
Dim nRemoteFileSize : nRemoteFileSize = objFTP.LastFileSizeLo
If nRemoteFileSize > 0 Then
'
' Get Local File Size
Dim nLocalFileSize : nLocalFileSize = 0
On Error Resume Next
Dim f
Set f = g_objFS.GetFile(strLocalFile)
If Err.Number = 0 Then
nLocalFileSize = f.Size
Set f = Nothing
End If
On Error GoTo 0
If nLocalFileSize = nRemoteFileSize Then
bSkip = true
Call Trace("Skipping file """ & strRemoteFile & """. Reason equal size.")
ElseIf nLocalFileSize < nRemoteFileSize Then
' Only resume if local size is smaller than remote size
nRestart = nLocalFileSize
End If
End If
End If
End If
If bSkip = false Then
' DownloadFile
result = objFTP.DownloadFile(strFile, strLocalFile, nRestart, 0)
If result = ftpErrorSuccess Then
bRet = true
Else
Call Trace("DownloadFile of " & strFile & " failed. Error = " & result)
bRet = false
End If
Else
bRet = true
End If
Else
Call Trace("Change directory to " & strPath & " failed.")
End If
End If
DownloadFile = bRet
End Function
'///////////////////////////////////////////////////////////////////////////////////
'// UploadFile
'//
'// strLocalFile : Path to local file e.g. ce262700
'// strRemoteFile : Path to remote file e.g. /ce262700/
'//
'// Returns: true on sucess, false otherwise
'//
'// Note: Function will fail if remote directory doesn't exist
Function UploadFile(objFTP, strLocalFile, strRemoteFile, bResume)
Dim bRet : bRet = false
Dim bFileExists : bFileExists = false ' pessimistic assumption
' Get Local File Size
Dim nLocalFileSize : nLocalFileSize = 0
On Error Resume Next
Dim f
Set f = g_objFS.GetFile(strLocalFile)
If Err.Number = 0 Then
nLocalFileSize = f.Size
bFileExists = true
Set f = Nothing
' Else
' Call Trace("Local file '" & strLocalFile & "' doesn't exist.")
End If
On Error GoTo 0
If bFileExists Then
' Change remote directory
Dim strFile : strFile = UnixPathGetLast(strRemoteFile)
Dim strPath : strPath = UnixPathRemoveFileSpec(strRemoteFile)
If ChangeDirectory(objFTP, strPath) Then
'
Dim nRestart : nRestart = 0 ' overwrite by default
Dim bSkip : bSkip = false ' don't skip, unless equal size
If bResume Then
' Get Remote File Size
result = objFTP.GetFileSize(strFile)
If result = ftpErrorSuccess Then
'
Dim nRemoteFileSize : nRemoteFileSize = objFTP.LastFileSizeLo
If nLocalFileSize = nRemoteFileSize Then
bSkip = true
Call Trace("Skipping file """ & strRemoteFile & """. Reason equal size.")
ElseIf nLocalFileSize > nRemoteFileSize Then
' Only resume if local size is greater than remote size
nRestart = nRemoteFileSize
End If
End If
End If
If bSkip = false Then
' UploadFile
result = objFTP.UploadFile(strLocalFile, strFile, nRestart, 0)
If result = ftpErrorSuccess Then
bRet = true
Else
Call Trace("UploadFile of " & strFile & " failed. Error = " & result)
bRet = false
End If
Else
bRet = true
End If
Else
Call Trace("Change directory to " & strPath & " failed.")
End if
End If
UploadFile = bRet
End Function
'///////////////////////////////////////////////////////////////////////////////////
'// FXPFile
'//
'// strFileSource : Path to source file e.g. /ce262700/
'// strFileDestination : Path to destination file e.g. /ce262700/
'//
'// Returns: true on sucess, false otherwise
'//
'// Note: Function will fail if remote directory doesn't exist
Function FXPFile(objFTPSource, objFTPDestination, strFileSource, strFileDestination, bResume)
Dim bRet : bRet = false
' Change Directory
Dim strFilenameSource : strFilenameSource = UnixPathGetLast(strFileSource)
Dim strPathSource : strPathSource = UnixPathRemoveFileSpec(strFileSource)
Dim strFilenameDestination : strFilenameDestination= UnixPathGetLast(strFileDestination)
Dim strPathDestination : strPathDestination = UnixPathRemoveFileSpec(strFileDestination)
If ChangeDirectory(objFTPSource, strPathSource) And ChangeDirectory(objFTPDestination, strPathDestination) Then
'
Dim bSkip : bSkip = false ' don't skip, unless equal size
Dim nRestart : nRestart = 0 ' overwrite by default
If bResume Then
'
' Get Source File Size
result = objFTPSource.GetFileSize(strFilenameSource)
If result = ftpErrorSuccess Then
'
Dim nFileSizeSource : nFileSizeSource = objFTPSource.LastFileSizeLo
' Get Destination File Size
result = objFTPDestination.GetFileSize(strFilenameDestination)
If result = ftpErrorSuccess Then
'
Dim nFileSizeDestination : nFileSizeDestination = objFTPDestination.LastFileSizeLo
If nFileSizeSource = nFileSizeDestination Then
bSkip = true
ElseIf nFileSizeSource > nFileSizeDestination Then
' Only resume if local size is greater than remote size
nRestart = nFileSizeSource
End If
End If
End If
End If
If bSkip = false Then
Dim objFTPFXP
Set objFTPFXP = CreateObject("sfFTPLib.FTPFXP")
objFTPFXP.Source = objFTPSource
objFTPFXP.Destination = objFTPDestination
' FXPFile
result = objFTPFXP.FXPFile(strFilenameSource, strFilenameDestination, nRestart, 0)
If result = ftpErrorSuccess Then
bRet = true
Else
Call Trace("FXPFile of " & strFilenameSource & " failed. Error = " & result)
bRet = false
End If
Else
Call Trace("Skipping file """ & strFilenameSource & """. Reason equal size.")
bRet = true
End If
Else
Call Trace("Change directory to " & strPathSource & " failed.")
End If
FXPFile = bRet
End Function
'///////////////////////////////////////////////////////////////////////////////////
'// UploadDirectory
'//
'// strLocalFolder : Path to local folder e.g. ce262700
'// strRemoteFolder: Path to remote folder e.g. /ce262700
'//
'// Returns: true on sucess, false otherwise
'//
Function UploadDirectory(objFTP, strLocalFolder, strRemoteFolder, bResume)
Dim bRet : bRet = false
' Create remote directory first
If MakeDirectory(objFTP, strRemoteFolder) Then
'
' ChangeDirectory
If ChangeDirectory(objFTP, strRemoteFolder) Then
'
bRet = true
' Read Local Directory
Dim bGetFolder : bGetFolder = false
On Error Resume Next
Dim objFolder
Set objFolder = g_objFS.GetFolder(strLocalFolder)
If Err.Number = 0 Then
bGetFolder = true
Else
Call Trace("GetFolder(""" & strLocalFolder & """) failed." & " Error = " & Err.Number)
End If
On Error GoTo 0
If bGetFolder Then
'
' Files
Dim objFileList
Set objFileList = objFolder.Files
Dim File
For Each File In objFileList
'
If File.Name <> "." And File.Name <> ".." Then
'
Dim strRemoteFile : strRemoteFile = UnixBuildPath(strRemoteFolder, File.Name)
Dim strLocalFile : strLocalFile = g_objFS.BuildPath(strLocalFolder, File.Name)
bRet = UploadFile(objFTP, strLocalFile, strRemoteFile, bResume)
If Not bRet Then
Call Trace("Failed to upload " & strRemoteFile & ".")
' ignore error. continue
bRet = true
End If
End If
Next
Set objFileList = Nothing
' Folders
Dim objFolderList
Set objFolderList = objFolder.SubFolders
Dim Folder
For Each Folder In objFolderList
'
If Folder.Name <> "." And Folder.Name <> ".." Then
'
Dim strNewRemoteFolder : strNewRemoteFolder = UnixBuildPath(strRemoteFolder, Folder.Name)
Dim strNewLocalFolder : strNewLocalFolder = g_objFS.BuildPath(strLocalFolder, Folder.Name)
bRet= UploadDirectory(objFTP, strNewLocalFolder, strNewRemoteFolder, bResume)
If Not bRet Then
Call Trace("Failed to upload " & strNewRemoteFolder & ".")
' ignore error. continue
bRet = true
End If
End If
Next
Set objFolderList = Nothing
Set objFolder = Nothing
End If
Else
Call Trace("Change directory to " & strRemoteFolder & " failed.")
End If
End If
' set return value
UploadDirectory = bRet
End Function
'///////////////////////////////////////////////////////////////////////////////////
'// ChangeDirectory
'//
'// objFTP : FTPConnection object
'// strPath : path to remote directory
'//
'// Changes remote working directory only if server working path is not equal to strPath
'//
'// Returns: true on success, false otherwise
'//
Function ChangeDirectory(objFTP, strPath)
Dim bRet : bRet = false
If strPath = objFTP.WorkingDirectory Then
bRet = true
Else
' ChangeDirectory
result = objFTP.ChangeDirectory(strPath)
If result = ftpErrorSuccess Then
bRet = true
End If
End If
ChangeDirectory = bRet
End Function
'///////////////////////////////////////////////////////////////////////////////////
'// MakeDirectory
'//
'// objFTP : FTPConnection object
'// strPath : path to remote directory
'//
'// Makes remote directory if directory doesn't exist yet
'//
'// Returns: true on success, false otherwise
'//
Function MakeDirectory(objFTP, strPath)
Dim bRet : bRet = false
' does remote directory exist?
If ChangeDirectory(objFTP, strPath) Then
bRet = true
Else
' change to parent and make dir
Dim strLeft : strLeft = UnixPathRemoveLast(strPath)
'Call Trace("MakeDirectory(): Parent = " & strLeft)
If ChangeDirectory(objFTP, strLeft) Then
'
Dim strFile : strFile = UnixPathGetLast(strPath)
' MakeDirectory
result = objFTP.MakeDirectory(strFile)
If result = ftpErrorSuccess Then
bRet = true
Else
Call Trace("Failed to make directoryto """ & strPath & """. Error = " & result)
End If
End If
End If
MakeDirectory = bRet
End Function
'///////////////////////////////////////////////////////////////////////////////////
'// LocalCreateDirectory
'//
'// Purpose:
'// Recursively creates a local directory.
'//
'// Input:
'// strFolder: Path to folder
'//
'// Returns: true on success
'// fals otherwise
'//
Function LocalCreateDirectory(strFolder)
Dim bRet : bRet = true
Dim nLastPos : nLastPos = 1
Dim nPos
Do
Dim strLeft
nPos = InStr(nLastPos, strFolder, "", 1)
If nPos = 0 Then
strLeft = strFolder
Else
strLeft = Left(strFolder, nPos - 1)
End If
If Len(strLeft) > 0 Then
'
' no drive
If Right(strLeft, 1) <> ":" Then
'
' Local folder check
Dim bFolderExists : bFolderExists = g_objFS.FolderExists(strLeft)
If Not bFolderExists Then
'
' Create local folder
On Error Resume Next
Dim f
Set f = g_objFS.CreateFolder(strLeft)
If Err.Number = 0 Then
bFolderExists = true
Else
Call Trace("Failed to create local folder" & strLeft & ". Error = " & Err.Number)
bRet = false
End If
On Error GoTo 0
If Not bRet Then
Exit Do
End If
End If
End If
End If
' ".../"
If nPos = Len(strFolder) Then
Exit Do
End If
nLastPos = nPos + 1
Loop Until nPos = 0
LocalCreateDirectory = bRet
End Function
'///////////////////////////////////////////////////////////////////////////////////
'// UnixBuildPath
'//
'// strBase : Base path
'// strAppend : Path to append
'//
'// Returns: Full path
'//
'// Note: Works for UNIX paths only!!!
'//
Function UnixBuildPath(strBase, strAppend)
'
Dim strFull
strFull = strBase
If Right(strFull, 1) <> "/" Then
strFull = strFull & "/"
End If
strFull = strFull & strAppend
UnixBuildPath = strFull
End Function
'///////////////////////////////////////////////////////////////////////////////////
'// UnixPathGetLast
'//
'// strPath : path
'//
'// Returns: last part of path
'//
'// Note: Works for UNIX paths only!!!
'//
Function UnixPathGetLast(strPath)
Dim nPos : nPos = InStrRev(strPath, "/")
'
Dim str : str = Mid(strPath, nPos + 1)
UnixPathGetLast = str
End Function
'///////////////////////////////////////////////////////////////////////////////////
'// UnixPathRemoveLast
'//
'// strPath : path
'//
'// Returns: path with last part removed
'// removes '/' at the end
'//
'// Examples:
'// "/test" returns "/"
'// "/test/bla" returns "/test"
'// "/test/bla/" returns "/test"
'//
'// Note: Works for UNIX paths only!!!
'//
Function UnixPathRemoveLast(strPath)
Dim str
' remove ending '/'
Dim nLen : nLen = Len(strPath)
If Right(strPath, 1) = "/" Then
str = strPath.Left(nLen - 1)
Else
str = strPath
End If
str = UnixPathRemoveFileSpec(str)
UnixPathRemoveLast = str
End Function
'///////////////////////////////////////////////////////////////////////////////////
'// UnixPathRemoveFileSpec
'//
'// strPath : path
'//
'// Returns: path with filespec removed from path
'// removes '/' at the end
'//
'// Examples:
'// "/test" returns "/"
'// "/test/bla" returns "/test"
'// "/test/bla/" returns "/test/bla"
'//
'// Note: Works for UNIX paths only!!!
'//
Function UnixPathRemoveFileSpec(strPath)
Dim nPos : nPos = InStrRev(strPath, "/")
Dim str
If nPos > 0 Then
str = Left(strPath, nPos - 1)
If Len(str) = 0 Then
str = "/"
End If
Else
str = strPath
End If
UnixPathRemoveFileSpec = str
End Function
'///////////////////////////////////////////////////////////////////////////////////
'// PathRemoveFileSpec
'//
'// strPath : path
'//
'// Returns: path with filespec removed from path
'//
Function PathRemoveFileSpec(strPath)
Dim nPos : nPos = InStrRev(strPath, "")
Dim str
If nPos > 0 Then
str = Left(strPath, nPos - 1)
Else
str = strPath
End If
PathRemoveFileSpec = str
End Function
