[HaBo]

' Script to delete all files older than a specified date w/detail logging
' Added provision for up to 10 filters on delete.
' Specify the date range, filter info and whether you
' want to actually delete the files.
' I use this tool to clean up server directories
' and was able to get rid of over 28,000 old dead files
' Last Modified 13:32 - 11/30/2002 RGhetti
' Resets Read-only attribute of entire path and deletes empty directories

Option Explicit
Dim WSHShell, fs, Header, LogFile, LogName
Dim PCName, FilePath, File
Dim FDate, Count, DelCount, AllFilters, OlderThan
Dim DoDelete, ObjDirectory, TheFiles
Dim TimeIt, EndTime, StartTime
Dim FilterList(10)

Const ForReading = 1, ForWriting = 2

Set WSHShell = WScript.CreateObject("WScript.Shell")
Set fs = CreateObject("Scripting.FileSystemObject")
Header = "Your Computer" 
PCName = WSHShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
Count = 0
DelCount = 0
AllFilters = 10
StartTime = Timer

' changeable Settings
LogName = "c:\temp\DelbyDate.LOG"


' Dont actually Delete the files, just log the ones that meet the criteria
' Change this to do the delete ( use this as a testing tool)
DoDelete = TRUE

' path to start from:
FilePath = "\\berlin\public_temp"
' FilePath = "C:\TEMP"
' ex: N:\DEPTS

' date "olderthan" to delete
OlderThan = (Now() - (120)) ' older than 120 days

' File and directory filters change these to your own settings, they 
' Populate FilterList
'FilterList(1) = UCase("pagefile.sys") ' system file
'FilterList(2) = UCase(".dll") ' system file
'FilterList(3) = UCase(".exe") ' dont delete any program files
'FilterList(4) = UCase("historic") ' dont delete any historic dept files 
'FilterList(5) = UCase("legal") ' dont delete any legal dept files 
'FilterList(6) = UCase("trackit") ' dont delete any files in the trackit directory
'FilterList(7) = UCase("keep") ' "keep" directories?
'FilterList(8) = UCase(".dbf") ' .dbf files
'FilterList(9) = UCase("") ' not used
'FilterList(10) = UCase("save") ' marked to save


'*****[ Script begin ]**************
WSHShell.Popup "Searching for Files Older than = " & CStr(OlderThan), 1, Header, 0

' Open log file
StartLogging()
StartTime = Now()
LogEvent(" Searching for Files Older than = " & OlderThan)
LogEvent("From " & FilePath & " on " & PCName & " !!@ " & Now())
Set ObjDirectory = fs.GetFolder(FilePath)
If NOT DoDelete Then
LogEvent("Files will not be Deleted.")
End If


' main subroutine
'msgbox "attrib.exe -R " & ObjDirectory & "\*.* /S /D"
WSHShell.run("attrib.exe -R " & ObjDirectory & "\*.* /S /D")
Process ObjDirectory


LogEvent("Total Files Counted = " & CStr(Count))
If DoDelete Then
LogEvent("Total Files Deleted = " & CStr(DelCount))
End If
EndTime = Timer
TimeIt = EndTime - StartTime
LogEvent("Total Time = " & TimeIt & " Seconds")
StopLogging()
Set fs = Nothing
'show_msg("Delete by Date Script Complete. ") 
WSHShell.Popup "Delete by Date Script Complete. ", 1, Header, 0
wscript.Quit


' EOS '*******************
'*************************
'*************************

Sub RemoveFile(TheFile)
Dim oFile
DelCount = DelCount + 1
Set oFile = fs.GetFile(theFile)
on error resume next
oFile.Delete
LogEvent(TheFile & " -Deleted")
End Sub 'RemoveFile()


Function InFilter(AFile)
Dim Z, TmpStr
InFilter = FALSE
For Z = 1 to AllFilters 
TmpStr = CStr(FilterList(Z))
If (Instr(UCase(AFile), TmpStr)> 1) Then
InFilter = TRUE
End If
Next 
End Function 'InFilter


Sub Process(objDirectory)
Dim MoreFolders, TempFolder
Set TheFiles = objDirectory.Files

For Each file in theFiles
Count = Count +1 
If FExist(File.Path) Then 
IF NOT InFilter(File.Path) Then
FDate = GetFileDate(File.Path)
If (FDate < OlderThan) Then
If DoDelete Then
RemoveFile(File.Path)
Else
LogEvent(File.Path & " - " & FDate & " To Delete.")
End If
End If 
End If 
End If
Next

Set MoreFolders = objDirectory.SubFolders

For Each TempFolder In MoreFolders
' start (ronny)
'msgbox "f:" & TempFolder.Files.Count & "->d:" & TempFolder.subfolders.count & "->" & TempFolder ' debug
if TempFolder.Files.Count = 0 and TempFolder.subfolders.count = 0 then
'msgbox "del" & TempFolder ' debug
TempFolder.Delete
else
Process TempFolder
end if
' end (ronny)
Next
End Sub 'Process()

Function GetFileDate(theFile)
Dim oFile
Set oFile = fs.GetFile(theFile)
GetFileDate = oFile.DateLastModified
End Function 'GetFileDate()

Sub LogFileInfo()
' LogEvent(File.Path & " : " & FDate & ": Is Older Than " & OlderThan)
LogEvent(File.Path & " - " & FDate)
End Sub 'LogFileInfo()

Sub StartLogging()
On Error Resume Next
Set LogFile = fs.CreateTextFile(LogName,vbTrue)
If (Err.Number <> 0) Then
WSHShell.Popup "Could not create log file " & LogFile, 2, Header, 0
Wscript.Quit(1)
End If
LogFile.WriteLine " Logging Enabled : " & Now()
ScriptLoc = wscript.scriptfullname
LogFile.WriteLine " Script running from : " & ScriptLoc
End Sub 'StartLogging()

Sub StopLogging()
On Error Resume Next
LogFile.WriteLine " Logging Disabled : " & Now()
LogFile.Close
End Sub

Sub LogEvent(StringtoWrite)
on error resume next
LogFile.WriteLine StringtoWrite
End Sub

Sub LogEventNoCR(StringtoWrite)
on error resume next
LogFile.Write StringtoWrite
End Sub

Sub show_msg(strText)
MsgBox strText, vbInformation, Header
End Sub

Function FExist(filespec) ' File Exists
FExist = FALSE
If (fs.FileExists(filespec)) Then
FExist = TRUE
End If
End Function

'****************