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.
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:
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.
The form is just the start/stop buttons and a list:
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.
Code:
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 LongCode:
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 IfRequirements
-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.
Code:
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 FunctionCode:
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