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 Fun

上一页  [1] [2] [3]  下一页