Windows未公开函数揭密
''''根据一个特定文件夹对象的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, NE_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 SHChange Notify Deregister(m_h SHNotify) Then m_hSHNotify = 0 Call CoTaskMemFree(m_pidlDesktop) 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 = 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 Comm [1] [2] 下一页 没有相关教程
|