WINDOWS unsuccessful function reveals - three
This introduction is how to use the Windows Unprecedented Function to implement system file operation monitoring. Use this feature to any files under Windows
Operation, including create files, folders; delete files; change file size and other operations can be recorded.
First introduce two undoled functions to implement above: SHCHANGENOTIFYREGISTER and SHCHANGENOTIFYDEREGOSTER
The definition of the SHCHANGENOTIGIGISTER function is as follows:
Declare function shchangenotifyregister lib "shell32" Alias "# 2" _
(Byval Hwnd As Long, _
Byval uflags as shcn_itemflags, _
Byval dweiventid as shcn_eventids, _
Byval umsg as long, _
Byval Citems as long, _
LPPS AS PIDLSTRUCT) AS Long
The 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 advice handle. When there is a system operation such as a file, the system will send the window specified by HWND.
UMSG messages, for other parameters, will be described below. The definition of the function ShchangenNotifydegegister is as follows:
DECLARE FUNCTION SHCHANGENOTIFYDEREGISTER LIB "shell32" Alias "# 4" _
(Byval Hnotify As Long) As Boolean
The parameter hNotify specifies the handle of the system notification.
Here is the specific VB example of the operation:
First create a new project, add a TextBox control in Form1. Add the following code among the Form1 code window:
Option expedition
Private sub flow_load ()
If SUBCLASS (HWND) THEN 'Change the message handler of Form1
If iside the
Text1.text = VBCRLF & _
"A Windows file directory operation instant monitor," & VBCRLF & "can monitor rename, new, delete text in Explore," "& _
VBCRLF & "Parts or Directory; changing file associations; insert, removing CDs and adding" & VBCRLF & "deleting network sharing can be recorded by the program."
END IF
Call ShNotify_Register (HWND)
Else
TEXT1 = "The system does not support operational monitoring programs :-)"
END IF
Move Screen.width - Width, Screen.height - Height
End Sub
Private function iside () as boolean
ON Error Goto Out
Debug.print 1/0
OUT:
ISIDE = ERR
END FUNCTION
Private Sub Form_Unload (Cancel AS Integer)
Call shNotify_unregister
Call unsubclass (hwnd)
End Sub
Public Sub NotificationReceipt (WPARAM 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 add three modules (BAS) files in the project, saved three files as mdef.bas, mshell.bas, msub.bas. Add the following code in MDEF.BAS:
'mdef.bas contains the definition of the function and data type of the shell operation
Option expedition
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 = 260
Public const noerror = 0
'ShgetSpecialFolderLocation Gets a location of a special directory, if the function call successfully returns noerror
'Or an OLE error
DecLare Function ShgetspecialFolderLocation Lib "shell32.dll" _
(Byval Hwndowner As Long, _
Byval nfolder as shssecialfolderids, _
PIDL AS Long) As Long
Public Enum ShSpecialFolderIDS 'Lists all IDs of all Windows special folders
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 = & H15CSIDL_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 = & H22
END ENUM
The 'ShgetPathFromidList function converts an Item into the file path
Declare function shgetpathfromidlist lib "shell32.dll" alias "shrickfromidlista" _
(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 long
Public Type Shfileinfobyte
Hicon as long
IICON As Long
Dwattributes as long
SZDisPlayName (1 to max_path) as byte
SzTypename (1 to 80) as Byte
End Type
Declare Function SHGETFILEINFO LIB "shell32" alias "shrGetfileinfoa" _
(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 * 80
End 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 = & H200SHGFI_TYPENAME = & H400
SHGFI_ATTRIBUTES = & h800
SHGFI_ICONLOCATION = & H1000
SHGFI_EXETYPE = & H2000
SHGFI_SYSICIONINDEX = & H4000
SHGFI_LINKOVERLAY = & h8000
SHGFI_SELECTED = & h10000
END ENUM
'Get its directory PIDL according to the ID of a specific folder object
Public Function GetPidLFromFolderId (HOWNER AS Long, NFolder As Shispecialfolderids) As long
DIM PIDL AS Long
If ShgetspecialFolderLocation (HOWNER, NFOLDER, PIDL) = noError Then
GetPidLFromFolderid = PIDL
END IF
END FUNCTION
Public 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 = getStrfromBuffer (Sfib.szdisPlayName, vbunicode)
END IF
END FUNCTION
Public Function GetPathFromPIDL (PIDL AS Long) AS String
DIM Spath As string * max_path
If ShgetPathFromidList (PIDL, SPATH) THEN
GetPathfromPidl = GetStrFromBuffer (Spath)
END IF
END FUNCTION
Public Function GetStrFromBuffra (SZ As String) AS String
IF INSTR (SZ, VBNULLCHAR) THEN
GetstrFromBuffera = Left $ (SZ, INSTR (SZ, VBNULLCHAR) - 1)
Else
GetstrfromBuffera = SZ
END IF
END FUNCTION
Add the following code in Mshell.BAS:
'mshell.ba function contains a function of registration and anti-registration system notification and folder information conversion
Option expedition
Private m_hshnotify as long 'system message announcement 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 Long
End Type
Declare function shchangenotifyregister lib "shell32" Alias "# 2" _
(Byval Hwnd As Long, _
Byval uflags as shcn_itemflags, _
Byval dweiventid as shcn_eventids, _
Byval umsg as long, _
Byval Citems as long, _
LPPS AS PIDLSTRUCT) AS Long
Type ShNotifyStruct
Dwitem1 As Long
Dwitem2 As Long
End Type
DECLARE FUNCTION SHCHANGENOTIFYDEREGISTER LIB "shell32" Alias "# 4" _
(Byval Hnotify As Long) As Boolean
Declare Sub ShchangenNotify Lib "shell32" _
(Byval Weventid AS SHCN_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_UPDATEM = & 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 = & H7FFFFFFFF
SHCNE_INTERRUPT = & h80000000
END ENUM
#If (Win32_ie> = & H400) THEN
Public const shcnee_orderchanged = & h2
#End IF
Public Enum SHW_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 IF
END 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
'Registering Windows monitoring, saving 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 IF
END FUNCTION
Public Function ShNotify_unregister () as boolean
IF m_hshnotifyim
If ShchangenGenotifydegegister (M_HshNotify) THEN
m_hshnotify = 0
Call cotaskmemfree (m_pidldesktop)
M_PIDLDESKTOP = 0
ShNotify_unregister = TRUE
END IF
END IF
END 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 File" StrPath1 " StrPath2
Case Shcne_create: sevent = "established file file name:" StrPath1
Case Shcne_Delete: sevent = "Delete file file name:" StrPath1
Case SHCNE_MKDIR: SEVENT = "New Directory Name:" StrPath1
Case Shcne_rmdir: sevent = "Delete Directory Directory Name:" StrPath1
Case Shcne_MediaInserted: Sevent = StrPath1 "Insert the removable storage medium"
Case shcne_mediaremoved: sevent = strpath1 "Transfer to removable storage media"
Case Shcne_Driveremoved: sevent = "Remove Drive" StrPath1
Case Shcne_DriveAdd: sevent = "Add Drive" StrPath1case Shcne_NetShare: Sevent = "Change the shared properties of the directory" StrPath1 "
Case SHCNE_UPDATEDIR: SEVENT = "Update Directory" StrPath1
Case Shcne_updateItem: sevent = "Update file file name:" StrPath1
Case Shcne_serverdisconnect: sevent = "Disconnect" StrPath1 " StrPath2
Case Shcne_UpdateImage: sevent = "shcne_updateImage"
Case Shcne_DriveAddgui: sevent = "shcne_driveaddgui"
Case Shcne_renamefolder: sevent = "Rename Folder" StrPath1 "" StrPath2
Case Shcne_Freespace: sevent = "Disk Space Change"
Case shcne_assochange: sevent = "Change file association"
End SELECT
SHNOTIFY_GETEVENTSTR = sevent
END FUNCTION
Add the following code in msub.ba:
The 'MSUB function includes a message processing function of the window
Option expedition
Private const wm_ncdestroy = & h82
Private const GWL_WndProc = (-4)
Private const ildWndproc = "oldwndproc"
Private Declare Function GetProp Lib "User32" Alias "getpropa" (Byval_
HWND As Long, Byval LPSTRING AS STRING AS Long
Private Declare Function SetProp Lib "User32" Alias "setPropa" (BYVAL _
HWND As Long, Byval LPSTRING AS STRING, BYVAL HDATA AS Long AS Long
Private 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 Nindex As Long, Byval Dwnewlong As long) As long
Private Declare Function CallWindowProc Lib "User32" Alias "CallWindowProca" _
(Byval lpprevwndfunc as long, byval hwnd 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 dam
Fsuccess = setProp (hwnd, oldwndproc, lpfnold)
END IF
END IF
IF Fsuccess Then
Subclass = TRUE
Else
IF lpfnold the call unsubclass (hwnd)
Msgbox "Unable to successfully subclass & h" & hex (hwnd), Vbcritical
END IF
END FUNCTION
Public Function unsubclass (hwnd as long) as boolean
DIM LPFNOLD AS Long
lpfnold = getProp (hwnd, oldwndproc)
IF lpfnold dam
IF RemoveProp (HWnd, OldWndProc) THEN
Unsubclass = setwindowlong (hwnd, gwl_wndproc, lpfnold)
END IF
END IF
END FUNCTION
Public 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 'Handling System Message Notice Function
Call Form1.NotificationRecationReceipt (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 build or delete a file or folder in the Explore, you can see in Form
What you do is recorded and displayed in TextBox.
Now analyze the following programs, the above program first calls the SHCHANGENOTIFYREGISTER function Add Form to the system message announcement chain,
And use the setwindowlong function to change the default message processing function of the Form, after accepting the system advertisement message, obtain the system according to the passing parameters
The content of the report is displayed in the text window. Call the SHCHANGENOTIFYDEREGISTER function logout system message announcement when exiting the program.
