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