module1.bas

来自「delphi 做的监控文件」· BAS 代码 · 共 87 行

Attribute VB_Name = "Module1"
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
   
    hTimer = SetTimer(0, 0, 100&, AddressOf TimerProc)
    TimerEnabled = True
End Sub

Public Sub Terminate()
    If hFile <> 0 Then Call FindCloseChangeNotification(hFile)
    
    Call KillTimer(0, hTimer)
    TimerEnabled = False
End Sub

Private Sub TimerProc(ByVal hWnd&, ByVal Msg&, ByVal idEvent&, _
                      ByVal dwTime&)
    If Not Flag Then
        Flag = True
        
        If Not Started Then
            hFile = FindFirstChangeNotification(WatchPath, SubDirs, _
                                     FILE_NOTIFY_CHANGE_FILE_NAME)
            If hFile <> INVALID_HANDLE_VALUE Then Started = True
        Else
            If WaitForSingleObject(hFile, 50) = WAIT_OBJECT_0 Then
                Form1.List1.AddItem Now & " - 发生改变"
                Beep
            End If
            Call FindNextChangeNotification(hFile)
            
            If hFile = 0 Then
                Call FindCloseChangeNotification(hFile)
                Started = False
            End If
        End If
    
        Flag = False
    End If
End Sub