見出し画像

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

先日、%たいとる%が欲しくなり、フリーのツールを探すのも面倒だったので、このくらいなら自分で書いてしまうかなぁと着手。
現在進行形で機能追加しているけど、その進捗をメモしておく。

VBScriptが今後廃止されるらしいけど、今現在、自分がラクに使えるのがVBSctiptなので、当面はまだこれで。

とはいえ1から自分で作るのが面倒だったので、最初はまぁまぁChatGPT-4oを使って書かせてみた。
ざっくり綺麗にできたし、起動オプションとか指定したら勝手に解釈してヘルプ機能とかログ機能とかつけてくれるし、「そのようなサンプルが多くネットに出回っていること」の証左であるとは思うけど、実用性が高いコードを書いてくるのは驚いた。

でも実際に動かしてみるとやっぱりバグがあって(ネットに転がっているサンプルの多くもそうだし)、「ファイルを削除してから、そのファイルのサイズを取得しようとする」みたいなことでコケてたりする。

あとChatGPTも、あんまりにも複雑な条件にしすぎていくと以前に回答したコードを忘れているっぽいなど、これ一本で完全な実用レベルは難しいんじゃないかな。

とりあえず、昨日時点までのコード。

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 shouldTrash, sa, noMessage, logWords, logStream

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

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
Set sa = CreateObject("Shell.Application")
noMessage = False
logWords = ""

' コマンドラインからの実行を確認
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) & "  /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と併用が必要です。また/m指定の場合、同時に/xの指定が無いと無視されます。"
    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 "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
            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) 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 = "Mode >>> "
    If shouldMove Then
        If shouldPreserveStructure Then
            logWords = logWords & "Move (PreserveStructure, "
        Else
            logWords = logWords & "Move ("
        End If
    ElseIf shouldHide Then
        logWords = logWords & "Hide ("
    Else
        logWords = logWords & "Delete ("
    End If
    If allFiles And ((shouldMove And shouldPreserveStructure) Or shouldHide) Then
        logWords = logWords & "AllFiles)"
    Else
        logWords = logWords & Cstr(sizeThreshold) & "Bytes or less)"
    End If
    logSTream.WriteText logWords, 1
End If

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 "Create Folder: " & movePath, 1
    Else
        logStream.WriteText "Destination: " & movePath, 1
    End If
End If

' 指定したフォルダを再帰的に処理
DeleteOrMoveFiles fso.GetFolder(folderPath), fso.GetFolder(folderPath)


' ログファイルの閉じる
If Not noLog Then
    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

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


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

    For Each file In folder.Files
        ' ログファイル自体とスクリプト本体は対象から除外
        If file.Path <> logFilePath And LCase(file.Path) <> scriptPath Then
            fileSize = file.Size
            filePath = file.Path
            If (allFiles Or fileSize <= sizeThreshold) 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
                            If fso.GetFile(targetPath).Size = fileSize Then
                                file.Delete True
                                action = "Redundant"
                            Else
                                fso.MoveFile file.Path, GetUniqueFilePath(targetPath)
                                action = "Moved to "
                            End If
                        Else
                            fso.MoveFile file.Path, GetUniqueFilePath(targetPath)
                            action = "Moved to "
                        End If
                    Else
                        If fileSize <= sizeThreshold Then
                            fso.MoveFile file.Path, GetUniqueFilePath(fso.BuildPath(movePath, file.Name))
                            action = "Moved to"
                        Else
                            action = ""
                        End If
                    End If
                Else
                    If fileSize <= sizeThreshold 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
                ' アクションを出力
                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

そういえば途中にあるコメントの「ログファイル閉じる」は、ChatGPTの誤字だからね。面倒なので直してないけど。

途中にある使用方法表示のサブルーチンを読めばだいたいわかるけど、現時点でのざっくりした使い方は次の通り。

  • Wscript (GUI = エクスプローラー) からでもCscript (CUI = コマンドプロンプト) からでも動く(メッセージの挙動がちょっと違う)

  • 一番簡単なのは、消したいファイルがあるフォルダにこのスクリプト(.vbs)をコピーして、ダブルクリック。サブフォルダ以下も含めて、0バイトのファイルは消える

  • なお、スクリプトファイルを同じフォルダへログファイルを出力する

  • 高度な指定をしたい時はコマンドラインから使う。

  • コマンドラインの場合の最も基本的な使い方は、パスのみ指定。
    指定したフォルダ内の0バイトのファイルが消える。
    ちなみにパスを指定せずに起動すると、スクリプトがあるフォルダを対象にする(エクスプローラーでのダブルクリック時と同じ挙動)

cscript DelZero.vbs "C:\path\to\your\folder"
  • 削除の代わりに特定のフォルダへ移動したい場合には、/m オプションを指定する(=に続けて移動先を指定するが、指定が無ければ勝手に「_delete」フォルダを作る)

  • そのほか、隠しファイルとする/h オプションもある

cscript DelZero.vbs "C:\path\to\your\folder" /m="C:\path\to\move\folder"
  • /s オプションを指定すると、=に続けて指定したサイズ以下のファイルを対象にする(バイト単位、またはkb/mbで指定)

cscript DelZero.vbs "C:\path\to\your\folder" /s=1kb
  • /s オプションでサイズ指定した場合、サイズが0バイトより大きいファイルはごみ箱へ移動する仕様だが、/d オプションを指定した場合、常にごみ箱を使用しない(削除として動作する)

  • また /a というオプションを指定すると、ファイルサイズに関わらず全てのファイルを対象とする。ただし、安全のため削除モードなど一部の条件下では動かない

cscript DelZero.vbs "C:\path\to\your\folder" /s=1kb /d
  • 移動モード時 、/x オプションを指定すると、フォルダ構造を保ったまま移動する

cscript DelZero.vbs "C:\path\to\your\folder" /m="C:\path\to\move\folder" /x
  • そのほか、ログ関係など

cscript DelZero.vbs "C:\path\to\your\folder" /l="C:\path\to\logfile.txt"
cscript DelZero.vbs "C:\path\to\your\folder" /nl
cscript DelZero.vbs "C:\path\to\your\folder" /nm


とりあえずは以上。
なお、現時点で「移動モード時(かつ /x オプション未指定)に同名ファイルがあるとエラーで止まる」という不具合が残っていることがわかっている。
なので、これを修正したり、あとは「指定した拡張子のみ対象とする」機能追加をしようと思ったけど、noteに書いていたら遅くなってしまったので、今日はおしまい。


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