Attribute VB_Name = "ShellHook"
Option Explicit

'**************************************************************************************

'   (c)2000, 2002, 2004 by Louis.
'
'   Sets up a shell hook to receive Shell change notification messages.
'
'   NOTE: the code is a manipulation of 'Shell Ueberwachung', which is a manipulation
'   of code written by James Holderness.
'   A link appeared to http://www.geocities.com/SiliconValley/4942/, but nobody knows
'   if this link is still valid.
'   Usage: call SetSH([hWnd of any form or control]), the present code will call the
'   callback sub set in SetSH() and pass a shell notification data if a shell event occured.
'
'   This module is a manipulation of code downloaded from www.louis-coder.com.
'
'   This module has been substantially improved and is now hopefully free of error.

'**************************************************************************************

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcW" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const WM_SHNOTIFY = &H401&
Private Const GWL_WNDPROC = (-4)

Private Declare Function SHChangeNotifyRegister Lib "shell32" Alias "#2" (ByVal hWnd As Long, ByVal uFlags As Long, ByVal EventID As SHCN_EventIDs, ByVal wMsg As Long, ByVal cEntries As Long, pfSNE As tSHChangeNotifyEntry) As Long
Private Declare Function SHChangeNotifyDeregister Lib "shell32" Alias "#4" (ByVal hNotify As Long) As Boolean
Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)

Private Type tSHChangeNotifyEntry
   lpIDList As Long         ' Pointer to an item identifier list (PIDL) for which to receive notifications.
   fWatchSubFolders As Long ' Flag indicating whether to post notifications for children of this PIDL. For example, if the PIDL points to a folder, then file notifications would come from the folder's children if this flag was TRUE.
End Type

Private Declare Function SHGetSpecialFolderLocation Lib "shell32" (ByVal hWndOwner As Long, ByVal nFolder As Long, pidl As Long) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" Alias "SHGetPathFromIDListW" (ByVal lpIDL As Long, ByVal pszPath As Long) As Long
Private Const CSIDL_DESKTOP = &H0& ' Each ITEMIDLIST must be relative to the desktop folder.

'Shell notification event IDs (SHChangeNotify wEventId)
'Describes the event that has occurred. Typically, only one event is specified at a time. If more than one event is specified, the values contained in the dwItem1 and dwItem2 parameters must be the same, respectively, for all specified events.
'This parameter can be one or more of the following values (D=Drives|G=Global):
Private Enum SHCN_EventIDs
    SHCNE_RENAMEITEM = &H1& '(D) a non-folder item name has changed. SHCNF_IDLIST or SHCNF_PATH must be specified in uFlags. dwItem1 contains the previous PIDL or name of the item. dwItem2 contains the new PIDL or name of the item.
    SHCNE_CREATE = &H2&     '(D) a non-folder item has been created. SHCNF_IDLIST or SHCNF_PATH must be specified in uFlags. dwItem1 contains the item that was created. dwItem2 is not used and should be NULL.
    SHCNE_DELETE = &H4&     '(D) a non-folder item has been deleted. SHCNF_IDLIST or SHCNF_PATH must be specified in uFlags. dwItem1 contains the item that was deleted. dwItem2 is not used and should be NULL.
    SHCNE_MKDIR = &H8&       '(D) a folder item has been created. SHCNF_IDLIST or SHCNF_PATH must be specified in uFlags. dwItem1 contains the folder that was created. dwItem2 is not used and should be NULL.
    SHCNE_RMDIR = &H10&       '(D) a folder has been removed. SHCNF_IDLIST or SHCNF_PATH must be specified in uFlags. dwItem1 contains the folder that was removed. dwItem2 is not used and should be NULL.
    SHCNE_MEDIAINSERTED = &H20& '(G) storage media has been inserted into a drive. SHCNF_IDLIST or SHCNF_PATH must be specified in uFlags. dwItem1 contains the root of the drive that contains the new media. dwItem2 is not used and should be NULL.
    SHCNE_MEDIAREMOVED = &H40& '(G) storage media has been removed from a drive. SHCNF_IDLIST or SHCNF_PATH must be specified in uFlags. dwItem1 contains the root of the drive from which the media was removed. dwItem2 is not used and should be NULL.
    SHCNE_DRIVEREMOVED = &H80& '(G) a drive has been removed. SHCNF_IDLIST or SHCNF_PATH must be specified in uFlags. dwItem1 contains the root of the drive that was removed. dwItem2 is not used and should be NULL.
    SHCNE_DRIVEADD = &H100&    '(G) a drive has been added. SHCNF_IDLIST or SHCNF_PATH must be specified in uFlags. dwItem1 contains the root of the drive that was added. dwItem2 is not used and should be NULL.
    SHCNE_NETSHARE = &H200     'a folder on the local computer is being shared via the network. SHCNF_IDLIST or SHCNF_PATH must be specified in uFlags. dwItem1 contains the folder that is being shared. dwItem2 is not used and should be NULL.
    SHCNE_NETUNSHARE = &H400   'a folder on the local computer is no longer being shared via the network. SHCNF_IDLIST or SHCNF_PATH must be specified in uFlags. dwItem1 contains the folder that is no longer being shared. dwItem2 is not used and should be NULL.
    SHCNE_ATTRIBUTES = &H800&  '(D) the attributes of an item or folder have changed. SHCNF_IDLIST or SHCNF_PATH must be specified in uFlags. dwItem1 contains the item or folder that has changed. dwItem2 is not used and should be NULL.
    SHCNE_UPDATEDIR = &H1000&  '(D) the contents of an existing folder have changed, but the folder still exists and has not been renamed. SHCNF_IDLIST or SHCNF_PATH must be specified in uFlags. dwItem1 contains the folder that has changed. dwItem2 is not used and should be NULL. If a folder has been created, deleted, or renamed, use SHCNE_MKDIR, SHCNE_RMDIR, or SHCNE_RENAMEFOLDER, respectively, instead.
    SHCNE_UPDATEITEM = &H2000&  '(D) an existing non-folder item has changed, but the item still exists and has not been renamed. SHCNF_IDLIST or SHCNF_PATH must be specified in uFlags. dwItem1 contains the item that has changed. dwItem2 is not used and should be NULL. If a nonfolder item has been created, deleted, or renamed, use SHCNE_CREATE, SHCNE_DELETE, or SHCNE_RENAMEITEM, respectively, instead.
    SHCNE_SERVERDISCONNECT = &H4000& 'the computer has disconnected from a server. SHCNF_IDLIST or SHCNF_PATH must be specified in uFlags. dwItem1 contains the server from which the computer was disconnected. dwItem2 is not used and should be NULL.
    SHCNE_UPDATEIMAGE = &H8000&  '(G) an image in the system image list has changed. SHCNF_DWORD must be specified in uFlags. dwItem1 contains the index in the system image list that has changed. dwItem2 is not used and should be NULL.
    SHCNE_DRIVEADDGUI = &H10000  '(G) a drive has been added and the shell should create a new window for the drive. SHCNF_IDLIST or SHCNF_PATH must be specified in uFlags. dwItem1 contains the root of the drive that was added. dwItem2 is not used and should be NULL.
    SHCNE_RENAMEFOLDER = &H20000  '(D) the name of a folder has changed. SHCNF_IDLIST or SHCNF_PATH must be specified in uFlags. dwItem1 contains the previous PIDL or name of the folder. dwItem2 contains the new PIDL or name of the folder.
    SHCNE_FREESPACE = &H40000      '(G) the amount of free space on a drive has changed. SHCNF_IDLIST or SHCNF_PATH must be specified in uFlags. dwItem1 contains the root of the drive on which the free space changed. dwItem2 is not used and should be NULL.
   'SHCNE_EXTENDED_EVENT = &H4000000 '(G) not used
    SHCNE_ASSOCCHANGED = &H8000000   '(G) a file type association has changed. SHCNF_IDLIST must be specified in the uFlags parameter. dwItem1 and dwItem2 are not used and must be NULL.
    SHCNE_DISKEVENTS = &H2381F       '(Disk) specifies a combination of all of the disk event identifiers
    SHCNE_GLOBALEVENTS = &HC0581E0   '(Global) specifies a combination of all of the global event identifiers
    SHCNE_ALLEVENTS = &H7FFFFFFF     ' All events have occurred
    'The following value modifies other event values and cannot be used alone:
    SHCNE_INTERRUPT = &H80000000 'the specified event occurred as a result of a system interruption; it is stripped out before the clients of SHCNNotify_ notify it
End Enum

'Private Enum SHCN_uFlags ' Flags that indicate the meaning of the dwItem1 and dwItem2 parameters. The uFlags parameter must be one of the following values.
'    SHCNF_DWORD       ' The dwItem1 and dwItem2 parameters are DWORD values.
'    SHCNF_IDLIST      ' dwItem1 and dwItem2 are the addresses of ITEMIDLIST structures that represent the item(s) affected by the change. Each ITEMIDLIST must be relative to the desktop folder.
'    SHCNF_PATH        ' dwItem1 and dwItem2 are the addresses of null-terminated strings of maximum length MAX_PATH that contain the full path names of the items affected by the change.
'    SHCNF_PRINTER     ' dwItem1 and dwItem2 are the addresses of null-terminated strings that represent the friendly names of the printer(s) affected by the change.
'    SHCNF_FLUSH       ' The function should not return until the notification has been delivered to all affected components. As this flag modifies other data-type flags, it cannot by used by itself.
'    SHCNF_FLUSHNOWAIT ' The function should begin delivering notifications to all affected components but should return as soon as the notification process has begun. As this flag modifies other data-type flags, it cannot by used by itself.
'End Enum

'Const SHCNF_IDLIST = &H0&
'Const SHCNF_ACCEPT_INTERRUPTS = &H1&
'Const SHCNF_PATHA = &H1&
'Const SHCNF_ACCEPT_NON_INTERRUPTS = &H2&
'Const SHCNF_PRINTERA = &H2&
'Const SHCNF_DWORD = &H3&
'Const SHCNF_PATHW = &H5&
'Const SHCNF_PRINTERW = &H6&
'Const SHCNF_TYPE = &HFF&
'Const SHCNF_FLUSH = &H1000&
'Const SHCNF_FLUSHNOWAIT = &H2000&
'Const SHCNF_NO_PROXY = &H8000&

Private Const SHCNF_IDLIST = &H0& ' dwItem1 and dwItem2 are ITEMIDLIST structures that represent the item(s) affected by the change. Each ITEMIDLIST must be relative to the desktop folder.
Private Const SHCNF_TYPE = &HFF&  ' Indicates what dwItem1 and dwItem2 mean.
Private Const SHCNF_FLAGS = SHCNF_IDLIST Or SHCNF_TYPE

Private Type tSHNotify
   dwItem1 As Long
   dwItem2 As Long
End Type

' System Timer API's
Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapseMilliseconds As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLenB As Long)
Private Declare Function StrLenW Lib "kernel32" Alias "lstrlenW" (ByVal lpStrW As Long) As Long

Private mTarget_hWnd As Long
Private mPrevWndProc As Long
Private mDesktopPIDL As Long
Private hChangeNotify As Long

Private Type SHEvent
   lEvent As Long
   fEvent As Long
   sName As String
   sName2 As String
End Type

Private tSHEvent(100) As SHEvent
Private cEvents As Long
Private nEvent As Long
Private fInProc As Long

Private clsSearch As cSearch

'************************************PUBLIC SUBS*************************************

' Here we have a Shell hook. Call SetSH([hWnd of any form or control]) to set up the hook.
' From this time on [target form].SHChangeNotify() will be called when e.g. the user
' deletes, copies or moves a file within the Windows Shell (Explorer, Internet Explorer etc.).
' In this way your app can reload file lists to display file changes made outside your app.
' Please look up MSDN for what the messages mean in detail.

Public Sub AttachShellHook(ByVal cSrch As cSearch, ByVal Valid_hWnd As Long)
   Const NOERROR = 0&
   Dim tFSNE As tSHChangeNotifyEntry
   On Error GoTo ErrHandler
   If mTarget_hWnd = 0& Then 'verify
      Set clsSearch = cSrch
      mTarget_hWnd = Valid_hWnd
      mPrevWndProc = SetWindowLong(mTarget_hWnd, GWL_WNDPROC, AddressOf ShellHookProc)
      If SHGetSpecialFolderLocation(0&, CSIDL_DESKTOP, mDesktopPIDL) = NOERROR Then
          tFSNE.lpIDList = mDesktopPIDL 'Each ITEMIDLIST is relative to the desktop.
          tFSNE.fWatchSubFolders = 1& 'TRUE
          hChangeNotify = SHChangeNotifyRegister(mTarget_hWnd, SHCNF_FLAGS, SHCNE_ALLEVENTS, WM_SHNOTIFY, 1&, tFSNE)
      End If
      cEvents = 1&
      nEvent = 1&
   End If
ErrHandler:
End Sub

Public Sub DetachShellHook()
   On Error Resume Next
   If hChangeNotify Then SHChangeNotifyDeregister hChangeNotify
   If mDesktopPIDL Then CoTaskMemFree mDesktopPIDL
   If mPrevWndProc Then SetWindowLong mTarget_hWnd, GWL_WNDPROC, mPrevWndProc
   Set clsSearch = Nothing
   hChangeNotify = 0& 'reset
   mDesktopPIDL = 0& 'reset
   mPrevWndProc = 0& 'reset
   mTarget_hWnd = 0& 'reset
End Sub

'********************************SHELL HOOKING FUNCTION********************************

Private Function ShellHookProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Dim tSHNot As tSHNotify
   Dim sItem As String
   Dim idEvent As Long
   Dim fBlock As Long
  On Error GoTo EndFunc
   Select Case uMsg
     Case WM_SHNOTIFY 'shell notification message

       'wParam points to the notification event-dependent values
       CopyMemory tSHNot, ByVal wParam, Len(tSHNot)
       sItem = PathFromPIDL(tSHNot.dwItem1)

       ' Ignore other events (eg: SHCNE_ASSOCCHANGED, SHCNE_FREESPACE)
       If LenB(sItem) = 0& Then GoTo EndFunc

       cEvents = (cEvents + 1) Mod 101 ' Increment global message counter
       idEvent = cEvents  ' Callback instance event id (bug fix 27 July 2016)
      On Error GoTo EndWith
       With tSHEvent(idEvent)
          .lEvent = lParam
          .sName = sItem

          'lParam is the ID of the notification event (see SHCN_EventIDs)
          Select Case lParam
            Case SHCNE_RENAMEITEM    ' A non-folder item name has changed.
                .sName2 = PathFromPIDL(tSHNot.dwItem2)
            Case SHCNE_RENAMEFOLDER  ' The name of a folder has changed.
                .sName2 = PathFromPIDL(tSHNot.dwItem2)
            Case SHCNE_CREATE        ' A non-folder item has been created.
            Case SHCNE_DELETE        ' A non-folder item has been deleted.
            Case SHCNE_MKDIR         ' A folder item has been created.
            Case SHCNE_RMDIR         ' A folder has been removed.
            Case SHCNE_UPDATEDIR     ' The contents of an existing folder have changed, but the folder still exists and has not been renamed.
            Case SHCNE_ATTRIBUTES    ' The attributes of an item or folder have changed.
            Case SHCNE_UPDATEITEM    ' An existing non-folder item has changed, but the item still exists and has not been renamed.
            Case SHCNE_MEDIAINSERTED ' Storage media has been inserted into a drive.
            Case SHCNE_MEDIAREMOVED  ' Storage media has been removed from a drive.
            Case SHCNE_DRIVEREMOVED  ' A drive has been removed.
            Case SHCNE_DRIVEADD      ' A drive has been added.
            Case Else: fBlock = -1&  ' Flag unwanted events
          End Select
EndWith:
      End With
      If Not fBlock Then ' Pass on only desired events (bug fix 27 July 2016)
         tSHEvent(idEvent).fEvent = -1&            ' Flag global msg as target event
         SetTimer 0&, 0&, 20&, AddressOf TimerProc ' Release back to the shell first
      End If

   End Select
EndFunc:
   ShellHookProc = CallWindowProc(mPrevWndProc, hWnd, uMsg, wParam, lParam)
End Function

Private Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idTimer As Long, ByVal dwTime As Long)
    If fInProc = 0& Then fInProc = -1& Else Exit Sub ' Keep messages in timer-fire limbo (bug fix 19 July 2016)
    KillTimer 0&, idTimer

    Do: nEvent = (nEvent + 1) Mod 101  ' Chase global counter for target events
    Loop Until tSHEvent(nEvent).fEvent ' Only desired events (bug fix 27 July 2016)

   On Error GoTo EndWith
    With tSHEvent(nEvent)
       .fEvent = 0& ' Clear the target event flag

       'lEvent is the ID of the notification event (see SHCN_EventIDs)
       Select Case .lEvent
         Case SHCNE_RENAMEITEM    ' A non-folder item name has changed.
            clsSearch.SHRenameNotify .sName, .sName2, eFile

         Case SHCNE_CREATE        ' A non-folder item has been created.
            clsSearch.SHCreateNotify .sName, eFile ' Create msg + update dir

         Case SHCNE_DELETE        ' A non-folder item has been deleted.
            clsSearch.SHDeleteNotify .sName, eFile ' Delete msg + update dir

         Case SHCNE_MKDIR         ' A folder item has been created.
            clsSearch.SHCreateNotify .sName, eFolder

         Case SHCNE_RMDIR         ' A folder has been removed.
            clsSearch.SHDeleteNotify .sName, eFolder

         Case SHCNE_UPDATEDIR     ' The contents of an existing folder have changed, but the folder
            clsSearch.SHUpdateNotify .sName, eFolder       ' still exists and has not been renamed.

         Case SHCNE_ATTRIBUTES    ' The attributes of an item or folder have changed.
            clsSearch.SHUpdateNotify .sName, eFile

         Case SHCNE_UPDATEITEM    ' An existing non-folder item has changed, but the item still
            clsSearch.SHUpdateNotify .sName, eFile         ' exists and has not been renamed.

         Case SHCNE_RENAMEFOLDER  ' The name of a folder has changed.
            clsSearch.SHRenameNotify .sName, .sName2, eFolder

         Case SHCNE_MEDIAINSERTED ' Storage media has been inserted into a drive.
            clsSearch.SHMediaInserted .sName

         Case SHCNE_MEDIAREMOVED  ' Storage media has been removed from a drive.
            clsSearch.SHMediaRemoved .sName

         Case SHCNE_DRIVEREMOVED  ' A drive has been removed.
            clsSearch.SHDriveRemoved .sName

         Case SHCNE_DRIVEADD      ' A drive has been added.
            clsSearch.SHDriveAdded .sName

       End Select
EndWith:
    End With
    fInProc = 0&
End Sub

Private Function PathFromPIDL(ByVal lpIDL As Long) As String
   Const MAX_PATH = 260&
   Dim SHPath As String
   SHPath = String$(MAX_PATH, vbNullChar)
   If SHGetPathFromIDList(lpIDL, StrPtr(SHPath)) Then
      PathFromPIDL = Left$(SHPath, StrLenW(StrPtr(SHPath)))
   End If
End Function

'**************************************************************************************

' Original Shell Change Notification module thanks to Louis - www.louis-coder.com

' Thanks also to the anonymous coder of 'Shell Ueberwachung' and to James Holderness
' who have generously contributed these undocumented APIs to the coding community

'**************************************************************************************

