Ideas on how I can stop this program?(ReadDirectoryChangesW)

I was looking at this thread http://www.vbforums.com/showthread.php?t=649143 with a view to 'stablising' the example given.

The following seems to work (I'm running as Administrator with UAC off on Vista)

Code:

---

Option Explicit
'
' Assumes:
' CommandButton named CommandStart
' TextBox named txtActions, with MultiLine Property set to True
'
Private Const FILE_NOTIFY_CHANGE_DIR_NAME As Long = 2
Private Const FILE_FLAG_BACKUP_SEMANTICS As Long = &H2000000
Private Const FILE_SHARE_READ As Long = &H1
Private Const FILE_SHARE_WRITE As Long = &H2
Private Const FILE_SHARE_DELETE As Long = &H4
Private Const FILE_LIST_DIRECTORY As Long = &H1
Private Const OPEN_EXISTING As Long = 3
Private Const GENERIC_READ As Long = &H80000000
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const MAX_PATH As Long = 260
Private Const FILE_ACTION_ADDED As Long = 1
Private Const FILE_ACTION_REMOVED As Long = 2
Private Const FILE_ACTION_RENAMED_OLD_NAME As Long = 4
Private Const FILE_ACTION_RENAMED_NEW_NAME As Long = 5

Private Type FILE_NOTIFY_INFORMATION
    NextEntryOffset As Long
    Action As Long
    FilenameLength As Long
End Type

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
                (ByVal lpFileName As String, _
                ByVal dwDesiredAccess As Long, _
                ByVal dwShareMode As Long, _
                ByVal lpSecurityAttributes As Long, _
                ByVal dwCreationDisposition As Long, _
                ByVal dwFlagsAndAttributes As Long, _
                ByVal hTemplateFile As Long) As Long
               
Private Declare Function ReadDirectoryChangesW Lib "kernel32" _
                (ByVal hDirectory As Long, _
                ByVal lpbufferout As Long, _
                ByVal nBufferLength As Long, _
                ByVal bwatchSubtree As Long, _
                ByVal dwNotifyFilter As Long, _
                lpBytesReturned As Long, _
                ByVal lpOverlapped As Long, _
                ByVal lpCompletionRoutine As Long) As Long
               
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
                (Destination As Any, _
                Source As Any, _
                ByVal Length As Long)

Private Declare Function CloseHandle Lib "kernel32" _
                (ByVal hObject As Long) As Long
               
Private lngHandle As Long

Private Sub cmdStart_Click()
Dim lngReturn As Long
Dim lngReturn1 As Long
Dim lngPos As Long
Dim intI As Integer
Dim bytRet() As Byte
Dim bytName() As Byte
Dim lngLen As Long
Dim strFolder As String
Dim udtFNI As FILE_NOTIFY_INFORMATION
ReDim bytRet(MAX_PATH * 4 + 23)
'
' Get a Handle to the Directory we want to monitor
'
Do
    lngHandle = CreateFile("c:\Doogle\Test\", _
                    FILE_LIST_DIRECTORY, _
                    FILE_SHARE_READ Or _
                    FILE_SHARE_WRITE Or _
                    FILE_SHARE_DELETE, _
                    0&, _
                    OPEN_EXISTING, _
                    FILE_FLAG_BACKUP_SEMANTICS, _
                    0&)
    If lngHandle <> INVALID_HANDLE_VALUE Then
        '
        ' Wait for a Change
        '
        lngReturn = ReadDirectoryChangesW(lngHandle, _
                    VarPtr(bytRet(0)), _
                    MAX_PATH * 4 + 24, _
                    0&, _
                    FILE_NOTIFY_CHANGE_DIR_NAME, _
                    lngLen, _
                    0&, _
                    0&)
        Do
            If lngReturn <> 0 Then
                '
                ' Establish the resulting UDT Header
                '
                CopyMemory udtFNI, bytRet(lngPos), Len(udtFNI)
                '
                ' Allocate and fill a Buffer for the Filename
                '
                ReDim bytName(udtFNI.FilenameLength - 1)
                CopyMemory bytName(0), bytRet(lngPos + Len(udtFNI)), udtFNI.FilenameLength
                '
                ' Convert the Filename to a string
                '
                For intI = 0 To udtFNI.FilenameLength - 1
                    strFolder = strFolder & Chr(bytName(intI))
                Next intI
                strFolder = StrConv(strFolder, vbFromUnicode)
                '
                ' Check whether it's a new folder or
                ' one that's been deleted or renamed
                ' And output the details to the multiline textbox
                '
                Select Case udtFNI.Action
                    Case FILE_ACTION_ADDED
                        txtActions.Text = txtActions.Text & "Added: "
                    Case FILE_ACTION_REMOVED
                        txtActions.Text = txtActions.Text & "Removed: "
                    Case FILE_ACTION_RENAMED_OLD_NAME
                        txtActions.Text = txtActions.Text & "Renamed Old Name: "
                    Case FILE_ACTION_RENAMED_NEW_NAME
                        txtActions.Text = txtActions.Text & "Renamed New Name: "
                End Select
                txtActions.Text = txtActions.Text & strFolder & vbCrLf
                strFolder = ""
                lngPos = lngPos + udtFNI.NextEntryOffset
            Else
                MsgBox "Error " & Err.LastDllError
            End If
        Loop Until udtFNI.NextEntryOffset = 0 Or lngReturn = 0
        lngPos = 0
    Else
        MsgBox "Unable to obtain Handle for Folder"
    End If
    lngReturn1 = CloseHandle(lngHandle)
    Me.Refresh
    DoEvents
Loop Until lngHandle = INVALID_HANDLE_VALUE Or lngReturn = 0
End Sub

---

However, I can't think of a simple way to terminate it. The ReadDirectoryChangesW API (and hence the process) goes into a Wait state until a Folder in the monitored folder is added/removed/renamed. I would like a way to stop it at the user's discretion.

The only way I can think of is to spawn this program from another process and use the parent process to terminate the wait (CancelSynchronousIo) and then terminate the process.

Has anyone got any better ideas ?

create a temp file (watched item), with specific name, into the watched directory so as to fire the notify if the name matches condition exit loops

no vb6 here, so i tested, running your code in excel vba, created tmp folder from word vba, which forced the excel code to terminate

Thanks for the suggestion. Currently I've used the approach I mentioned ie spawned the 'Watch' program from another program. I also 'captuerd' it using the SetParent API so the two applications look as if they're one in the same. I'll give your idea a go though.

still sort of needs 2 programs as the one becomes too unresponsive, but your setparent method should solve that issue of appearance

The other thing is the User Interface, currently I'm writing the changes to a TextBox with scroll bars - of course you can't scroll whilst it's inactive (which is most of the time).

I suspect that the 'two program' approach is a reasonable solution, using some sort of IPC between the two so that the changes are displayed in a TextBox in the Parent (which is active) rather than the 'child'. (like simulating multithreading - I wish I knew why Microsoft deliberately broke Multithreading under VB - suppose I shouldn't moan, should just move to .Net)

I've had a re-think and done the obvious (well to me it's obvious).

I've re-designed the code that monitors the folder such that it has no user interface. It is started via CreateProcess from another Program and uses SendMessage to populate a TextBox in the calling Progrm.

If anyone wants to play I've attached the 2 two Projects.

A word of explanation re the attached:

The Project1 (MonDir) and Monitor.bas files make up the Monitoring code (no user interface)
The Directory 'Harness' contains the CallingProgram (Monitor).

Make the MonDir.exe file (don't try to run it - you'll get a 'subscript out of bounds' error), change the variables 'strProg' and 'strWatch' to reflect the location of the MonDir program and folder path to watch, respectively, in the Monitor project and run it.

EDIT: Ought to point out that this only works on Vista and above since it uses the CancelSynchronousIo API.