NonSoft

フォルダを監視(ファイルの追加/変更/削除)する
サンプル(VB.NET)


 サンプル(ソース/コード)
<このサンプルの概要>
フォルダ内のファイルを監視してファイルが新規作成、更新、削除された事を監視するサンプルです。
指定フォルダ以下の全てのファイルを監視します。

関連するツールはこちらです。
・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