用子类获取消息、将当前目录下所有子目录加入动态菜单及获取其事件

　　 
　　用子类获取消息、将当前目录下所有子目录加入动态菜单及获取其事件!
经过多次调试，现给出源代码，在VB5/WIN98中调试正常
------ WBC著 ------

`======================================================
`[设计部分]

`此例是在菜单中加子菜单，设计时需要加两个command button；
`加一个菜单，其菜单下至少要有两个子菜单项
`第二个子菜下再加入下一级子菜单(此子菜单也要有两项）
`菜单设计如下(改变本程序中的相关参数值可改变插入菜单位置)
`菜单0
`......子菜单0
`......子菜单1
`............子子菜单0
`............子子菜单1
`............本程式的菜单插入位置,止项在设计时不用

`[窗体部分]

Option Explicit

Private Sub Form_Load()
   LoadNewMenu Me
End Sub
Private Sub Command1_Click()
   Hook
End Sub

Private Sub Command2_Click()
   Unhook
End Sub

`[模块部分]

Option Explicit
Declare Function InsertMenu Lib "user32" Alias "InsertMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long

Const MF_BYPOSITION = &H400&

Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Const GWL_WNDPROC = -4

Public Const WM_NEWMENU = &H111
`系统控制菜单的消息为 &112

Global lpPrevWndProc As Long
Global gHW As Long
   
Public gsDirName() As String

Sub LoadNewMenu(frm As Form)
   Dim myName As String, myPath As String
   Dim i As Integer
   Dim MenuHwnd As Long
   

   myPath = "c:"    ` 指定路径,如果不是根目录,请注意最后必须加一个""
   myName = Dir(myPath, vbDirectory)   `找寻第一项。
   
   `下面循环将子目录名加入数组
   Do While myName <> ""
      ` 跳过当前的目录及上层目录。
      If myName <> "." And myName <> ".." Then
         ` 使用位比较来确定 MyName 代表一目录。
         If (GetAttr(myPath & myName) And vbDirectory) = vbDirectory Then
            Debug.Print myName   ` 如果它是一个目录，将其名称显示出来。
            ReDim Preserve gsDirName(i)
            gsDirName(i) = myName
            i = i + 1
         End If
      End If
      myName = Dir   `查找下一个目录。
   Loop
   
   `说明一下,在新增菜单函数中的 0,1,2 表示:在0号菜单的1号子菜单的2号子菜单项下插入,
            `改变此值就可以改变插入菜单位置,
   `菜单0
   `......子菜单0
   `......子菜单1
   `............子子菜单0
   `............子子菜单1
   `............本程式的菜单插入位置,止项在设计时不用
   
   `说明一下 , 目录的ID之所以加1000是为了防止和设计时的菜单的ID相同
   MenuHwnd = GetSubMenu(GetSubMenu(GetMenu(frm.hwnd), 0), 1)
   For i = UBound(gsDirName) To 0 Step -1
      InsertMenu MenuHwnd, 2, MF_BYPOSITION, 1000 + i, gsDirName(i)
   Next i
   DrawMenuBar frm.hwnd
   gHW = frm.hwnd
   
   `在实际运用中,可用下面的语句直接打开子类,就可响应新增菜单事件了.
   `lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)
End Sub

`下一步，使用两个例程“钩入”消息流。第一个过程 (Hook) 调用了 SetWindowLong 函数，
`它使用了 GWL_WNDPROC 索引来创建窗口类的子类，窗口类是用来创建窗口的。然后它使
`用 AddressOf 关键字和回调函数 (WindowProc) 来截取消息并在“立即”窗口中打印消息的值。
`第二个过程 (Unhook) 关闭了子类，重新使原来的 Windows 过程成为回调函数。

Sub Hook()
   `打开子类
   lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Sub Unhook()
   Dim temp As Long
   `关闭子类
   temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
End Sub

Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Dim i As Integer
   
   `可以用Debug方法获取各种消息的值
   Debug.Print "Message: "; hw, uMsg, wParam, lParam
   
   If uMsg = WM_NEWMENU Then
      `进一步检查是否是自定义菜单项的ID      For i = 0 To UBound(gsDirName)
      For i = 0 To UBound(gsDirName)
         If wParam = 1000 + i Then
            MsgBox gsDirName(i)
            Exit Function
         End If
      Next i
      WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
   Else
      WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
   End If

End Function

`==========================================
` 注解不详, 如有问题, 请大家指正.

原文转自：http://www.ltesting.net