VBScript tree comparison and replication script speed

[DougalScott]

Hi, I am a self taught vbscript user, and have a VB script that is used to maintain local copy of server data on laptop for access when disconnected. This runs on a system with limited access (can't add executables), but I can use vbs. I have been using ROBOCOPY to do the grunt work of mirroring the data in the past, but the system has expanded and I now have to get it to work on another system that doesn't have ROBOCOPY available. I have also considered creating my own tree sync code for a while, and now I have the motivation.

I have written some test code to replace just the ROBOCOPY functionality that works, but it is slow compared to ROBOCOPY. Using a test local data source (2318 files in 118 subfolders), it takes ROBOCOPY 1 sec to compare these two trees (that are in sync eg no actual file data to copy), but 20 secs for my code. Is there something obvious in my code that I could fix to improve the speed of the compare part of the operation?

Most of the code is fairly standard (I think), although I have used a variable in the recursive function call to hold the recurse depth, rather than the more common (in forums) global scope variable. This is so the code is easier to incorporate into other projects (don't have to remember to dim the global variable, worry about variable name conflicts nor increment and decrement the level each time it is called and returns). I only use this to report the source and destinations folders when first called (recurse level is 0), but will also use for optional output tree indenting.

I saw a reference to string appending being slow, and intend to look at skipping appending the return value to the log string which gets quite large as it includes all the files. If that is the bottleneck I will look at using a global dictionary object to save the log entries.

I would also welcome any other advice on improving the code - I expect there is plenty of room for improvement .

Cheers

Option Explicit
Dim objFSO
Set objFSO = WScript.CreateObject("Scripting.Filesystemobject")
Dim strSrc, strDest, strMethod, intStart, strReport
strSrc="Q:\PEMS\FSR\Updating\Masters"
strDest = "T:\PFPS\MPA\Masters"
strMethod = "Mirror"
intStart = Now()
strReport = strCopyTree(strSrc, strDest, strMethod, 0)
MsgBox (Now - intStart) *24 *60 *60 & "secs"
'******************************************************************
Function strCopyTree(ByVal strSrc, ByVal strDest, ByVal strMethod, ByVal intLevel)
	Const intIndent = 4, intMargin = 20
	Dim objSrcFile, objDestFile, objDestFolder, strSrcFile, strDestFile, objSrcFolder, strSrcFolder, strResult, objSubFolder, blnCopy, strStatus
	Dim strLog
	If intLevel = 0 Then Wscript.Echo strSrc & " ---> " & strDest & vbCrLf
	strMethod = LCase(strMethod)
	Wscript.Echo String(intMargin, " ") & strSrc
	' check source folder exists, exit and return error if not
	If Not objFSO.FolderExists(strSrc) Then
		strCopyTree = "Error: Source (" & strSrc & ") doesn't exist" 
		Exit Function
	End If
	Set objSrcFolder = objFSO.GetFolder(strSrc)
	' check dest exists and create if doesn't
	If Not objFSO.FolderExists(strDest) Then
		If strCreateFolder(strDest) <> "" Then ' Dest not created so abort
			strCopyTree = "Error: Folder (" & strDest & ") doesn't exist and couldn't be created"
			Exit Function
		End If
	End If
	' compare and copy files
	For Each objSrcFile In objFSO.GetFolder(strSrc).Files
		blnCopy = False
		strDestFile = Replace(objSrcFile.path, strSrc, strDest, 1, -1, vbTextCompare)
		If Not objFSO.FileExists(strDestFile) Then ' doesn't exist in dest
			strStatus = "New file"
			blnCopy = (InStr(1, "mirror,update", strMethod, vbTextCompare) > 0) ' copy orphan for mirror and update methods
		Else
			Set objDestFile = objFSO.GetFile(strDestFile)
			If objSrcFile.DateLastModified > objDestFile.DateLastModified Then ' copy newer always
				strStatus = "Newer"
				blnCopy = True
			ElseIf objSrcFile.DateLastModified < objDestFile.DateLastModified Then
				strStatus = "Older"
			ElseIf objSrcFile.Size <> objDestFile.Size Then
				strStaus = "Modified"
			Else
				strStatus = "Same"
			End If
			If Not blnCopy Then blnCopy = ((strMethod = "mirror") And (InStr(1, "older,modified", strStatus, vbTextCompare) > 0)) ' copy older and/or different size for mirror method
		End If
		If blnCopy Then
		strStatus = strStatus & " : copy"
			WScript.Echo strStatus &  String(intMargin + intIndent - Len(strStatus), " ") & objSrcFile.Name
			strResult = strCopyFile(objSrcFile.Path, strDestFile)
			If strResult = "Failed" Then Wscript.Echo "**Copy failed**"
			strLog = strLog & strResult & vbCrLf
		Else
			strStatus = strStatus & " : skip"
			Wscript.Echo strStatus &  String(intMargin + intIndent - Len(strStatus), " ") & objSrcFile.name
			strLog = strLog & "Skipped: " & objSrcFile.Path & vbCrLf
		End If
	Next
	' delete dest orphan files and folders for mirror method
	If strMethod = "mirror" Then
		For Each objDestFile In objFSO.GetFolder(strDest).Files
			strSrcFile = Replace(objDestFile.Path, strDest, strSrc, 1, -1, vbTextCompare)
			If Not objFSO.FileExists(strSrcFile) Then
				WScript.Echo "Extra file" & String(intMargin-Len("Extra file")," ") & "Deleted: " & strDestFile
				On Error Resume Next
				Call objFSO.DeleteFile(strDestFile, True)
				If Err.Number <> 0 Then
					strLog = strLog & "Error: delete file " & strDestFile & " failed" & vbCrLf
					Wscript.Echo vbTab & "Error: delete file " & strDestFile & " failed"
				End If
				On Error Goto 0
			End If
		Next
		For Each objDestFolder In objFSO.GetFolder(strDest).SubFolders
			strSrcFolder = Replace(objDestFolder.Path, strDest, strSrc, 1, - 1, vbTextCompare)
			If Not objFSO.FolderExists(strSrcFolder) Then
				Wscript.Echo "Extra folder" & String(intMargin-Len("Extra folder")," ") & "Deleted: " & strDestFile
				On Error Resume Next
				call objFSO.DeleteFolder(strDestFolder, True)
				If Err.Number <> 0 Then
					strLog = strLog & "Error: delete folder " & strDestFolder & " failed" & vbCrLf
					Wscript.Echo vbTab & "Error: delete folder " & strDestFolder & " failed"
				End If
				On Error Goto 0
			End If
		Next
	End If
	' recurse subfolders
	For Each objSubFolder In objSrcFolder.SubFolders ' walk parallel folders in src and dest tree
		strLog = strLog & strCopyTree(objSubFolder.Path, objFSO.BuildPath(strDest, objFSO.GetFileName(objSubFolder.Name)), strMethod, intLevel + 1)
	Next
	' return log
	strCopyTree = strLog
End Function
'******************************************************************
Function strCreateFolder(ByVal strFolder)
	Dim strError
	If Not objFSO.FolderExists(objFSO.GetParentFolderName(strFolder)) Then ' recurse parent folder
		strError = strCreateFolder(objFSO.GetParentFolderName(strFolder))
		If strError <> "" Then ' pass error back
			strCreateFolder = strError
			Exit Function
		End If
	End If
	' try to create folder and catch error if occurs
	On Error Resume Next
	objFSO.CreateFolder(strFolder)
	If Err.Number <> 0 Then
		strCreateFolder = "Error"
	Else
		strCreateFolder = "Created"
	End If
	On Error Goto 0
End Function
'******************************************************************
Function strCopyFile(ByVal strSrc, ByVal strDest)
	' clear dest file RO attribute if exists and set
	Const intRO = 1, intHidden = 2, intSystem = 4
	If objFSO.FileExists(strDest) Then
		Dim objFile
		Set objFile = objFSO.GetFile(strDest)
		objFile.Attributes = objFile.Attributes And -(intRO + intHidden + intSystem + 1) ' remove these attributes before copying
		Set objFile = Nothing
	End If
	' copy the file
	On Error Resume Next
	Call objFSO.CopyFile(strSrc, strDest, True)
	If Err.Number <> 0 Then
		strCopyFile = "Failed"
	Else
		strCopyFile = "Copied"
	End If
	On Error Goto 0
End Function

 

[DougalScott]

Update: I removed the log concatenation, and now just return an empty string from the function. Time has dropped from 20 secs to 15 secs, which is good improvement but nothing like ROBOCOPY's 1 sec.

Is it worth creating separate thread for each top level folder?

Cheers

 

[DougalScott]

Update2: removed the wscript.echo commands and time now dropped to 10 secs.

Couple of general questions:
1. Are compound commands (eg

If Not objFSO.FileExists(Replace(objDestFile.Path, strDest, strSrc, 1, -1, vbTextCompare)) Then

faster than multiple commands eg

strSrcFile = Replace(objDestFile.Path, strDest, strSrc, 1, -1, vbTextCompare)
If Not objFSO.FileExists(strSrcFile) Then

It doesn't seem to make any time difference in my code, and latter much easy to follow.

2. I suspect a good bit of the time may be consumed in generating the collections eg

For Each objSrcFile In objFSO.GetFolder(strSrc).Files
For Each objDestFile In objFSO.GetFolder(strDest).Files
For Each objDestFolder In objFSO.GetFolder(strDest).SubFolders

Would using another method to generate the list of files (search or WMI?) saved to a dictionary object before then using the dictionary object elements to connect and test the properties be quicker?

3. I haven't tested copy times yet, but is it likely to make any difference if I used a shell copy command instead of the vbscript objFSO.Copy commands eg does extra overhead of calling the shell negate the extra speed of the native file operation? And is there any significant difference between FileSystemObject CopyFile method and file object Copy method?

4. I guess I should have asked/researched this first, but is there any simple profiler for vbscript?

Cheers
Cheers

 

[DougalScott]

Update3: I thought the order of the file comparison may be an issue, as "same" (which is most common) was the last test after all others (size and modified) were false. I reorganised that block

If objSrcFile.DateLastModified = objDestFile.DateLastModified Then
	If objSrcFile.Size = objDestFile.Size Then
		strStatus = "Same"
	Else
		strStaus = "Modified" ' same date but different size = "Modified"
	End If			
ElseIf objSrcFile.DateLastModified > objDestFile.DateLastModified Then ' copy newer always
	strStatus = "Newer"
	blnCopy = True
ElseIf objSrcFile.DateLastModified < objDestFile.DateLastModified Then
	strStatus = "Older"
End If

so the test for "same" happens first. This shaved another 1 sec off the time, useful but still 9 secs not 1 sec.

Commenting out the recursive code to remove orphan files and folders shaved another second, so that isn't the main time consumer either. I also tried implementing as a sub rather than function (since I am not using the return value in a log now), but that made no difference.

I can't see any other likely candidates for speed up, so maybe this is just a limit of the FileSystemObject file operations, unless one of you has any suggestions.

Cheers

 

[strongm]

>a limit of the FileSystemObject

Unfortunately, yes. It is not optimised for what you are trying to do. You'd probably be better off trying to convince the powers that be to allow Robocopy onto the new system

 

[DougalScott]

Thanks, not the answer I was hoping for, but somewhat expected. I'll let someone else bash their head against the ROBOCOPY brick wall, and accept the time delay for now. Any advise regarding using cmd shell copy compared to vbscript copy for the actual file copying?

 

[strongm]

>the ROBOCOPY brick wall

They do know that robocopy isn't just some 3rd party bit of freeware, that it ships as a completely official part of the Windows Resource Kit tools since 1997, and as part of the OS with Vista onwards (i.e. it as much a part of the system as Copy)?

Oh well.

 

[DougalScott]

>Windows Resource Kit
Can't have any of that sort of dodgy software infecting our system.