Option Explicit ' Creates an FTP upload script / batch file for files whose archive bit is set. ' Clears the archive bit for each file afterwards. New directories will be created. ' The created script is named same as this VBS file except with ".script.bat" ' An "undo" batch file is created same name as this VBS file except with ".undo.bat" ' Written by Eric Phelps ' http://www.ericphelps.com '''''''''' Un-comment the below -On Error Resume Next- line if you ' will be uploading from a CDROM. This program tries to ' clear the archive bit on files, which can't be done on a CD! 'On Error Resume Next '''''''''' Un-comment the below -Force "cscript"- line if you want ' to force operation to be with CSCRIPT in a DOS window. ' Or change it to "wscript" if you don't want it in a DOS window. 'Force "cscript" Main Wscript.Quit 0 Sub Main() Dim ts '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 Dim strDirectories() 'As String Dim strRemoteDirectory 'As String Dim strRemoteSite 'As String Dim strRemoteFile 'As String Dim strUserName 'As String Dim strPassword 'As String Dim strFileTypes 'As String Dim lngCounter 'As Long Dim blnDirectoryCreated 'As Boolean Const DIALOGLABEL = "Create FTP Upload Script" Const READONLY = 1 Const HIDDEN = 2 Const SYSTEM = 4 Const ARCHIVE = 32 If MsgBox ("This program will create a batch file FTP uploading script allowing you to upload all changed files to your FTP server. This program DOES NOT upload -- it only creates an upload batch file. This program WILL clear the archive bit on files, but will create an ""undo"" batch file for that action. Continue?", vbOkCancel) = vbCancel Then Wscript.Quit Set fs = CreateObject("Scripting.FileSystemObject") If Lcase(Right(Wscript.FullName, 11)) = "wscript.exe" Then If MsgBox ("This program is being run under WSCRIPT. Results will be stored in a log at " & Wscript.ScriptFullName & ".log. Run this program under CSCRIPT if you want a real-time display of activity. Otherwise, a message box will pop up to inform you when the program finishes. Continue?", vbOkCancel, DIALOGLABEL) = vbCancel Then Wscript.Quit Else If MsgBox ("This program is being run under CSCRIPT. Results will be displayed on-screen. Continue?", vbOkCancel, DIALOGLABEL) = vbCancel Then Wscript.Quit End If '''''''''' Get remote site data ' Ask the toughest question first to see whether we will write a script or a batch file. strPassword = InputBox("Enter the password needed to log in to the remote FTP server. CAUTION -- YOUR PASSWORD WILL BE VISIBLE UNTIL YOU CLICK ""OK""! If you supply this data, the output "".script.bat"" file will be written as a combination ftp script/batch file. Otherwise, it will be written as a non-functional simple ftp script.", DIALOGLABEL, "") If strPassword <> "" Then strUserName = InputBox("Enter the user name needed to log in to the remote FTP server:", DIALOGLABEL, "") If strUserName <> "" Then strRemoteSite = InputBox("Enter the remote FTP server name or IP address. Do not add protocol or directory information, just put the machine name here:", DIALOGLABEL, "127.0.0.1") If (Instr(strRemoteSite, "/") <> 0) Then Wscript.Quit 1 If strRemoteSite = "" Then strPassword = "" strUserName = "" End If Else strPassword = "" strRemoteSite = "" End If Else strUserName = "" strRemoteSite = "" End If strRemoteDirectory = InputBox("Enter remote path to start uploading to:", DIALOGLABEL, "/pub/users/") If strRemoteDirectory = "" Then Wscript.Quit 1 If Right(strRemoteDirectory, 1) <> "/" Then strRemoteDirectory = strRemoteDirectory & "/" If Left(strRemoteDirectory, 1) <> "/" Then strRemoteDirectory = "/" & strRemoteDirectory '''''''''' Get local data Redim strDirectories(0) strDirectories(0) = InputBox("Enter local path to start uploading from:", DIALOGLABEL, FileNameInThisDir("")) If strDirectories(0) = "" Then Wscript.Quit 1 strDirectories(0) = fs.GetAbsolutePathName(strDirectories(0)) strFileTypes = InputBox("Enter extensions for file types to be uploaded as plain text (include the leading dot):", DIALOGLABEL, ".txt .htm .html .asp .css .js .vbs .bat .cmd") If MsgBox("This is your last question. FTP script creation starts if you click yes. Okay to create script named """ & Wscript.ScriptFullName & ".script.bat"" to upload all files in and below the " & strDirectories(0) & " directory to """ & strRemoteSite & strRemoteDirectory & """, sending """ & strFileTypes & """ files as text and all other files as binary? ", vbYesNo, DIALOGLABEL) = vbNo Then Wscript.Quit 1 '''''''''' Create output script and undo batch files. Overwrite them if they exist. Set ts = fs.CreateTextFile(Wscript.ScriptFullName & ".script.bat", True) If strPassword <> "" Then If fs.FileExists(fs.GetSpecialFolder(1) & "\ftp.exe") Then ts.WriteLine fs.GetSpecialFolder(1) & "\ftp.exe -s:%f%0" Else ts.WriteLine fs.GetSpecialFolder(0) & "\ftp.exe -s:%0" End If ts.WriteLine "goto done" ts.WriteLine "open " & strRemoteSite ts.WriteLine strUserName ts.WriteLine strPassword End If ts.WriteLine "hash" ts.Close Set ts = fs.CreateTextFile(Wscript.ScriptFullName & ".undo.bat", True) ts.WriteLine ":: UNDO BATCH FILE - will set archive bit on all files cleared" ts.WriteLine ":: by " & Wscript.ScriptFullName & " FTP script creation tool." ts.Close Set ts = Nothing '''''''''' Start the log. Or the status display. Or whatever. Status "*************************************" Status "*************************************" Status "Program: " & Wscript.ScriptFullName Status "Program started: " & Now Status "Creating script to upload all files in and below the """ & strDirectories(0) & """ directory" Status "to """ & strRemoteSite & strRemoteDirectory & """, " Status "sending """ & strFileTypes & """" Status "files as text and all other files as binary." Status "Output script will be written to """ & Wscript.ScriptFullName & ".script.bat""" If strPassword <> "" Then Status " (Double click the output script to actually upload the files)" Status "Undo batch file will be written to """ & Wscript.ScriptFullName & ".undo.bat""" Status " (Double click the undo batch file to mark all found files as not found)" '''''''''' Recursively search all directories lngCounter = 0 Do Until lngCounter > Ubound(strDirectories,1) 'Next folder to process Set fol = fs.GetFolder(strDirectories(lngCounter)) blnDirectoryCreated = False 'Get each file in turn Set fils = fol.Files If Err.Number <> 0 Then Exit Sub For Each fil In fils Status fil.Path 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, strDirectories(0), strRemoteDirectory) If Instr(fil.Path, ".") = 0 Then 'Create the directory if it might be needed If (fol.Path <> strDirectories(0)) Then blnDirectoryCreated = CreateDirectory(blnDirectoryCreated, RemoteFileName(fol.Path, strDirectories(0), strRemoteDirectory)) 'File with no extension. Probably a shell script. Text. AppendScript "ascii" Status " ascii" Else If Instr(1, strFileTypes, Mid(fil.Path, InstrRev(fil.Path, ".")), vbTextCompare) = 0 Then 'Create the directory if it might be needed If (fol.Path <> strDirectories(0)) Then blnDirectoryCreated = CreateDirectory(blnDirectoryCreated, RemoteFileName(fol.Path, strDirectories(0), strRemoteDirectory)) 'Not one of the user-designated text file extensions. Binary. AppendScript "binary" Status " binary" Else 'Create the directory if it might be needed If (fol.Path <> strDirectories(0)) Then blnDirectoryCreated = CreateDirectory(blnDirectoryCreated, RemoteFileName(fol.Path, strDirectories(0), strRemoteDirectory)) 'One of the user-designated text file extensions. Text. AppendScript "ascii" Status " ascii" End If End If AppendScript "put " & fil.ShortPath & " " & strRemoteFile Status " " & strRemoteFile fil.Attributes = fil.Attributes - ARCHIVE AppendUndo "attrib +A " & fil.ShortPath 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 strDirectories(Ubound(strDirectories,1) + 1) strDirectories(Ubound(strDirectories,1)) = fol.Path End If Next lngCounter = lngCounter + 1 Loop AppendScript "bye" If strPassword <> "" Then AppendScript ":done" AppendScript "@echo off" AppendScript "cls" End If Status "Program finished: " & Now Status "*************************************" Status "*************************************" If Lcase(Right(Wscript.FullName, 11)) = "wscript.exe" Then MsgBox "Program Finished! Details are in the log at " & Wscript.ScriptFullName & ".log", vbOkOnly, DIALOGLABEL Else MsgBox "Program Finished! Output script was written to """ & Wscript.ScriptFullName & ".script.bat"". " _ & "Double click the output script (if you supplied password, user name, and server info) to actually upload the files. " _ & "Undo batch file was written to """ & Wscript.ScriptFullName & ".undo.bat"". " _ & "Double click the undo batch file to mark all found files as not found." 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 Function CreateDirectory(blnAlreadyDone, strRemoteDirectory) If Not blnAlreadyDone Then 'Write a MKDIR command to create the directory. Harmless if it already exists. AppendScript "mkdir " & strRemoteDirectory End If CreateDirectory = True End Function Function FileNameInThisDir(strFileName) 'As String 'Returns the complete path and file name to a file in 'the script directory. For example, "trans.log" might 'return "C:\Program Files\Scripts\Database\trans.log" 'if the script was in the "C:\Program Files\Scripts\Database" 'directory. Dim fs 'As Scripting.FileSystemObject Set fs = CreateObject("Scripting.FileSystemObject") FileNameInThisDir = fs.GetAbsolutePathName(fs.BuildPath(Wscript.ScriptFullName, "..\" & strFileName)) ''''''''''Clean up Set fs = Nothing End Function Sub Status (strMessage) 'If the program was run with CSCRIPT, this writes a 'line into the DOS box. If run with WSCRIPT, it writes 'to a log with the same name as the script (except .log). Dim ts '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 Else Set fs = CreateObject("Scripting.FileSystemObject") Set ts = fs.OpenTextFile(Wscript.ScriptFullName & ".log", ForAppending, True) ts.WriteLine strMessage ts.Close ''''''''''Clean up Set ts = Nothing Set fs = Nothing End If End Sub Sub AppendScript(strText) 'Writes a new command line to the script file Dim ts 'As Scripting.TextStream Dim fs 'As Scripting.FileSystemObject Const ForAppending = 8 'Scripting.IOMode Set fs = CreateObject("Scripting.FileSystemObject") Set ts = fs.OpenTextFile(Wscript.ScriptFullName & ".script.bat", ForAppending, True) ts.WriteLine strText ts.Close ''''''''''Clean up Set ts = Nothing Set fs = Nothing End Sub Sub AppendUndo(strText) 'Writes a new command line to the undo batch file Dim ts 'As Scripting.TextStream Dim fs 'As Scripting.FileSystemObject Const ForAppending = 8 'Scripting.IOMode Set fs = CreateObject("Scripting.FileSystemObject") Set ts = fs.OpenTextFile(Wscript.ScriptFullName & ".undo.bat", ForAppending, True) ts.WriteLine strText ts.Close ''''''''''Clean up Set ts = Nothing Set fs = Nothing End Sub Sub Force(sScriptEng) 'Forces this script to be run under the desired scripting host 'Valid sScriptEng arguments are "wscript" or "cscript" 'If you don't supply a valid name, Force will switch hosts... If Lcase(Right(Wscript.FullName, 12)) = "\wscript.exe" Then 'Running under WSCRIPT If Instr(1, Wscript.FullName, sScriptEng, 1) = 0 Then 'Need to switch to CSCRIPT CreateObject("Wscript.Shell").Run "cscript.exe " & Wscript.ScriptFullName Wscript.Quit End If Else 'Running under CSCRIPT If Instr(1, Wscript.FullName, sScriptEng, 1) = 0 Then 'Need to switch to WSCRIPT CreateObject("Wscript.Shell").Run "wscript.exe " & Wscript.ScriptFullName Wscript.Quit End If End If End Sub