API高手，请请请。。。（如何用VB编写系统监控程序?）来者有分！

[jincai78]

用VB编写系统监控程序用到的API函数有哪些？希望晓得的朋友能告知一些！

[MonkeyLin]

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 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 Long
End 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 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 Lib "shell32" _
(ByVal wEventId As SHCN_EventIDs, _
ByVal uFlags As SHCN_ItemFlags, _
ByVal dwItem1 As Long, _
ByVal dwItem2 As Long)

' Shell notification event IDs

Public Enum 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 mean
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

#If UNICODE Then
SHCNF_PATH = SHCNF_PATHW
SHCNF_PRINTER = SHCNF_PRINTERW
#Else
SHCNF_PATH = SHCNF_PATHA
SHCNF_PRINTER = SHCNF_PRINTERA
#End If
End Enum
'

' Registers the one and only shell change notification.

Public 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() 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 If

End Function

' Returns the event string associated with the specified event ID value.

Public 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 = sEvent

End Function

[MonkeyLin]

还不清楚的话，我又找了个中文的：

Windows未公开函数揭密--之三
这次介绍的是如何利用Windows未公开函数实现系统文件操作监视功能。利用该功能可以对Windows下的任何文件
操作，包括建立文件、文件夹；删除文件；改变文件大小等操作都可以纪录在案。
首先来介绍实现上面操作的两个未公开函数：SHChangeNotifyRegister和SHChangeNotifyDeregister
，SHChangeNotifyRegister函数的定义如下：
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
其中参数hWnd指定接受系统通告的窗口句柄，参数uMsg指定消息值，如果函数调用成功，系统就会将hWnd指定的
窗口加入到系统通告链中，并且返回系统通告句柄。当有建立文件等系统操作发生时，系统会向hWnd指定的窗口发送
uMsg消息，关于其它参数，会在下面的程序中说明。函数SHChangeNotifyDeregister的定义如下：
Declare Function SHChangeNotifyDeregister Lib "shell32" Alias "#4" _
(ByVal hNotify As Long) As Boolean
其中参数hNotify指定系统通告的句柄。
下面是操作的具体的VB范例：
首先建立一个新的工程，在Form1中加入一个TextBox控件。在Form1的代码窗口之中加入以下代码：
Option Explicit

Private Sub Form_Load()
If SubClass(hWnd) Then '改变Form1的消息处理函数
If IsIDE Then
Text1.Text = vbCrLf & _
"一个 Windows的文件目录操作即时监视程序," & vbCrLf & "可以监视在Explore中的重命名、新建、删除文" & _
vbCrLf & "件或目录；改变文件关联；插入、取出CD和添加" & vbCrLf & "删除网络共享都可以被该程序记录下来。"
End If
Call SHNotify_Register(hWnd)
Else
Text1 = "系统不支持操作监视程序 :-)"
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, 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
然后在工程中加入三个模块（Bas）文件，将三个文件分别保存为mDef.Bas、mShell.Bas、mSub.Bas。在mDef.Bas中加入以下代码：
'mDef.Bas包含Shell操作的函数和数据类型的定义
Option Explicit

Declare Sub MoveMemory 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获得某一个特殊的目录的位置,如果函数调用成功返回NOERROR
'或者一个OLE错误
Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hwndOwner As Long, _
ByVal nFolder As SHSpecialFolderIDs, _
pidl As Long) As Long

Public Enum SHSpecialFolderIDs '列出所有Windows下特殊文件夹的ID
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
CSIDL_COMMON_ALTSTARTUP = &H1E
CSIDL_COMMON_FAVORITES = &H1F
CSIDL_INTERNET_CACHE = &H20
CSIDL_COOKIES = &H21
CSIDL_HISTORY = &H22
End Enum

'SHGetPathFromIDList函数将一个Item转换为文件路径
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long

'SHGetFileInfoPidl函数获得某个文件对象的信息。
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 "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 * 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 = &H200
SHGFI_TYPENAME = &H400
SHGFI_ATTRIBUTES = &H800
SHGFI_ICONLOCATION = &H1000
SHGFI_EXETYPE = &H2000
SHGFI_SYSICONINDEX = &H4000
SHGFI_LINKOVERLAY = &H8000
SHGFI_SELECTED = &H10000
End Enum

'根据一个特定文件夹对象的ID获得它的目录pidl
Public Function GetPIDLFromFolderID(hOwner As Long, nFolder As SHSpecialFolderIDs) 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 = GetStrFromBufferA(StrConv(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 = GetStrFromBufferA(sPath)
End If
End 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 If
End Function

在mShell.Bas中加入以下代码：
'mShell.Bas函数包含注册和反注册系统通告以及文件夹信息转换的函数
Option Explicit

Private m_hSHNotify As Long '系统消息通告句柄
Private m_pidlDesktop As Long

'定义系统通告的消息值
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 dwEventID 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 SHChangeNotify 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_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
End Enum

#If (WIN32_IE >= &H400) Then
Public Const SHCNEE_ORDERCHANGED = &H2
#End If

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 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

'注册Windows监视,将获得的句柄保存到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_hSHNotify Then
If SHChangeNotifyDeregister(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 = "重命名文件" + strPath1 + "为" + strPath2
Case SHCNE_CREATE: sEvent = "建立文件 文件名：" + strPath1
Case SHCNE_DELETE: sEvent = "删除文件 文件名：" + strPath1
Case SHCNE_MKDIR: sEvent = "新建目录 目录名：" + strPath1
Case SHCNE_RMDIR: sEvent = "删除目录 目录名：" + strPath1
Case SHCNE_MEDIAINSERTED: sEvent = strPath1 + "中插入可移动存储介质"
Case SHCNE_MEDIAREMOVED: sEvent = strPath1 + "中移去可移动存储介质"
Case SHCNE_DRIVEREMOVED: sEvent = "移去驱动器" + strPath1
Case SHCNE_DRIVEADD: sEvent = "添加驱动器" + strPath1
Case SHCNE_NETSHARE: sEvent = "改变目录" + strPath1 + "的共享属性"
Case SHCNE_UPDATEDIR: sEvent = "更新目录" + strPath1
Case SHCNE_UPDATEITEM: sEvent = "更新文件 文件名：" + strPath1
Case SHCNE_SERVERDISCONNECT: sEvent = "断开与服务器的连" + strPath1 + " " + strPath2
Case SHCNE_UPDATEIMAGE: sEvent = "SHCNE_UPDATEIMAGE"
Case SHCNE_DRIVEADDGUI: sEvent = "SHCNE_DRIVEADDGUI"
Case SHCNE_RENAMEFOLDER: sEvent = "重命名文件夹" + strPath1 + "为" + strPath2
Case SHCNE_FREESPACE: sEvent = "磁盘空间大小改变"

Case SHCNE_ASSOCCHANGED: sEvent = "改变文件关联"
End Select

SHNotify_GetEventStr = sEvent
End Function

在mSub.Bas中加入以下代码：
'mSub函数包括窗口的消息处理函数
Option Explicit

Private Const WM_NCDESTROY = &H82
Private Const GWL_WNDPROC = (-4)
Private Const OLDWNDPROC = "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 hWnd As Long, 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 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 If
End 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 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 '处理系统消息通告函数
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

保存文件，然后运行程序，然后你可以在Explore中试着建立或者删除一个文件或者文件夹，在Form中可以看到
你所做的操作已经被纪录并且显示到TextBox中了。
现在分析以下上面的程序，上面的程序首先调用SHChangeNotifyRegister函数将Form添加到系统消息通告链中，
并利用SetWindowLong函数改变Form的缺省的消息处理函数，当接受到系统通告消息后，根据传递的参数获得系统通
告的内容并且显示在文本窗口中。退出程序时调用SHChangeNotifyDeregister函数注销系统消息通告。

[MonkeyLin]

还不清楚的话，去这里下载一个例子，我能帮的就这些了，祝你好运！
http://www.mvps.org/btmtz/shnotify/

[houyingjun]

给我你的信箱我发给你

[jincai78]

谢谢各位！
my mail: [e-mail]
欢迎交流！

[Leemaasn]

哈哈，太好了。。。

[zzh]

你新建一个关于对话框时，系统有一个控件，可以得到系统的有关信息，为什么还要自己去得到这些东西呢，
多麻烦啊

[fengyang]

没有MSDN的猴子：
只有之三，没有之一，二，四。。。

[MonkeyLin]

1,2,4你要吗？自己去雅虎查找，关键字：“Windows未公开函数揭密”

[jincai78]

谢谢,我一定再加分，我有的是分！
我是想通过监控，知道别人再干什么，再往文本框里输入什么东西！

[szxzwang]

随便看看！

[jincai78]

谢谢houyingjun(心神),MonkeyLin(没有MSDN的小猴儿)

[jincai78]

houyingjun(心神）：我已经收到你程序，且已运行过，很好，谢谢！
我很想通过监控知道别人在往文本框里输什么东西！

[jincai78]

能告诉我需要用到哪些API函数吗？

[jixian]

晕。。。。

[xyjdn]

gz