Ejemplos usando el Api de windows para Visual basic

250 - Monitorear cambios en carpetas y archivos

Módulo de clase para poder notificar y capturar cuando se producen cambios en un directorio o archivo usando algunas funciones del Api

En este ejemplo se usan las funciones FindFirstChangeNotification, FindCloseChangeNotification y FindNextChangeNotification

Para usar el módulo se debe indicar:

El path del archivo o directorio al cual se va a monitorear
El intervalo de monitoreo, por ejemplo 100 milisegundos
Indicar si se incluyen o no los subdirectorios ( en caso de que se monitoree una carpeta )
Indicar los flags

Por ejemplo

    ' nueva instancia de class1
    Set Obj1 = New Class1
    
    With Obj1
        .Intervalo = 100 ' tiempo en milisegundos
        ' flags
        .FLAGS = FILE_NOTIFY_CHANGE_FILE_NAME Or _
                 FILE_NOTIFY_CHANGE_DIR_NAME Or _
                 FILE_NOTIFY_CHANGE_LAST_WRITE Or _
                 FILE_NOTIFY_CHANGE_ATTRIBUTES
    
        .IncluirSubdir = True ' incluye subcarpetas
        .Path = "c:\windows" ' ruta
    End With

Los Flags determinan que cambios se deberán notificar, por ejemplo: cambios en archivos, en solo directorios, en ambos, cambio en el tamaño, cambio en todos los atributos , cuando se crea y otros . (Estos se pueden combinar con el operador Or )

Por ejemplo para notificar todos los posibles cambios :

        .FLAGS = FILE_NOTIFY_CHANGE_FILE_NAME Or _
                 FILE_NOTIFY_CHANGE_ATTRIBUTES Or _
                 FILE_NOTIFY_CHANGE_DIR_NAME Or _
                 FILE_NOTIFY_CHANGE_CREATION Or _
                 FILE_NOTIFY_CHANGE_LAST_ACCESS Or _
                 FILE_NOTIFY_CHANGE_LAST_WRITE Or _
                 FILE_NOTIFY_CHANGE_SIZE

Luego para comenzar a monitorear, ejecutar el método Comenzar

Obj1.Comenzar

Para terminar

Obj1.Detener

Cuando se produce un cambio en el directorio o carpeta , se dispara el evento Change

Formulario de Ejemplo

Agregar dos Comamndbutton

Código fuente en el formulario

Private WithEvents Obj1 As Class1 Private Sub Command1_Click() Obj1.Comenzar End Sub Private Sub Command2_Click() Obj1.Detener End Sub Private Sub Form_Load() ' nueva instancia Set Obj1 = New Class1 With Obj1 .Intervalo = 100 ' tiempo ' flags (Archivos y directorios ) .FLAGS = FILE_NOTIFY_CHANGE_FILE_NAME Or _ FILE_NOTIFY_CHANGE_DIR_NAME .IncluirSubdir = True ' incluye subcarpetas .Path = "c:\windows" ' ruta End With Command1.Caption = "Comenzar" Command2.Caption = "Detener" End Sub ' finaliza ''''''''''''' Private Sub Form_Unload(Cancel As Integer) Obj1.Detener Set Obj1 = Nothing End Sub ' cambios en el directorio o archivo ''''''''''''''''''''''''''''''''''''''' Private Sub Obj1_Change(Spath As String) MsgBox "El Path : " & Spath & " ha cambiado", vbInformation End Sub ' comienzo ''''''''''''''''''''''''''''''''''''''''' Private Sub Obj1_Inicio(Spath As String) MsgBox "Comienzo para monitorear cambios en : " & _ Spath, vbInformation End Sub ' fin ''''''''''''''''''''''''''''''''''''''''''''' Private Sub Obj1_Terminado(Spath As String) MsgBox "Terminado", vbInformation End Sub

Código fuente en un módulo de clase llamado Class1

Option Explicit ' declaraciones Api y constantes '''''''''''''''''''''''''''''''''''''''''''' Private Const INFINITE = &HFFFF Enum EFlags FILE_NOTIFY_CHANGE_FILE_NAME = &H1 FILE_NOTIFY_CHANGE_DIR_NAME = &H2 FILE_NOTIFY_CHANGE_ATTRIBUTES = &H4 FILE_NOTIFY_CHANGE_SIZE = &H8 FILE_NOTIFY_CHANGE_LAST_WRITE = &H10 FILE_NOTIFY_CHANGE_LAST_ACCESS = &H20 FILE_NOTIFY_CHANGE_CREATION = &H40 FILE_NOTIFY_CHANGE_SECURITY = &H100 End Enum Private Declare Function FindFirstChangeNotification Lib "kernel32" _ Alias "FindFirstChangeNotificationA" _ (ByVal lpPathName As String, _ ByVal bWatchSubtree As Long, _ ByVal dwNotifyFilter As Long) As Long Private Declare Function FindCloseChangeNotification Lib "kernel32" _ (ByVal hChangeHandle As Long) As Long Private Declare Function FindNextChangeNotification Lib "kernel32" _ (ByVal hChangeHandle As Long) As Long Private Declare Function WaitForSingleObject Lib "kernel32" _ (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long Private Const WAIT_OBJECT_0 = &H0 Private Const WAIT_ABANDONED = &H80 Private Const WAIT_IO_COMPLETION = &HC0 Private Const WAIT_TIMEOUT = &H102 Private Const STATUS_PENDING = &H103 ''''''''''''''''''''''''''''''''''''''''''''''' Dim Handle As Long Dim terminateFlag As Long Dim mPath As String Dim mIntervalo As Long Public FLAGS As EFlags Public IncluirSubdir As Boolean Public Event Inicio(Spath As String) Public Event Terminado(Spath As String) Public Event Change(Spath As String) Sub Detener() Call Eliminar_Monitoreo(Handle) Handle = 0 End Sub Sub Comenzar() Dim ret As Long Dim Status As Long terminateFlag = False Handle = Crear_Monitoreo(mPath) RaiseEvent Inicio(mPath) Status = WatchDirectory(Handle) If Status = 0 Then RaiseEvent Change(mPath) Do Status = Resumir(Handle) If Status = -1 Then RaiseEvent Terminado(mPath) Else RaiseEvent Change(mPath) End If Loop While Status = 0 Else RaiseEvent Terminado(mPath) End If End Sub Private Function Crear_Monitoreo(Ruta As String) As Long Crear_Monitoreo = FindFirstChangeNotification(Ruta, IncluirSubdir, FLAGS) End Function Private Sub Eliminar_Monitoreo(Handle As Long) Dim ret As Long terminateFlag = True DoEvents ret = FindCloseChangeNotification(Handle) End Sub Private Function WatchDirectory(Handle As Long) As Long Dim ret As Long Do ret = WaitForSingleObject(Handle, mIntervalo) DoEvents Loop While ret <> 0 And terminateFlag = False WatchDirectory = ret End Function Private Function Resumir(Handle As Long) As Boolean Dim ret As Long ret = FindNextChangeNotification(Handle) Do ret = WaitForSingleObject(Handle, mIntervalo) DoEvents Loop While ret <> 0 And terminateFlag = False Resumir = ret End Function Private Sub Class_Terminate() If Handle > 0 Then Call Eliminar_Monitoreo(Handle) End If End Sub Public Property Get Path() As String Path = mPath End Property Property Let Path(v As String) mPath = v End Property Public Property Get Intervalo() As Long Intervalo = mIntervalo End Property Public Property Let Intervalo(v As Long) If IsNumeric(v) Then mIntervalo = v Else MsgBox "El valor para los milisegundos no es válido", "Error" End If End Property

Recursos visual basic 6.0

Folder security : Programa para proteger directorios en windows xp y windows 2000

Recursos visual basic.net

Dos ejemplos del componente FilesystemWatcher

Buscar en Recursos vb