fshell.bas

提供进程监视[包括启动参数] 进程检测[包括启动参数] 网络连接检测 SSDT检测 BHO检测 IE插件检测 自启动项检测 -------程序部分[使用彩字显示] 包

Attribute VB_Name = "mShell"
'Option Explicit

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

'定义系统通告的消息值
Public Const WM_SHNOTIFY = &H401
Global buftxt As String
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
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long

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, ByVal clv As Long) As Boolean
    Dim ps As PIDLSTRUCT
  
    If (m_hSHNotify = 0) Then
  
        m_pidlDesktop = GetPIDLFromFolderID(0, clv)
        If m_pidlDesktop Then
      
            ps.pidl = m_pidlDesktop
            ps.bWatchSubFolders = True
      
            '注册Windows监视,将获得的句柄保存到m_hSHNotify中
            m_hSHNotify = SHChangeNotifyRegister(Form1.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: SHNotify_GetEventStr = sEvent
        Case SHCNE_CREATE: sEvent = "建立文件 文件名：" + strPath1: SHNotify_GetEventStr = sEvent:
        Case SHCNE_DELETE: sEvent = "删除文件 文件名：" + strPath1: SHNotify_GetEventStr = sEvent
        Case SHCNE_MKDIR: sEvent = "新建目录 目录名：" + strPath1: SHNotify_GetEventStr = sEvent
        Case SHCNE_RMDIR: sEvent = "删除目录 目录名：" + strPath1: SHNotify_GetEventStr = sEvent
        '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 + "的共享属性": SHNotify_GetEventStr = sEvent
        'Case SHCNE_UPDATEDIR: sEvent = "更新目录" + strPath1: SHNotify_GetEventStr = sEvent
        Case SHCNE_UPDATEITEM: sEvent = "更新文件 文件名：" + strPath1: SHNotify_GetEventStr = sEvent
        'Case SHCNE_SERVERDISCONNECT: sEvent = "断开与服务器的连" + strPath1 + "  " + strPath2
        'Case SHCNE_UPDATEIMAGE: sEvent = "SHCNE_UPDATEIMAGE"
        'Case SHCNE_DRIVEADDGUI: sEvent = "SHCNE_DRIVEADDGUI"
        Case SHCNE_RENAMEFOLDER: sEvent = "重命名文件夹" + strPath1 + "为" + strPath2: SHNotify_GetEventStr = sEvent
        'Case SHCNE_FREESPACE: sEvent = "磁盘空间大小改变"
    
        Case SHCNE_ASSOCCHANGED: sEvent = "改变文件关联": SHNotify_GetEventStr = sEvent
    End Select
    
'------------------------
'    Dim npid As Long
'    Dim rp1 As Long
'    Dim rp2 As Long
'------------------------
'    Dim txt1 As String
'    txt1 = sEvent
'  If txt1 = "" Then Exit Function
'  If buftxt <> txt1 Then
'    GetWindowThreadProcessId mainHwnd, npid
'    rp1 = gwfp.WriterRemoteData(npid, sEvent)
'    rp2 = gwfp.WriterRemoteData(npid, dwEventID)
'    PostMessage mainHwnd, &H404, ByVal rp1, ByVal rp2
' End If
'------------------------
End Function