![見出し画像](https://assets.st-note.com/production/uploads/images/143545084/rectangle_large_type_2_2b2c551d5f1eb58c5412011f08dc0448.png?width=800)
0バイトのファイルを削除するツール2
本日は、前回に宿題で残しておいた2つの機能追加が主眼。
移動モード時、同名ファイルだったら上書きするオプション (/o)
対象にするファイルを拡張子で指定できるオプション (/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つ。
Unicodeを含むファイル名へ対応するため、ログファイルの処理をADODB.Streamにしていることから、処理動作中に逐次出力できず、処理完了時に一気に書き込んでいる。このためエラー等で落ちた場合を探るためのログとしては、やや機能が弱い(→標準出力をそのままリダイレクトでファイル化したりできないだろうか)
今日テストをかけながら思ったのだが、ファイルサイズではなく画像サイズが一定以下のファイルを削除するモードがあると使えそう。調べたら、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
本日も午後それなりの時間をかけてしまったので、とりあえずここまで。
家事とか他にもやらなければいけないことはあるんだけど…
この記事が気に入ったらサポートをしてみませんか?