Genopslag: Tilretning af VBS Script

Anybody ?

Opdateret Point...

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

<gammelhat>:
... efter hvad jeg ka' læse mig til *S* ser det lovende ud...
Kan afprøve det imorgen...
I'Will Back...

BINGO <gammelhat>: Læg [svar] ...

<gammelhat>: Læg [svar] ...

... eller skal jeg virkelig ta' P til mig selv ?