Notes

FolderWatcher.VBS V1.03 (C) [email protected] 2006-12-17

フォルダを監視してファイル/サブフォルダの作成/削除/変更を検出するVBScript

1. 目的、用途

フォルダの監視は、WMIや.NETを使わずとも、比較的簡単に出来そうです。
Shell.FolderViewのEnumDoneイベントを利用します。

2. 使用方法

(1) Windows XP

フォルダを指定して実行するか、ドロップします。

FolderWatcherW.VBS [フォルダ]
FolderWatcherM.VBS [フォルダ]

フォルダを省略すると、テンポラリフォルダを監視します。

FolderWatcherW.VBS は、IEウィンドウを開きます

ファイル/サブフォルダの作成/削除/変更を検出すると、IEウィンドウの末行に表示、
スクロールし、IEウィンドウをアクティブにします。
IEウィンドウがアクティブにできないときは、タスクバーで点滅します。

IEウィンドウを閉じると、フォルダの監視を終了します。

FolderWatcherM.VBS は、「フォルダ監視中」のメッセージを表示します。

ファイル/サブフォルダの作成/削除/変更を検出すると、メッセージを表示します。
CScript.exeで実行した場合は、コンソール/標準出力にメッセージを出力します。

「フォルダ監視中」のメッセージを閉じると、フォルダの監視を終了します。

(2) Windows 2000

Windows 2000では、変化があっても、EnumDoneイベントが発生しないようです。
WMIなどでも駄目かも。何かそういうことを聞いたような気がします。

で、ファイル名に2を付けたものが2000用です。タイマで監視します。

そのため、FolderWatcherM2.VBSは、「フォルダ監視中」のメッセージを出しません。
代わりに、監視先フォルダを表示します。

それを閉じると、フォルダの監視を終了します。

タイマは１秒(1000ミリ秒)なので、精度とオーバヘッドを勘案して変えてください。

****
' FolderWatcherM.VBS V1.02 (C) [email protected] 2006-09-01
' FolderWatcherM.VBS watches folder for changes.
' Usage: FolderWatcherM.VBS [folder]

Option Explicit
Dim ix
Dim arg
Dim Folder
Dim Dic
Dim FolderItem
Dim SFV

If WScript.Arguments.Count() Then
arg=WScript.Arguments.Item(0)
Else
arg=CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2).Path
End If
Set ix=CreateObject("InternetExplorer.Application")
ix.Navigate "file://" & arg
Do While ix.Busy Or ix.ReadyState<>4
WScript.Sleep 100
Loop
Set Folder=ix.Document.Folder

Set Dic=CreateObject("Scripting.Dictionary")
For Each FolderItem In Folder.Items()
Dic.Add FolderItem.Path,FolderItem.ModifyDate
Next
Set SFV=CreateObject("Shell.FolderView.1")
SFV.SetFolderView ix.Document
WScript.ConnectObject SFV,"SFV_"

MsgBox arg,vbInformation,"フォルダ監視中"

Sub SFV_EnumDone()
Dim Dic2
Dim Path
'WScript.Echo "EnumDone"
Set Dic2=CreateObject("Scripting.Dictionary")
For Each FolderItem In Folder.Items()
Dic2.Add FolderItem.Path,FolderItem.ModifyDate
If Dic.Exists(FolderItem.Path) Then
If Dic.Item(FolderItem.Path)<>Dic2.Item(FolderItem.Path) Then
WScript.Echo Join(Array(Now,"変更",FolderItem.Path,Dic.Item(FolderItem.Path),Dic2.Item(FolderItem.Path)),vbTab)
End If
Dic.Remove FolderItem.Path
Else
WScript.Echo Join(Array(Now,"作成",FolderItem.Path,Dic2.Item(FolderItem.Path)),vbTab)
End If
Next
For Each Path In Dic.Keys()
WScript.Echo Join(Array(Now,"削除",Path,Dic.Item(Path)),vbTab)
Next
Set Dic=Dic2
End Sub

*****
' FolderWatcherW.VBS V1.02 (C) [email protected] 2006-09-01
' FolderWatcherW.VBS watches folder for changes.
' Usage: FolderWatcherW.VBS [folder]

Option Explicit
Dim ie
Dim ix
Dim arg
Dim Folder
Dim Dic
Dim FolderItem
Dim SFV

If WScript.Arguments.Count() Then
arg=WScript.Arguments.Item(0)
Else
arg=CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2).Path
End If
Set ix=CreateObject("InternetExplorer.Application")
ix.Navigate "file://"&arg
Do While ix.Busy Or ix.ReadyState<>4
WScript.Sleep 100
Loop
Set Folder=ix.Document.Folder

Set ie=CreateObject("InternetExplorer.Application")
ie.AddressBar=False
ie.ToolBar=False
ie.MenuBar=False
ie.StatusBar=False
ie.Navigate "about:blank"
ie.Visible=True
Do While ie.Busy Or ie.ReadyState<>4
WScript.Sleep 100
Loop
ie.Document.Title="フォルダ監視中 - "&arg

Set Dic=CreateObject("Scripting.Dictionary")
For Each FolderItem In Folder.Items()
Dic.Add FolderItem.Path,FolderItem.ModifyDate
Next
Set SFV=CreateObject("Shell.FolderView.1")
SFV.SetFolderView ix.Document
WScript.ConnectObject SFV,"SFV_"

Do While TypeName(ie)="IWebBrowser2"
WScript.Sleep 1000
Loop
'MsgBox "Watch Ended."&" - "&arg,vbInformation,WScript.ScriptName

Sub SFV_EnumDone()
Dim Dic2
Dim Path
'WScript.Echo "EnumDone"
Set Dic2=CreateObject("Scripting.Dictionary")
For Each FolderItem In Folder.Items()
Dic2.Add FolderItem.Path,FolderItem.ModifyDate
If Dic.Exists(FolderItem.Path) Then
If Dic.Item(FolderItem.Path)<>Dic2.Item(FolderItem.Path) Then
ie.Document.body.insertAdjacentText "BeforeEnd",Join(Array(Now,"変更",FolderItem.Path,Dic.Item(FolderItem.Path),Dic2.Item(FolderItem.Path)),vbTab)&vbCrLf
End If
Dic.Remove FolderItem.Path
Else
ie.Document.body.insertAdjacentText "BeforeEnd",Join(Array(Now,"作成",FolderItem.Path,Dic2.Item(FolderItem.Path)),vbTab)&vbCrLf
End If
Next
For Each Path In Dic.Keys()
ie.Document.body.insertAdjacentText "BeforeEnd",Join(Array(Now,"削除",Path,Dic.Item(Path)),vbTab)&vbCrLf
Next
Set Dic=Dic2
ie.Document.parentWindow.scrollBy 0,ie.Document.body.scrollHeight
ie.Visible=True
End Sub

********
' FolderWatcherM2.VBS V1.03 (C) [email protected] 2006-12-17
' FolderWatcherM2.VBS watches folder for changes.
' Usage: FolderWatcherM2.VBS [folder]

Option Explicit
Dim fso
Dim ix
Dim arg
Dim Folder
Dim Dic
Dim FolderItem
Dim SFV

Set fso=CreateObject("Scripting.FileSystemObject")
If WScript.Arguments.Count() Then
arg=fso.GetAbsolutePathName(WScript.Arguments.Item(0))
Else
arg=fso.GetSpecialFolder(2).Path
End If
Set ix=CreateObject("InternetExplorer.Application")
ix.Visible=True
ix.Navigate "file://" & arg
Do While ix.Busy Or ix.ReadyState<>4
WScript.Sleep 100
Loop
Set Folder=ix.Document.Folder

Set Dic=CreateObject("Scripting.Dictionary")
For Each FolderItem In Folder.Items()
Dic.Add FolderItem.Path,FolderItem.ModifyDate
Next
Set SFV=CreateObject("Shell.FolderView.1")
SFV.SetFolderView ix.Document
WScript.ConnectObject SFV,"SFV_"

Do While TypeName(ix)="IWebBrowser2"
Try_EnumDone
If Err Then Exit Do
WScript.Sleep 1000
Loop
WScript.Echo "Watch Ended."

Sub Try_EnumDone()
On Error Resume Next
SFV_EnumDone
End Sub

Sub SFV_EnumDone()
Dim Dic2
Dim Path
'WScript.Echo "EnumDone"
Set Dic2=CreateObject("Scripting.Dictionary")
For Each FolderItem In Folder.Items()
Dic2.Add FolderItem.Path,FolderItem.ModifyDate
If Dic.Exists(FolderItem.Path) Then
If Dic.Item(FolderItem.Path)<>Dic2.Item(FolderItem.Path) Then
WScript.Echo Join(Array(Now,"変更",FolderItem.Path,Dic.Item(FolderItem.Path),Dic2.Item(FolderItem.Path)),vbTab)
End If
Dic.Remove FolderItem.Path
Else
WScript.Echo Join(Array(Now,"作成",FolderItem.Path,Dic2.Item(FolderItem.Path)),vbTab)
End If
Next
For Each Path In Dic.Keys()
WScript.Echo Join(Array(Now,"削除",Path,Dic.Item(Path)),vbTab)
Next
Set Dic=Dic2
End Sub

**********
' FolderWatcherW2.VBS V1.03 (C) [email protected] 2006-12-17
' FolderWatcherW2.VBS watches folder for changes.
' Usage: FolderWatcherW2.VBS [folder]

Option Explicit
Dim ie
Dim ix
Dim arg
Dim Folder
Dim Dic
Dim FolderItem
Dim SFV

If WScript.Arguments.Count() Then
arg=WScript.Arguments.Item(0)
Else
arg=CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2).Path
End If
Set ix=CreateObject("InternetExplorer.Application")
ix.Navigate "file://"&arg
Do While ix.Busy Or ix.ReadyState<>4
WScript.Sleep 100
Loop
Set Folder=ix.Document.Folder

Set ie=CreateObject("InternetExplorer.Application")
ie.AddressBar=False
ie.ToolBar=False
ie.MenuBar=False
ie.StatusBar=False
ie.Navigate "about:blank"
ie.Visible=True
Do While ie.Busy Or ie.ReadyState<>4
WScript.Sleep 100
Loop
ie.Document.Title="フォルダ監視中 - "&arg

Set Dic=CreateObject("Scripting.Dictionary")
For Each FolderItem In Folder.Items()
Dic.Add FolderItem.Path,FolderItem.ModifyDate
Next
Set SFV=CreateObject("Shell.FolderView.1")
SFV.SetFolderView ix.Document
WScript.ConnectObject SFV,"SFV_"

Do While TypeName(ie)="IWebBrowser2"
Try_EnumDone
If Err Then Exit Do
WScript.Sleep 1000
Loop
'MsgBox "Watch Ended."&" - "&arg,vbInformation,WScript.ScriptName

Sub Try_EnumDone()
On Error Resume Next
SFV_EnumDone
End Sub

Sub SFV_EnumDone()
Dim Dic2
Dim Path
Dim fChanged
'WScript.Echo "EnumDone"
Set Dic2=CreateObject("Scripting.Dictionary")
For Each FolderItem In Folder.Items()
Dic2.Add FolderItem.Path,FolderItem.ModifyDate
If Dic.Exists(FolderItem.Path) Then
If Dic.Item(FolderItem.Path)<>Dic2.Item(FolderItem.Path) Then
ie.Document.body.insertAdjacentText "BeforeEnd",Join(Array(Now,"変更",FolderItem.Path,Dic.Item(FolderItem.Path),Dic2.Item(FolderItem.Path)),vbTab)&vbCrLf
fChanged=True
End If
Dic.Remove FolderItem.Path
Else
ie.Document.body.insertAdjacentText "BeforeEnd",Join(Array(Now,"作成",FolderItem.Path,Dic2.Item(FolderItem.Path)),vbTab)&vbCrLf
fChanged=True
End If
Next
For Each Path In Dic.Keys()
ie.Document.body.insertAdjacentText "BeforeEnd",Join(Array(Now,"削除",Path,Dic.Item(Path)),vbTab)&vbCrLf
fChanged=True
Next
Set Dic=Dic2
If fChanged Then
ie.Document.parentWindow.scrollBy 0,ie.Document.body.scrollHeight
ie.Visible=True
End If
End Sub
--------------------------------------------------------------------------------