06 Sep 2007
Deleting Old Files

' DeleteAgedFiles.vbs -- Remove files by any combination of timestamp aging, file pattern.
' John J Schultz -- 12/12/2005 -- Public Domain.
'
' //B is the switch recommended for production use with wscript to suppress operator messages from
' the script engine (e.g. when launched from a timer).  Due to the number of WScript.Echo statements used,
' Cscript is highly recommended--even when testing.
 
' ----------------------------
' Parameters
Dim bAggressive
Dim bTestRun
Dim bIncludeSubFolders
Dim bSpareRootFolder
Dim bRemoveEmptyFolders
Dim bBatchMode
Dim bUserConfirmationForDelete
Dim bIgnoreZeroLengthFiles
Dim nDateToCheck
Dim nDays
Dim sStartFolder
Dim sFilePattern
Dim nPreserveFileCount
 
' ----------------------------
' Global
Dim dCutOff
Dim iErr, sErr
 
' ###################################################################################
' Support Functions and Subs
Sub LogAnEvent (iType, sMessage)
	Set WshShell = WScript.CreateObject("WScript.Shell")
	WshShell.LogEvent iType, sMessage
	Set WshShell = Nothing
End Sub
 
Function DateToAnsi (dTime)
   DateToAnsi = _
   Year(dTime) & Right ("0" & Month (dTime), 2) & Right ("0" & Day (dTime), 2) & _
   Hour(dTime) & Right ("0" & Minute (dTime), 2) & Right ("0" & Second (dTime), 2)
End Function
 
Sub QuickSort(ByRef aKey, nLowBound, nHighBound)
	' Single dimension array only.
	Dim vPivot, nLowSwap, nHighSwap, vTemp
 
	If IsEmpty (nLowBound) Then
		nLowBound = LBound (aKey)
	End If
	If IsEmpty (nHighBound) Then
		nHighBound = UBound (aKey)
	End If
 
	' Two items to sort
	If nHighBound - nLowBound = 1 Then
		If aKey(nLowBound) > aKey(nHighBound) Then
			vTemp = aKey(nLowBound)
			aKey(nLowBound) = aKey(nHighBound)
			aKey(nHighBound) = vTemp
		End If
	End If
 
	' Three or more items to sort
 
	vPivot = aKey(int((nLowBound + nHighBound) / 2))
	aKey(int((nLowBound + nHighBound) / 2)) = aKey(nLowBound)
	aKey(nLowBound) = vPivot
 
	nLowSwap = nLowBound + 1
	nHighSwap = nHighBound
 
	Do
		' Find the right nLowSwap
		While nLowSwap < nHighSwap and aKey(nLowSwap) <= vPivot
			nLowSwap = nLowSwap + 1
		Wend
		' Find the right nHighSwap
		While aKey(nHighSwap) > vPivot
			nHighSwap = nHighSwap - 1
		Wend
		' Swap values if out of sort order
		If nLowSwap < nHighSwap Then
			vTemp = aKey(nLowSwap)
			aKey(nLowSwap) = aKey(nHighSwap)
			aKey(nHighSwap) = vTemp
		End If
	Loop While nLowSwap < nHighSwap
 
	aKey(nLowBound) = aKey(nHighSwap)
	aKey(nHighSwap) = vPivot
 
	' Recursive call
	' 2 or more items in first section
	If nLowBound < (nHighSwap - 1) Then Call QuickSort(aKey, nLowBound, nHighSwap - 1)
	' 2 or more items in second section
	If nHighSwap + 1 < nHighBound Then Call QuickSort(aKey, nHighSwap + 1, nHighBound)
 
End Sub
 
Function FolderExists (sFolderName)
	Dim oFS
 
	Set oFS = CreateObject("Scripting.FileSystemObject")
	FolderExists = oFS.FolderExists(sFolderName)
	set oFS = Nothing
End Function
 
Function FileMatchesPattern (sFile, sPattern, bIgnoreCase)
    ' Returns true if the file name matches the regular expression in sPattern.
    Dim oRegEx
 
    Set oRegEx = New RegExp
    With oRegEx
	    .Pattern = sPattern
	    .IgnoreCase = bIgnoreCase
	    FileMatchesPattern = .Test (sFile)   ' Execute search.
    End With
    Set oRegEx = Nothing
End Function
 
Sub RemoveFilesInFolder (sPath, bAtTop)
	' Recursive -- uses modular variables
	Dim objFSO
	Dim objFolder
	Dim objFolders
	Dim objFile
	Dim objFiles
	Dim objItem
	Dim sFileName
	Dim bPardoned
	Dim sWorkPath
	Dim iErr
	Dim aSort
 
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	sWorkPath = sPath
	If Right (sWorkPath, 1) <> "\" Then sWorkPath = sWorkPath & "\"
 
	Set objFolder = objFSO.GetFolder(sPath)
 
	' First recurse to any sub-folders, and remove files from them.
	If bIncludeSubFolders Then
		For Each objItem In objFolder.SubFolders
			Call RemoveFilesInFolder (sWorkPath & objItem.Name, False)
		Next 'objItem
	End If
 
	WScript.Echo
	WScript.Echo "--- " & sPath
 
	' First, enumerate the files and delete them.
	If Not bAtTop Or Not bSpareRootFolder Then
		If objFolder.Files.Count - nPreserveFileCount > 0 Then
			ReDim aSort (objFolder.Files.Count - 1)
			nI = 0
			For Each objItem in objFolder.Files
				If nDateToCheck = 0 Then
					aSort (nI) = DateToAnsi (objItem.DateCreated) & "\" & objItem.Name
 
				ElseIf nDateToCheck = 1 Then
					aSort (nI) = DateToAnsi (objItem.DateLastModified) & "\" & objItem.Name
 
				ElseIf nDateToCheck = 2 Then
					aSort (nI) = DateToAnsi (objItem.DateLastAccessed) & "\" & objItem.Name
 
				End If
				nI = nI + 1
			Next
 
			Call QuickSort (aSort, Empty, Empty)
 
			For nI = 0 To UBound (aSort) - nPreserveFileCount
				sTmp = Split(aSort(nI), "\")(1)
				'WScript.Echo sTmp
				Set objFile = objFSO.GetFile (sWorkPath & sTmp)
 
				If Not FileMatchesPattern (objFile.Name, sFilePattern, True) Then
					bPardoned = True
					'WScript.Echo "Name does not match filter pattern: " & objFile.Name
 
				ElseIf bIgnoreZeroLengthFiles And objFile.Size = 0 Then
					bPardoned = True
					WScript.Echo "Ignoring null-length file: " & objFile.Name
 
				ElseIf Not bAggressive And (objFile.Attributes AND 7) <> 0 Then
					WScript.Echo "Attribute-protected file ignored: " & objFile.Name
					bPardoned = True
 
				ElseIf nDateToCheck = 0 And DateAdd ("d", 0, objFile.DateCreated) > dCutOff Then
					WScript.Echo "Young file kept: " & objFile.Name
					bPardoned = True
 
				ElseIf nDateToCheck = 1 And DateAdd ("d", 0, objFile.DateLastAccessed) > dCutOff Then
					WScript.Echo "Young file kept: " & objFile.Name
					bPardoned = True
 
				ElseIf nDateToCheck = 2 And DateAdd ("d", 0, objFile.DateLastModified > dCutOff) Then
					WScript.Echo "Young file kept: " & objFile.Name
					bPardoned = True
 
				ElseIf bTestRun Then
					WScript.Echo "Qualifies for deletion: " & objFile.Name
					bPardoned = True
 
				Else
					bPardoned = False
 
				End If
 
				If Not bPardoned Then
					Err.Clear
					sFileName = objFile.Name
					On Error Resume Next
					objFile.Delete
					iErr = Err.Number
					On Error Goto 0
					If iErr = 0 Then
						WScript.Echo "Deleted: " & objFile.Name
					Else
						WScript.Echo "Could not delete: " & objFile.Name
					End If
				End If
				Set objFile = Nothing
			Next ' File
		End If
	End If
 
	' Remove the folder if it is empty, and the option to remove empty folders has been selected.
	' NOTE: We don't delete the folder if any files are detected in it--protected or not.
	If (Not bAtTop Or bSpareRootFolder) And bRemoveEmptyFolders Then
 
		bPardoned = False
		For Each objItem In objFolder.Files
			bPardoned = True
			Exit For
		Next
		For Each objItem In objFolder.SubFolders
			bPardoned = True
			Exit For
		Next
 
		If Not bPardoned Then
			Err.Clear
			On Error Resume Next
			objFolder.Delete
			iErr = Err.Number
			On Error Goto 0
			If iErr = 0 Then
				WScript.Echo "Killed empty folder..."
			Else
				WScript.Echo "Empty folder survived (may contain hidden or system files)..."
			End If
		End If
	End If
 
	Set objItem = Nothing
	Set objFolder = Nothing
	Set objFSO = CreateObject("Scripting.FileSystemObject")
 
End Sub
 
Sub HandleError (iErr, sErr)
 
	If bBatchMode Then
		LogAnEvent 1, sMsg
	Else
		WScript.Echo sMsg
	End If
 
End Sub
 
Sub Usage ()
	WScript.Echo "DeleteOldFiles.vbs -- Remove files older than a specified number of days from one or more folders. "
	WScript.Echo "John J Schultz -- 12/12/2005 -- Public Domain. "
	WScript.Echo " "
	WScript.Echo "cscript DeleteOldFiles.vbs [{switches}] {days} folder [pattern]"
	WScript.Echo " "
	WScript.Echo "- Days is the age (in days) of the file's time stamp, to remove the file. Default: 30 days "
	WScript.Echo "- Folder is an existing folder containing the files targeted for removal. "
	WScript.Echo "- pattern is a regular expression used to filter matching file names targeted for removal. If not present, all files are included."
	WScript.Echo " "
	WScript.Echo "-------------------------- Available switches --------------------------- "
	WScript.Echo "/t   - test only (a.k.a. chicken run): shows files affected, but does not actually delete them."
	WScript.Echo "/a   - aggressive: attempts to remove read-only files. "
	WScript.Echo "/s   - recurse files in subdirectories. "
	WScript.Echo "/d   - remove a sub-directory if it is empty after removing files (does not include the initial folder). "
	WScript.Echo "/b   - run in batch mode (errors logged to NT Event Log) "
	WScript.Echo "/r   - spares files in the initial (root) folder.  Use with /s when only files in sub-folders "
	WScript.Echo "       should be removed.  If this switch is used without /s, it has no effect. "
	WScript.Echo "/0-  - ignores files with zero-length. "
	WScript.Echo "/d:c[reate]   - (default) uses creation date to measure age.  Note: Creation date on a copied "
	WScript.Echo "                file is the date it was copied (i.e.: it does not inherit the original file's "
	WScript.Echo "                creation date). "
	WScript.Echo "/d:a[ccess]   - uses last access date to measure age. "
	WScript.Echo "/d:m[odified] - uses last modified date to measure age. "
	WScript.Echo "/n:# - preserve a count of files. Leaves at least this number of the newest files in the folder."
	WScript.Echo "/l:n - Log to NT Event Log: n = chatter level: "
	WScript.Echo "       0 = single summary "
	WScript.Echo "       1 = start/completion "
	WScript.Echo "       2 = (1) and all failures "
	WScript.Echo "       3 = (2) and all successes "
	WScript.Echo "    NOTE: NT Event logging is performed if /b (batch mode) is specified, otherwise messages "
	WScript.Echo "          are directed to the console. "
	WScript.Echo "------------------------------------------------------------------------ "
	WScript.Echo " "
	WScript.Echo "//B is the switch recommended for production use with wscript to suppress operator messages from "
	WScript.Echo "the script engine (e.g. when launched from a timer).  Due to the number of WScript.Echo statements used, "
	WScript.Echo "CScript is highly recommended--even when testing. "
End Sub
 
' ###################################################################################
' MAIN
 
' Module
Dim oFSO
Dim oFolder
Dim oFile
Dim oArgs
Dim nArgCnt
Dim iCount
Dim sApp
Dim bValidParameters
Dim sTmp
Dim sMsg
 
sApp = "DeleteOldFiles.vbs"
 
bTestRun = False
bIncludeSubFolders = False
bRemoveEmptyFolders = False
bBenchmark = False
bUserConfirmationForDelete = False
bIgnoreZeroLengthFiles = False
bTestOnly = False
nDateToCheck = 2  ' Default to date modified.
nDays = -1
nPreserveFileCount = 0
sStartFolder = ""
sFilePattern = "[.]+"
 
bValidParameters = True
 
Set oArgs = WScript.Arguments
iCount = oArgs.Count
If iCount = 0 Then
	bValidParameters = False
End If
 
If bValidParameters Then
	For iCount = 0 to oArgs.Count - 1
		sTmp = LCase (LTrim (RTrim (oArgs(iCount))))
		If Left (sTmp, 1) = "/" Then
 
			If sTmp = "/a" Then
				bAggressive = True
 
			ElseIf sTmp = "/t" Then
				bTestRun = True
 
			ElseIf sTmp = "/s" Then
				bIncludeSubFolders = True
 
			ElseIf sTmp = "/r" Then
				bSpareRootFolder = True
 
			ElseIf sTmp = "/d" Then
				bRemoveEmptyFolders = True
 
			ElseIf sTmp = "/b" Then
				bBatchMode = False
 
			ElseIf sTmp = "/q" Then
				bUserConfirmationForDelete = True
 
			ElseIf sTmp = "/0-" Then
				bIgnoreZeroLengthFiles = True
 
			ElseIf Left (sTmp & Space (4), 4) = "/d:c" Then
				nDateToCheck = 0
 
			ElseIf Left (sTmp & Space (4), 4) = "/d:a" Then
				nDateToCheck = 1
 
			ElseIf Left (sTmp & Space (4), 4) = "/d:m" Then
				nDateToCheck = 2
 
			ElseIf Left (sTmp & Space (3), 3) = "/n:" Then
				nPreserveFileCount = Int (Mid (sTmp & Space (4), 4))
				If nPreserveFileCount < 0 Then
					WScript.Echo "Invalid preserve count: " & nPreserveFileCount
					bValidParameters = False
				End If
 
			Else
				bValidParameters = False
				sMsg = "unrecognized switch: " & sTmp
 
			End If
 
		ElseIf nDays = -1 And Instr ("0123456789", Left (sTmp, 1)) > 0 Then
			on error resume next
			nDays = CInt (sTmp)
			on error goto 0
			If nDays < 0 Then
				bValidParameters = False
				sMsg = "day count must be >= 0: " & sTmp
			End If
 
		ElseIf sStartFolder = "" Then
			sStartFolder = LTrim (RTrim (oArgs(iCount)))
 
		ElseIf sFilePattern = "[.]+" Then
			sFilePattern = LTrim (RTrim (oArgs(iCount)))
 
		Else
			bValidParameters = False
			sMsg = _
			"Attempt to re-specify the folder: " & sTmp & vbCrLf & _
			"Already set as: " & sStartFolder
		End If
	Next
End If
 
Set objArgs = Nothing
 
If sStartFolder = "" Then
	sMsg = _
	"No starting folder specified"
	bValidParameters = False
End If
 
If Not bValidParameters Then
	If bBatchMode Then
		LogAnEvent 1, sMsg
	Else
		WScript.Echo sMsg
	End If
	Call Usage()
	WScript.Quit (1)
End If
 
If nDays < 0 Then nDays = 30
 
dCutOff = DateAdd ("d", -nDays, Now ())
 
WScript.Echo "Removing files older than " & nDays & " days (cutoff time: " & dCutoff & ")"
WScript.Echo "Expiration is evaluated on the " & Split ("creation|last access|last modification", "|")(nDateToCheck) & " timestamp."
 
' --- Processing starts here
Call RemoveFilesInFolder (sStartFolder, True)
 
WScript.Echo "Script completed"
 
WScript.Quit(0)