100分求拦截系统消息的程序

用API hook ,如果钩住CreateFile

下面是操作的具体的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--------------------------------------------------------------------------------
AnsiString MorPath = ExtractFilePath( Application->ExeName ) + "Temp\\";
  if( FindFirstChangeNotification( MorPath.c_str() ,false, FILE_NOTIFY_CHANGE_LAST_WRITE ) == INVALID_HANDLE_VALUE )
    ShowMessage("Error");
  else
  {
    if(WaitForSingleObject(FindFirstChangeNotification( MorPath.c_str() ,false,FILE_NOTIFY_CHANGE_LAST_WRITE),INFINITE) == WAIT_FAILED)
      ShowMessage("Error");
    else
      {
        if(Application->MessageBox(("The Attachment " + ExtractFileName( SourceFileName ) + " has changed.  Do you want to save the changes?" ).c_str(), "XLibrary", MB_YESNO + MB_ICONQUESTION ) == ID_YES )
        {
          TAttachment *myAttach = DMod->GetTAttachFromDB( DocCode_ID, AttachAuto_ID, aetNone, DMod->TempDirPathName );
          myAttach->attAttach->LoadFromFile( AttachFileName );
          DMod->SaveTAttachToDatabase( myAttach );
          delete myAttach;
          DeleteFile( AttachFileName );
        }
      }
    FindCloseChangeNotification(FindFirstChangeNotification( MorPath.c_str() ,false,FILE_NOTIFY_CHANGE_LAST_WRITE));
  }

to:jjkk168(老加班的人--好好学习,天天吃饭)
很谢谢你能给我提供这段代码，如果可以希望你能再补上“怎样拦截系统信息”的代码，拜托了！！

拦截得用HOOK API
VB是不行的要用到全局钩子

TO 楼上的楼上的楼上的楼上。我也是从别的地方COPY过来的，需要你自己进行测试了。

在vb这种层次上面实现不了拦截，因为要用全局hook

调试易

100分求拦截系统消息的程序

解决方案 »