Programming
From Vandelay Wiki
Artvandelay (Talk | contribs) |
Artvandelay (Talk | contribs) |
||
| Line 263: | Line 263: | ||
</pre> | </pre> | ||
| + | <pre> | ||
| + | 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 | ||
| + | </pre> | ||
---- | ---- | ||
Back to [[Main_Page|Main Page]] | Back to [[Main_Page|Main Page]] | ||
