00001 ' Attribute VB_Name = "DirectoryCleaner"
00002 Option Explicit
00003 '----------------------------------------------
00004 '! @brief ディレクトリ内部の掃除
00005 '! @require common.vbs
00006 '! @require Logger.cls
00007 '! @note 対象ディレクトリの「内部」を掃除する。したがって対象ディレクトリは削除しない。
00008 '----------------------------------------------
00009 Class DirectoryCleaner
00010
00011
00012 Public FileSystem '* @property ファイルシステム
00013
00014 Public TargetDirectory '* @property 対象ディレクトリ
00015
00016 Public LastDate '* @property LastDate
00017
00018 '-------------------------------------------------------------------
00019 '* @brief 掃除開始
00020 '-------------------------------------------------------------------
00021 Sub Clean()
00022 Logger.Debug "DirectoryCleaner#Clean TargetDirectory = " & TargetDirectory
00023
00024 If IsEmpty(LastDate) Then
00025 LastDate = Now
00026 End If
00027 WalkDirectory TargetDirectory
00028
00029 End Sub
00030 '-------------------------------------------------------------------
00031 '* @brief ディレクトリを再帰的に処理する
00032 '* @param dirSpec 処理対象ディレクトリ。
00033 '-------------------------------------------------------------------
00034 Sub WalkDirectory( dirSpec )
00035 Logger.Debug "DirectoryCleaner#WalkDirectory Directory = " & dirSpec
00036 On Error Resume Next
00037 Dim folder
00038 Set folder = FileSystem.GetFolder(dirSpec)
00039
00040 Dim fileCollection
00041 Set fileCollection = folder.Files
00042
00043 Dim fileObject
00044 For Each fileObject in fileCollection
00045 If (fileObject.DateLastModified < LastDate) Then
00046 fileObject.Delete
00047 If Err.Number <> 0 Then
00048 PrintError
00049 Exit Sub
00050 End If
00051 End If
00052 Next
00053 Set fileCollection = folder.SubFolders
00054 For Each fileObject in fileCollection
00055 WalkDirectory fileObject.Path
00056 '' 中身が無くなったら自身を削除
00057 If (fileObject.Files.Count = 0) Then
00058 fileObject.Delete
00059 If Err.Number <> 0 Then
00060 PrintError
00061 Exit Sub
00062 End If
00063 End If
00064 Next
00065
00066 Set folder = nothing
00067 Set fileCollection = nothing
00068 End Sub
00069 '-------------------------------------------------------------------
00070 '* @brief エラー表示
00071 '-------------------------------------------------------------------
00072 Sub PrintError()
00073 Dim handler
00074 Set handler = New ScriptErrorHandler
00075 handler.Error "DirectoryCleaner",true
00076 End Sub
00077
00078 '--------------------------------------------------------
00079 '* オブジェクト初期化
00080 '--------------------------------------------------------
00081 Sub Class_Initialize
00082 LastDate = Empty
00083 End Sub
00084 '--------------------------------------------------------
00085 '* オブジェクト破棄
00086 '--------------------------------------------------------
00087 Sub Class_Terminate
00088 End Sub
00089 End Class