SHChangeNotifyRegister updated and corrected, including new delivery method

[fafalone]

So there's two reasons why I wanted to post this,
1) The examples on popular sites like VBNet and Brad Martinez's site have several errors, and
2) MSDN states that as of XP and later, all clients should be using a new delivery method that uses shared memory. The only example of this in VB is some obscure, hard to connect to chinese forum posts.

If you're not already familiar with SHChangeNotifyRegister, it allows your program to be notified of any changes to files, folders, and other shell objects. See the SHCNE enum below for the events it has.

Private Declare Function SHChangeNotifyRegister Lib "shell32" _
                              (ByVal hWnd As Long, _
                              ByVal fSources As SHCNRF, _
                              ByVal fEvents As SHCN_EventIDs, _
                              ByVal wMsg As Long, _
                              ByVal cEntries As Long, _
                              lpps As SHChangeNotifyEntry) As Long

The uFlags argument is not SHCNF values. It's always returned in pidls. SHCNF is for when your program calls SHChangeNotify (I should make a separate thread about that since nobody does that when they should). One of the new SHCNRF values is SHCNRF_NEWDELIVERY, which changes the way you handle the WM_SHNOTIFY message:

Public Function F1WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long

    Select Case uMsg

        Case WM_SHNOTIFY
            Dim lEvent As Long
            Dim pInfo As Long
            Dim tInfo As SHNOTIFYSTRUCT
            Dim hNotifyLock As Long
            hNotifyLock = SHChangeNotification_Lock(wParam, lParam, pInfo, lEvent)
            If hNotifyLock Then
                CopyMemory tInfo, ByVal pInfo, LenB(tInfo)
                Form1.HandleNotify tInfo.dwItem1, tInfo.dwItem2, lEvent
                Call SHChangeNotification_Unlock(hNotifyLock)
            End If

Other than demonstrating those changes, it's just a straightforward SHChangeNotifyRegister example that also uses the newer, easier, and safer SetWindowSubclass API for its subclassing.

Requirements
-Windows XP or higher

Code
For quicker implementation, here the full module from the sample; the form just calls start/stop and handles the pidls.

Option Explicit

Public m_hSHNotify As Long
Public Const WM_SHNOTIFY = &H488 'WM_USER through &H7FF

Public Enum SHCN_EventIDs
   SHCNE_RENAMEITEM = &H1          '(D) A non-folder item has been renamed.
   SHCNE_CREATE = &H2              '(D) A non-folder item has been created.
   SHCNE_DELETE = &H4              '(D) A non-folder item has been deleted.
   SHCNE_MKDIR = &H8               '(D) A folder item has been created.
   SHCNE_RMDIR = &H10              '(D) A folder item has been removed.
   SHCNE_MEDIAINSERTED = &H20      '(G) Storage media has been inserted into a drive.
   SHCNE_MEDIAREMOVED = &H40       '(G) Storage media has been removed from a drive.
   SHCNE_DRIVEREMOVED = &H80       '(G) A drive has been removed.
   SHCNE_DRIVEADD = &H100          '(G) A drive has been added.
   SHCNE_NETSHARE = &H200          'A folder on the local computer is being
                                   '    shared via the network.
   SHCNE_NETUNSHARE = &H400        'A folder on the local computer is no longer
                                   '    being shared via the network.
   SHCNE_ATTRIBUTES = &H800        '(D) The attributes of an item or folder have changed.
   SHCNE_UPDATEDIR = &H1000        '(D) The contents of an existing folder have changed,
                                   '    but the folder still exists and has not been renamed.
   SHCNE_UPDATEITEM = &H2000       '(D) An existing non-folder item has changed, but the
                                   '    item still exists and has not been renamed.
   SHCNE_SERVERDISCONNECT = &H4000 'The computer has disconnected from a server.
   SHCNE_UPDATEIMAGE = &H8000&     '(G) An image in the system image list has changed.
   SHCNE_DRIVEADDGUI = &H10000     '(G) A drive has been added and the shell should
                                   '    create a new window for the drive.
   SHCNE_RENAMEFOLDER = &H20000    '(D) The name of a folder has changed.
   SHCNE_FREESPACE = &H40000       '(G) The amount of free space on a drive has changed.

'#If (WIN32_IE >= &H400) Then
   SHCNE_EXTENDED_EVENT = &H4000000 '(G) Not currently used.
'#End If

  SHCNE_ASSOCCHANGED = &H8000000   '(G) A file type association has changed.
  SHCNE_DISKEVENTS = &H2381F       '(D) Specifies a combination of all of the disk
                                   '    event identifiers.
  SHCNE_GLOBALEVENTS = &HC0581E0   '(G) Specifies a combination of all of the global
                                   '    event identifiers.
  SHCNE_ALLEVENTS = &H7FFFFFFF
  SHCNE_INTERRUPT = &H80000000     'The specified event occurred as a result of a system
                                   'interrupt. It is stripped out before the clients
                                   'of SHCNNotify_ see it.
End Enum

'#If (WIN32_IE >= &H400) Then
   Public Const SHCNEE_ORDERCHANGED = &H2 'dwItem2 is the pidl of the changed folder
'#End If
Public Enum SHCNRF
    SHCNRF_InterruptLevel = &H1
    SHCNRF_ShellLevel = &H2
    SHCNRF_RecursiveInterrupt = &H1000
    SHCNRF_NewDelivery = &H8000&
End Enum


Public Enum SHCN_ItemFlags
  SHCNF_IDLIST = &H0                ' LPITEMIDLIST
  SHCNF_PATHA = &H1               ' path name
  SHCNF_PRINTERA = &H2         ' printer friendly name
  SHCNF_DWORD = &H3             ' DWORD
  SHCNF_PATHW = &H5              ' path name
  SHCNF_PRINTERW = &H6        ' printer friendly name
  SHCNF_TYPE = &HFF
  ' Flushes the system event buffer. The function does not return until the system is
  ' finished processing the given event.
  SHCNF_FLUSH = &H1000
  ' Flushes the system event buffer. The function returns immediately regardless of
  ' whether the system is finished processing the given event.
  SHCNF_FLUSHNOWAIT = &H2000

'I prefer to always specify A or W, but you can also do it the way previous examples have
' (but this doesn't apply to SHChangeNotifyRegister, just SHChangeNotify, not covered here)
'#If UNICODE Then
'  SHCNF_PATH = SHCNF_PATHW
'  SHCNF_PRINTER = SHCNF_PRINTERW
'#Else
'  SHCNF_PATH = SHCNF_PATHA
'  SHCNF_PRINTER = SHCNF_PRINTERA
'#End If
End Enum



Private Type SHNOTIFYSTRUCT
  dwItem1 As Long
  dwItem2 As Long
End Type

Private Type SHChangeNotifyEntry
  ' Fully qualified pidl (relative to the desktop folder) of the folder to monitor changes in.
  ' 0 can also be specifed for the desktop folder.
  pidl As Long
  ' Value specifying whether changes in the folder's subfolders trigger a change notification
  '  event (it's actually a Boolean, but we'll go Long because of VB's DWORD struct alignment).
  fRecursive As Long
End Type

Private Declare Function SHChangeNotifyRegister Lib "shell32" _
                              (ByVal hWnd As Long, _
                              ByVal fSources As SHCNRF, _
                              ByVal fEvents As SHCN_EventIDs, _
                              ByVal wMsg As Long, _
                              ByVal cEntries As Long, _
                              lpps As SHChangeNotifyEntry) As Long

Private Declare Function SHChangeNotifyDeregister Lib "shell32" Alias "#4" (ByVal hNotify As Long) As Boolean

Private Declare Function SHChangeNotification_Lock Lib "shell32" (ByVal hChange As Long, _
                                                                 ByVal dwProcId As Long, _
                                                                 pppidl As Long, _
                                                                 plEvent As Long) As Long
                                                                 
Private Declare Function SHChangeNotification_Unlock Lib "shell32" (ByVal hLock As Long) As Long
Private Declare Function SHGetPathFromIDListW Lib "shell32.dll" (ByVal pidl As Long, ByVal pszPath As Long) As Long
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hWndOwner As Long, ByVal nFolder As SHSpecialFolderIDs, pidl As Long) As Long
Public Enum SHSpecialFolderIDs
    'See full project or somewhere else for the full enum, including it all ran over the post length limit
    CSIDL_DESKTOP = &H0

End Enum

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function DefSubclassProc Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Const WM_DESTROY = &H2
Public Const MAX_PATH = 260

Public Function StartNotify(hWnd As Long, Optional pidlPath As Long = 0) As Long
  Dim tCNE As SHChangeNotifyEntry
  Dim pidl As Long
  
  If (m_hSHNotify = 0) Then
        If pidlPath = 0 Then
            tCNE.pidl = VarPtr(0) 'This is a shortcut for the desktop pidl (to watch all locations)
                                  'only use this shortcut as a one-off reference immediately passed
                                  'to an API and not used again
        Else
            tCNE.pidl = pidlPath 'You can specify any other fully qualified pidl to watch only that folder
                                 'Use ILCreateFromPathW(StrPtr(path))
        End If
      tCNE.fRecursive = 1
      
      'instead of SHCNE_ALLEVENTS you could choose to only monitor specific ones
      m_hSHNotify = SHChangeNotifyRegister(hWnd, SHCNRF_ShellLevel Or SHCNRF_InterruptLevel Or SHCNRF_NewDelivery, SHCNE_ALLEVENTS Or SHCNE_INTERRUPT, WM_SHNOTIFY, 1, tCNE)
      
      
      StartNotify = m_hSHNotify
        
  End If   ' (m_hSHNotify = 0)

End Function
Public Function StopNotify() As Boolean
StopNotify = SHChangeNotifyDeregister(m_hSHNotify)
End Function
Public Function LookUpSHCNE(uMsg As Long) As String

Select Case uMsg

Case &H1: LookUpSHCNE = "SHCNE_RENAMEITEM"
Case &H2: LookUpSHCNE = "SHCNE_CREATE"
Case &H4: LookUpSHCNE = "SHCNE_DELETE"
Case &H8: LookUpSHCNE = "SHCNE_MKDIR"
Case &H10: LookUpSHCNE = "SHCNE_RMDIR"
Case &H20: LookUpSHCNE = "SHCNE_MEDIAINSERTED"
Case &H40: LookUpSHCNE = "SHCNE_MEDIAREMOVED"
Case &H80: LookUpSHCNE = "SHCNE_DRIVEREMOVED"
Case &H100: LookUpSHCNE = "SHCNE_DRIVEADD"
Case &H200: LookUpSHCNE = "SHCNE_NETSHARE"
Case &H400: LookUpSHCNE = "SHCNE_NETUNSHARE"
Case &H800: LookUpSHCNE = "SHCNE_ATTRIBUTES"
Case &H1000: LookUpSHCNE = "SHCNE_UPDATEDIR"
Case &H2000: LookUpSHCNE = "SHCNE_UPDATEITEM"
Case &H4000: LookUpSHCNE = "SHCNE_SERVERDISCONNECT"
Case &H8000&: LookUpSHCNE = "SHCNE_UPDATEIMAGE"
Case &H10000: LookUpSHCNE = "SHCNE_DRIVEADDGUI"
Case &H20000: LookUpSHCNE = "SHCNE_RENAMEFOLDER"
Case &H40000: LookUpSHCNE = "SHCNE_FREESPACE"
Case &H4000000: LookUpSHCNE = "SHCNE_EXTENDED_EVENT"
Case &H8000000: LookUpSHCNE = "SHCNE_ASSOCCHANGED"
Case &H2381F: LookUpSHCNE = "SHCNE_DISKEVENTS"
Case &HC0581E0: LookUpSHCNE = "SHCNE_GLOBALEVENTS"
Case &H7FFFFFFF: LookUpSHCNE = "SHCNE_ALLEVENTS"
Case &H80000000: LookUpSHCNE = "SHCNE_INTERRUPT"

End Select
End Function
Public Function GetPathFromPIDLW(pidl As Long) As String
  Dim pszPath As String
  pszPath = String(MAX_PATH, 0)
  If SHGetPathFromIDListW(pidl, StrPtr(pszPath)) Then
    If InStr(pszPath, vbNullChar) Then
        GetPathFromPIDLW = Left$(pszPath, InStr(pszPath, vbNullChar) - 1)
    End If
  End If
End Function
Public Function Subclass(hWnd As Long, lpfn As Long, Optional uId As Long = 0&, Optional dwRefData As Long = 0&) As Boolean
If uId = 0 Then uId = hWnd
    Subclass = SetWindowSubclass(hWnd, lpfn, uId, dwRefData):      Debug.Assert Subclass
End Function

Public Function UnSubclass(hWnd As Long, ByVal lpfn As Long, pid As Long) As Boolean
    UnSubclass = RemoveWindowSubclass(hWnd, lpfn, pid)
End Function
Public Function FARPROC(pfn As Long) As Long
  FARPROC = pfn
End Function

Public Function F1WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long

    Select Case uMsg

        Case WM_SHNOTIFY
            Dim lEvent As Long
            Dim pInfo As Long
            Dim tInfo As SHNOTIFYSTRUCT
            Dim hNotifyLock As Long
            hNotifyLock = SHChangeNotification_Lock(wParam, lParam, pInfo, lEvent)
            If hNotifyLock Then
                CopyMemory tInfo, ByVal pInfo, LenB(tInfo)
                Form1.HandleNotify tInfo.dwItem1, tInfo.dwItem2, lEvent
                Call SHChangeNotification_Unlock(hNotifyLock)
            End If

      Case WM_DESTROY
      
        Call UnSubclass(hWnd, PtrF1WndProc, uIdSubclass)
        'Exit Function
   End Select
   
   ' Pass back to default message handler.

      F1WndProc = DefSubclassProc(hWnd, uMsg, wParam, lParam)


Exit Function

End Function
Private Function PtrF1WndProc() As Long
PtrF1WndProc = FARPROC(AddressOf F1WndProc)
End Function

The form is just the start/stop buttons and a list:

Option Explicit

Public Function HandleNotify(dwItem1 As Long, dwItem2 As Long, idEvent As Long) As Long
Dim sArg1 As String, sArg2 As String
If dwItem1 Then
    sArg1 = GetPathFromPIDLW(dwItem1)
End If
If dwItem2 Then
    sArg2 = GetPathFromPIDLW(dwItem2)
End If
Dim sEvent As String
sEvent = LookUpSHCNE(idEvent)

List1.AddItem sEvent & ", Item1=" & sArg1 & ", Item2=" & sArg2


End Function

Private Sub cmdStart_Click()
StartNotify Me.hWnd
End Sub

Private Sub cmdStop_Click()
StopNotify
End Sub

Private Sub Form_Load()
Subclass Me.hWnd, AddressOf F1WndProc
End Sub

Private Sub Form_Unload(Cancel As Integer)
StopNotify
End Sub

Private Sub Form_Resize()
On Error Resume Next
List1.Width = Me.Width - 220
List1.Height = Me.Height - 1000
End Sub

64-bit twinBASIC Version: https://github.com/fafalone/WatchDirectoryChanges