29. januar 2008 - 21:33
#3
Et forsøg:
'====================
'
' NAME: PURGEFILES.vbs
'
' AUTHOR: Scott Weeks
' DATE: 10/31/2002
'
' COMMENT:PURGEFILES.vbs uses the LastModifiedDate of a file and deletes it
' if it is older that the specified number of days.
'
' USAGE: CScript.exe purgefiles.vbs <rootfolder> <maxdaysold> [/R] [/S] [/T] [/V]
' [/L:logfile] [/E]
'
' <rootfolder> - Specifies the directory to start purging files.
' <maxdaysold> - Specifies how old a file can be in Days before it is purged.
' [/E] - Report status and results to the Event Log.
' [/L:logfile] - Specifies a file to output the results to.
' [/R] - Deletes the rootfolder if it is empty.
' [/S] - Deletes any empty subdirectories.
' [/T] - Test Mode - does not delete any files or directories.
' [/V] - Verbose Mode - shows detailed information to the screen.
' /? - Displays USAGE message.
'
'====================
'Revision History:
'
'v1.2.1 - 11/06/02
'*Fixed* Script would not write anything to the logfile unless it was in TestMode.
'*Fixed* Potential problem that could delete the logfile if 0 maxdaysold was used.
'
'v1.2 - 11/04/02
'*Added* [/L] - LogFile option.
'*Added* [/E] - Event Log option.
'*Added* [/V] - Verbose Mode option.
'*Added* [/T] - Test Mode option.
'
'v1.1 - 11/01/02
'*Added* [/R] - bDeleteRoot option.
'*Added* [/S] - bDeleteSub option.
'
'v1.0 - 10/31/02
'Initial Release.
'====================
Const EVENT_SUCCESS = 0
Const EVENT_ERROR = 1
Const EVENT_WARNING = 2
Const EVENT_INFORMATION = 4
Dim objFSO, objWSH, objLogFile
Dim argCount, iArg, flg
Dim RootFolder, MaxDaysOld, Logfile
Dim iDelFiles, iDelDirs
Dim bDeleteRoot, bDeleteSub,bVerbMode, bTestMode, bEventLog
Dim bTraverseSubDir
On Error Resume Next
Set objWSH = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
argCount = WScript.Arguments.Count
iArg = 0
' Check to see if the user is asking for help.
If argCount > 0 Then
flg = LCase(WScript.Arguments(0))
If (flg="help") Or (flg="/h") Or (flg="\h") Or (flg="-h") Or (flg="h") Or _
(flg="/?") Or (flg="\?") Or (flg="-?") Or (flg="?") Then
Call ShowUsage
End If
End If
' Make sure that we have at least 2 arguments.
If argCount < 2 Then
Call Fail("Usage: " & WScript.ScriptName & " /? for help.")
End If
' Initialize variables.
iDelFiles = 0
iDelDirs = 0
bDeleteSub = False
bDeleteRoot = False
bVerbMode = False
bTestMode = False
bEventLog = False
bTraverseSubDir = False
' Verify that the first argument is a folder and it exists.
RootFolder = NextArgument
If Not objFSO.FolderExists(RootFolder) Then
Call Fail("Can't find " & chr(34) & RootFolder & chr(34) & ".")
End If
' Verify that the second argument is a valid number of days.
MaxDaysOld = NextArgument
If IsNumeric(MaxDaysOld) Then
If (MaxDaysOld >= 1) Then
MaxDaysOld = Int(MaxDaysOld)
Else
Call Fail("Invalid MAXDAYSOLD parameter.")
End If
Else
Call Fail("Invalid MAXDAYSOLD parameter.")
End If
' If we have more than 2 arguments then error out.
If Not IsEmpty(NextArgument)Then
Call Fail("Usage: " & WScript.ScriptName & " /? for help.")
End If
' Open the logfile if it was an option.
If Not IsEmpty(Logfile) Then
Set objLogFile = objFSO.CreateTextFile(Logfile, True)
Call CheckError
End If
' Everything should be ok so proceed with the purging.
Call LogToEventLog("Script has started...", EVENT_INFORMATION)
Call LogEvent("PurgeFiles.vbs has started..." & vbCrLf)
Call ScanFolder(RootFolder)
' Show the results. If there were any errors then the script would have exited already.
Call LogToEventLog("Script has ended..." & vbCrLf & "Deleted Files: " & _
iDelFiles & vbCrLf & "Deleted Folders: " & iDelDirs, _
EVENT_INFORMATION)
Call LogEvent(vbCrLf & "PurgeFiles.vbs is complete." & vbCrLf & "Deleted Files: " & _
iDelFiles & vbCrLf & "Deleted Folders: " & _
iDelDirs)
' Clean up.
Set objWSH = Nothing
Set objFSO = Nothing
If Not IsEmpty(Logfile) Then objLogFile.Close
' Exit the script.
WScript.Quit 0
'====================
Sub ScanFolder(sFolderName)
Dim objFolder, objSubFolders, objFiles
Dim Folder, File
Dim ret
On Error Resume Next
Set objFolder = objFSO.GetFolder(sFolderName)
Set objSubFolders = objFolder.SubFolders
Set objFiles = objFolder.Files
' Only traverse subdirectories, if /D is present
If bTraverseSubDir = True Then
For Each Folder In objSubFolders
ScanFolder (Folder.Path)
Next
End If
For Each File In objFiles
ret = DaysOld(File.Path)
' If the file older then the wanted # of days then delete it.
If ret > MaxDaysOld Then
If bTestMode = False Then
If StrComp(File.Path, Logfile, vbTextCompare) <> 0 Then
Call LogEvent(File.Path & " is " & ret & " days old. - FILE DELETED.")
objFSO.DeleteFile File, True
Call CheckError
End If
End If
iDelFiles = iDelFiles + 1
End If
Next
' If the folder is empty the delete the folder.
If objFiles.Count <= 0 Then
If sFolderName = RootFolder Then
If bDeleteRoot = True Then
If bTestMode = False Then
Call LogEvent(sFolderName & " is empty. - FOLDER DELETED")
objFSO.DeleteFolder sFolderName, True
Call CheckError
End If
iDelDirs = iDelDirs + 1
Exit Sub
Else: Exit Sub
End If
End If
If bDeleteSub = True Then
If bTestMode = False Then
Call LogEvent(sFolderName & " is empty. - FOLDER DELETED")
objFSO.DeleteFolder sFolderName, True
Call CheckError
End If
iDelDirs = iDelDirs + 1
Exit Sub
Else: Exit Sub
End If
End If
End Sub
'====================
Function DaysOld(sFileName)
Dim objFile
On Error Resume Next
Set objFile = objFSO.GetFile(sFileName)
Call CheckError
' Return the difference in days.
DaysOld = Int(Now() - objFile.DateLastModified)
End Function
'====================
' Extract argument value from command line, processing any option flags.
Function NextArgument
Dim arg
Do ' Loop to pull in option flags until an argument value is found.
If iArg >=argCount Then Exit Function
arg = WScript.Arguments(iArg)
iArg = iArg + 1
If (AscW(arg) <> AscW("/")) And (AscW(arg) <> AscW("-")) Then Exit Do
Select Case UCase(Right(arg, Len(arg) -1))
Case "D" : bTraverseSubDir = True
Case "E" : bEventLog = True
Case "R" : bDeleteRoot = True
Case "S" : bDeleteSub = True
Case "T" : bTestMode = True
Case "V" : bVerbMode = True
Case Else
If UCase(Mid(arg, 2, 2)) = "L:" Then
LogFile = Mid(arg,4)
Else
Call Fail("Invalid option flag: " & arg)
End If
End Select
Loop
NextArgument = arg
End Function
'====================
Sub ShowUsage
WScript.Echo "CScript.exe " & WScript.ScriptName & " <rootfolder> <maxdaysold> [/R] [/S] [/T] [/V] [/D]" & vbCrLf & _
vbTab & vbTab & vbTab & vbTab & vbTab & " [/L:logfile]" & vbCrLf & vbCrLf & _
" rootfolder" & vbTab & "Specifies the directory to start purging files." & vbCrLf & _
" maxdaysold" & vbTab & "Specifies how old a file can be in Days before it is purged." & vbCrLf & _
" /D" & vbTab & vbTab & "Also traverse subdirectories" & vbCrLf & _
" /E" & vbTab & vbTab & "Report status and results to the Event Log." & vbCrLf & _
" /L:logfile" & vbTab & vbTab & "Specifies a file to output the results to." & vbCrLf & _
" /R" & vbTab & vbTab & "Deletes the rootfolder if it is empty." & vbCrLf & _
" /S" & vbTab & vbTab & "Deletes any empty subdirectories." & vbCrLf & _
" /T" & vbTab & vbTab & "Test Mode - does not delete any files or directories." & vbCrLf & _
" /V" & vbTab & vbTab & "Verbose Mode - shows detailed information to the screen." & vbCrLf & _
" /?" & vbTab & vbTab & "Displays this message." & vbCrLf & vbCrLf & _
WScript.ScriptName & " will not delete any directories by default."
WScript.Quit 1
End Sub
'====================
Sub CheckError()
Dim msg
If Err.Number = 0 Then Exit Sub
msg = Err.Source & " " & Hex(Err) & ": " & Err.Description
Call Fail(msg)
End Sub
'====================
Sub LogEvent(sMessage)
If bVerbMode Then WScript.Echo(sMessage)
If IsObject(objLogFile) Then objLogFile.WriteLine(sMessage)
End Sub
'====================
Sub LogToEventLog(sMessage, nValue)
If bEventLog Then objWSH.LogEvent nValue, WScript.ScriptName & ": " & sMessage
End Sub
'====================
Sub Fail(sMessage)
If bEventLog Then LogToEventLog sMessage, EVENT_ERROR
If IsObject(objLogFile) Then
objLogFile.WriteLine(WScript.ScriptName & ": " & sMessage)
objLogFile.Close
End If
WScript.Echo WScript.ScriptName & ": " & sMessage
WScript.Quit(1)
End Sub