見出し画像

0バイトのファイルを削除するツール2

本日は、前回に宿題で残しておいた2つの機能追加が主眼。

  1. 移動モード時、同名ファイルだったら上書きするオプション (/o)

  2. 対象にするファイルを拡張子で指定できるオプション (/e)

また、その他細かく仕様の変更・追加など。
ファイルサイズを無視して対象にする /a オプションは、安全性を優先して「削除モードでは機能しない」「移動モードでは構造保持指定と併用でないと機能しない」としていたが、実際に使ってみるとこれらの場合でも /a で指定したくなってきた。
このため、構造保持指定が無くても /a が有効となるようにしたほか、削除モードでも機能する /af オプションを新たに追加した。(/a とは別の指定とすることで、明示的に「削除モードで使用する」ことを意識できるよう、別オプションにしたが、あまり意味は無いかもしれない。)

細かいバグとして、削除処理の対象とするフォルダが実在していなかった場合、エラーを吐いて止まってしまうことに気が付いたので、これを回避。
このあたりのエラー対策ができていないのはChatGPTで作った場合の悪い点かも。(前回も書いたが、そういったエラー対策を考慮していないサンプルとしてネットに情報が上がっている故の限界かもしれない。)

本日も、2.の拡張子を判別するあたりは、その辺だけを切り出してChatGPTに作ってもらった。

Function isPatternMatch(fileName, pattern)
' パターンマッチング関数
    regexPattern = "^" & Replace(Replace(pattern, ".", "\."), "*", ".*") & "$"
    regex.Pattern = regexPattern
    regex.IgnoreCase = True
    isPatternMatch = regex.Test(fileName)
End Function

コアとなるルーチンは上記の関数だけど、これに
  filename = a01.png
  pattern = png
とか引き渡しても全くマッチしてくれなくて悩んだ。

正規表現の解説を読むと、どうも「^」が先頭から一致、「$」が末尾へ一致、という意味らしく、だとすると今回のケースでは「拡張子をチェックしたい」のだから、引き渡すfilenameの末尾だけチェックすれば良いのでは?と思い「^」を外すと、期待した通り動くようになった。

またこれだと「*」には対応しているが「?」に対応できていないので、もう1段、Replaceをネストして「?」にも対応できるようにする。

ちょっと新鮮だったのが、最初、「引数で e= に続く指定を、ダブルクォーテーションで囲む場合と囲んでいない場合を考慮して、分岐して処理するのメンドウだなぁ。」「拡張子の書き方が、「*.ext」「.ext」「ext」どれでも対応できるようにしたいけど、同じく分岐して処理するのメンドウだなぁ。」とか思っていたら、提示されたコードでこれらが吸収できてしまったのは意外だった。
前者はおそらくVBScriptかWindowsの仕様(特に何も記述していないが暗黙的に /e="*.ext" みたいな囲みのダブルクォーテーションが、/e=以降の文字列を取得してSplit関数にかけた段階で、ダブルクォーテーションは無いものとして処理がきちんと走る)、後者はChatGPTが提示したルーチンで広範的に対処が含まれているから、だと思う。

というわけで、本日の作業完了時点↓

'-------------------------------------------------------------------------
'DelZero
'サイズが0のファイルを削除する
'
'Usage:
'【パス指定】
'	Path	処理対象のフォルダを指定する
'			指定は必ずフォルダとして解釈する。存在しない場合やファイルである場合は処理を中止する
'【モード指定】
'	/m		削除ではなく移動する
'			/m=xxxx のように=を付けた場合、=以降で指定されたパスへ移動する。(この例ではxxxxフォルダ)
'			=を付けなかった場合、このスクリプトがあるフォルダ内に"_delete"フォルダを作成し、そこへ移動する
'	/h		削除ではなく隠しファイル属性を付与する
'【詳細オプション】
'	/d		削除モード時、常にごみ箱を使用しない(常にファイルを削除する)
'			(通常、サイズが0ではないファイルはごみ箱へ入れるが、この指定時には削除で動作する)
'	/x		移動モード時、フォルダ構造を保って移動する
'			またこのオプションを指定した場合、移動によって空になったフォルダは削除される
'	/o		移動モード時、同名ファイルがあった場合は上書きする
'			(通常、同名ファイルは同サイズなら重複として削除、サイズ相違なら連番リネームするが、
'			 この指定時には、サイズ相違の場合は上書き(既存ファイルを削除し移動)する)
'【対象ファイル指定】
'	/s		処理対象とするファイルサイズを指定する
'			/s=zzzzz のように=に続いてサイズを指定する(Byte単位、またはKB/MB指定)
'	/a		ファイルサイズに関わらず、すべてのファイルを対象とする
'			ただしこの指定は/m(移動モード)、/h(隠しファイル属性付与モード)と合わせて指定した場合のみ有効
'			(安全のため、削除モードでは動作しないこととしている)
'	/af		ファイルサイズに関わらず、すべてのファイルを対象とする(削除モード時も含む)
'	/e=		処理対象とするファイルの拡張子を指定する。
'			複数の拡張子を指定する場合は;(セミコロン)で区切る。ワイルドカード(*、?)指定可能
'【ログ、メッセージ】
'	/l=		ログファイルの出力先、出力ファイル名を指定する
'			指定先が存在するフォルダの場合、フォルダ内に標準名で作成する
'	/nl		ログファイルの出力をしない
'	/nm		メッセージを出力しない
'


Dim fso, folderPath, args, movePath, sizeThreshold, shouldMove, shouldHide, logFilePath, noLog
Dim logFile, logDateTime, fileCount, sizeUnit
Dim shouldProceed
Dim filePath, scriptPath, subfolderPath
Dim shouldPreserveStructure, allFiles
Dim regexPattern, regex, filePatterns, filePattern, shouldLimitExt, isTargetExt

Dim shouldTrash, shouldOverwrite, sa, noMessage, logWords, logStream, allFilesForce

Set fso = CreateObject("Scripting.FileSystemObject")
Set args = WScript.Arguments
Set regex = New RegExp

folderPath = ""
movePath = ""
sizeThreshold = 0
sizeUnit = ""
shouldMove = False
shouldHide = False
noLog = False
logDateTime = Year(Now) & Right("0" & Month(Now), 2) & Right("0" & Day(Now), 2) & "-" & Right("0" & Hour(Now), 2) & Right("0" & Minute(Now), 2) & Right("0" & Second(Now), 2)
logFilePath = "dellog-" & logDateTime & ".txt"
fileCount = 0
shouldProceed = True
shouldPreserveStructure = False
allFiles = False

filePath = ""
scriptPath = ""
subfolderPath = ""
shouldTrash = True
shouldOverwrite = False
Set sa = CreateObject("Shell.Application")
noMessage = False
logWords = ""
shouldLimitExt = False
filePatterns = Split("", ";")
filePattern = ""
isTargetExt = False
allFilesForce = False

' コマンドラインからの実行を確認
Dim isCScript
isCScript = (InStr(LCase(WScript.FullName), "cscript") > 0)

' Echoメッセージを表示する関数
Sub LogMessage(message)
	If noMessage Then Exit Sub
    If isCScript Then
        WScript.Echo message
    Else
        MsgBox message, vbInformation, "処理ログ" 
    End If
End Sub

' 使用方法を表示するサブルーチン
Sub ShowUsage()
	Dim usage
	usage = ""
    usage = usage & chr(13) & Chr(10) & "使用方法:"
    usage = usage & chr(13) & Chr(10) & "  cscript " & WScript.ScriptName & " [フォルダパス] [/m[=パス] [/x]] [/h] [/d] [/s[=サイズ]] [/a] [/l=ログファイルパス] [/nl] [/nm]"
    usage = usage & chr(13) & Chr(10) & ""
    usage = usage & chr(13) & Chr(10) & "オプション:"
    usage = usage & chr(13) & Chr(10) & "  フォルダパス"
    usage = usage & chr(13) & Chr(10) & "      処理対象のフォルダのパス。"
    usage = usage & chr(13) & Chr(10) & "      指定されていない場合は、スクリプトのあるフォルダが使用されます。"
    If isCScript then usage = usage & chr(13) & Chr(10)
    usage = usage & chr(13) & Chr(10) & "  /m[=パス]"
    usage = usage & chr(13) & Chr(10) & "      ファイルを削除せずに移動します。"
    usage = usage & chr(13) & Chr(10) & "      'パス'が指定されている場合はそのパスに移動します。"
    If isCScript then usage = usage & chr(13) & Chr(10)
    usage = usage & chr(13) & Chr(10) & "  /h"
    usage = usage & chr(13) & Chr(10) & "      ファイルを削除せずに隠しファイル属性を付与します。"
    If isCScript then usage = usage & chr(13) & Chr(10)
    usage = usage & chr(13) & Chr(10) & "  /d"
    usage = usage & chr(13) & Chr(10) & "      削除モード時、ファイルをごみ箱に入れずに削除します。"
    usage = usage & chr(13) & Chr(10) & "      通常、サイズが0バイトではない場合はごみ箱へ移動しますが、この指定時には削除で動作します。"
    If isCScript then usage = usage & chr(13) & Chr(10)
    usage = usage & chr(13) & Chr(10) & "  /x"
    usage = usage & chr(13) & Chr(10) & "      移動モード時、フォルダ構造を保って移動します。"
    usage = usage & chr(13) & Chr(10) & "      このオプション指定を指定した場合、移動によって空になったフォルダは削除されます。"
    If isCScript then usage = usage & chr(13) & Chr(10)
    usage = usage & chr(13) & Chr(10) & "  /o"
    usage = usage & chr(13) & Chr(10) & "      移動モード時、同名ファイルは常に上書きします。"
    usage = usage & chr(13) & Chr(10) & "      通常、ファイルサイズが違う場合は連番リネームしますが、この指定時にはサイズを無視します。"
    If isCScript then usage = usage & chr(13) & Chr(10)
    usage = usage & chr(13) & Chr(10) & "  /s[=サイズ]"
    usage = usage & chr(13) & Chr(10) & "      バイト数でファイルサイズの閾値を指定します。指定されたサイズ以下のファイルが処理されます。"
    usage = usage & chr(13) & Chr(10) & "      サイズが指定されていない場合、デフォルトで0バイトになります。KB/MBでの指定も可能です。"
    If isCScript then usage = usage & chr(13) & Chr(10)
    usage = usage & chr(13) & Chr(10) & "  /a"
    usage = usage & chr(13) & Chr(10) & "      ファイルサイズ指定を無視します。"
    usage = usage & chr(13) & Chr(10) & "      /mまたは/hと併用が必要です。(/aではなく/afとすると、/mや/hが無くても強制的に機能します)"
    If isCScript then usage = usage & chr(13) & Chr(10)
    usage = usage & chr(13) & Chr(10) & "  /e=拡張子1[;拡張子2][;拡張子3...]"
    usage = usage & chr(13) & Chr(10) & "      削除対象とするファイルを拡張子で指定します。"
    usage = usage & chr(13) & Chr(10) & "      複数指定する場合は;で区切ります。(例=png;jp*g;mp?)"
    If isCScript then usage = usage & chr(13) & Chr(10)
    usage = usage & chr(13) & Chr(10) & "  /l=ログファイルパス"
    usage = usage & chr(13) & Chr(10) & "      ログファイルの出力先パスを指定します。"
    If isCScript then usage = usage & chr(13) & Chr(10)
    usage = usage & chr(13) & Chr(10) & "  /nl"
    usage = usage & chr(13) & Chr(10) & "      ログファイルを作成しません。"
    If isCScript then usage = usage & chr(13) & Chr(10)
    usage = usage & chr(13) & Chr(10) & "  /nm"
    usage = usage & chr(13) & Chr(10) & "      メッセージ表示を抑制します。(サイレントモード)"
    usage = usage & chr(13) & Chr(10) & "      /nlと/nmは、それぞれ独立して動作します。"
    If isCScript then usage = usage & chr(13) & Chr(10)
    usage = usage & chr(13) & Chr(10) & "  /?"
    usage = usage & chr(13) & Chr(10) & "      このヘルプメッセージを表示します。"
    usage = usage & chr(13) & Chr(10) & ""
    usage = usage & chr(13) & Chr(10) & "※ログは標準出力とテキストファイルに出力します。"
    usage = usage & chr(13) & Chr(10) & " (コマンドラインでもcscriptを付けて起動しないとMessageBoxへ出力されます)"
    noMessage = False
    LogMessage usage
End Sub

' 引数の処理
For i = 0 To args.Count - 1
    If Left(args(i), 1) = "/" Then
        Select Case LCase(Mid(args(i), 2, 1))
            Case "m"    '移動モード(/m=でパス指定可能)
                shouldMove = True
                If InStr(args(i), "=") > 0 Then
                    movePath = Mid(args(i), InStr(args(i), "=") + 1)
                    'ディレクトリ名を含む完全なパスを再取得する
                    movePath = fso.GetAbsolutePathName(movePath)
                End If
            Case "x"    '移動モード時、フォルダ構造を保持して移動する
                shouldPreserveStructure = True
            Case "o"    '移動モード時、同名ファイルは上書きする
                shouldOverwrite = True
            Case "h"    '隠しファイル属性付与モード
                shouldHide = True
            Case "s"    'サイズ指定(/s=で必ずサイズ指定を伴う)
                If InStr(args(i), "=") > 0 Then
                    sizeThreshold = Mid(args(i), InStr(args(i), "=") + 1)
                    sizeUnit = ""
                    If Not IsNumeric(sizeThreshold) Then										'全体が数値でない(=文字を含む)ならば
                        If Not IsNumeric(Mid(sizeThreshold, Len(sizeThreshold) - 1, 1)) Then	'  後ろから2文字目が数値でないならば
                            sizeUnit = Lcase(Right(sizeThreshold, 2))                           '    後ろ2文字をサイズ単位として取得
                            sizeThreshold = Left(sizeThreshold, Len(sizeThreshold) - 2)         '    後ろ2文字より前をサイズ数値として取得
                        ElseIf Not IsNumeric(Mid(sizeThreshold, Len(sizeThreshold), 1)) Then    '  最後の文字が数値でないならば
                            sizeUnit = LCase(Right(sizeThreshold, 1))                           '    最後の文字をサイズ単位として取得
                            sizeThreshold = Left(sizeThreshold, Len(sizeThreshold) - 1)         '    最後の文字より前をサイズ数値として取得
                        Else                                                                    '  2文字目も最後も数値ならば
                            sizeUnit = ""                                                       '    解釈できないため、サイズ指定を無効化
                            sizeThreshold = 0
                        End If
                        If Not IsNumeric(sizeThreshold) Then                                    '  処理後を見て、全体が数値でないならば
                            sizeThreshold = 0                                                   '    サイズは0とする
                            sizeUnit = ""                                                       '    サイズ単位を無効化
                        ElseIf sizeUnit <> "" Then                                              '  全体が数値ならば(ただしサイズ指定無効時は除外)
                            sizeThreshold = CLng(sizeThreshold)                                 '    数値(Long型)に変換しておく
                            Select Case sizeUnit                                                '    サイズ単位を確認し、サイズをByte単位へ変換
                                Case "k", "kb"
                                    sizeThreshold = CLng(sizeThreshold) * 1024
                                Case "m", "mb"
                                    sizeThreshold = CLng(sizeThreshold) * 1024 * 1024
                                Case Else
                                    sizeUnit = ""                                               '    (KB、MBでなければサイズ単位を無効化)
                            End Select
                        End If
                    Else                                                                        '全体が数値ならば
                        sizeThreshold = CLng(sizeThreshold)                                     '  サイズを数値(Long型)に変換しておく
                    End If
                End If
            Case "a"    'ファイルサイズを無視しすべてのファイルを対象とする
                allFiles = True    '移動モード、隠しファイル属性付与モードでのみ機能
                If LCase(Mid(args(i), 2, 2)) = "af" Then allFilesForce = True    '削除モードでも機能
            Case "e"    ' 対象とする拡張子を限定する
                If Instr(args(i), "=") > 0 Then
                    filePatterns = Split(Right(args(i), Len(args(i)) - Instr(args(i), "=")), ";")
                    shouldLimitExt = True
                End If
            Case "l"    'ログ出力(/l=で出力先フォルダ、ファイル名を指定)
                noLog = False
                If InStr(args(i), "=") > 0 Then
                    logFilePath = Mid(args(i), InStr(args(i), "=") + 1)
                    'ディレクトリ名を含む完全なパスを再取得する
                    logFilePath = GetUniqueFilePath (fso.GetAbsolutePathName(logFilePath))
                    If fso.FolderExists(logFilePath) Then
                        logFilePath = fso.BuildPath(logFilePath, "dellog-" & logDateTime & ".txt")
                    ElseIf Not fso.FolderExists(fso.GetParentFolderName(logFilePath)) Then
                        fso.CreateFolder fso.GetParentFolderName(logFilePath)
                    End If
                End If
            Case "n"
                If LCase(Mid(args(i), 2, 2)) = "nl" Then        'ログ出力を抑制する
                    noLog = True
                ElseIf Lcase(Mid(args(i), 2, 2)) = "nm" Then    'メッセージ出力を抑制する
                    noMessage = True
                End If
            Case "d"    '常にごみ箱を使用しない
                shouldTrash = False
            Case "?"    'ヘルプ表示
                ShowUsage()
                WScript.Quit
        End Select
    Else
        folderPath = args(i)
    End If
Next

' ユーザーに確認
If Not(noMessage) Then
    shouldProceed = True
ELseIf sizeUnit <> "" Or sizeThreshold >= 1024 Then
    shouldProceed = MsgBox("ファイルサイズの閾値として " & sizeThreshold & " バイトが設定されました。処理を実行しますか?", vbYesNo + vbQuestion, "確認") = vbYes
End If

If Not shouldProceed Then
    LogMessage "処理はキャンセルされました。"
    WScript.Quit
End If

If allFiles And Not (shouldMove Or shouldHide Or allFilesForce) Then
    LogMessage "エラー: /aオプションは/mまたは/hオプションと併用する必要があります。"
    WScript.Quit
End If

' フォルダパスが指定されていない場合、スクリプトのあるフォルダを使用
If folderPath = "" Then
    folderPath = fso.GetParentFolderName(WScript.ScriptFullName)
End If
' スクリプトのフルパスも取得
scriptPath = LCase(WScript.ScriptFullName)

' ログファイルの作成
If Not noLog Then
    Set logStream = CreateObject("ADODB.Stream")
    logStream.Type = 2            'テキストファイル
    logStream.Charset = "unicode" '文字コード
    logStream.Open
    logStream.WriteText "Log started at: " & Now, 1
End If

'動作モード(大分類のみ)をログに記録
If Not noLog Then
    logWords = "動作モード >>> "
    If shouldMove Then
        If shouldPreserveStructure Then
            logWords = logWords & "移動モード (構造保持, "
        Else
            logWords = logWords & "移動モード ("
        End If
    ElseIf shouldHide Then
        logWords = logWords & "隠しファイル属性付与モード ("
    Else
        logWords = logWords & "削除モード ("
    End If
    If allFiles Then
        If shouldMove Or shouldHide Or allFilesForce Then
            logWords = logWords & "サイズ無視)"
        Else
            logWords = logWords & Cstr(sizeThreshold) & "Bytes or less)" & chr(10) & Chr(13) & "※削除モードのため、サイズ無視(/a)の指定は無視します。"
        End If
    Else
        logWords = logWords & Cstr(sizeThreshold) & "Bytes or less)"
    End If
    logStream.WriteText logWords, 1
    If shouldLimitExt Then logStream.WriteText "対象拡張子 >>> " & Join(filePatterns, ";"), 1
End If

If Not(noLog) Then logStream.WriteText "移動元 >>> " & folderPath, 1

If shouldMove Then
' 移動先のフォルダが指定されていない場合、デフォルトの"_delete"フォルダを設定
    If movePath = "" Then movePath = fso.BuildPath(folderPath, "_delete")
    '移動先フォルダの存在を確認し、なければ作成(GUIを考慮し、メッセージは表示しない)
    If Not fso.FolderExists(movePath) Then
        fso.CreateFolder(movePath)
        If Not(noLog) Then logStream.WriteText "移動先フォルダを作成: " & movePath, 1
    Else
        If Not(noLog) Then logStream.WriteText "移動先 >>> " & movePath, 1
    End If
End If

' 指定したフォルダを再帰的に処理
If fso.FolderExists(folderPath) Then
    DeleteOrMoveFiles fso.GetFolder(folderPath), fso.GetFolder(folderPath)
Else
    '指定フォルダが無い場合(ファイルである場合を含む)は、処理を中止する
    LogMessage "エラー: 削除する対象のフォルダが見つかりません"
    If Not(noLog) Then logStream.WriteText "エラー: 削除する対象のフォルダが見つかりません", 1
End If

' ログファイルの閉じる
If Not noLog Then
    LogStream.WriteText "Done: " & fileCount & " Files"
    logStream.WriteText "Log ended at: " & Now, 1
    logStream.SaveToFile logFilePath,2
    logStream.Close
End If

Set fso = Nothing
Set sa = Nothing
If Not noLog Then Set logStream = Nothing
Set regex = Nothing

' 処理したファイル数を報告する
LogMessage "Done: " & fileCount & " Files"


Sub DeleteOrMoveFiles(folder, baseFolder)
    Dim file, subfolder, action, fileSize, relativePath, targetPath

    For Each file In folder.Files
        ' ログファイル自体とスクリプト本体は対象から除外
        ' また、拡張子限定モードの場合には対象拡張子であるかもチェックする
        action = ""
        If file.Path <> logFilePath And LCase(file.Path) <> scriptPath Then
            fileSize = file.Size
            filePath = file.Path
            If (allFiles Or fileSize <= sizeThreshold) Then
                '拡張子を順次チェック
                If shouldLimitExt Then
                    isTargetExt = False
                    For Each filePattern In filePatterns
                        If isPatternMatch(file.Name, filePattern) Then
                            isTargetExt = True
                            Exit For
                        End If
                    Next
                Else
                    isTargetExt = True
                End If
                If isTargetExt Then
                    If shouldHide Then
                        ' 隠しファイル属性付与モード
                        file.Attributes = file.Attributes Or 2 ' 隠しファイル属性を設定
                        action = "Hidden   "
                    ElseIf shouldMove Then
                        ' 移動モード
                        If shouldPreserveStructure Then
                            ' 構造を保って移動
                            relativePath = Replace(filePath, baseFolder.Path, "")
                            targetPath = fso.BuildPath(movePath, relativePath)
                            If Not fso.FolderExists(fso.GetParentFolderName(targetPath)) Then
                                fso.CreateFolder(fso.GetParentFolderName(targetPath))
                            End If
                            If fso.FileExists(targetPath) Then
                                ' ケース1:同名ファイルが存在する場合
                                If shouldOverwrite Then
                                    ' 上書きモードなら、同サイズでも上書きする
                                    fso.GetFile(targetPath).Delete
                                    fso.MoveFile file.Path, targetPath
                                    action = "Overwrite"
                                Else
                                    ' 通常モードなら、サイズを確認して動作を変える
                                    If fso.GetFile(targetPath).Size = fileSize Then
                                        file.Delete True
                                        action = "Redundant"
                                    Else
                                        fso.MoveFile file.Path, GetUniqueFilePath(targetPath)
                                        action = "Moved    "
                                    End If
                                End If
                            Else
                                'ケース2:同名ファイルは存在しない場合
                                fso.MoveFile file.Path, GetUniqueFilePath(targetPath)
                                action = "Moved    "
                            End If
                        Else
                            ' 単一のフォルダへ移動
                            'If fileSize <= sizeThreshold Then	←旧仕様では/aは/x併用必須としていたための判定(一応保存)
                                targetPath = fso.BuildPath(movePath, file.Name)
                                ' 上書きモードなら、ファイルが存在する場合には常に上書き
                                If (fso.FileExists(targetPath) And shouldOverwrite) Then
                                    fso.GetFile(targetPath).Delete
                                    fso.MoveFile file.Path, targetPath
                                    action = "Overwrite"
                                Else
                                    fso.MoveFile file.Path, GetUniqueFilePath(fso.BuildPath(movePath, file.Name))
                                    action = "Moved    "
                                End If
                            'Else								←旧仕様では/aは/x併用必須としていたための判定(一応保存)
                            '    action = ""					←旧仕様では/aは/x併用必須としていたための判定(一応保存)
                            'End If								←旧仕様では/aは/x併用必須としていたための判定(一応保存)
                        End If
                    Else
                        ' 削除モード(デフォルト)
                        If (fileSize <= sizeThreshold Or allFilesForce) Then
                            If fileSize = 0 Or shouldTrash = False Then
                                file.Delete True
                                action = "Deleted  "
                            Else
                                sa.NameSpace(10).MoveHere(filePath) ' ごみ箱に捨てる
                                While fso.FileExists(filePath)      ' ごみ箱に入るまで待機する
                                    WScript.Sleep(100)
                                WEnd
                                action = "Trashed  "
                            End If
                        End If
                    End If
                    fileCount = fileCount + 1
                End If
                ' アクションを出力
                If (isCScript And action<>"") Then LogMessage action & ": " & filePath & " (" & fileSize & " Bytes)"
                If (Not noLog ANd action<>"") Then
                    logStream.WriteText action & ": " & filePath & " (" & fileSize & " Bytes)", 1
                End If
            End If
        End If
    Next

    For Each subfolder In folder.SubFolders
        subfolderPath = subfolder.Path
        If Not (shouldMove And subfolderPath = movePath) Then
            DeleteOrMoveFiles subfolder, baseFolder
        End If
        ' 移動後、空のサブフォルダを削除
        If shouldPreserveStructure And (subFolder.Files.Count = 0 And subFolder.SubFolders.Count = 0) Then
            subFolder.Delete True
            LogMessage "Deleted empty folder: " & subFolderPath
            If Not noLog Then
                logStream.WriteText "Deleted empty folder: " & subFolderPath, 1
            End If
        End If
    Next
End Sub

Function GetUniqueFilePath (sourceFilePath)
'指定ファイル名が存在する場合、連番を付す
'なお、あえてフォルダ名はチェックしていないので注意
'ファイル名だけを引き渡した場合も、戻り値はフルパスとなる
    Dim result
    result = fso.GetAbsolutePathName(sourceFilePath)
    If fso.FileExists(result) Then
        Dim parentFolder, baseName, extension, counter
        parentFolder = fso.GetParentFolderName(result)
        baseName = fso.GetBaseName(result)
        extension = fso.GetExtensionName(result)
        counter = 1
        Do While fso.FileExists(result)
            result = fso.BuildPath (parentFolder, baseName & "_" & counter)
            if extension <> "" Then result = result & "." & extension
            counter = counter + 1
        Loop
    End If
    GetUniqueFilePath = result
End Function

Function isPatternMatch(fileName, pattern)
' パターンマッチング関数
    regexPattern = Replace(Replace(Replace(pattern, ".", "\."), "*", ".*"), "?", ".") & "$"
    regex.Pattern = regexPattern
    regex.IgnoreCase = True
    isPatternMatch = regex.Test(fileName)
End Function

/o 指定は特に迷うことは無いと思うが、/e 指定のサンプルは次の通り。
拡張子を列記する場合は「;」で区切ること、拡張子を書く書き方には大体対応できていること(*.extでも.extでもextでも通る)あたりがポイント。
あと、下例ではダブルクォーテーションで囲っているが、特に囲わなくても動作はする。

'特定の拡張子を対象とする
cscript DelZero.vbs "C:\path\to\your\folder" /e=".png;.jp*g;.mp?"

さて、本日時点での残課題は2つ。

  1. Unicodeを含むファイル名へ対応するため、ログファイルの処理をADODB.Streamにしていることから、処理動作中に逐次出力できず、処理完了時に一気に書き込んでいる。このためエラー等で落ちた場合を探るためのログとしては、やや機能が弱い(→標準出力をそのままリダイレクトでファイル化したりできないだろうか)

  2. 今日テストをかけながら思ったのだが、ファイルサイズではなく画像サイズが一定以下のファイルを削除するモードがあると使えそう。調べたら、VBScriptでも画像サイズを取得することは可能っぽい。

https://qiita.com/nillnull/items/85b86115f512c2150aee
https://t-amago.hatenadiary.org/entry/20071205/p1
https://www.whitire.com/vbs/tips0059.html
https://hrkworks.com/it/programming/vbs/image_resize/#google_vignette

本日も午後それなりの時間をかけてしまったので、とりあえずここまで。
家事とか他にもやらなければいけないことはあるんだけど…


この記事が気に入ったらサポートをしてみませんか?