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
在msub.bas中加入以下代码:
'msub函数包括窗口的消息处理函数
option explicit
private const wm_ncdestroy = &h82
private 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 long
private declare function setprop lib "user32" alias "setpropa" (byval _
hwnd as long, byval lpstring as string, byval hdata as long) as long
private 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 if
end 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