这是一个简单的监控程序(我感觉有问题的)
Module:
Option Explicit
Global WatchStart As Boolean
Global DirHndl As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Public FolderPath As StringType FILE_NOTIFY_INFORMATION
   NextEntryOffset As Long
   Action As Long
   FileNameLength As Long
   FileName As String
End Type
Public WSubFolder  As Boolean
Public Const FILE_FLAG_OVERLAPPED = &H40000000
Public Const FILE_LIST_DIRECTORY = &H1
Public Const FILE_SHARE_READ = &H1&
Public Const FILE_SHARE_DELETE = &H4&
Public Const OPEN_EXISTING = 3
Public Const FILE_FLAG_BACKUP_SEMANTICS = &H2000000
Public Const FILE_NOTIFY_CHANGE_FILE_NAME = &H1&
Public Const FILE_NOTIFY_CHANGE_LAST_WRITE = &H10&
Public Const FILE_SHARE_WRITE As Long = &H2
Public Const FILE_NOTIFY_CHANGE_ATTRIBUTES As Long = &H4
Public Const FILE_NOTIFY_CHANGE_DIR_NAME As Long = &H2Public Const FILE_ACTION_ADDED = &H1&
Public Const FILE_ACTION_REMOVED = &H2&
Public Const FILE_ACTION_MODIFIED = &H3&
Public Const FILE_ACTION_RENAMED_OLD_NAME = &H4&
Public Const FILE_ACTION_RENAMED_NEW_NAME = &H5&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_WRITEPublic Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpcSource As Any, ByVal dwLength As Long)
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function ReadDirectoryChangesW Lib "kernel32" (ByVal hDirectory As Long, lpBuffer As Any, ByVal nBufferLength As Long, ByVal bWatchSubtree As Long, ByVal dwNotifyFilter As Long, lpBytesReturned As Long, ByVal PassZero As Long, ByVal PassZero As Long) As Long
Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal PassZero As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal PassZero As Long) As Long
Public Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Public Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As LongPublic Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) 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 FunctionPublic Sub StartWatch()
 If (DirHndl = 0) Or (DirHndl = -1) Then Exit Sub
    nBufLen = 1024
    ReDim cBuffer(0 To nBufLen)
    Call ReadDirectoryChangesW(DirHndl, cBuffer(0), nBufLen, WSubFolder, _
                        FILE_NOTIF_GLOB, nReadLen, 0, 0)
End SubPublic 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 = "Added file"
            Case FILE_ACTION_REMOVED
                sAction = "Removed file"
            Case FILE_ACTION_MODIFIED
                sAction = "Modified file"
            Case FILE_ACTION_RENAMED_OLD_NAME
                sAction = "Renamed from"
            Case FILE_ACTION_RENAMED_NEW_NAME
                sAction = "Renamed to"
            Case Else
                sAction = "Unknown"
   End Select
   fName = sAction + "-" + FolderPath + fiBuffer.FileName
   If sAction <> "Unknown" Then GetChanges = fName
End Function
      
Public Sub ClearHndl(Handle As Long)
 CloseHandle Handle
 Handle = 0
End SubForm:
Option Explicit
Dim ThreadHandle   As Long
Dim Fin As Boolean
Private Sub Check1_Click()
    WSubFolder = Check1.Value
End SubPrivate Sub cmdStart_Click()
Dim Dummy As Long
Dim Changes As String
Dim WaitNum As Long
  WSubFolder = Check1.Value
  WatchStart = True
'Get Folder Handle
  FolderPath = Text1.Text
  If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath + "\"
  DirHndl = GetDirHndl(FolderPath)
  If (DirHndl = 0) Or (DirHndl = -1) Then MsgBox "Cannot create handle": Exit Sub
  cmdStart.Enabled = False
  cmdStop.Enabled = True
  'Create thread to Watch changes
Do
    ThreadHandle = CreateThread(ByVal 0&, ByVal 0&, AddressOf StartWatch, DirHndl, 0, Dummy)
    Do
    WaitNum = WaitForSingleObject(ThreadHandle, 50)
    DoEvents
    Loop Until (WaitNum = 0) Or (WatchStart = False)
    Changes = ""
    If WaitNum = 0 Then Changes = GetChanges
    If Changes <> "" Then List1.AddItem Changes
Loop Until Not WatchStart
 'Terminate the Thread & Clear Handle
If DirHndl <> 0 Then ClearHndl DirHndl
If ThreadHandle <> 0 Then Call TerminateThread(ThreadHandle, ByVal 0&): ThreadHandle = 0
End Sub
Private Sub cmdStop_Click()
WatchStart = False
cmdStop.Enabled = False
cmdStart.Enabled = True
End Sub
Private Sub Form_Resize()
List1.Width = Me.Width
End Sub
Private Sub Form_Unload(Cancel As Integer)
Cancel = -1
Fin = True
cmdStop_Click
tmrEND.Enabled = True
End Sub
Private Sub tmrEND_Timer()
    End
End Sub下面是一个简单的测试用例
Form:
Private Const FO_MOVE = &H1
Private Const FO_COPY = &H2
Private Const FO_DELETE = &H3
Private Const FO_RENAME = &H4
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_SILENT = &H4
Private Const FOF_NOERRORUI = &H400
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As LongPrivate Type SHFILEOPSTRUCT
               hwnd  As Long
               wFunc  As Long
               pFrom  As String
               pTo  As String
               fFlags  As Integer
               fAnyOperationsAborted  As Long
               hNameMappings  As Long
               lpszProgressTitle  As String   '    only  used  if  FOF_SIMPLEPROGRESS
End TypeDim fso As New FileSystemObject
Public Function KillPath(ByVal sPath As String) As Boolean
       On Error Resume Next
       Dim udtPath   As SHFILEOPSTRUCT
       udtPath.hwnd = 0
       udtPath.wFunc = FO_DELETE
       udtPath.pFrom = sPath
       udtPath.pTo = ""
       udtPath.fFlags = FOF_NOCONFIRMATION Or FOF_SILENT Or FOF_NOERRORUI
       KillPath = Not CBool(SHFileOperation(udtPath))
End FunctionPrivate Sub Command1_Click()
    Dim i As Integer
    fso.CreateFolder "c:\abc"
    fso.CreateFolder "c:\abc\aaa"
    For i = 1 To 15
        fso.CreateFolder "c:\abc\" & "abc" & i
    Next i
    For i = 1 To 15
        fso.CreateTextFile "c:\abc\" & "abc" & i & ".txt"
    Next i
End SubPrivate Sub Command2_Click()
    KillPath "c:\abc"
End Sub问题:
当我按下测试用例的Command1时监控程序并不能完全记录下测试用
例所有新建的文件及文件夹,只能部份记录?
请各位大侠帮帮忙万分感谢!