Option Explicit ' Written by Eric Phelps www.ericphelps.com ' Uploads files whose archive bit is set. Clears the archive bit for each uploaded file. ' You must hard-code all five values listed in the "User info REQUIRED ITEMS" section ' and delete or comment the below MsgBox line to actually run the script. If you feel ' uncomfortabe embedding user name and password in a script, consider encoding this file ' or replacing those lines with an InputBox. You might also want to create a time-limited ' upload-only FTP account on the FTP server for this script to log in to. MsgBox "This script must be edited! It is designed to be run with no user interaction!" : Wscript.Quit 1 On Error Resume Next Main Wscript.Quit 0 Sub Main() On Error Resume Next 'Declare objects Dim wsh 'As Wscript.Shell Dim tsScript 'As Scripting.TextStream Dim tsUndo 'As Scripting.TextStream Dim tsLsFile 'As Scripting.TextStream Dim fil 'As Scripting.File Dim fils 'As Scripting.Files Dim fol 'As Scripting.Folder Dim fols 'As Scripting.Folders Dim fs 'As Scripting.FileSystemObject 'Declare variables Dim strLocalDirectory() 'As String Dim strRemoteDirectory 'As String Dim strRemoteSite 'As String Dim strRemoteFile 'As String Dim strUserName 'As String Dim strPassword 'As String Dim strTextFileTypes 'As String Dim strLsFileContents 'As String Dim intWindowStyle 'As Integer Dim strFtpScriptFileName 'As String Dim strUndoBatchFileName 'As String Dim strLsFileName 'As String 'Declare variables Dim lngCounter 'As Long Dim blnDirectoryCreated 'As Boolean Dim blnNeedToUpload 'As Boolean 'Define constants Const TemporaryFolder = 2 Const READONLY = 1 Const HIDDEN = 2 Const SYSTEM = 4 Const ARCHIVE = 32 Const WshHide = 0 Const WshNormalFocus = 1 Const WshMinimizedFocus = 2 Const WshMaximizedNoFocus = 3 Const WshNormalNoFocus = 4 Const WshMinimizedNoFocus = 6 '''''''''' Create needed objects Set wsh = CreateObject("Wscript.Shell") Set fs = CreateObject("Scripting.FileSystemObject") '''''''''' Set initial values Redim strLocalDirectory(0) strFtpScriptFileName = fs.BuildPath(fs.GetSpecialFolder(TemporaryFolder), fs.GetBaseName(Wscript.ScriptFullName) & ".script") strUndoBatchFileName = fs.BuildPath(fs.GetSpecialFolder(TemporaryFolder), fs.GetBaseName(Wscript.ScriptFullName) & ".bat") strLsFileName = fs.BuildPath(fs.GetSpecialFolder(TemporaryFolder), fs.GetBaseName(Wscript.ScriptFullName) & ".ls") '''''''''' User info REQUIRED ITEMS '''''''''''''''''''''' strPassword = "ieuser@" 'FTP server password strUserName = "anonymous" 'FTP server user name strRemoteSite = "ftp.microsoft.com" 'FTP server machine name strRemoteDirectory = "/pub" 'FTP server top directory you are synchronizing strLocalDirectory(0) = "c:\www\pub" 'LOCAL directory that mirrors "strRemoteDirectory" '''''''''' User preferences '''''''''''''''''''''' strTextFileTypes = ".plan .htaccess" 'Text file extensions intWindowStyle = WshNormalFocus 'Just how visible? Use any Wsh constant defined above ' CAUTION: If intWindowStyle is set to WshHide and user needs a dial-up connection, the dial-up ' dialog will be hidden too, effectively hanging the program! If the connection is dialed before ' this program is run, or if the user is on a LAN, there is no problem using wshHide. '''''''''' Set the window style If Lcase(Right(Wscript.FullName, 11)) = "wscript.exe" Then 'Running under WSCRIPT If intWindowStyle <> WshHide Then 'Need to switch to CSCRIPT CreateObject("Wscript.Shell").Run "cscript.exe """ & Wscript.ScriptFullName & """", intWindowStyle Wscript.Quit End If Else 'Running under CSCRIPT 'Do nothing. Assume CSCRIPT was started with the START 'command or shortcut properties set for the correct window style. End If '''''''''' Fix up values strLocalDirectory(0) = fs.GetAbsolutePathName(strLocalDirectory(0)) If Right(strRemoteDirectory, 1) <> "/" Then strRemoteDirectory = strRemoteDirectory & "/" If Left(strRemoteDirectory, 1) <> "/" Then strRemoteDirectory = "/" & strRemoteDirectory If fs.FileExists(strLsFileName) Then fs.DeleteFile strLsFileName '''''''''' Start output text files Set tsScript = fs.CreateTextFile(strFtpScriptFileName, True) tsScript.WriteLine "open " & strRemoteSite tsScript.WriteLine strUserName tsScript.WriteLine strPassword tsScript.WriteLine "hash" Set tsUndo = fs.CreateTextFile(strUndoBatchFileName, True) tsUndo.WriteLine "@echo off" '''''''''' Recursively search all directories blnNeedToUpload = False lngCounter = 0 Do Until lngCounter > Ubound(strLocalDirectory,1) 'Next folder to process Set fol = fs.GetFolder(strLocalDirectory(lngCounter)) If Err.Number <> 0 Then 'Probably a mapped drive when the user isn't logged in tsScript.Close fs.DeleteFile strFtpScriptFileName Status "FAILED in local folder """ & strLocalDirectory(lngCounter) & """ : " & Err.Description & " " & Now tsUndo.Close wsh.Run strUndoBatchFileName, intWindowStyle, True fs.DeleteFile strUndoBatchFileName Wscript.Quit 1 End If blnDirectoryCreated = False 'Get each file in turn Set fils = fol.Files For Each fil In fils If ((fil.Attributes And ARCHIVE) = ARCHIVE) Then If ((fil.Attributes And SYSTEM) = 0) Then If ((fil.Attributes And HIDDEN) = 0) Then If fil.Size > 0 Then 'Get the remote file name strRemoteFile = RemoteFileName(fil.Path, strLocalDirectory(0), strRemoteDirectory) 'Create the remote directory just in case it doesn't exist. Harmless if it exists. If Not blnDirectoryCreated Then If (fol.Path <> strLocalDirectory(0)) Then blnDirectoryCreated = True tsScript.WriteLine "mkdir " & RemoteFileName(fol.Path, strLocalDirectory(0), strRemoteDirectory) End If End If 'Flag that we have something to do blnNeedToUpload = True 'Set for ascii or binary mode based on file extension (or lack) If Instr(fil.Path, ".") = 0 Then 'File with no extension. Probably a shell script. Text. Your mileage may vary. tsScript.WriteLine "ascii" Status " ascii: " & fil.Path & " >> " & strRemoteFile Else If Instr(1, strTextFileTypes, Mid(fil.Path, InstrRev(fil.Path, ".")), vbTextCompare) = 0 Then 'Not one of the user-designated text file extensions. Binary. tsScript.WriteLine "binary" Status " binary: " & fil.Path & " >> " & strRemoteFile Else 'One of the user-designated text file extensions. Text. tsScript.WriteLine "ascii" Status " ascii: " & fil.Path & " >> " & strRemoteFile End If End If tsScript.WriteLine "put " & fil.ShortPath & " " & strRemoteFile tsUndo.WriteLine "attrib +A " & fil.ShortPath fil.Attributes = fil.Attributes - ARCHIVE End If End If End If End If Next 'Check for any sub folders and add them to the folder array Set fols = fol.SubFolders For each fol in fols If Lcase(fol.Name) <> "recycled" Then Redim Preserve strLocalDirectory(Ubound(strLocalDirectory,1) + 1) strLocalDirectory(Ubound(strLocalDirectory,1)) = fol.Path End If Next lngCounter = lngCounter + 1 Loop tsScript.WriteLine "ls -CF " & """" & strLsFileName & """" tsScript.WriteLine "bye" tsScript.Close tsUndo.WriteLine "cls" tsUndo.Close Set tsScript = Nothing Set tsUndo = Nothing If blnNeedToUpload Then 'Actually run the FTP command using the script we generated If fs.FileExists(fs.GetSpecialFolder(1) & "\ftp.exe") Then wsh.Run fs.GetSpecialFolder(1) & "\ftp.exe -s:""" & strFtpScriptFileName & """", intWindowStyle, True Else wsh.Run fs.GetSpecialFolder(0) & "\ftp.exe -s:""" & strFtpScriptFileName & """", intWindowStyle, True End If 'Delete the script as soon as possible because it has the user name and password in clear text fs.DeleteFile strFtpScriptFileName 'Check to see if the ls command gave us a response (did we actually log in?) If (fs.FileExists(strLsFileName)) Then If fs.GetTextFile(strLsFileName).Size <> 0 Then Status "Above files uploaded by ftp " & Now fs.DeleteFile strUndoBatchFileName fs.DeleteFile strLsFileName Else Status "FAILED ftp action " & Now wsh.Run strUndoBatchFileName, intWindowStyle, True fs.DeleteFile strUndoBatchFileName fs.DeleteFile strLsFileName Wscript.Quit 1 End If Else Status "FAILED ftp action " & Now wsh.Run strUndoBatchFileName, intWindowStyle, True fs.DeleteFile strUndoBatchFileName Wscript.Quit 1 End If End If End Sub Function RemoteFileName(strLocalFile, strLocalRoot, strRemoteRoot) Dim strRemoteFileName 'As String strRemoteFileName = Mid(strLocalFile, Len(strLocalRoot) + 1) Do While Instr(strRemoteFileName, "\") <> 0 strRemoteFileName = Left(strRemoteFileName, Instr(strRemoteFileName, "\") - 1) _ & "/" _ & Mid(strRemoteFileName, Instr(strRemoteFileName, "\") + 1) Loop If Left(strRemoteFileName, 1) = "/" Then strRemoteFileName = Mid(strRemoteFileName, 2) strRemoteFileName = strRemoteRoot & strRemoteFileName RemoteFileName = strRemoteFileName End Function Sub Status (strMessage) 'If the program was run with CSCRIPT, this writes a 'line into the DOS box. In any case, it writes 'to a log with the same name as the script (except .log). Dim tsLog 'As Scripting.TextStream Dim fs 'As Scripting.FileSystemObject Const ForAppending = 8 'Scripting.IOMode If Lcase(Right(Wscript.FullName, 12)) = "\cscript.exe" Then Wscript.Echo strMessage End If Set fs = CreateObject("Scripting.FileSystemObject") Set tsLog = fs.OpenTextFile(fs.BuildPath(Wscript.ScriptFullName & "\..", fs.GetBaseName(Wscript.ScriptFullName) & ".log"), ForAppending, True) tsLog.WriteLine strMessage tsLog.Close ''''''''''Clean up Set tsLog = Nothing Set fs = Nothing End Sub