如何监控目录操作？

[xsyun]

如何监控目录操作？

[sworddx]

这里给个例子，使用readdirectorychangesw的

以下代码放在一个模块里面:

Option Explicit

Public Const INFINITE = &HFFFF

Public Const FILE_NOTIFY_CHANGE_FILE_NAME As Long = &H1
Public Const FILE_NOTIFY_CHANGE_DIR_NAME As Long = &H2
Public Const FILE_NOTIFY_CHANGE_ATTRIBUTES As Long = &H4
Public Const FILE_NOTIFY_CHANGE_SIZE As Long = &H8
Public Const FILE_NOTIFY_CHANGE_LAST_WRITE As Long = &H10
Public Const FILE_NOTIFY_CHANGE_LAST_ACCESS As Long = &H20
Public Const FILE_NOTIFY_CHANGE_CREATION As Long = &H40
Public Const FILE_NOTIFY_CHANGE_SECURITY As Long = &H100
Public Const FILE_NOTIFY_FLAGS = FILE_NOTIFY_CHANGE_ATTRIBUTES Or _
FILE_NOTIFY_CHANGE_FILE_NAME Or _
FILE_NOTIFY_CHANGE_LAST_WRITE

Declare Function FindFirstChangeNotification Lib "kernel32" _
Alias "FindFirstChangeNotificationA" _
(ByVal lpPathName As String, _
ByVal bWatchSubtree As Long, _
ByVal dwNotifyFilter As Long) As Long

Declare Function FindCloseChangeNotification Lib "kernel32" _
(ByVal hChangeHandle As Long) As Long

Declare Function FindNextChangeNotification Lib "kernel32" _
(ByVal hChangeHandle As Long) As Long

Declare Function WaitForSingleObject Lib "kernel32" _
(ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Public Const WAIT_OBJECT_0 = &H0
Public Const WAIT_ABANDONED = &H80
Public Const WAIT_IO_COMPLETION = &HC0
Public Const WAIT_TIMEOUT = &H102
Public Const STATUS_PENDING = &H103



以下代码放在一个窗体里面：

Option Explicit

Dim hChangeHandle As Long
Dim hWatched As Long
Dim terminateFlag As Long

Private Sub Form_Load()

lbMsg = "点击 '开始监视'"

End Sub


Private Sub cmdEnd_Click()

If hWatched > 0 Then Call WatchDelete(hWatched)

Unload Me
Set Form1 = Nothing

End Sub


Private Sub cmdStop_Click()

Call WatchDelete(hWatched)
hWatched = 0

cmdBegin.Enabled = True
lbMsg = "点击 '开始监视'"

End Sub
Private Sub cmdBegin_Click()

Dim r As Long
Dim watchPath As String
Dim watchStatus As Long

watchPath = "c:\bat"

terminateFlag = False
cmdBegin.Enabled = False

lbMsg = "在被监视的位置使用 Explorer 或者 Notepad, 创建、修改、重命名或者修改属性或者删除一个文件"


WatchChangeAction watchPath

MsgBox "Beginning watching of folder " & watchPath & " .. 点击 OK"

hWatched = WatchCreate(watchPath, FILE_NOTIFY_FLAGS)

watchStatus = WatchDirectory(hWatched, 100)

If watchStatus = 0 Then
WatchChangeAction watchPath

MsgBox "监视文件夹变更。恢复监视……"

Do
watchStatus = WatchResume(hWatched, 100)

If watchStatus = -1 Then
'watchStatus must have exited with the terminate flag
MsgBox "监视终止于 " & watchPath

Else: WatchChangeAction watchPath
MsgBox "监视文件夹再次改变"

End If

Loop While watchStatus = 0


Else
MsgBox "监视终止于 " & watchPath

End If

End Sub



Private Function WatchCreate(lpPathName As String, flags As Long) As Long

WatchCreate = FindFirstChangeNotification(lpPathName, False, flags)

End Function


Private Sub WatchDelete(hWatched As Long)

Dim r As Long

terminateFlag = True
DoEvents

r = FindCloseChangeNotification(hWatched)

End Sub


Private Function WatchDirectory(hWatched As Long, interval As Long) As Long

Dim r As Long

Do

r = WaitForSingleObject(hWatched, interval)
DoEvents

Loop While r <> 0 And terminateFlag = False

WatchDirectory = r

End Function


Private Function WatchResume(hWatched As Long, interval) As Boolean

Dim r As Long

r = FindNextChangeNotification(hWatched)

Do

r = WaitForSingleObject(hWatched, interval)
DoEvents

Loop While r <> 0 And terminateFlag = False

WatchResume = r

End Function


Private Sub WatchChangeAction(fPath As String)

Dim fName As String

List1.Clear

fName = Dir(fPath & "\" & "*.txt")

If fName > "" Then

List1.AddItem "路径: " & vbTab & fPath
List1.AddItem "文件: " & vbTab & fName
List1.AddItem "大小: " & vbTab & FileLen(fPath & "\" & fName)
List1.AddItem "属性: " & vbTab & GetAttr(fPath & "\" & fName)

End If

End Sub

[wumy_ld]

gz

[pandengzhe]

1、使用SHChangeNotify/SHChangeNotifyRegister/SHChangeNotifyDeregister等
2、使用ReadDirectoryChangesW

具体由这方面的例子，并参考msdn.