Windows Schell Script: Syncronize folders

SyncFolders.vbs

Option Explicit

'
' Syncronize folders, in both ways, recursivelly
'
' Usage: cscript SyncFolders.vbs {source} {dest} [{logfile}] [/nolog] [/noecho] [/oneway] [/backup]
'
' {source}  - Source path
' {dest}    - Target path
' {logfile} - Log file. If not passed, "SyncFolders_YYYYMMDDHHMMSS.log" will be created.
' /nolog    - Do not create log file
' /noecho   - Do not echo
' /oneway   - Do not check the reverse way
' /backup   - Update files on target path as they are in source path. 
'             CAUTION: THIS OPTION WILL DELETE FILES ON DEST IF IT WAS REMOVED FROM SOURCE!!!
'
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")

Dim bHasLogFile
Dim objLogFile
bHasLogFile = False

Dim dtTimestamp
Dim strTimestamp

Dim arrValidOptions
arrValidOptions = Array("/nolog", "/noecho", "/oneway", "/backup")

If (WScript.Arguments.Count < 2) Then
    WScript.Echo("Usage: cscript SyncFolders.vbs {source} {dest} [/options] [{log-file}]")
	WScript.Quit(1)
End If

Dim strArg
Dim strSrcFolder: strSrcFolder = ""
Dim strDstFolder: strDstFolder = ""
Dim strLogFile: strLogFile = ""
Dim arrOptions()
Dim intOptions
intOptions = 0

For Each strArg in WScript.Arguments
	If (Left(strArg, 1) = "/") Then
		If UBound(Filter(arrValidOptions, strArg)) = -1 Then
			WScript.Echo("Parameter not expected: " & strArg)
			WScript.Quit(1)
		End If
		
		intOptions = intOptions + 1
		ReDim Preserve arrOptions(intOptions)
		arrOptions(intOptions - 1) = strArg
	Else
		If strSrcFolder = "" Then
			strSrcFolder = strArg
		Else
			If strDstFolder = "" Then
				strDstFolder = strArg
			Else
				If strLogFile = "" Then
					strLogFile = strArg
				Else
					WScript.Echo("Unexpected parameter found: " & strArg)
					WScript.Quit(1)
				End If
			End If
		End If
	End If
Next
If strSrcFolder = "" Or strDstFolder = "" Then
    WScript.Echo("Usage: cscript SyncFolders.vbs {source} {dest} [/options] [{log-file}]")
	WScript.Quit(1)
End If

If strLogFile = "" Then
	strLogFile = "SyncFolders_" & GetTime() & ".log"
Else
	If Mid(strLogFile, Len(strLogFile) - 3, 1) = "." Then
		strLogFile = Left(strLogFile, Len(strLogFile) - 4) & "_" & GetTime() & Right(strLogFile, 4)
	Else
		strLogFile = strLogFile & "_" & GetTime() & ".log"
	End If
End If

If UBound(Filter(arrOptions, "/noecho")) = -1 Then
	WScript.Echo("Start of Script")
End If

SyncFolders strSrcFolder, strDstFolder

If UBound(Filter(arrOptions, "/noecho")) = -1 Then
	WScript.Echo("End of Script")
End If

' Close Log file, if is opened
If bHasLogFile Then
	objLogFile.Close
End If

Set objFSO = Nothing

' 
' Pad characters of strSource on the left with strPad until intSize
'
Function LPad(strAlpha, strPad, intSize)
	Dim strPadded
	
	If Len(strAlpha) < intSize Then
		strPadded = String(intSize - Len(strAlpha), strPad) & strAlpha
	Else
		strPadded = strAlpha
	End If
	
	LPad = strPadded
End Function 

'
' Get Timestamp on format YYYYMMDDHHmmss
'
Function GetTime()
	dtTimestamp = now
	strTimestamp = LPad(Year(dtTimestamp), "0", 4) & LPad(Month(dtTimestamp), "0", 2) & LPad(Day(dtTimestamp), "0", 2) & LPad(Hour(dtTimestamp), "0", 2) & LPad(Minute(dtTimestamp), "0", 2) & LPad(Second(dtTimestamp), "0", 2)
	GetTime = strTimestamp
End Function

'
' WriteLog
'
Sub WriteLog(strProcedure, arrParams)
	' Echo output
	If UBound(Filter(arrOptions, "/noecho")) = -1 Or arrParams(0) = "Error" Then
		WScript.Echo(strProcedure & ", " & Join(arrParams, ", "))
	End If
	
	If UBound(Filter(arrOptions, "/nolog")) = -1 Then
		' Check to open Log File
		If Not bHasLogFile Then
			Set objLogFile = objFSO.CreateTextFile(strLogFile, True)
			bHasLogFile = True
		End If
		
		' Write Log file
		objLogFile.Write strProcedure & ";" & Join(arrParams, ";") & vbCrLf
	End If
End Sub

'
' Syncronize Both ways
'
Sub SyncFolders(strFolderSync1, strFolderSync2)
	WriteLog "SyncFolders", Array("Call", strFolderSync1, strFolderSync2)
    
	Dim i
    For i = 0 To 1
		If i = 0 Then
			SyncToFolder strFolderSync1, strFolderSync2, i
		Else
			If UBound(Filter(arrOptions, "/oneway")) = -1 Then
				If UBound(Filter(arrOptions, "/backup")) = -1 Then
					SyncToFolder strFolderSync2, strFolderSync1, i
				Else
					UpdateBackupFolder strFolderSync1, strFolderSync2
				End If
			End If
		End If
	Next
End Sub

'
' Syncronize One way, recursivelly
'
Sub SyncToFolder(strFolderOrig, strFolderTarget, intWay)
	WriteLog "SyncToFolder", Array("Call", strFolderOrig, strFolderTarget, intWay)
	
	Dim strSource
	Dim strDest
	
	' Check if source folder exists
	If objFSO.FolderExists(strFolderOrig) = False Then
		WriteLog "SyncToFolder", Array("Error", "Source folder does not exists", strFolderOrig)
		WScript.Quit(1)
	End If

	Dim bError
	bError = False

	' Check if destiny folder exists
	If objFSO.FolderExists(strFolderTarget) = False Then
		WriteLog "SyncToFolder", Array("Create folder", strFolderTarget)
		
		On Error Resume Next
	    objFSO.CreateFolder(strFolderTarget)
		If Err.Number > 0 Then
			WriteLog "SyncToFolder", Array("Error", "Can't create folder", strFolderTarget, Err.Number, Err.Description, Err.Source)
			Err.Clear
			bError = True
		End If
		On Error Goto 0
	End If

	If bError Then
		Exit Sub
	End If
	
    Dim objFolderOrig
    Set objFolderOrig = objFSO.GetFolder(strFolderOrig)
    Dim objFolderTarget
    Set objFolderTarget = objFSO.GetFolder(strFolderTarget)
    
    ' Check Files
    Dim objFileSrc
    Dim objFileDst
	
	On Error Resume Next
    For Each objFileSrc in objFolderOrig.Files
		strSource = objFolderOrig.Path & "\" & objFileSrc.Name
		strDest = objFolderTarget.Path & "\" & objFileSrc.Name
		
		If Not objFSO.FileExists(strDest) Then
			' File does not exists
			WriteLog "SyncToFolder", Array("Copy file", strSource, strDest)
			objFSO.CopyFile strSource, strDest
		Else
			Set objFileDst = objFSO.GetFile(strDest)
			
			If (objFileSrc.DateLastModified > objFileDst.DateLastModified) Then
				' Copy newer file
				WriteLog "SyncToFolder", Array("Overwrite older file", strSource, strDest)
				objFSO.CopyFile strSource, strDest
			End If
		End If
    Next
	If Err.Number > 0 Then
		WriteLog "SyncToFolder", Array("Error", "Can't read source files", objFolderOrig, Err.Number, Err.Description, Err.Source)
		Err.Clear
		bError = True
	End If
	On Error Goto 0

	If Not bError Then
		' Check Subfolders
		Dim objSubFolder
		
		On Error Resume Next
		For Each objSubFolder in objFolderOrig.SubFolders
			strSource = objFolderOrig.Path & "\" & objSubFolder.Name
			strDest = objFolderTarget.Path & "\" & objSubFolder.Name
			
			If intWay = 0 Then
				' If on way forward, check both ways
				SyncFolders strSource, strDest
			Else
				' If on way back, check one way. Only if not exists
				If objFSO.FolderExists(strDest) = False Then
					SyncToFolder strSource, strDest, 1
				End If
			End If
		Next
		If Err.Number > 0 Then
			WriteLog "SyncToFolder", Array("Error", "Can't read subfolders", objFolderOrig, Err.Number, Err.Description, Err.Source)
			Err.Clear
			bError = True
		End If
		On Error Goto 0
	End If
End Sub

'
' Update Backup folder, recursivelly
'
Sub UpdateBackupFolder(strFolderOrig, strFolderTarget)
	WriteLog "UpdateBackupFolder", Array("Call", strFolderOrig, strFolderTarget)
	
	Dim strSource
	Dim strDest
	
	' Check if source folder exists
	If objFSO.FolderExists(strFolderOrig) = False Then
		WriteLog "UpdateBackupFolder", Array("Error", "Source folder does not exists", strFolderOrig)
		WScript.Quit(1)
	End If

	Dim bError
	bError = False

	' Check if backup folder exists
	If objFSO.FolderExists(strFolderTarget) = False Then
		WriteLog "UpdateBackupFolder", Array("Create folder", strFolderTarget)
		
		On Error Resume Next
	    objFSO.CreateFolder(strFolderTarget)
		If Err.Number > 0 Then
			WriteLog "UpdateBackupFolder", Array("Error", "Can't create folder", strFolderTarget, Err.Number, Err.Description, Err.Source)
			Err.Clear
			bError = True
		End If
		On Error Goto 0
	End If

	If bError Then
		Exit Sub
	End If
	
    Dim objFolderOrig
    Set objFolderOrig = objFSO.GetFolder(strFolderOrig)
    Dim objFolderTarget
    Set objFolderTarget = objFSO.GetFolder(strFolderTarget)
    
    ' Check Files
    Dim objFileSrc
    Dim objFileDst
	
	On Error Resume Next
    For Each objFileDst in objFolderTarget.Files
		strDest = objFolderTarget.Path & "\" & objFileDst.Name
		strSource = objFolderOrig.Path & "\" & objFileDst.Name
		
		If Not objFSO.FileExists(strSource) Then
			' File does not exists on SOURCE. Delete it.
			WriteLog "UpdateBackupFolder", Array("Delete file", strDest)
			objFSO.DeleteFile strDest
		Else
			Set objFileSrc = objFSO.GetFile(strSource)
			If Err.Number > 0 Then
				WriteLog "UpdateBackupFolder", Array("Error", "Can't read source file", strSource, Err.Number, Err.Description, Err.Source)
				Err.Clear
				bError = True
			End If
			
			If (objFileDst.DateLastModified > objFileSrc.DateLastModified) Then
				' Replace back
				WriteLog "UpdateBackupFolder", Array("Replace back older file", strSource, strDest)
				objFSO.CopyFile strSource, strDest
			End If
			If Err.Number > 0 Then
				WriteLog "UpdateBackupFolder", Array("Error", "Can't restore this item", strSource, strDest, Err.Number, Err.Description)
				Err.Clear
				bError = True
			End If
		End If
    Next
	If Err.Number > 0 Then
		WriteLog "UpdateBackupFolder", Array("Error", "Can't read backup files", objFolderTarget, Err.Number, Err.Description, Err.Source)
		Err.Clear
		bError = True
	End If
	On Error Goto 0

	If Not bError Then
		' Check Subfolders
		Dim objSubFolder
		
		On Error Resume Next
		For Each objSubFolder in objFolderTarget.SubFolders
			strDest = objFolderTarget.Path & "\" & objSubFolder.Name
			strSource = objFolderOrig.Path & "\" & objSubFolder.Name
			
			' If subfolder does not exists on SOURCE, delete all folder recursivelly
			If objFSO.FolderExists(strSource) = False Then
				DeleteAllFolder strDest
			End If
		Next
		If Err.Number > 0 Then
			WriteLog "UpdateBackupFolder", Array("Error", "Can't read subfolders", objFolderTarget, Err.Number, Err.Description, Err.Source)
			Err.Clear
			bError = True
		End If
		On Error Goto 0
	End If
End Sub

'
' Delete all folder recursivelly
'
Sub DeleteAllFolder(strFolderToDelete)
	WriteLog "DeleteAllFolder", Array("Call", strFolderToDelete)
	
	Dim strDest 
	
	Dim bError
	bError = False
	
	' Delete all files
	Dim objDeletedFolder
	Set objDeletedFolder = objFSO.GetFolder(strFolderToDelete)
    
    ' Check Files
    Dim objDeleteFile
	
	On Error Resume Next
    For Each objDeleteFile in objDeletedFolder.Files
		strDest = objDeletedFolder.Path & "\" & objDeleteFile.Name
		
		WriteLog "DeleteAllFolder", Array("Delete file", strDest)
		objFSO.DeleteFile strDest
	Next
	If Err.Number > 0 Then
		WriteLog "DeleteAllFolder", Array("Error", "Can't read delete folder files", strDest, Err.Number, Err.Description, Err.Source)
		Err.Clear
		bError = True
	End If
	On Error Goto 0
	
	If Not bError Then
		' Delete all subfolders
		Dim objSubFolder
		
		On Error Resume Next
		For Each objSubFolder in objDeletedFolder.SubFolders
			strDest = objDeletedFolder.Path & "\" & objSubFolder.Name
			
			DeleteAllFolder strDest
		Next
		If Err.Number > 0 Then
			WriteLog "DeleteAllFolder", Array("Error", "Can't read delete subfolders", objDeletedFolder, Err.Number, Err.Description, Err.Source)
			Err.Clear
			bError = True
		End If
		On Error Goto 0
	End If
	
	' Delete itself
	WriteLog "DeleteAllFolder", Array("Delete folder", strFolderToDelete)
	objFSO.DeleteFolder(strFolderToDelete)
End Sub

Complete this script with options, to enlarge process options.