'
' 長期停滞ファイル削除スクリプト dss.vbs（ファイル更新日基準）
' for Windows 2000/2003/XP + Windows Scripting Host
' AKI ON WEB  http://akionweb.com/
'
' 注意事項 ------------------------------------------------------------------
'
' このスクリプトは長期停滞ファイルを削除するもので、使用方法次第で大変な危険
' を伴います。　使用に際してはデバッグモードでのテストを行うなど、細心の注意
' を払って下さい。
'
' ネットワークドライブにも対応しますが、対象フォルダに対して削除権限を持つユ
' ーザーの元で実行して下さい。
'
' 特にネットワークドライブ上にdss.vbsを置く場合は、他のユーザーが誤って起動し
' ない様に置き場、権限等にも注意して下さい。
'
' リードオンリー属性が付与されているファイルも強制的に削除されます。
'

' 設定項目 ------------------------------------------------------------------

DebugMode = True	' デバッグモード True/False (True=ファイル消去しない)

RootDir="e:\Target"	' 削除対象フォルダ

Limit = 6		' 保存期間
LimitUnit = "m"		' 保存期間の単位：年="y", 月="m", 日="d"

DeleteFolder = True	' 空になったフォルダの削除(True=する,False=しない)

LogFile = "e:\dss.log"	' ログファイル名
LogLevel = 30		' ログ保存レベル

' ---------------------------------------------------------------------------

set fs = WScript.CreateObject("Scripting.FileSystemObject")
set sh = WScript.CreateObject("Shell.Application")

if LimitUnit = "y" then LimitUnit="yyyy"
DateLimit = DateAdd(LimitUnit, Limit*-1, date)

if LogFile="" then LogFile = WScript.ScriptFullName
LogFilePath = fs.GetParentFolderName(LogFile)
LogFilePath = fs.BuildPath(LogFilePath, fs.GetBaseName(LogFile) & ".log")

if LogLevel>0 then	LogRotate LogFilePath,LogLevel

set ts=fs.CreateTextFile(LogFilePath,True)
set oRootDir = sh.NameSpace(RootDir)

Search oRootDir.Self
ts.Close

Sub Search(obj)
    on error resume next
    dim I
    if obj.IsFolder then
        set oItems=obj.GetFolder.Items
        for Each child In oItems
            dpath= child.Path
            if child.IsFolder then
                Search child
                if fs.FolderExists(dpath) then
                    set d = fs.GetFolder(dpath)
                    ds=d.Files.Count + d.SubFolders.Count
                    if ds<1 then
                        ' 空のフォルダ削除 (強制)
                        if DeleteFolder then
                            ts.write "D" & chr(9)
                            ts.write d.DateLastModified & chr(9)
                            ts.write dpath
                            if not DebugMode then
                                fs.DeleteFolder dpath,True
                                if Err.Number then
                                    ts.write "<< Folder Delete Error!!"
                                    Err.Clear
                                end if
                            end if
                            ts.writeline
                        end if
                    end if
                end if
            else
                if fs.FileExists(dpath) then
                    set f = fs.GetFile(dpath)
                    if f.DateLastModified < DateLimit then
                        ts.write "F" & chr(9)
                        ts.write f.DateLastModified & chr(9)
                        ts.write dpath

                        ' ファイル削除（ReadOnlyも消す)
                        if not DebugMode then fs.DeleteFile dpath,True

                        if Err.Number then
                            ts.write "<< File Delete Error!!"
                            Err.Clear
                        end if
                        ts.writeline
                    end if
                end if
            end if
        next
    end if
    on error goto 0
end sub

sub LogRotate(fn,ll)
    f0 = fs.GetParentFolderName(fs.GetAbsolutePathName(fn)) & "\"
    f1 = fs.GetBaseName(fn)
    f2 = "." & fs.GetExtensionName(fn)
    fp = f0 & f1 & ll & f2
    if fs.FileExists(fp) then fs.DeleteFile fp
    for i = ll to 2 step -1
        fp1 = f0 & f1 & i-1 & f2
        fp2 = f0 & f1 & i & f2
        if fs.FileExists(fp1) then fs.MoveFile fp1, fp2
    next
    fp = f0 & f1 & "1" & f2
    if fs.FileExists(fn) then fs.MoveFile fn, fp
end sub