概述
Attribute VB_Name
=
"
mShellNotify
"
Option
Explicit
'
Brought to you by Brad Martinez
'
http://members.aol.com/btmtz/vb
'
http://www.mvps.org/ccrp
'
Code was written in and formatted for 8pt MS San Serif
'
====================================================================
'
Demonstrates how to receive shell change notifications (ala "what happens when the
'
SHChangeNotify API is called?")
'
Interpretation of the shell's undocumented functions SHChangeNotifyRegister (ordinal 2)
'
and SHChangeNotifyDeregister (ordinal 4) would not have been possible without the
'
assistance of James Holderness. For a complete (and probably more accurate) overview
'
of shell change notifcations, please refer to James' "Shell Notifications" page at
'
http://www.geocities.com/SiliconValley/4942/
'
====================================================================
Private
m_hSHNotify
As
Long
'
the one and only shell change notification handle for the desktop folder
Private
m_pidlDesktop
As
Long
'
the desktop's pidl
'
User defined notiication message sent to the specified window's window proc.
Public
Const
WM_SHNOTIFY
=
&
H401
'
====================================================================
Public
Type PIDLSTRUCT
'
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).
bWatchSubFolders
As
Long
End
Type
Declare
Function SHChangeNotifyRegister()
Function SHChangeNotifyRegister Lib "shell32" Alias "#2" _
(ByVal hWnd As Long, _ ByVal uFlags As SHCN_ItemFlags, _ ByVal dwEventID As SHCN_EventIDs, _ ByVal uMsg As Long, _ ByVal cItems As Long, _ lpps As PIDLSTRUCT) As Long' hWnd - Handle of the window to receive the window message specified in uMsg.' uFlags - Flag that indicates the meaning of the dwItem1 and dwItem2 members of the' SHNOTIFYSTRUCT (which is pointed to by the window procedure's wParam' value when the specifed window message is received). This parameter can' be one of the SHCN_ItemFlags enum values below.' This interpretaion may be inaccurate as it appears pdils are almost alway returned' in the SHNOTIFYSTRUCT. See James' site for more info...' dwEventId - Combination of SHCN_EventIDs enum values that specifies what events the' specified window will be notified of. See below. ' uMsg - Window message to be used to identify receipt of a shell change notification.' The message should *not* be a value that lies within the specifed window's' message range ( i.e. BM_ messages for a button window) or that window may' not receive all (if not any) notifications sent by the shell!!!' cItems - Count of PIDLSTRUCT structures in the array pointed to by the lpps param.' lpps - Pointer to an array of PIDLSTRUCT structures indicating what folder(s) to monitor' changes in, and whether to watch the specified folder's subfolder.' If successful, returns a notification handle which must be passed to SHChangeNotifyDeregister' when no longer used. Returns 0 otherwise.' Once the specified message is registered with SHChangeNotifyRegister, the specified' window's function proc will be notified by the shell of the specified event in (and under)' the folder(s) speciifed in apidl. On message receipt, wParam points to a SHNOTIFYSTRUCT' and lParam contains the event's ID value.' The values in dwItem1 and dwItem2 are event specific. See the description of the values' for the wEventId parameter of the documented SHChangeNotify API function.Type SHNOTIFYSTRUCT dwItem1 As Long dwItem2 As LongEnd Type' ...?'Declare Function SHChangeNotifyUpdateEntryList Lib "shell32" Alias "#5" _' (ByVal hNotify As Long, _' ByVal Unknown As Long, _' ByVal cItem As Long, _' lpps As PIDLSTRUCT) As Boolean''Declare Function SHChangeNotifyReceive Lib "shell32" Alias "#5" _' (ByVal hNotify As Long, _' ByVal uFlags As SHCN_ItemFlags, _' ByVal dwItem1 As Long, _' ByVal dwItem2 As Long) As Long' Closes the notification handle returned from a call to SHChangeNotifyRegister.' Returns True if succeful, False otherwise.
Declare Function SHChangeNotifyDeregister()Function SHChangeNotifyDeregister Lib "shell32" Alias "#4" (ByVal hNotify As Long) As Boolean' ====================================================================' This function should be called by any app that changes anything in the shell.' The shell will then notify each "notification registered" window of this action.Declare Sub SHChangeNotify()Sub SHChangeNotify Lib "shell32" _ (ByVal wEventId As SHCN_EventIDs, _ ByVal uFlags As SHCN_ItemFlags, _ ByVal dwItem1 As Long, _ ByVal dwItem2 As Long)' Shell notification event IDsPublic Enum SHCN_EventIDsEnum SHCN_EventIDs SHCNE_RENAMEITEM = &H1 ' (D) A nonfolder item has been renamed. SHCNE_CREATE = &H2 ' (D) A nonfolder item has been created. SHCNE_DELETE = &H4 ' (D) A nonfolder 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 nonfolder 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 ' WIN32_IE >= &H0400 SHCNE_ASSOCCHANGED = &H8000000 ' (G) A file type association has changed. SHCNE_DISKEVENTS = &H2381F ' Specifies a combination of all of the disk event identifiers. (D) SHCNE_GLOBALEVENTS = &HC0581E0 ' Specifies a combination of all of the global event identifiers. (G) 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' Notification flags' uFlags & SHCNF_TYPE is an ID which indicates what dwItem1 and dwItem2 meanPublic Enum SHCN_ItemFlagsEnum 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#If UNICODE Then SHCNF_PATH = SHCNF_PATHW SHCNF_PRINTER = SHCNF_PRINTERW#Else SHCNF_PATH = SHCNF_PATHA SHCNF_PRINTER = SHCNF_PRINTERA#End IfEnd Enum'' Registers the one and only shell change notification.Public Function SHNotify_Register()Function SHNotify_Register(hWnd As Long) As Boolean Dim ps As PIDLSTRUCT ' If we don't already have a notification going... If (m_hSHNotify = 0) Then ' Get the pidl for the desktop folder. m_pidlDesktop = GetPIDLFromFolderID(0, CSIDL_DESKTOP) If m_pidlDesktop Then ' Fill the one and only PIDLSTRUCT, we're watching ' desktop and all of the it's subfolders, everything... ps.pidl = m_pidlDesktop ps.bWatchSubFolders = True ' Register the notification, specifying that we want the dwItem1 and dwItem2 ' members of the SHNOTIFYSTRUCT to be pidls. We're watching all events. m_hSHNotify = SHChangeNotifyRegister(hWnd, SHCNF_TYPE Or SHCNF_IDLIST, _ SHCNE_ALLEVENTS Or SHCNE_INTERRUPT, _ WM_SHNOTIFY, 1, ps) Debug.Print Hex(SHCNF_TYPE Or SHCNF_IDLIST) Debug.Print Hex(SHCNE_ALLEVENTS Or SHCNE_INTERRUPT) Debug.Print m_hSHNotify SHNotify_Register = CBool(m_hSHNotify) Else ' If something went wrong... Call CoTaskMemFree(m_pidlDesktop) End If ' m_pidlDesktop End If ' (m_hSHNotify = 0) End Function' Unregisters the one and only shell change notification.Public Function SHNotify_Unregister()Function SHNotify_Unregister() As Boolean ' If we have a registered notification handle. If m_hSHNotify Then ' Unregister it. If the call is successful, zero the handle's variable, ' free and zero the the desktop's pidl. If SHChangeNotifyDeregister(m_hSHNotify) Then m_hSHNotify = 0 Call CoTaskMemFree(m_pidlDesktop) m_pidlDesktop = 0 SHNotify_Unregister = True End If End IfEnd Function' Returns the event string associated with the specified event ID value.Public Function SHNotify_GetEventStr()Function SHNotify_GetEventStr(dwEventID As Long) As String Dim sEvent As String Select Case dwEventID Case SHCNE_RENAMEITEM: sEvent = "SHCNE_RENAMEITEM" ' = &H1" Case SHCNE_CREATE: sEvent = "SHCNE_CREATE" ' = &H2" Case SHCNE_DELETE: sEvent = "SHCNE_DELETE" ' = &H4" Case SHCNE_MKDIR: sEvent = "SHCNE_MKDIR" ' = &H8" Case SHCNE_RMDIR: sEvent = "SHCNE_RMDIR" ' = &H10" Case SHCNE_MEDIAINSERTED: sEvent = "SHCNE_MEDIAINSERTED" ' = &H20" Case SHCNE_MEDIAREMOVED: sEvent = "SHCNE_MEDIAREMOVED" ' = &H40" Case SHCNE_DRIVEREMOVED: sEvent = "SHCNE_DRIVEREMOVED" ' = &H80" Case SHCNE_DRIVEADD: sEvent = "SHCNE_DRIVEADD" ' = &H100" Case SHCNE_NETSHARE: sEvent = "SHCNE_NETSHARE" ' = &H200" Case SHCNE_NETUNSHARE: sEvent = "SHCNE_NETUNSHARE" ' = &H400" Case SHCNE_ATTRIBUTES: sEvent = "SHCNE_ATTRIBUTES" ' = &H800" Case SHCNE_UPDATEDIR: sEvent = "SHCNE_UPDATEDIR" ' = &H1000" Case SHCNE_UPDATEITEM: sEvent = "SHCNE_UPDATEITEM" ' = &H2000" Case SHCNE_SERVERDISCONNECT: sEvent = "SHCNE_SERVERDISCONNECT" ' = &H4000" Case SHCNE_UPDATEIMAGE: sEvent = "SHCNE_UPDATEIMAGE" ' = &H8000&" Case SHCNE_DRIVEADDGUI: sEvent = "SHCNE_DRIVEADDGUI" ' = &H10000" Case SHCNE_RENAMEFOLDER: sEvent = "SHCNE_RENAMEFOLDER" ' = &H20000" Case SHCNE_FREESPACE: sEvent = "SHCNE_FREESPACE" ' = &H40000" #If (WIN32_IE >= &H400) Then Case SHCNE_EXTENDED_EVENT: sEvent = "SHCNE_EXTENDED_EVENT" ' = &H4000000"#End If ' WIN32_IE >= &H0400 Case SHCNE_ASSOCCHANGED: sEvent = "SHCNE_ASSOCCHANGED" ' = &H8000000" Case SHCNE_DISKEVENTS: sEvent = "SHCNE_DISKEVENTS" ' = &H2381F" Case SHCNE_GLOBALEVENTS: sEvent = "SHCNE_GLOBALEVENTS" ' = &HC0581E0" Case SHCNE_ALLEVENTS: sEvent = "SHCNE_ALLEVENTS" ' = &H7FFFFFFF" Case SHCNE_INTERRUPT: sEvent = "SHCNE_INTERRUPT" ' = &H80000000" End Select SHNotify_GetEventStr = sEventEnd Function
Attribute VB_Name
=
"
mSubClass
"
Option
Explicit
'
Brought to you by Brad Martinez
'
http://members.aol.com/btmtz/vb
'
http://www.mvps.org/ccrp
'
Code was written in and formatted for 8pt MS San Serif
Private
Const
WM_NCDESTROY
=
&
H82
Private
Declare
Function GetProp()
Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) As LongPrivate Declare Function SetProp()Function SetProp Lib "user32" Alias "SetPropA" (ByVal hWnd As Long, ByVal lpString As String, ByVal hData As Long) As LongPrivate Declare Function RemoveProp()Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hWnd As Long, ByVal lpString As String) As LongPrivate Declare Function SetWindowLong()Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Const GWL_WNDPROC = (-4)Private Declare Function CallWindowProc()Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPrivate Const OLDWNDPROC = "OldWndProc"'Public Function SubClass()Function SubClass(hWnd As Long) As Boolean Dim lpfnOld As Long Dim fSuccess As Boolean If (GetProp(hWnd, OLDWNDPROC) = 0) Then lpfnOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc) If lpfnOld Then fSuccess = SetProp(hWnd, OLDWNDPROC, lpfnOld) End If End If If fSuccess Then SubClass = True Else If lpfnOld Then Call UnSubClass(hWnd) MsgBox "Unable to successfully subclass &H" & Hex(hWnd), vbCritical End If End FunctionPublic Function UnSubClass()Function UnSubClass(hWnd As Long) As Boolean Dim lpfnOld As Long lpfnOld = GetProp(hWnd, OLDWNDPROC) If lpfnOld Then If RemoveProp(hWnd, OLDWNDPROC) Then UnSubClass = SetWindowLong(hWnd, GWL_WNDPROC, lpfnOld) End If End IfEnd FunctionPublic Function WndProc()Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Select Case uMsg Case WM_SHNOTIFY Call Form1.NotificationReceipt(wParam, lParam) Case WM_NCDESTROY Call UnSubClass(hWnd) MsgBox "Unubclassed &H" & Hex(hWnd), vbCritical, "WndProc Error" End Select WndProc = CallWindowProc(GetProp(hWnd, OLDWNDPROC), hWnd, uMsg, wParam, lParam) End Function
Attribute VB_Name
=
"
mShellDefs
"
Option
Explicit
'
Brought to you by Brad Martinez
'
http://members.aol.com/btmtz/vb
'
http://www.mvps.org/ccrp
'
Code was written in and formatted for 8pt MS San Serif
'
====================================================================
Declare
Function FlashWindow()
Function FlashWindow Lib "user32" (ByVal hWnd As Long, ByVal bInvert As Long) As LongDeclare Sub MoveMemory()Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)' Frees memory allocated by the shell (pidls)Declare Sub CoTaskMemFree()Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)Public Const MAX_PATH = 260' Defined as an HRESULT that corresponds to S_OK.Public Const NOERROR = 0' Retrieves the location of a special (system) folder.' Returns NOERROR if successful or an OLE-defined error result otherwise.Declare Function SHGetSpecialFolderLocation()Function SHGetSpecialFolderLocation Lib "shell32.dll" _ (ByVal hwndOwner As Long, _ ByVal nFolder As SHSpecialFolderIDs, _ pidl As Long) As Long' Special folder values for SHGetSpecialFolderLocation and' SHGetSpecialFolderPath (Shell32.dll v4.71)Public Enum SHSpecialFolderIDsEnum SHSpecialFolderIDs CSIDL_DESKTOP = &H0 CSIDL_INTERNET = &H1 CSIDL_PROGRAMS = &H2 CSIDL_CONTROLS = &H3 CSIDL_PRINTERS = &H4 CSIDL_PERSONAL = &H5 CSIDL_FAVORITES = &H6 CSIDL_STARTUP = &H7 CSIDL_RECENT = &H8 CSIDL_SENDTO = &H9 CSIDL_BITBUCKET = &HA CSIDL_STARTMENU = &HB CSIDL_DESKTOPDIRECTORY = &H10 CSIDL_DRIVES = &H11 CSIDL_NETWORK = &H12 CSIDL_NETHOOD = &H13 CSIDL_FONTS = &H14 CSIDL_TEMPLATES = &H15 CSIDL_COMMON_STARTMENU = &H16 CSIDL_COMMON_PROGRAMS = &H17 CSIDL_COMMON_STARTUP = &H18 CSIDL_COMMON_DESKTOPDIRECTORY = &H19 CSIDL_APPDATA = &H1A CSIDL_PRINTHOOD = &H1B CSIDL_ALTSTARTUP = &H1D ' ' DBCS CSIDL_COMMON_ALTSTARTUP = &H1E ' ' DBCS CSIDL_COMMON_FAVORITES = &H1F CSIDL_INTERNET_CACHE = &H20 CSIDL_COOKIES = &H21 CSIDL_HISTORY = &H22End Enum' Converts an item identifier list to a file system path.' Returns TRUE if successful or FALSE if an error occurs, for example,' if the location specified by the pidl parameter is not part of the file system.Declare Function SHGetPathFromIDList()Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _ (ByVal pidl As Long, _ ByVal pszPath As String) As Long' Retrieves information about an object in the file system, such as a file,' a folder, a directory, or a drive root.Declare Function SHGetFileInfoPidl()Function SHGetFileInfoPidl Lib "shell32" Alias "SHGetFileInfoA" _ (ByVal pidl As Long, _ ByVal dwFileAttributes As Long, _ psfib As SHFILEINFOBYTE, _ ByVal cbFileInfo As Long, _ ByVal uFlags As SHGFI_flags) As Long' If pidl is invalid, SHGetFileInfoPidl can very easily blow up when filling the' szDisplayName and szTypeName string members of the SHFILEINFO structPublic Type SHFILEINFOBYTE ' sfib hIcon As Long iIcon As Long dwAttributes As Long szDisplayName(1 To MAX_PATH) As Byte szTypeName(1 To 80) As ByteEnd TypeDeclare Function SHGetFileInfo()Function SHGetFileInfo Lib "shell32" Alias "SHGetFileInfoA" _ (ByVal pszPath As String, _ ByVal dwFileAttributes As Long, _ psfi As SHFILEINFO, _ ByVal cbFileInfo As Long, _ ByVal uFlags As SHGFI_flags) As LongPublic Type SHFILEINFO ' shfi hIcon As Long iIcon As Long dwAttributes As Long szDisplayName As String * MAX_PATH szTypeName As String * 80End TypeEnum SHGFI_flagsEnum SHGFI_flags SHGFI_LARGEICON = &H0 ' sfi.hIcon is large icon SHGFI_SMALLICON = &H1 ' sfi.hIcon is small icon SHGFI_OPENICON = &H2 ' sfi.hIcon is open icon SHGFI_SHELLICONSIZE = &H4 ' sfi.hIcon is shell size (not system size), rtns BOOL SHGFI_PIDL = &H8 ' pszPath is pidl, rtns BOOL SHGFI_USEFILEATTRIBUTES = &H10 ' pretent pszPath exists, rtns BOOL SHGFI_ICON = &H100 ' fills sfi.hIcon, rtns BOOL, use DestroyIcon SHGFI_DISPLAYNAME = &H200 ' isf.szDisplayName is filled, rtns BOOL SHGFI_TYPENAME = &H400 ' isf.szTypeName is filled, rtns BOOL SHGFI_ATTRIBUTES = &H800 ' rtns IShellFolder::GetAttributesOf SFGAO_* flags SHGFI_ICONLOCATION = &H1000 ' fills sfi.szDisplayName with filename ' containing the icon, rtns BOOL SHGFI_EXETYPE = &H2000 ' rtns two ASCII chars of exe type SHGFI_SYSICONINDEX = &H4000 ' sfi.iIcon is sys il icon index, rtns hImagelist SHGFI_LINKOVERLAY = &H8000 ' add shortcut overlay to sfi.hIcon SHGFI_SELECTED = &H10000 ' sfi.hIcon is selected iconEnd Enum'' Returns an absolute pidl (realtive to the desktop) from a special folder's ID.' (calling proc is responsible for freeing the pidl)' hOwner - handle of window that will own any displayed msg boxes' nFolder - special folder IDPublic Function GetPIDLFromFolderID()Function GetPIDLFromFolderID(hOwner As Long, nFolder As SHSpecialFolderIDs) As Long Dim pidl As Long If SHGetSpecialFolderLocation(hOwner, nFolder, pidl) = NOERROR Then GetPIDLFromFolderID = pidl End IfEnd Function' If successful returns the specified absolute pidl's displayname,' returns an empty string otherwise.Public Function GetDisplayNameFromPIDL()Function GetDisplayNameFromPIDL(pidl As Long) As String Dim sfib As SHFILEINFOBYTE If SHGetFileInfoPidl(pidl, 0, sfib, Len(sfib), SHGFI_PIDL Or SHGFI_DISPLAYNAME) Then GetDisplayNameFromPIDL = GetStrFromBufferA(StrConv(sfib.szDisplayName, vbUnicode)) End IfEnd Function' Returns a path from only an absolute pidl (relative to the desktop)Public Function GetPathFromPIDL()Function GetPathFromPIDL(pidl As Long) As String Dim sPath As String * MAX_PATH If SHGetPathFromIDList(pidl, sPath) Then ' rtns TRUE (1) if successful, FALSE (0) if not GetPathFromPIDL = GetStrFromBufferA(sPath) End IfEnd Function' Returns the string before first null char encountered (if any) from an ANSII string.Public Function GetStrFromBufferA()Function GetStrFromBufferA(sz As String) As String If InStr(sz, vbNullChar) Then GetStrFromBufferA = Left$(sz, InStr(sz, vbNullChar) - 1) Else ' If sz had no null char, the Left$ function ' above would return a zero length string (""). GetStrFromBufferA = sz End IfEnd Function
Powered by barenx
最后
以上就是开放手链为你收集整理的VB 监视文件改变 代码的全部内容，希望文章能够帮你解决VB 监视文件改变 代码所遇到的程序开发问题。
如果觉得靠谱客网站的内容还不错，欢迎将靠谱客网站推荐给程序员好友。
本图文内容来源于网友提供，作为学习参考使用，或来自网络收集整理，版权属于原作者所有。
发表评论 取消回复