Startseite / Tipps / VB 5/6-Tipp 0367: Verzeichnis inkl. Unterverzeichnisse auf Änderungen überwachen

VB 5/6-Tipp 0367: Verzeichnis inkl. Unterverzeichnisse auf Änderungen überwachen

 von ActiveVB

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Kontrollkästchen-Steuerelement "Check1"
' Steuerelement: Verzeichnisauswahlliste "Dir1"
' Steuerelement: Festplattenauswahlliste "Drive1"
' Steuerelement: Schaltfläche "Command3"
' Steuerelement: Listen-Steuerelement "List1"
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Beschriftungsfeld "Label3"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"


'Anmerkung: Eigentlich sollte die Überwachung in einem eigenen
'           Thread laufen. Aus Gründen die der Einfachheit und
'           Übersicht dienen sollen, wurde deswegen hierauf ver-
'           zichtet und ein API-Timer verwendet.
'           Somit ist es jedem freigestellt, die Routine später
'           dann in einem Thread seiner Wahl laufen zu lassen.
'           Denkbar wäre im einfachsten Falle eine ActiveExe
'           ohne Oberfläche und dem Attribut "Unbeaufsichtigt"
            
Option Explicit

Private Sub Form_Load()
    Drive1.Drive = "C:\"
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If TimerEnabled Then Call Terminate
End Sub

Private Sub Command1_Click()
    Dim SubTrees As Boolean
    
    If Not TimerEnabled Then
        SubTrees = IIf(Check1.Value = vbChecked, True, False)
        Call Init(Dir1.Path, SubTrees)
        Check1.Enabled = False
        Dir1.Enabled = False
        Drive1.Enabled = False
        Command1.Enabled = False
        Command2.Enabled = True
    End If
End Sub

Private Sub Command2_Click()
    If TimerEnabled Then
        Call Terminate
        Check1.Enabled = True
        Dir1.Enabled = True
        Drive1.Enabled = True
        Command1.Enabled = True
        Command2.Enabled = False
    End If
End Sub

Private Sub Command3_Click()
    List1.Clear
End Sub

Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive
End Sub

Private Sub Dir1_Change()
    Label3.Caption = Dir1.Path
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Modul "Module1" alias Module1.bas ---------

Option Explicit

Private Declare Function SetTimer Lib "user32" (ByVal hWnd As _
        Long, ByVal nIDEvent As Long, ByVal uElapse As Long, _
        ByVal lpTimerFunc As Long) As Long

Private Declare Function KillTimer Lib "user32" (ByVal hWnd As _
        Long, ByVal nIDEvent As Long) As Long

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 FindNextChangeNotification Lib _
        "kernel32" (ByVal hChangeHandle As Long) As Long
       
Private Declare Function FindCloseChangeNotification _
        Lib "kernel32" (ByVal hChangeHandle As Long) _
        As Long

Private Declare Function WaitForSingleObject Lib "kernel32" _
        (ByVal hHandle As Long, ByVal dwMilliseconds As _
        Long) As Long
              
Const FILE_NOTIFY_CHANGE_ATTRIBUTES = &H4
Const FILE_NOTIFY_CHANGE_DIR_NAME = &H2
Const FILE_NOTIFY_CHANGE_FILE_NAME = &H1
Const FILE_NOTIFY_CHANGE_LAST_WRITE = &H10
Const FILE_NOTIFY_CHANGE_SECURITY = &H100
Const FILE_NOTIFY_CHANGE_SIZE = &H8

Const INVALID_HANDLE_VALUE = -1
Const WAIT_OBJECT_0 = 0
 
Public TimerEnabled As Boolean

Dim hTimer As Long, hFile As Long, SubDirs As Long
Dim WatchPath As String
Dim Flag As Boolean, Started As Boolean

Public Sub Init(Path As String, SubTrees As Boolean)
    SubDirs = IIf(SubTrees, 1, 0)
    WatchPath = Path & Chr$(0)
    Flag = False
    Started = False
    hFile = 0
   
    'Timer initialisieren
    hTimer = SetTimer(0, 0, 100&, AddressOf TimerProc)
    TimerEnabled = True
End Sub

Public Sub Terminate()
    'Wenn die Überwachung noch läuft, dann jetzt beenden
    If hFile <> 0 Then Call FindCloseChangeNotification(hFile)
    
    'Timer entfernen
    Call KillTimer(0, hTimer)
    TimerEnabled = False
End Sub

Private Sub TimerProc(ByVal hWnd&, ByVal Msg&, ByVal idEvent&, _
                      ByVal dwTime&)
    
    If Not Flag Then
        'Flag setzen damit weitere TimerEvents nicht in die
        'Quere kommen
        Flag = True
        
        'Schaun ob Überwachung gestartet wurde
        If Not Started Then
            
            'Nein, daher erstmal ein Handle für die Überwachung holen.
            'FILE_NOTIFY_CHANGE_FILE_NAME gibt hierbei den Überwach-
            'ungstyp an, d.h. es wird auf Änderungen mit Dateinamen
            'gelauscht. Werden weitere gewünscht, so kann dieser
            'Parameter mit durch Veroderung der entsprechenden Flags
            'erweitert werden.
            hFile = FindFirstChangeNotification(WatchPath, SubDirs, _
                                     FILE_NOTIFY_CHANGE_FILE_NAME)
            
            'Lieg alles glatt dann ein Flag setzen um beim nächsten
            'TimerEvent an anderer Stelle fortzufahren
            If hFile <> INVALID_HANDLE_VALUE Then Started = True
            
        Else
        
            'Mal schaun ob was anliegt und ein bissel warten um die
            'Änderungen wirksam werden su lassen
            If WaitForSingleObject(hFile, 50) = WAIT_OBJECT_0 Then
            
                'Benachrichtigung des Anwenders
                Form1.List1.AddItem Now
                Beep
            End If
            
            'Mal gucken ob's noch weitere Dateien werden, deshalb die
            'Überwachung fortsetzen.
            Call FindNextChangeNotification(hFile)
            
            'Alles in Ordnung?
            If hFile = 0 Then
                
                'Ups, da lag ein Fehler vor, besser mal die Überwachung
                'schließen.
                Call FindCloseChangeNotification(hFile)
                Started = False
            End If
        End If
    
        'Timer Events wieder zum Verarbeiten zulassen
        Flag = False
    End If
End Sub
'---------- Ende Modul "Module1" alias Module1.bas ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-Version	Win32s	Win95	Win98	WinME	WinNT4	Win2000	WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version: VB6 VB5 VB4

Windows-Version: Windows XP Windows 2000 Windows NT4 Windows Me Windows 98 Windows 95 Win32s

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 15 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.