【叶帆源码】获取Windows 外壳信息通知

Question

从网上看了一篇《分享windows的秘密－外壳通知消息》的文章，感觉很不错，可是它是delphi的程序，和VB相差很大，API在VB中没有对应的声明，并且一些结构体在VB中没有现成的定义，所以很是研究了一番，优盘的插入、拔出，光盘的插入、取出都有了相应的通知，效果不错。      可以接收的消息如下：  SHCNE_ASSOCCHANGED  一个文件关联被改变了
  SHCNE_ATTRIBUTES    一个项目或文件夹的属性被改变了
  SHCNE_CREATE        文件夹的外壳成员被创建了
  SHCNE_DELETE        非文件夹的外壳成员被删除了
  SHCNE_DRIVEADD      添加了一个驱动器
  SHCNE_DRIVEADDGUI   通过外壳添加的驱动器
  SHCNE_DRIVEREMOVED  一个驱动器被删除了
  SHCNE_EXTENDED_EVENT  未被使用
  SHCNE_FREESPACE     驱动器的自由空间数有了变化
  SHCNE_MEDIAINSERTED  存储介质被插入到驱动器中
  SHCNE_MEDIAREMOVED  存储介质从驱动器中被删除
  SHCNE_MKDIR         一个目录被创建
  SHCNE_NETSHARE      本地的目录被共享
  SHCNE_NETUNSHARE    本地目录被取消共享
  SHCNE_RENAMEFOLDER  文件夹名称被改变
  SHCNE_RENAMEITEM    非文件的外壳对象的名称被改变
  SHCNE_RMDIR         一个文件夹被删除
  SHCNE_SERVERDISCONNECT  计算机被服务器断开
  SHCNE_UPDATEDIR     一个文件夹中的内容被改变
  SHCNE_UPDATEIMAGE   系统图像列表中的一个图像被改变
  SHCNE_UPDATEITEM    一个非文件夹外壳对象的名称被改变
   【文章链接】http://blog.csdn.net/yefanqiu/archive/2005/12/23/560234.aspx
   【源码地址】http://www.bjjr.com.cn/YeFan/SourceCode/yfsysmsg.rar
   【示例图片】http://blog.csdn.net/images/blog_csdn_net/yefanqiu/23649/o_Test.jpg
   【关键源码】
  
'*************************************************************************
'**函 数 名：SysMsgRegister
'**输    入：无
'**输    出：无
'**功能描述：消息注册
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2005-12-23 13:18:02
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Public Sub SysMsgRegister(hwnd As Long)
    Dim nr As NotifyRegister    lngFlag = Array(SHCNE_ASSOCCHANGED, _
              SHCNE_ATTRIBUTES, _
              SHCNE_CREATE, _
              SHCNE_DELETE, _
              SHCNE_DRIVEADD, _
              SHCNE_DRIVEADDGUI, _
              SHCNE_DRIVEREMOVED, _
              SHCNE_EXTENDED_EVENT, _
              SHCNE_FREESPACE, _
              SHCNE_MEDIAINSERTED, _
              SHCNE_MEDIAREMOVED, _
              SHCNE_MKDIR, _
              SHCNE_NETSHARE, _
              SHCNE_NETUNSHARE, _
              SHCNE_RENAMEFOLDER, _
              SHCNE_RENAMEITEM, _
              SHCNE_RMDIR, _
              SHCNE_SERVERDISCONNECT, _
              SHCNE_UPDATEDIR, _
              SHCNE_UPDATEIMAGE, _
              SHCNE_UPDATEITEM)    strFlag = Array("文件关联被改变", _
              "文件夹属性被改变", _
              "文件夹外壳成员被创建", _
              "非文件夹外壳成员被删除", _
              "添加了一个驱动器", _
              "通过外壳添加的驱动器", _
              "一个驱动器被删除了", _
              "未使用", _
              "驱动器自由空间发生变化", _
              "存储介质插入驱动器", _
              "存储介质被移除", _
              "一个目录被创建", _
              "本地目录被共享", _
              "本地目录被取消共享", _
              "文件夹名称被改变", _
              "非文件的外壳对象名称被改变", _
              "一个文件夹被删除", _
              "计算机被服务器断开", _
              "一个文件夹的内容被改变", _
              "系统图像列表中的一个图像被改变", _
              "一个非文件夹外壳对象的名称被改变")    lngHandle = SHChangeNotifyRegister(hwnd, SHCNF_ACCEPT_INTERRUPTS Or SHCNF_ACCEPT_NON_INTERRUPTS, SHCNE_ALLEVENTS, WM_YFSYSMSG, 1, nr)
    If lngHandle > 0 Then
        frmSysmsg.picFlag.BackColor = RGB(0, 200, 0)
    Else
        frmSysmsg.picFlag.BackColor = RGB(255, 0, 0)
    End If
End Sub'*************************************************************************
'**函 数 名：UnSysMsgRegister
'**输    入：无
'**输    出：无
'**功能描述：取消注册
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2005-12-23 13:19:06
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Public Sub UnSysMsgRegister()
    If lngHandle > 0 Then
        SHChangeNotifyDeregister lngHandle
    End If
End Sub
 

Answer 1

看看＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
免费的学习、交流、源码、工具下载网站，欢迎大家访问！
http://www.j2soft.cn/

Answer 2

to hot1kang1(许仙)
至于截获，需要对相关操作API进行拦截，单纯用VB搞不定，必须用VC做DLL。

Answer 3

Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    '-------------------------------
    Dim i As Long
    Dim strPath As String * 255
    Dim pl As TwoPLDLArray
    
    If uMsg = WM_YFSYSMSG Then
        For i = 0 To 20
            If (lParam And lngFlag(i)) > 0 Then
                frmSysmsg.lstMsg.AddItem Format(Now, "HH:MM:SS") & " " & strFlag(i)
            End If
        Next
        '-------------------------------------------------------
        '新添加代码
        Call CopyMemorys(pl, ByVal wParam, Len(pl))
        
        SHGetPathFromIDList pl.pidl1, strPath
        frmSysmsg.lstMsg.AddItem Format(Now, "HH:MM:SS") & " " & strPath
        
        SHGetPathFromIDList pl.pidl2, strPath
        frmSysmsg.lstMsg.AddItem Format(Now, "HH:MM:SS") & " " & strPath
        '-----------------------------------------------------------------
        Exit Function
    End If 在窗口函数中，添加以上代码，哈哈，具体的路径信息都可以获取了
 这样添加删除文件，文件改名，光盘插入拿出，优盘插入拿出都可以显示具体的路径了 如果有兴趣，当然还可以对代码继续研究，可以具体设定具体要监控的目录信息
    
    '-------------------------------
    WindowProc = CallWindowProc(lngPreWinProc, hwnd, uMsg, wParam, lParam)
End Function

Answer 4

这里有一个实现同样功能的程序（Sunlight 网友提供）SHChangeNotifyRegister 实现文件目录操作即时监视程序 
http://members.aol.com/btmtz/vb 
http://www.mvps.org/ccrp download it at: 
http://www.supercss.com/code/1658.htm感觉实现的有些麻烦了，并且不能指定任意要监控的目录，不过是一个很好的程序

Answer 5

你好。可以问你另一个问题吗？那就是关于控件注册的问题。
问题说明网址链接：
http://community.csdn.net/Expert/topic/4476/4476317.xml?temp=.8426477

Answer 6

楼主亲自来顶啊没仔细看楼主的代码，我知道用IShellExecuteHook完全可以获得Shell消息。

Answer 7

顺便说一下，用了楼主的API浏览器，好象不能像FOXAPI一样在VB的外接程序中载入，还是我没找到？如果没有建议完善一下，这个功能好象挺实用的。另外，建议设一个查找功能，有时一大段实例，要找到你想看的函数，相当不容易。

Answer 8

呵呵！
学习ING！
顶！！