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 = set window long(h wnd, gwl-wndproc, address of wnd proc)
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
unsubclass = setwindowlong(hwnd, gwl_wndproc, lpfnold)
end if
end if
end function
public function wndproc(byval hwnd as long,pbyval umsg ap long, byval wparam as _
long, byval lparam as long) as long
select case umsg
case wm_shnotify '处理e统消息通告函数
call form1.notificationreceipt(wparamn lparam)
case wm_ncdestroy
call unsubclass(hwnd)n d sgbox ″unubclassed &h″ & hex(hwnd), vbcritical, ″wndproc error″
end select
wndproc = callwindowproc(getprop(hwnd, oldwndproc), hwnd, umsg, wparam, lparam)
end function
保存文件,然后运行程序,然后你可以在explore中试着建立或者删除一个文件或者文件夹,在form中可以看到你所做的ll已经被纪录l且显示到textbox中了。
现在分析以下上面的程序,上面的程序首先调用shchangenotifyregister函数将form添加到系统消息通告链中,并利用setwindowlong函数改变formed省的消息d理函数,当y受到系统通告消后,根据传递的参数获得系统通告的内容并且显示在文本窗口中。退出程序时调用shchangenotifyderegister函数注销系统消息通告。
接下来我要向大家介绍如何使用windows未公开函数实现调用windows系统中的一些对话框的功能。其中包括如何调用系统的″运行程序″对话框、”查找文件″对话框、更改与文件相关联的图标对话框等等。
首先在vb中建立一个新的工程文件,然后在form1中加入五个commandbutton控件,不要改变它们的属性,然后在form1的代码窗口中加入以下代码:
option explicit
private type browseinfo
hwndowner as long
pidlroot as long
pszdisplayname as long
lpsztitle as long
ulflags as long
lpfncallback as long
lparam as long
iimage as long
end type
const bif_returnonlyfsdirs = 1
const max_path = 260
private declare function shobjectproperties lib ″shell32″ alias ″#178″ _
(byval hwndowner as long, _
byval uflags as long, _
byval lpstrname as string, _
byval lpstrpar as string) as long
private declare sub cotaskmemfree lib ″ole32.dll″ (byval hmem as long)
private declare function shbrowseforfolder lib ″shell32″ (lpbi _
as browseinfo) as long
private declare function shfindfiles lib ″shell32″ alias ″#90″ _
(byval pidlroot as long, _
byval pidlsavedsearch as long) as long
private declare function getfilenamefrombrowse lib ″shell32″ alias ″#63″ ( _
byval hwndowner as long, _
byval lpstrfile as string, _
byval nmaxfile as long, _
byval lpstrinitdir as string, _
byval lpstrdefext as string, _
byval lpstrfilter as string, _
byval lpstrtitle as string) as long
private declare sub pickicondlg lib ″shell32″ alias ″#62″ (byval hwndowner as long, _
byval lpstrfile as string, byval nmaxfile as long, lpdwiconindex as long)
private declare function shrunfiledlg lib ″shell32″ alias ″#61″ _
(byval howner as long, _
byval hicon as long, _
byval lpstrdirectory as string, _
byval sztitle as string, _
byval szprompt as string, _
byval uflags as long) as long
private sub command1_click()
shrunfiledlg form1.hwnd, form1.icon.handle, ″c:\windows″, ″运行程序演示″,
″在文本框中输入程序名或按浏览键查找程序″, 0
end sub
private sub command2_click()
dim a as long
dim astr as string
astr = ″c:\windows\notepad.exe″
pickicondlg form1.hwnd, astr, 1, a
end sub
private sub command3_click()
dim astr as string * 256
dim bstr as string
bstr = ″c:\windows″
getfilenamefrombrowse form1.hwnd, astr, 256, bstr, ″*.txt″, _
″文本文件 *.txt″, ″open sample″
debug.print astr
end sub
private sub command4_click()