Windows未公开函数揭密
'根据一个特定文件夹对象的ID获得它的目录pidlPublic Function GetPIDLFromFolderID(hOwner As Long, nFolder As SHSpecialFolderIDs) As LongDim pidl As LongIf SHGetSpecialFolderLocation(hOwner, nFolder, pidl) = NOERROR ThenGetPIDLFromFolderID = pidlEnd IfEnd FunctionPublic Function GetDisplayNameFromPIDL(pidl As Long) As StringDim sfib As SHFILEINFOBYTEIf SHGetFileInfoPidl(pidl, 0, sfib, Len(sfib), SHGFI_PIDL Or SHGFI_DISPLAYNAME) ThenGetDisplayNameFromPIDL = GetStrFromBufferA(StrConv(sfib.szDisplayName, vbUnicode))End IfEnd FunctionPublic Function GetPathFromPIDL(pidl As Long) As StringDim sPath As String ＊ MAX_PATHIf SHGetPathFromIDList(pidl, sPath) ThenGetPathFromPIDL = GetStrFromBufferA(sPath)End IfEnd FunctionPublic Function GetStrFromBufferA(sz As String) As StringIf InStr(sz, vbNullChar) ThenGetStrFromBufferA = Left＄(sz, InStr(sz, vbNullChar) － 1)ElseGetStrFromBufferA = szEnd IfEnd Function在mShell.Bas中加入以下代码：'mShell.Bas函数包含注册和反注册系统通告以及文件夹信息转换的函数Option ExplicitPrivate m_hSHNotify As Long '系统消息通告句柄Private m_pidlDesktop As Long'定义系统通告的消息值Public Const WM_SHNOTIFY = ＆H401Public Type PIDLSTRUCTpidl As LongbWatchSubFolders As LongEnd TypeDeclare 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 LongType SHNOTIFYSTRUCTdwItem1 As LongdwItem2 As LongEnd TypeDeclare Function SHChangeNotifyDeregister Lib ″shell32″ Alias ″＃4″ _(ByVal hNotify As Long) As BooleanDeclare 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_EventIDsSHCNE_RENAMEITEM = ＆H1SHCNE_CREATE = ＆H2SHCNE_DELETE = ＆H4SHCNE_MKDIR = ＆H8SHCNE_RMDIR = ＆H10SHCNE_MEDIAINSERTED = ＆H20SHCNE_MEDIAREMOVED = ＆H40SHCNE_DRIVEREMOVED = ＆H80SHCNE_DRIVEADD = ＆H100SHCNE_NETSHARE = ＆H200SHCNE_NETUNSHARE = ＆H400SHCNE_ATTRIBUTES = ＆H800SHCNE_UPDATEDIR = ＆H1000SHCNE_UPDATEITEM = ＆H2000SHCNE_SERVERDISCONNECT = ＆H4000SHCNE_UPDATEIMAGE = ＆H8000＆SHCNE_DRIVEADDGUI = ＆H10000SHCNE_RENAMEFOLDER = ＆H20000SHCNE_FREESPACE = ＆H40000SHCNE_ASSOCCHANGED = ＆H8000000SHCNE_DISKEVENTS = ＆H2381FSHCNE_GLOBALEVENTS = ＆HC0581E0SHCNE_ALLEVENTS = ＆H7FFFFFFFSHCNE_INTERRUPT = ＆H80000000End Enum＃If (WIN32_IE >= ＆H400) ThenPublic Const SHCNEE_ORDERCHANGED = ＆H2＃End IfPublic Enum SHCN_ItemFlagsSHCNF_IDLIST = ＆H0SHCNF_PATHA = ＆H1SHCNF_PRINTERA = ＆H2SHCNF_DWORD = ＆H3SHCNF_PATHW = ＆H5SHCNF_PRINTERW = ＆H6SHCNF_TYPE = ＆HFFSHCNF_FLUSH = ＆H1000SHCNF_FLUSHNOWAIT = ＆H2000＃If UNICODE ThenSHCNF_PATH = SHCNF_PATHWSHCNF_PRINTER = SHCNF_PRINTERW＃ElseSHCNF_PATH = SHCNF_PATHASHCNF_PRINTER = SHCNF_PRINTERA＃End IfEnd EnumPublic Function SHNotify_Register(hWnd As Long) As BooleanDim ps As PIDLSTRUCTIf (m_hSHNotify = 0) Thenm_pidlDesktop = GetPIDLFromFolderID(0, CSIDL_DESKTOP)If m_pidlDesktop Thenps.pidl = m_pidlDesktopps.bWatchSubFolders = True'注册Windows监视,将获得的句柄保存到m_hSHNotify中m_hSHNotify = SHChangeNotifyRegister(hWnd, SHCNF_TYPE Or SHCNF_IDLIST, NE_ALLEVENTS Or SHCNE_INTERRUPT, WM_SHNOTIFY, 1, ps)SHNotify_Register = CBool(m_hSHNotify)ElseCall CoTaskMemFree(m_pidlDesktop)End IfEnd IfEnd FunctionPublic Function SHNotify_Unregister() As BooleanIf m_hSHNotify ThenIf SHChange Notify Deregister(m_h SHNotify) Thenm_hSHNotify = 0Call CoTaskMemFree(m_pidlDesktop)m_pidlDesktop = 0SHNotify_Unregister = TrueEnd IfEnd IfEnd FunctionPublic Function SHNotify_GetEventStr(strPath1, strPath2 As String, dwEventID As Long) As StringDim sEvent As StringSelect Case dwEventIDCase SHCNE_RENAMEITEM: sEvent = ″重命名文件″ ＋ strPath1 ＋ ″为″ ＋ strPath2Case SHCNE_CREATE: sEvent = ″建立文件 文件名：″ ＋ strPath1Case SHCNE_DELETE: sEvent = ″删除文件 文件名：″ ＋ strPath1Case SHCNE_MKDIR: sEvent = ″新建目录 目录名：″ ＋ strPath1Case SHCNE_RMDIR: sEvent = ″删除目录 目录名：″ ＋ strPath1Case SHCNE_MEDIAINSERTED: sEvent = strPath1 ＋ ″中插入可移动存储介质″Case SHCNE_MEDIAREMOVED: sEvent = strPath1 ＋ ″中移去可移动存储介质″Case SHCNE_DRIVEREMOVED: sEvent = ″移去驱动器″ ＋ strPath1Case SHCNE_DRIVEADD: sEvent = ″添加驱动器″ ＋ strPath1Case SHCNE_NETSHARE: sEvent = ″改变目录″ ＋ strPath1 ＋ ″的共享属性″Case SHCNE_UPDATEDIR: sEvent = ″更新目录″ ＋ strPath1Case SHCNE_UPDATEITEM: sEvent = ″更新文件 文件名：″ ＋ strPath1Case SHCNE_SERVERDISCONNECT: sEvent = ″断开与服务器的连″ ＋ strPath1 ＋ ″ ″ ＋ strPath2Case SHCNE_UPDATEIMAGE: sEvent = ″SHCNE_UPDATEIMAGE″Case SHCNE_DRIVEADDGUI: sEvent = ″SHCNE_DRIVEADDGUI″Case SHCNE_RENAMEFOLDER: sEvent = ″重命名文件夹″ ＋ strPath1 ＋ ″为″ ＋ strPath2Case SHCNE_FREESPACE: sEvent = ″磁盘空间大小改变″ Case SHCNE_ASSOCCHANGED: sEvent = ″改变文件关联″End Select SHNotify_GetEventStr = sEventEnd Function在mSub.Bas中加入以下代码：'mSub函数包括窗口的消息处理函数Option ExplicitPrivate 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 LongPrivate Declare Function SetWindowLong Lib ″user32″ Alias ″SetWindowLongA″ _(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate 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 LongPublic Function SubClass(hWnd As Long) As BooleanDim lpfnOld As LongDim fSuccess As BooleanIf (GetProp(hWnd, OLDWNDPROC) = 0) ThenlpfnOld = Set Window Long(h Wnd, GWL－WNDPROC, Address Of Wnd Proc)If lpfnOld ThenfSuccess = SetProp(hWnd, OLDWNDPROC, lpfnOld)End IfEnd IfIf fSuccess ThenSubClass = TrueElseIf lpfnOld Then Call UnSubClass(hWnd)MsgBox ″Unable to successfully subclass ＆H″ ＆ Hex(hWnd), vbCriticalEnd IfEnd FunctionPublic Function UnSubClass(hWnd As Long) As BooleanDim lpfnOld As LonglpfnOld = GetProp(hWnd, OLDWNDPROC)If lpfnOld ThenIf RemoveProp(hWnd, OLDWNDPROC) ThenUnSubClass = SetWindowLong(hWnd, GWL_WNDPROC, lpfnOld)End IfEnd IfEnd FunctionPublic Function WndProc(ByVal hWnd As Long,pByVal uMsg Ap Long, ByVal wParam As _Long, ByVal lParam As Long) As LongSelect Case uMsgCase WM_SHNOTIFY '处理e统消息通告函数Call Form1.NotificationReceipt(wParamN lParam)Case WM_NCDESTROYCall UnSubClass(hWnd)N D sgBox ″Unubclassed ＆H″ ＆ Hex(hWnd), vbCritical, ″WndProc Error″End SelectWndProc = 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 ExplicitPrivate Type BrowseInfohwndOwner As LongpIDLRoot As LongpszDisplayName As LonglpszTitle As LongulFlags As LonglpfnCallback As LonglParam As LongiImage As LongEnd TypeConst BIF_RETURNONLYFSDIRS = 1Const MAX_PATH = 260Private Declare Function SHObjectProperties Lib ″Shell32″ Alias ″＃178″ _(ByVal hwndOwner As Long, _ByVal uFlags As Long, _ByVal lpstrName As String, _ByVal lpstrPar As String) As LongPrivate Declare Sub CoTaskMemFree Lib ″ole32.dll″ (ByVal hMem As Long)Private Declare Function SHBrowseForFolder Lib ″Shell32″ (lpbi _As BrowseInfo) As LongPrivate Declare Function SHFindFiles Lib ″Shell32″ Alias ″＃90″ _(ByVal pIDLRoot As Long, _ByVal pidlSavedSearch As Long) As LongPrivate 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 LongPrivate 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 LongPrivate Sub Command1_Click()SHRunFileDlg Form1.hWnd, Form1.Icon.Handle, ″c:/windows″, ″运行程序演示″, ″在文本框中输入程序名或按浏览键查找程序″, 0End SubPrivate Sub Command2_Click()Dim a As LongDim astr As Stringastr = ″c:/windows/notepad.exe″PickIconDlg Form1.hWnd, astr, 1, aEnd SubPrivate Sub Command3_Click()Dim astr As String ＊ 256Dim bstr As Stringbstr = ″c:/windows″GetFileNameFromBrowse Form1.hWnd, astr, 256, bstr, ″＊.txt″, _″文本文件 ＊.txt″, ″Open Sample″Debug.Print astrEnd SubPrivate Sub Command4_Click()Dim lpIDList As LongDim udtBI As BrowseInfo'初试化udtBI结构With udtBI.hwndOwner = Form1.hWnd.ulFlags = BIF_RETURNONLYFSDIRSEnd With'弹出文件夹查看窗口lpIDList = SHBrowseForFolder(udtBI)If lpIDList Then'查找文件SHFindFiles lpIDList, 0Call CoTaskMemFree(lpIDList)End IfEnd SubPrivate Sub Command5_Click()SHObjectProperties Form1.hWnd, 2, ″c:/windows/notepad.exe″, ″Samples″End SubPrivate Sub Form_Load()Command1.Caption = ″运行程序″Command2.Caption = ″更改图标″Command3.Caption = ″打开文件″Command4.Caption = ″查找文件″Command5.Caption = ″显示文件属性″End Sub运行程序，分别点击不同的按钮，就可以看到不同的按钮实现了对不同的系统对话框的调用。以上程序在Windows98、VB6下运行通过。（完）（长沙 陈锐）
