|
|||||
<このサンプルの概要> フォルダ内のファイルを監視してファイルが新規作成、更新、削除された事を監視するサンプルです。 指定フォルダ以下の全てのファイルを監視します。 関連するツールはこちらです。 ・PC状況メール通知(PcEvMail) PC起動/PC終了/ログイン/ログアウト/ファイル更新時にメール通知/ログ出力するツールです。 ・ファイル監視人 ファイルやフォルダの更新時にメッセージ表示またはメール送信するツールです。 ・フォルダ監視人 フォルダ内のファイル更新時に更新通知(差分メール等)、指定プログラム実行するツールです。 このサンプルはSystem.IO.DirectoryInfoを使用しフォルダ内のファイル一覧を取得しています。 そのファイル一覧を使用してファイル追加チェックおよびファイル削除チェックをしています。 System.IO.File.GetLastWriteTimeを使用してファイルの更新日時チェックをしています。 ファイルが更新された事をすぐに知りたいと言う要望を聞く事があり、 そんな時にこのサンプルが役に立つかも知れません。 C#.NET版はこちらです。 フォルダを監視(ファイルの追加/変更/削除)するサンプル(C#.NET) ★フォーム・クラス(Form1.vb) Public Class Form1 Private fpath As String ' 監視するフォルダPATH Private flist_old As String() ' 監視するフォルダ内のファイル一覧(PATH,更新日時) ' フォームロード時に監視フォルダの初期処理 Private Sub Form1_Load( _ ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load ' 監視するフォルダPATH設定 fpath = "D:\Temp\Test" ' 監視するフォルダ内のファイル一覧取得(PATH,更新日時) flist_old = GetFList(fpath) End Sub ' タイマーで監視フォルダの変更チェック Private Sub Timer1_Tick( _ ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick ' 監視するフォルダ内のファイル一覧取得(PATH,更新日時) Dim flist_new As String() = GetFList(fpath) ' フォルダ内のファイル更新チェック(追加/変更/削除) Dim fcmp As String() = FolderCompare(flist_old, flist_new) ' ファイル更新チェック結果表示 For i As Integer = 0 To fcmp.Length - 1 Dim kbn As String() = fcmp(i).Split(vbTab) If kbn(0) <> "___" Then System.Diagnostics.Debug.Print("" & (i + 1) & ":" & fcmp(i)) End If Next ' 変更後情報を変更前情報として保存 flist_old = flist_new End Sub ' ファイル一覧(PATH,更新日時)を比較し ' 比較結果一覧(区分,PATH,更新日時1,更新日時2)を返す Public Function FolderCompare(ByVal ls1 As String(), ByVal ls2 As String()) As String() Dim fpt As String = fpath If fpt.Substring(fpt.Length - 1, 1) <> "\" Then fpt = fpt & "\" Dim fc As String() = New String(-1) {} Dim p1 As Integer = 0 Dim p2 As Integer = 0 Do ' ファイル1の情報(PATH,更新日時) Dim fd1 As String() = New String(1) {"", ""} ' ファイル2の情報(PATH,更新日時) Dim fd2 As String() = New String(1) {"", ""} ' 更新タイプ(0:同じ,1:追加,2:削除,3:更新) Dim upd As Integer = 0 If p1 >= ls1.Length Then If p2 >= ls2.Length Then ' 比較完了 Exit Do Else ' 追加ファイル発見 fd2 = ls2(p2).Split(vbTab) ' 相対PATHに変換 fd2(0) = fd2(0).Replace(fpt, "") upd = 1 End If ElseIf p2 >= ls2.Length Then If p1 >= ls1.Length Then ' 比較完了 Exit Do Else ' 削除ファイル発見 fd1 = Split(ls1(p1) & vbTab & vbTab, vbTab) ' 相対PATHに変換 fd1(0) = fd1(0).Replace(fpt, "") upd = 2 End If Else fd1 = Split(ls1(p1) & vbTab & vbTab, vbTab) fd2 = Split(ls2(p2) & vbTab & vbTab, vbTab) ' 相対PATHに変換 fd1(0) = fd1(0).Replace(fpt, "") fd2(0) = fd2(0).Replace(fpt, "") If fd1(0).ToLower > fd2(0).ToLower Then ' 追加ファイル発見 upd = 1 ElseIf fd1(0).ToLower < fd2(0).ToLower Then ' 削除ファイル発見 upd = 2 Else ' ファイルの更新日時を比較する If upd = 0 Then Dim dt1 As String = fd1(1) Dim dt2 As String = fd2(1) If dt1 <> dt2 Then ' 更新ファイル発見 upd = 3 End If End If End If End If ' 結果一覧へ追加 Dim fn As String = fd1(0) ' ファイルPATH Dim od As String = fd1(1) ' ファイル更新日時1 Dim nd As String = fd2(1) ' ファイル更新日時2 If upd = 0 Then ' 同じファイルの情報 Dim recdt As String = fn & vbTab & od & vbTab & nd ReDim Preserve fc(fc.Length) fc(fc.Length - 1) = "___" & vbTab & recdt p1 += 1 p2 += 1 ElseIf upd = 1 Then ' 追加ファイルの情報 fn = fd2(0) Dim recdt As String = fn & vbTab & "" & vbTab & nd ReDim Preserve fc(fc.Length) fc(fc.Length - 1) = "ADD" & vbTab & recdt p2 += 1 ElseIf upd = 2 Then ' 削除ファイルの情報 Dim recdt As String = fn & vbTab & od & vbTab & "" ReDim Preserve fc(fc.Length) fc(fc.Length - 1) = "DEL" & vbTab & recdt p1 += 1 ElseIf upd = 3 Then ' 更新ファイルの情報 Dim recdt As String = fn & vbTab & od & vbTab & nd ReDim Preserve fc(fc.Length) fc(fc.Length - 1) = "UPD" & vbTab & recdt p1 += 1 p2 += 1 End If Loop Return fc End Function ' フォルダ内のファイル一覧取得(PATH,更新日時) Private Function GetFList(ByVal pt As String) As String() Dim ls As String() = New String(-1) {} Dim l2 As String() = New String(-1) {} Dim ln As Integer ' ファイル一覧/フォルダ一覧取得初期設定 If IO.Directory.Exists(IO.Path.GetPathRoot(pt)) Then ' ドライブ存在OK If IO.File.Exists(pt) Then ' 指定ファイル初期設定 ReDim Preserve ls(0) ls(0) = pt ElseIf IO.Directory.Exists(pt) Then ' 指定フォルダ初期設定 ReDim Preserve ls(0) ls(0) = pt ln = ls(0).Length If ls(0).Substring(ln - 1) <> "\" Then ls(0) = ls(0) & "\" End If GetFList_Sub(pt, ls) ' ファイル名の昇順 Array.Sort(ls) End If Else ' ドライブ存在NG Throw New Exception("Drive Not Found(" & IO.Path.GetPathRoot(pt) & ")") End If ' ファイルの更新日時取得 For i As Integer = 0 To ls.Length - 1 Dim fp As String = ls(i) ln = ls(i).Length If ls(i).Substring(ln - 1) <> "\" Then ' ファイルのみ一覧に加える Dim fi As New IO.FileInfo(ls(i)) Dim df As String = "yyyy/MM/dd HH:mm:ss" Dim dt As String = fi.LastWriteTime.ToString(df) ReDim Preserve l2(l2.Length) ' タブ区切り(PATH,更新日時) l2(l2.Length - 1) = fp & vbTab & dt End If Next Return l2 End Function ' 再帰的にフォルダ内のファイル一覧取得(PATH,更新日時) Private Sub GetFList_Sub(ByVal pt As String, ByRef ls As String()) ' フォルダの情報取得 Dim di As IO.DirectoryInfo = New IO.DirectoryInfo(pt) ' ファイルの一覧取得 Dim sf As IO.FileInfo() = di.GetFiles() For i As Integer = 0 To sf.Length - 1 ReDim Preserve ls(ls.Length) ls(ls.Length - 1) = sf(i).FullName Next ' フォルダの一覧取得 Dim sd As IO.DirectoryInfo() = di.GetDirectories() For i As Integer = 0 To sd.Length - 1 ReDim Preserve ls(ls.Length) ls(ls.Length - 1) = sd(i).FullName & "\" Dim sds As String() = New String(-1) {} GetFList_Sub(sd(i).FullName, sds) For j As Integer = 0 To sds.Length - 1 ReDim Preserve ls(ls.Length) ls(ls.Length - 1) = sds(j) Next Next End Sub End Class |