Windows未公开函数揭密——之三

    技术2022-05-11  79

    Windows未公开函数揭密——之三

    http://www.applevb.com 这次介绍的是如何利用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 - HeightEnd Sub

    Private Function IsIDE() As Boolean    On Error GoTo Out    Debug.Print 1 / 0Out:    IsIDE = ErrEnd 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 = 260Public 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 = &H22End 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 ByteEnd 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 * 80End 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 = &H10000End Enum

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

    Public Function GetPathFromPIDL(pidl As Long) As String    Dim sPath As String * MAX_PATH    If SHGetPathFromIDList(pidl, sPath) Then        GetPathFromPIDL = GetStrFromBufferA(sPath)    End IfEnd 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 IfEnd 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 LongEnd 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 LongEnd 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 = &H80000000End 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 IfEnd 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 IfEnd 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 IfEnd 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 = sEventEnd Function

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

    Private Const WM_NCDESTROY = &H82Private 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 LongPrivate Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal _        hWnd As Long, ByVal lpString As String, ByVal hData As Long) As LongPrivate 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 IfEnd 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 IfEnd 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函数注销系统消息通告。


    最新回复(0)