特定のフォルダに保存されているファイルの監視。
・ファイルが改ざんされてないか。
・勝手にファイルが置かれていないか。
をチェックする為のスプリクトです。

Web サーバで公開しているファイルを監視するのが目的ですが
「公開ファイル」を監視するって目的ですので P2P でも FTP フォルダにでも
応用出来るでしょう。

FileChecker.wsf  監視プログラム
inc.vbs     サブルーチンファイル(インクルード)
main.vbs     メインファイル(インクルード)
list.txt     監視フォルダ定義ファイル(ファイル名は何でも良い)
ダウンロード


list.txt は、フォルダリストで 1 行 1 フォルダを指定します。(ファイル名は何でも良い)

サブフォルダ内のファイルは監視しませんので
監視する場合はそのフォルダを指定して下さい。

例)
list.txt------------
C:\Inetpub\wwwroot
C:\www
C:\ftp
--------------------


監視する為のインデックス作成手順

1.list.txt を編集して監視したいフォルダを記述します。

2.FileChecker.wsf に作成した list.txt をドラッグ&ドロップします。

  この作業を行なうと、FileChecker.wsf と同一フォルダ上に「LIST.MDB」
  を自動作成します。(Access 2000 用の MDB ファイル)


3.FileChecker.wsf をクリックして実行すると、この MDB 内のデータと監視フォルダを
  比較します。

※
FileChecker.wsf をタスクスケジューラに設定すれば定期的に監視する事が出来ます。
インデックスと監視フォルダが不一致の場合、アプリケーションログにエラー内容を書き込みます。
ソースを書き換えればメールを送信したり、バックアップしたファイルに戻すって事も可能です。


ソース inc.vbs Dim DB, CMD, RS, SQL Function Open_MDB(DBF) 'ACCESSファイルのオープン On Error Resume Next Err.Clear Set DB = WScript.CreateObject("ADODB.Connection") With DB .ConnectionString = DBF .Provider = "Microsoft.Jet.OLEDB.4.0" .ConnectionTimeout = 90 .CommandTimeout = 90 .Mode = 3 .CursorLocation=3 .Open .Errors.Clear End With Set CMD = WScript.CreateObject("ADODB.Command") With CMD .ActiveConnection = DB .CommandType = &h0001 .CommandTimeout = 90 .Prepared = True End With If Err.Number <> 0 Then Open_MDB = False Else Open_MDB = True End If On Error Goto 0 End Function '********************************************************************************** Function EXEC_CMD(strSQL) On Error Resume Next Err.Clear CMD.CommandText = strSQL EXEC_CMD = CMD.Execute If Err.number<>0 Then EXEC_CMD = False Else EXEC_CMD = True End If On Error Goto 0 End Function '********************************************************************************** Sub Close_DB() RS.Close DB.Close Set RS = Nothing Set CMD = Nothing Set DB = Nothing End Sub '********************************************************************************** 'IE メッセージ表示生成処理 Function ieView(msg) Dim viewHD, viewFT Dim Stm, Mtm, Htm, Dtm etime = Now() Stm = DateDiff("s",stime,etime) '秒 Dtm = Stm \ 86400 Htm = (Stm Mod 86400) \ 3600 Mtm = ((Stm Mod 86400) Mod 3600) \ 60 Stm = ((Stm Mod 86400) Mod 3600) Mod 60 If Dtm <> 0 Then etime = Dtm & " 日と " & _ Right("00" & Htm, 2) & " 時間 " & _ Right("00" & Mtm, 2) & " 分 " & _ Right("00" & Stm, 2) & " 秒" ElseIf Htm <> 0 Then etime = Right("00" & Htm, 2) & " 時間 " & _ Right("00" & Mtm, 2) & " 分 " & _ Right("00" & Stm, 2) & " 秒" ElseIf Mtm <> 0 Then etime = Right("00" & Mtm, 2) & " 分 " & _ Right("00" & Stm, 2) & " 秒" Else etime = Right("00" & Stm, 2) & " 秒" End If viewHD = "<font size=-2>開始< " & FormatDateTime(stime,0) & _ " >  経過< " & etime & " ><br />" viewFT = "" ieView = viewHD & "<font size=""-1"">" & msg & "</font>" & viewFT End Function '********************************************************************************** ソース main.vbs Option Explicit Dim Args, Fs, Fl, sFl, File, Dic, objIE, WshShell Dim stime, etime Dim CAT, TBL, COL, keyX Dim RS2 Dim IDX Dim CNT Dim FLD Dim key Dim LogData Dim FolderPass, FileName Dim D '********************************************************************************** stime = Now() Const MDBFN = "LIST.MDB" '保存データベース名 '********************************************************************************** Set Args = WScript.Arguments Set Fs = WScript.CreateObject("Scripting.FileSystemObject") Set Dic = WScript.CreateObject("Scripting.Dictionary") 'Dictionary オブジェクト 'http://www.microsoft.com/japan/msdn/library/default.asp?url=/japan/msdn/library/ja/script56/html/jsobjDictionary.asp Set objIE = WScript.CreateObject("InternetExplorer.Application") Set WshShell = WScript.CreateObject("WScript.Shell") Set CAT = WScript.CreateObject("ADOX.Catalog") Set RS = WScript.CreateObject("ADODB.RecordSet") 'ADOX用定義 Const adBinary = 128 'バイナリ値を示します (DBTYPE_BYTES)。 Const adBoolean = 11 'ブール値型 Const adCurrency = 6 '通貨型 Const adDate = 7 '日付時刻型 Const adDouble = 5 '倍精度浮動小数点数型 Const adGUID = 72 'オートナンバー型 Const adInteger = 3 '長整数型 Const adLongVarBinary = 205 '長バイナリ値を示します (Parameter オブジェクトのみ)。 Const adLongVarWChar = 203 'メモ型 Const adSingle = 4 '単精度浮動小数点数型 Const adSmallInt = 2 '整数型 Const adUnsignedTinyInt = 17 '1 バイトの符号なし整数を示します (DBTYPE_I1)。 Const adVarBinary = 204 'バイナリ値を示します (Parameter オブジェクトのみ)。 Const adVarWChar = 202 'テキスト型 Const adWChar = 130 'Null で終了する Unicode 文字列を示します (DBTYPE_WSTR)。 FLD = Fs.GetParentFolderName(WScript.ScriptFullName) '********************************************************************************** 'ドラッグ&ドロップでファイル名取得&データ読み取り If Args.Count <> 0 Then Dim FN, FDN, TFs Dim strFD FN = Args(0) FDN = Fs.GetParentFolderName(FN) Set TFs = Fs.OpenTextFile(FN, 1) Dic.RemoveAll '初期化 Dic.CompareMode = 1 'キーの比較をバイナリモードに設定 Do While Not TFs.AtEndOfStream strFD = Fs.GetAbsolutePathName(TFs.ReadLine) If Fs.FolderExists(strFD) = False Then Wscript.Echo TFs.Line & "行目でエラーが発生しました。" & _ vbCrLf & "指定したフォルダは見付りません。" & _ vbCrLf & "『" & strFD & "』" TFs.Close Set TFs = Nothing Set Fs = Nothing Set Dic = Nothing Set Args = Nothing Wscript.Quit End If Dic.Add TFs.Line, CStr(strFD) Loop TFs.Close Set TFs = Nothing With objIE .Left = 50 'Windows position .Top = 100 .Height = 128 'Windows size .Width = 450 .Menubar = 0 'メニュ−バ−の表示 True(1)/False(0) .Toolbar = 0 'ツ−ルバ−表示 True(1)/False(0) .StatusBar = 0 'ステ−タスバ−の表示 True(1)/False(0) .AddressBar = 0 'アドレスバーの表示 True(1)/False(0) .Navigate "about:blank" Do While (.Busy) Wscript.Sleep 100 Loop .Visible = 1 .Document.Body.InnerHTML = ieView("データベースファイルを新規作成中…") 'データベースが存在する場合は削除 If Fs.FileExists(Fs.BuildPath(FLD,MDBFN)) Then Fs.DeleteFile Fs.BuildPath(FLD,MDBFN), True End If 'データベースの新規作成 'Access2000形式のファイル作成 CAT.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fs.BuildPath(FLD,MDBFN) & ";Jet OLEDB:Engine Type=5;" CAT.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fs.BuildPath(FLD,MDBFN) & ";Jet OLEDB:Engine Type=5;" Set COL = WScript.CreateObject("ADOX.Column") Set TBL = WScript.CreateObject("ADOX.Table") TBL.Name = "T_監視フォルダ" CAT.Tables.Append TBL 'オートナンバー設定 COL.Name = "ID" ' フィールド名 COL.Type = adInteger ' データ型 COL.ParentCatalog = CAT ' Properties を設定する前に ParentCatalog の設定が必須 COL.Properties("Autoincrement") = True ' オートナンバーの指定 CAT.Tables("T_監視フォルダ").Columns.Append COL '主キー設定 Set keyX = WScript.CreateObject("ADOX.Key") keyX.Name = "PrimaryKey" ' 任意の名前を割り当てる keyX.Type = 1 keyX.RelatedTable = "T_監視フォルダ" ' 対象の既存テーブル名を指定 keyX.Columns.Append "ID" ' キーフィールドの追加 CAT.Tables("T_監視フォルダ").Keys.Append keyX 'フィールドの定義 With CAT.Tables("T_監視フォルダ").Columns .Append "FolderPass", adLongVarWChar 'フォルダ名 .Append "FolderDateCreated", adDate '作成日 .Append "FolderDateLastModified", adDate '最終更新日 .Append "FolderSize", adInteger 'サイズ .Append "SubFolderCount", adInteger 'フォルダ数 .Append "FileCount", adInteger 'ファイル数 .Append "SubFolder", adBoolean 'サブフォルダ .Append "CheckFlag", adBoolean '確認済みフラグ End With Set keyX = Nothing Set COL = Nothing Set TBL = Nothing Set COL = WScript.CreateObject("ADOX.Column") Set TBL = WScript.CreateObject("ADOX.Table") TBL.Name = "T_監視ファイル" CAT.Tables.Append TBL 'オートナンバー設定 COL.Name = "ID" COL.Type = adInteger COL.ParentCatalog = CAT COL.Properties("Autoincrement") = True CAT.Tables("T_監視ファイル").Columns.Append COL 'フィールドの定義 With CAT.Tables("T_監視ファイル").Columns .Append "IDX", adInteger .Append "FileDateCreated", adDate '作成日 .Append "FileDateLastModified", adDate '最終更新日 .Append "FileName", adVarWChar, 255 'ファイル名 .Append "FileSize", adInteger 'ファイルサイズ .Append "FolderPass", adLongVarWChar 'フォルダ名 .Append "CheckFlag", adBoolean '確認済みフラグ End With '主キー設定 Set keyX = WScript.CreateObject("ADOX.Key") keyX.Name = "PrimaryKey" keyX.Type = 1 keyX.RelatedTable = "T_監視ファイル" keyX.Columns.Append "ID" keyX.Columns.Append "IDX" CAT.Tables("T_監視ファイル").Keys.Append keyX Set keyX = Nothing Set COL = Nothing Set TBL = Nothing .Document.Body.InnerHTML = ieView("インデックステーブル作成中…") If Open_MDB(Fs.BuildPath(FLD,MDBFN)) Then SQL = "SELECT * FROM [T_監視フォルダ]" Set RS = WScript.CreateObject("ADODB.RecordSet") RS.Open SQL, DB, 3, 3 For Each key In Dic.keys Set Fl = Fs.GetFolder(Dic.Item(key)) .Document.Body.InnerHTML = ieView("インデックステーブル作成中…<br>" & Dic.Item(key)) RS.AddNew RS.Fields("FolderPass").Value = Dic.Item(key) RS.Fields("FolderDateCreated").Value = Fl.DateCreated RS.Fields("FolderDateLastModified").Value = Fl.DateLastModified RS.Fields("FolderSize").Value = Fl.Size RS.Fields("SubFolder").Value = False RS.Fields("SubFolderCount").Value = Fl.SubFolders.Count RS.Fields("FileCount").Value = Fl.Files.Count RS.Update For Each sFl In Fl.SubFolders 'サブフォルダの登録 .Document.Body.InnerHTML = ieView("インデックステーブル作成中…<br>" & sFl.Path) RS.AddNew RS.Fields("FolderPass").Value = sFl.Path RS.Fields("FolderDateCreated").Value = sFl.DateCreated RS.Fields("FolderDateLastModified").Value = sFl.DateLastModified RS.Fields("FolderSize").Value = sFl.Size RS.Fields("SubFolder").Value = True RS.Fields("SubFolderCount").Value = sFl.SubFolders.Count RS.Fields("FileCount").Value = sFl.Files.Count RS.Update Next Next RS.Close 'カタログファイル再構築 Dic.RemoveAll '初期化 Dic.CompareMode = 1 'キーの比較をバイナリモードに設定 SQL = "SELECT ID, FolderPass FROM [T_監視フォルダ] WHERE SubFolder=False ORDER BY ID" RS.Open SQL, DB, 3, 1 Do Until RS.Eof Dic.Add CInt(RS.Fields("ID").Value), CStr(RS.Fields("FolderPass").Value) RS.MoveNext Loop RS.Close '監視ファイル登録 SQL = "SELECT * FROM [T_監視ファイル]" RS.Open SQL, DB, 3, 3 For Each key In Dic.keys Set Fl = Fs.GetFolder(Dic.Item(key)) For Each File In Fl.Files .Document.Body.InnerHTML = ieView("インデックステーブル作成中…<br>" & Dic.Item(key) & "\" & File.Name) RS.AddNew RS.Fields("IDX").Value = key RS.Fields("FileDateCreated").Value = File.DateCreated RS.Fields("FileDateLastModified").Value = File.DateLastModified RS.Fields("FileName").Value = File.Name RS.Fields("FileSize").Value = File.Size RS.Fields("FolderPass").Value = File.ParentFolder RS.Update Next Next Call Close_DB() Set Fl = Nothing On Error Goto 0 Else .Document.Body.InnerHTML = ieView("データベースのオープンに失敗しました。") Wscript.Quit End If .Document.Body.InnerHTML = ieView("完了しました。") Wscript.Sleep 2000 .Quit End With Wscript.Quit End If '********************************************************************************** 'データベースの確認 If Fs.FileExists(Fs.BuildPath(FLD,MDBFN))=False Then Wscript.Echo "監視フォルダが定義されていません。" & vbCrLf & vbCrLf & _ "定義ファイルの作成例" & vbCrLf & _ "- list.dat -----------------" & vbCrLf & _ "C:\Inetpub\wwwroot" & vbCrLf & _ "C:\www" & vbCrLf & _ "C:\ftp" & vbCrLf & _ " :" & vbCrLf & _ " :" & vbCrLf & _ "-------------------------" & vbCrLf & vbCrLf & _ "のように1行につき、一つのフォルダを指定したファイルを作成し" & vbCrLf & _ "このプログラムにドラッグ&ドロップして下さい。" & vbCrLf & _ "このプログラムと同一フォルダに『 LIST.MDB 』が作成します。" End If If Open_MDB(Fs.BuildPath(FLD,MDBFN)) Then 'フラグのリセット SQL = "UPDATE T_監視フォルダ SET CheckFlag=False" If EXEC_CMD(SQL)=False Then '初期化失敗時のエラー処理 End If SQL = "UPDATE T_監視ファイル SET CheckFlag=False" If EXEC_CMD(SQL)=False Then '初期化失敗時のエラー処理 End If '監視フォルダの&新規フォルダの確認 D = Now() LogData = D & vbCrLf On Error Resume Next SQL = "SELECT * FROM T_監視フォルダ ORDER BY ID" Set RS = WScript.CreateObject("ADODB.RecordSet") Set RS2 = WScript.CreateObject("ADODB.RecordSet") RS.Open SQL, DB, 3, 3 Do Until RS.Eof CNT = 0 FolderPass = RS.Fields("FolderPass").Value ERR.Clear Set Fl = Fs.GetFolder(FolderPass) If ERR.Number <> 0 Then LogData = LogData & "監視フォルダが見付かりませんでした。[ " & FolderPass & " ]" & vbCrLf & vbCrLf Else If RS.Fields("FolderDateCreated").Value <> Fl.DateCreated Then LogData = LogData & "監視フォルダの作成日が一致しません。[ " & FolderPass & " ]" & vbCrLf & _ "作成日 インデックス内:[ " & RS.Fields("FolderDateCreated").Value & " ] 監視フォルダ内:[ " & Fl.DateCreated & " ]" & vbCrLf End If If RS.Fields("FolderDateLastModified").Value <> Fl.DateLastModified Then LogData = LogData & "監視フォルダの更新日が一致しません。[ " & FolderPass & " ]" & vbCrLf & _ "更新日 インデックス内:[ " & RS.Fields("FolderDateLastModified").Value & " ] 監視フォルダ内:[ " & Fl.DateLastModified & " ]" & vbCrLf End If If RS.Fields("FolderSize").Value <> Fl.Size Then LogData = LogData & "監視フォルダ内のサイズが一致しません。[ " & FolderPass & " ]" & vbCrLf & _ "容量 インデックス内:[ " & RS.Fields("FolderSize").Value & " ] 監視フォルダ内:[ " & Fl.Size & " ]" & vbCrLf End If If RS.Fields("SubFolderCount").Value <> Fl.SubFolders.Count Then LogData = LogData & "監視フォルダ内のサブフォルダ数が一致しません。[ " & FolderPass & " ]" & vbCrLf & _ "サブフォルダ インデックス内:[ " & RS.Fields("SubFolderCount").Value & " ] 監視フォルダ内:[ " & Fl.SubFolders.Count & " ]" & vbCrLf If RS.Fields("SubFolder").Value = False Then If RS.Fields("SubFolderCount").Value < Fl.SubFolders.Count And RS.Fields("SubFolderCount").Value Then '新規フォルダをチェック For Each sFl In Fl.SubFolders SQL = "SELECT * FROM T_監視フォルダ WHERE FolderPass='" & Replace(sFl.Path,"'","''") & "'" RS2.Open SQL, DB, 3, 1 If RS2.Eof Then LogData = LogData & vbCrLf & "監視フォルダ内に新規サブフォルダが作成されています。[ " & sFl.Path & " ]" & vbCrLf & vbCrLf End If RS2.Close Next End If End If End If If RS.Fields("FileCount").Value <> Fl.Files.Count Then LogData = LogData & "監視フォルダ内のファイル数が一致しません。[ " & FolderPass & " ]" & vbCrLf & _ "ファイル数 インデックス内:[ " & RS.Fields("FileCount").Value & " ] 監視フォルダ内:[ " & Fl.Files.Count & " ]" & vbCrLf '一致しないファイルを探す If RS.Fields("FileCount").Value < Fl.Files.Count Then For Each File In Fl.Files SQL = "SELECT * FROM T_監視ファイル WHERE IDX = " & RS.Fields("ID").Value & _ " AND FileName='" & Replace(Fl.Name,"'","''") & "'" RS2.Open SQL, DB, 3, 3 If Not RS2.Eof Then FileName = File.Name If RS2.Fields("FileDateCreated").Value <> File.DateCreated Then LogData = LogData & "作成日が一致しません。[ " & FileName & " ]" & vbCrLf & _ "作成日 インデックス内:[ " & RS2.Fields("FileDateCreated").Value & " ] 監視ファイル:[ " & File.DateCreated & " ]" & vbCrLf End If If RS2.Fields("FileDateLastModified").Value <> File.DateLastModified Then LogData = LogData & "更新日が一致しません。[ " & FileName & " ]" & vbCrLf & _ "更新日 インデックス内:[ " & RS2.Fields("FileDateLastModified").Value & " ] 監視ファイル:[ " & File.DateLastModified & " ]" & vbCrLf End If If RS2.Fields("FileSize").Value <> File.Size Then LogData = LogData & "ファイルサイズが一致しません。[ " & FileName & " ]" & vbCrLf & _ "サイズ インデックス内:[ " & RS2.Fields("FileSize").Value & " ] 監視ファイル:[ " & File.Size & " ]" & vbCrLf End If RS2.Fields("CheckFlag").Value = True RS2.Update End If RS2.Close Next End If End If 'ファイル監査 SQL = "SELECT * FROM T_監視ファイル WHERE IDX = " & RS.Fields("ID").Value & " AND CheckFlag=False" RS2.Open SQL, DB, 3, 3 Do Until RS2.Eof ERR.Clear Set File = Fs.GetFile(Fs.BuildPath(CStr(RS2.Fields("FolderPass").Value), CStr(RS2.Fields("FileName").Value))) If ERR.Number <> 0 Then LogData = LogData & "監視ファイルが見付かりませんでした。[ " & RS2.Fields("FileName").Value & " ]" & vbCrLf & vbCrLf Else FileName = File.Name If RS2.Fields("FileDateCreated").Value <> File.DateCreated Then LogData = LogData & "作成日が一致しません。[ " & FileName & " ]" & vbCrLf & _ "作成日 インデックス内:[ " & RS2.Fields("FileDateCreated").Value & " ] 監視ファイル:[ " & File.DateCreated & " ]" & vbCrLf End If If RS2.Fields("FileDateLastModified").Value <> File.DateLastModified Then LogData = LogData & "更新日が一致しません。[ " & FileName & " ]" & vbCrLf & _ "更新日 インデックス内:[ " & RS2.Fields("FileDateLastModified").Value & " ] 監視ファイル:[ " & File.DateLastModified & " ]" & vbCrLf End If If RS2.Fields("FileSize").Value <> File.Size Then LogData = LogData & "ファイルサイズが一致しません。[ " & FileName & " ]" & vbCrLf & _ "サイズ インデックス内:[ " & RS2.Fields("FileSize").Value & " ] 監視ファイル:[ " & File.Size & " ]" & vbCrLf End If End If 'RS2.Fields("CheckFlag").Value = True 'RS2.Update '↑XP, 2003 ではなぜか動かない SQL = "UPDATE T_監視ファイル SET CheckFlag=True WHERE ID=" & RS.Fields("ID").Value Call EXEC_CMD(SQL) RS2.MoveNext Loop RS2.Close End If RS.Fields("CheckFlag").Value = True RS.Update RS.MoveNext Loop Set RS2 = Nothing Call Close_DB() End If '********************************************************************************** ソース FileChecker.wsf <job id="FileChecker"> <script language="VBScript" src="inc.vbs"/> <script language="VBScript" src="main.vbs" /> <script language="VBScript"> If IsDate(LogData) = False Then WshShell.LogEvent 16, "監視フォルダに異常が見付かりました。" & vbCrLf & LogData Else WshShell.LogEvent 8, "正常" End If Wscript.Quit </script> </job> WSF(Windows Script File) http://www.microsoft.com/japan/msdn/library/ja/script56/html/wsoriXMLElements.asp ソース list.txt ※監視するフォルダを記述する。 C:\Inetpub\wwwroot C:\www C:\ftp