modwatch.bas

delphi 做的监控文件

Attribute VB_Name = "modWatch"
Option Explicit

Global WatchStart As Boolean
Global DirHndl As Long
Private Const FILE_NOTIF_GLOB = FILE_NOTIFY_CHANGE_ATTRIBUTES Or _
                                FILE_NOTIFY_CHANGE_FILE_NAME Or _
                                FILE_NOTIFY_CHANGE_DIR_NAME Or _
                                FILE_NOTIFY_CHANGE_ATTRIBUTES Or _
                                FILE_NOTIFY_CHANGE_LAST_WRITE
Private nErr As Long
Private nBufLen As Long
Private nReadLen As Long
Private sAction As String
Private fiBuffer As FILE_NOTIFY_INFORMATION
Private cBuffer() As Byte
Private cBuff2() As Byte
Private lpBuf As Long
    
Public Function GetDirHndl(ByVal PathDir As String) As Long
    On Error Resume Next
    Dim hDir As Long
    If Right(PathDir, 1) <> "\" Then PathDir = PathDir + "\"
    hDir = CreateFile(PathDir, FILE_LIST_DIRECTORY, FILE_SHARE_READ + FILE_SHARE_WRITE + FILE_SHARE_DELETE, _
                      ByVal 0&, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS Or FILE_FLAG_OVERLAPPED, ByVal 0&)
    GetDirHndl = hDir
End Function

Public Sub StartWatch()
    If (DirHndl = 0) Or (DirHndl = -1) Then Exit Sub
    
    nBufLen = 256
    ReDim cBuffer(0 To nBufLen)
    nErr = ReadDirectoryChangesW(DirHndl, cBuffer(0), nBufLen, WSubFolder, _
                        FILE_NOTIF_GLOB, nReadLen, 0, 0)
End Sub

Public Function GetChanges() As String
    On Error Resume Next
    Dim fName As String
    MoveMemory fiBuffer.NextEntryOffset, cBuffer(0), 4
    MoveMemory fiBuffer.Action, cBuffer(4), 4
    MoveMemory fiBuffer.FileNameLength, cBuffer(8), 4
    ReDim cBuff2(0 To fiBuffer.FileNameLength)
    MoveMemory cBuff2(0), cBuffer(12), fiBuffer.FileNameLength
    fiBuffer.FileName = cBuff2
    Select Case fiBuffer.Action
        Case FILE_ACTION_ADDED
            sAction = "添加文件"
        Case FILE_ACTION_REMOVED
            sAction = "删除文件"
        Case FILE_ACTION_MODIFIED
            sAction = "修改文件"
        Case FILE_ACTION_RENAMED_OLD_NAME
            sAction = "重命名文件，源文件名为"
        Case FILE_ACTION_RENAMED_NEW_NAME
            sAction = "重命名文件，目标文件名为"
        Case Else
            sAction = "未知"
    End Select
    fName = sAction + "-" + fiBuffer.FileName
    GetChanges = fName
End Function
      
Public Sub ClearHndl(Handle As Long)
    CloseHandle Handle
    Handle = 0
End Sub