SonotaCo.JP

[小林 隆]

こんばんは。

UFOCapture シリーズには録画時間の合計を表示する機能がないため、
検知数が多くなると、削除するのにどれくらい時間がかかるかが分か
らず、困っていました。

簡易的にフォルダ内の録画時間の合計を求める VBScript をかきました。
よろしかったらご意見を頂けたら幸いです。

--

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0,"フォルダを選択してください",&h200,&h11)

If (objFolder Is Nothing) Then
WScript.Quit
End If

t = 0

Set fso = CreateObject("Scripting.FileSystemObject")
For Each strFileName in objFolder.Items
If fso.GetExtensionName(strFileName.Path) = "avi" Then
If t < 1 then
t = DateAdd("s",Mid(objFolder.GetDetailsOf(strFileName,27),1,2) * 3600 _
+ Mid(objFolder.GetDetailsOf(strFileName,27),4,2) * 60 _
+ Mid(objFolder.GetDetailsOf(strFileName,27),7,2) _
,t)
Else
MsgBox("オーバーフローしました")
WScript.Quit
End If
End If
Next
MsgBox(t)
Set fso = Nothing

--


以下の問題点はあります。

・合計が 24 時間以上になるとオーバーフローする。
・Windows XP 以前では正しく動作しない。
・AVI の録画時間しか合計していない。
・ごみ箱を選択すると正しく動作しない。

です。

[小林 隆]

こんにちは。

Copilot に改善をお願いしてやりとりした結果、
以下のようなコードに修正してくれました。

--

Option Explicit

Dim objShell, selectedFolder, fso, strFileName, time, total
Dim hours, minutes, seconds

Set objShell = CreateObject("Shell.Application")
Set selectedFolder = objShell.BrowseForFolder(0, "フォルダを選択してください", &h200, &h11)

If selectedFolder Is Nothing Then
MsgBox "フォルダが選択されていません。"
Set objShell = Nothing
WScript.Quit
End If

Set fso = CreateObject("Scripting.FileSystemObject")

For Each strFileName In selectedFolder.Items
If fso.GetExtensionName(strFileName.Path) = "avi" Then
time = selectedFolder.GetDetailsOf(strFileName, 27)
hours = Mid(time, 1, 2)
minutes = Mid(time, 4, 2)
seconds = Mid(time, 7, 2)
total = total + (hours * 3600) + (minutes * 60) + seconds
End If
Next

MsgBox "AVIファイルの合計録画時間：" & (total \ 3600) Mod 24 & "時間" & (total \ 60) Mod 60 & "分" & total Mod 60 & "秒"

Set fso = Nothing
Set selectedFolder = Nothing
Set objShell = Nothing

--

[SonotaCo]

投稿ありがとうございます。
面白いツールですね。
上げて頂いたデキストのOption Explicit以降を適当なAviTime.bvs等の名前のファイルとしてセーブしてエクスプローラでクリックするとちゃんと動きました。
せっかくなら指定したフォルダーのより下位のフォルダーも調べて合計してくれるとよりありがたいかと思いました。
GetDetailsOf で 再生時間を調べている点が面白い方法と思いました。

[小林 隆]

こんばんは。SonotaCo さん。ご返信ありがとうございます。

SonotaCo さんの質問に、先にお答えしますと、動画はひとつひとつ１回は
再生してから削除しています。総再生時間が分かれば、削除にかかる時間は
少なくともそれ以上はかかることが見積もれます。

朝、私は家を出る時間は決まっているので、削除するのにかかる時間が分か
れば、今日は家を出る前に、終わらせられるか、どうかの判断がつきます。

UAでの解析にかかる時間はまちまちなので、解析は時間のとれる帰宅後など
に行っています。

下位のフォルダーも調べて合計する件についてですが、再帰を使って仕事で
実装したことはあるのですが、少しコードが読みにくくなるので今回は作り
ませんでした。アレンジはご覧になった方にお任せしようと思います。

[SonotaCo]

[小林 隆]

こんにちは。

SonotaCo さんのリクエストにお答えして、指定したフォルダより下位のフォルダも調
べて合計するように書き換えました。 Copilot の答えが間違っていたため、修正した結
果、以下のようなコードになりました。テストで録画時間を取得できない場合があるこ
とが分かり、スキップする処理を追加しました。なお、下記のテキストをコピーして、
拡張子は .vbs で ANSI で保存すると実行できると思います。

--

Option Explicit

Dim objShell, selectedFolder, fso, total

Set objShell = CreateObject("Shell.Application")
Set selectedFolder = objShell.BrowseForFolder(0, "フォルダを選択してください", &h200, &h11)

If selectedFolder Is Nothing Then
MsgBox "フォルダが選択されていません。"
Set objShell = Nothing
WScript.Quit
End If

Set fso = CreateObject("Scripting.FileSystemObject")

total = GetTotalTime(selectedFolder)

MsgBox "AVIファイルの合計録画時間：" & (total \ 3600) Mod 24 & "時間" & (total \ 60) Mod 60 & "分" & total Mod 60 & "秒"

Set fso = Nothing
Set selectedFolder = Nothing
Set objShell = Nothing

Function GetTotalTime(folder)
Dim hours, minutes, seconds
Dim strFileName, time, totalTime, subFolder, shellSubFolder

totalTime = 0

For Each strFileName In folder.Items
If fso.GetExtensionName(strFileName.Path) = "avi" Then
time = folder.GetDetailsOf(strFileName, 27)
If time <> "" Then
hours = Mid(time, 1, 2)
minutes = Mid(time, 4, 2)
seconds = Mid(time, 7, 2)
totalTime = totalTime + (hours * 3600) + (minutes * 60) + seconds
End If
End If
Next

For Each subFolder In fso.GetFolder(folder.Self.Path).SubFolders
Set shellSubFolder = objShell.Namespace(subFolder.Path)
totalTime = totalTime + GetTotalTime(shellSubFolder)
Next

Set shellSubFolder = Nothing

GetTotalTime = totalTime
End Function

--