WINDOWS unsuccessful function reveals - three
Http://www.applevb.com This introduction is how to use the Windows unappromated function to implement system file operation monitoring. With this feature, you can operate any files, folders, folders; delete files; change file size, etc., can be recorded. First, to achieve the above described operation does not disclose two functions: SHChangeNotifyRegister definitions and SHChangeNotifyDeregister, SHChangeNotifyRegister function is as follows: Declare 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 line These parameter hWnd Specifies the window handle of the system advertisement, the parameter uMSG specifies the message value, if the function call is successful, the system will specify hWnd The window is added to the system advertisement chain and returns the system adverb handle. When there is a system operation such as a setup file, the system sends a UMSG message to the window specified by the HWND, and the other parameters will be described below. The definition of SHCHANGENOTIFYDEREGISTER is as follows: DECLARE FUNCHANGENOTIFYDEREGISTER LIB "Shell32" Alias "# 4" _ (BYVAL HNOTIFY As Long) AS Boolean is the handle of the parameter hNotify specifies the system notification. Here is the specific VB example: first establish a new project, add a TextBox control in Form1. Add the following code among the Form1 code window: Option Explicit
Private Sub Form_Load () if SubClass (HWND) THEN 'Change Form1 Message Processing IF Iside TEEN TEXT1.TEXT = VBCRLF & _ "A Windows File Directory Operation Instant Monitor," & VBCRLF & "can be monitored in Explore Rename, new, delete text "& _ VBCRLF &" Parts or Directory; change file associations; insert, remove CD and add "& VBCRLF &" to delete network sharing can be recorded by the program. "Endiff shNotify_Register (HWnd ELSE TEXT1 = "The system does not support operation monitor :-)" endiff screen.width - width, screen.height - Heightend Sub
Private function iside () as boolean on error got debug.print 1 / 0out: iside = Errend FunctionPrivate Sub Form_unload (Cancel As Integer) Call ShNotify_unregister Call unsubclass (hwnd) End Sub
Public Sub NotificationReceipt (wParam As Long, lParam As Long) Dim sOut As String Dim shns As SHNOTIFYSTRUCT Dim sDisplayname1 As String Dim sDisplayname2 As String MoveMemory shns, ByVal wParam, Len (shns) If shns.dwItem1 Then sDisplayname1 = GetDisplayNameFromPIDL (shns.dwItem1 ) End If If shns.dwItem2 then sDisplayname2 = GetDisplayNameFromPIDL (shns.dwItem2) End If sOut = SHNotify_GetEventStr (sDisplayname1, sDisplayname2, lParam) & vbCrLf Text1 = Text1 & sOut & vbCrLf Text1.SelStart = Len (Text1) End Sub then in the project The three modules (BAS) files are added to save three files as MDEF.BAS, MSHELL.BAS, MSUB.BAS. Add the following code in MDEF.BAS: 'MDEF.BAS contains the function of the shell operation and the definition of the data type Option Explicit
DECLARE SUB MOVEMORY LIB "kernel32" Alias "RTLMoveMemory" (PDEST AS Any, _ Psource As Any, Byval Dwlength As Long) Declare Sub Cotaskmemfree Lib "OLE32.DLL" (Byval Pv As Long)
Public const Max_path = 260public const noerror = 0
'SHGetSpecialFolderLocation get a position in a special directory, if the function returns successfully NOERROR' or an OLE error Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _ (ByVal hwndOwner As Long, _ ByVal nFolder As SHSpecialFolderIDs, _ pidl As Long) As Long
Public Enum SHSpecialFolderIDs' listed ID CSIDL_DESKTOP all Windows special folders = & 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 CSIDL_COMMON_ALTSTARTUP = & H1E CSIDL_COMMON_FAVORITES = & H1F CSIDL_INTERNET_CACHE = & H20 CSIDL_COOKIES = & H21 csidl_history = & h22nd enum'ShgetPathFromidList function converts an item to file path Declare function shGetpathfromidlist lib "shell32.dll" Alias "SHGETPATHFROMIDLISTA" _ (Byval PIDL As Long, _ Byval Pszpath As String) As long
The 'ShgetFileInfopidl function gets information about a file object. Declare 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 LongPublic Type SHFILEINFOBYTE hIcon As Long iIcon As Long dwattributes as long szdisplayname (1 to max_path) as byte sztypename (1 to 80) as Byteend Type
Declare 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 Long
Public Type Shfileinfo Hicon As Long Iicon As Long Dwattributes As Long SzdisplayName As String * Max_Path Sztypename As String * 801nd Type
Enum SHGFI_flags SHGFI_LARGEICON = & H0 SHGFI_SMALLICON = & H1 SHGFI_OPENICON = & H2 SHGFI_SHELLICONSIZE = & H4 SHGFI_PIDL = & H8 SHGFI_USEFILEATTRIBUTES = & H10 SHGFI_ICON = & H100 SHGFI_DISPLAYNAME = & H200 SHGFI_TYPENAME = & H400 SHGFI_ATTRIBUTES = & H800 SHGFI_ICONLOCATION = & H1000 SHGFI_EXETYPE = & H2000 SHGFI_SYSICONINDEX = & H4000 SHGFI_LINKOVERLAY = & H8000 SHGFI_SELECTED = & H10000End Enum
'According to ID a specific folder object obtained by its directory pidlPublic 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 FunctionPublic 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
PUBLIC FUNCTION GETPATHFROMPIDL (PIDL As Long) AS String Dim Spath AS String * Max_Path if ShgetPathFromidList (PIDL, Spath) Then getPathFromPIDL = GetStrFromBuffera (spath) ends ifend function
Public Function GetStrFromBufferA (sz As String) As String If InStr (sz, vbNullChar) Then GetStrFromBufferA = Left $ (sz, InStr (sz, vbNullChar) - 1) Else GetStrFromBufferA = sz End IfEnd Function
Add the following code in MShell.ba: 'mshell.baS function contains a function of registration and anti-registration system notification and folder information conversion Option Explicit
Private M_HSHNOTIFY As Long 'System Message Notification Handle Private M_PIDLDESKTOP AS LONG
'Define the message value of the system notification public const wm_shNotify = & H401
Public Type Pidlstruct PIDL As Long BwatchSubfolders As LONGEND TYPE
Declare 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
TYPE SHNOTIFYSTRUCT DWITEM1 AS Long Dwitem2 As LONGEND TYPEDECLARE FUNCTION SHCHANGENGENOTIFYDEREGISTER LIB "Shell32" Alias "# 4" _ (Byval Hnotify As Long) AS Boolean
Declare Sub ShchangenNotify Lib "Shell32" _ (Byval Weventid AS SHW_EVENTIDS, _ BYVAL UFLAGS AS SHCN_ITEMFLAGS, _ BYVAL DWITEM1 AS Long, _ Byval dwitem2 as long
Public Enum SHCN_EventIDs SHCNE_RENAMEITEM = & H1 SHCNE_CREATE = & H2 SHCNE_DELETE = & H4 SHCNE_MKDIR = & H8 SHCNE_RMDIR = & H10 SHCNE_MEDIAINSERTED = & H20 SHCNE_MEDIAREMOVED = & H40 SHCNE_DRIVEREMOVED = & H80 SHCNE_DRIVEADD = & H100 SHCNE_NETSHARE = & H200 SHCNE_NETUNSHARE = & H400 SHCNE_ATTRIBUTES = & H800 SHCNE_UPDATEDIR = & H1000 SHCNE_UPDATEITEM = & H2000 SHCNE_SERVERDISCONNECT = & H4000 SHCNE_UPDATEIMAGE = & H8000 & shcne_driveaddgui = & h10000 shcne_renamefolder = & h20000 shcne_freespace = & h40000 shcne_assocchanged = & h8000000
SHCNE_DISKEVENTS = & h2381f shcne_globalevents = & hc0581e0 shcne_allevents = & h7fffffff shcne_interrupt = & h80000000 中文 ENUM
#If (win32_ie> = & h400) THEN public const shcnee_orderchanged = & h2 # endiff
Public Enum SHCN_ItemFlags SHCNF_IDLIST = & H0 SHCNF_PATHA = & H1 SHCNF_PRINTERA = & H2 SHCNF_DWORD = & H3 SHCNF_PATHW = & H5 SHCNF_PRINTERW = & H6 SHCNF_TYPE = & HFF SHCNF_FLUSH = & H1000 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
Public Function SHNotify_Register (hWnd As Long) As Boolean Dim ps As PIDLSTRUCT If (m_hSHNotify = 0) Then m_pidlDesktop = GetPIDLFromFolderID (0, CSIDL_DESKTOP) If m_pidlDesktop Then ps.pidl = m_pidlDesktop ps.bWatchSubFolders = True 'Windows monitoring registration, obtained save the handle to m_hSHNotify m_hSHNotify = SHChangeNotifyRegister (hWnd, SHCNF_TYPE Or SHCNF_IDLIST, _ SHCNE_ALLEVENTS Or SHCNE_INTERRUPT, _ WM_SHNOTIFY, 1, ps) SHNotify_Register = CBool (m_hSHNotify) Else Call CoTaskMemFree (m_pidlDesktop) End If End IfEnd Function
Public Function SHNotify_Unregister () As Boolean If m_hSHNotify Then If SHChangeNotifyDeregister (m_hSHNotify) Then m_hSHNotify = 0 Call CoTaskMemFree (m_pidlDesktop) m_pidlDesktop = 0 SHNotify_Unregister = True End If End IfEnd Function
Public Function SHNotify_GetEventStr (strPath1, strPath2 As String, dwEventID As Long) As String Dim sEvent As String Select Case dwEventID Case SHCNE_RENAMEITEM: sEvent = "Rename Files" strPath1 "to" strPath2 Case SHCNE_CREATE: sEvent = "build file name: " strPath1 Case SHCNE_DELETE: sEvent =" delete file name: " strPath1 Case SHCNE_MKDIR: sEvent =" new directory directory name: " strPath1 Case SHCNE_RMDIR: sEvent =" delete directory directory name: " strPath1 Case SHCNE_MEDIAINSERTED: sEvent = strPath1 "is inserted into the removable storage medium" Case SHCNE_MEDIAREMOVED: sEvent = strPath1 "in removing the removable storage medium" Case SHCNE_DRIVEREMOVED: sEvent = "remove drive" strPath1 Case SHCNE_DRIVEADD: sEvent = "Add drive" strPath1 Case SHCNE_NETSHARE: sEvent = "change directory" strPath1 "shared property" Case SHCNE_UPDATEDIR: sEvent = "update directory" strPath1 Case SHCNE_UPDATEITEM: sEvent = "update file name:" strPath1 Case SHCNE_SERVERDISCONNECT: sEvent = "off Open " StrPath1 " StrPath2 Case Shcne_UPDATEIMAGE: sEvent = "SHCNE_UPDATEIMAGE" Case SHCNE_DRIVEADDGUI: sEvent = "SHCNE_DRIVEADDGUI" Case SHCNE_RENAMEFOLDER: sEvent = "Rename Folder" strPath1 "to" strPath2 Case SHCNE_FREESPACE: sEvent = "disk space change" Case SHCNE_ASSOCCHANGED: sEvent = "change Document association "End select shNotify_geteventstr = seventend function
Add the following code in msub.bas: 'MSUB functions include the message processing function of the window Option ExplicitPrivate const wm_ncdestroy = & h82private const GWL_WndProc = (-4) private constldWndProc = "OldWndProc"
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal _ hWnd As Long, ByVal lpString As String) As LongPrivate Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal _ hWnd As Long, ByVal lpString As String, ByVal HDATA AS Long) As longprivate declare function removeprop lib "user32" Alias "removepropa" (byval _ hwnd as long, byval lpstring as string) AS Long
Private Declare Function SetWindowlong Lib "User32" Alias "Setwindowlonga" _ (Byval Hwnd As Long, BYVAL DWNEWLONG AS long) As long
Private declare function callwindowproc lib "user32" Alias "CallWindowProca" _ (Byval HWND As Long, Byval Umsg As Long, _ Byval WParam As Long, BYVAL LPARAM AS Long AS Long
Public 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 IfEnd Function
Public 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 (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As _ Long, ByVal lParam As Long) As Long Select Case uMsg Case WM_SHNOTIFY 'Newsletter processing system function 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
Save the file, then run the program, then you can try to create or delete a file or folder in Explore, you can see what you do in Form has been recorded and displayed in TextBox. Now analyze the following programs, the above program first calls the SHCHANGENOTIGISTER function to add the Form to the system message advertisement chain, and use the setWindowlong function to change the default message processing function of the Form, after accepting the system advertisement message, according to the passing parameters Get the contents of the system advertisement and appear in the text window. Call the SHCHANGENOTIFYDEREGISTER function logout system message announcement when exiting the program.
