非高手不可的问题：VB键盘钩子无法在多重窗体存在，谁来帮我改一改这个？

Question

下面的钩子程序在打开form2的时候，加载钩子；关闭form2的时候，卸载钩子，达到在dhtmledit控件无键盘返回值中用上enter的目的，很好用。 但是当在打开多重窗体的时候，会发生问题。比如打开form2(1)，再打开form2(2)，则form2(1)的钩子失效。 还有就是，这个时候如果关闭了form2(2)，再操作form2(1)，会产生错误，程序被全部关闭。 希望哪位大侠帮忙改一改，实现正常使用，非常感谢。 使用键盘钩子 
新建一个模块，加入如下代码： 
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long 
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long 
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long 
Dim hHook As Long Public Sub BeginHook() 
'调用API函数设置钩子函数，2表示键盘钩子 
hHook = SetWindowsHookEx(2, AddressOf HookFunc, 0, App.ThreadID) 
End Sub 
Public Function HookFunc(ByVal ncode As Long, ByVal Key As Long, ByVal Shift As Long) As Long 
'如果按键是回车就调用Form里面的函数，13是VK_ENTER的值 
If Key = 13 Then 
Form1.OnEnter Shift 
'返回1表示此消息已经被处理过，并且不调用CallNext...屏蔽后续处理 
HookFunc = 1 
Else 
'不是回车键就调用默认的处理 
HookFunc = CallNextHookEx(hHook, ncode, wParam, lParam) 
End If 
End Function 
Public Sub EndHook() 
'调用API卸载掉键盘钩子 
UnhookWindowsHookEx hHook 
End Sub 然后在Form里面增加如下代码： 
Private Sub Form_Load() 
' 设置钩子函数 
BeginHook 
End Sub Private Sub Form_Unload(Cancel As Integer) 
' 退出前卸载掉钩子 
EndHook 
End Sub 
' 钩子函数会调用此函数通知按键按下 
Public Sub OnEnter(ByVal Shift As Long) 
MsgBox Shift 
End Sub 

Answer 1

将hook作为public过程,并设置全局标识,如果已经hook了就不再hook.

Answer 2

先在模块或通用中设置一全局变量hooked,类型为boolean.Private Sub Form_Load() 
if not hooked then
' 设置钩子函数 
BeginHook 
hooked=true
endif
End Sub 在整个程序退出的时候才unhook.

Answer 3

Public Function HookFunc(ByVal ncode As Long, ByVal Key As Long, ByVal Shift As Long) As Long 
If Key = 13 Then 
Form1.OnEnter Shift‘这里出错
HookFunc = 1 
Else 
HookFunc = CallNextHookEx(hHook, ncode, wParam, lParam) 
End If 
End Function 你看这个出错是因为无法获得究竟是哪个窗体form1调用它,因为有好几个form1，有form1(0),form1(1),form1(2)......，如何处理这问题呢。

Answer 4

调用时带form1的参数，可以是forms1（i），也可以是form1的tag。

Answer 5

Private objFrm As Form4
Public Sub BeginHook(frm As Form4)
    Set objFrm = frm
    hHook = SetWindowsHookEx(2, AddressOf HookFunc, 0, App.ThreadID)
End Sub上面语句发现定义不了，愿闻其详？

Answer 6

form4中：（实际应是firm4(?)）
Private Sub Form_Load() 
if not hooked then 
' 设置钩子函数 
BeginHook 
hooked=true 
endif 
End Sub 

Answer 7

Public Function HookFunc(ByVal ncode As Long, ByVal Key As Long, ByVal Shift As Long,dim formindex as long) As Long

Answer 8

form4中调用是这样：
BeginHook（i）那么模块中如何定义呢？
Private objFrm As Form4
Public Sub BeginHook(frm As Form4)
    Set objFrm = frm

Answer 9

上面搞错了，应该是：
Public Function HookFunc(ByVal ncode As Long, ByVal Key As Long, ByVal Shift As Long,byval  formindex as long) As Long

Answer 10

form4中调用是这样： 
BeginHook（i） 那么模块中如何定义呢？ 
Private objFrm As Form4 
Public Sub BeginHook(frm As Form4) 
    Set objFrm = frm 

Answer 11

唉，真的不想复了，你把form的index一级一级的传递到HookFunc就可以了，声明HookFunc的时候：
Public Function HookFunc(ByVal ncode As Long, ByVal Key As Long, ByVal Shift As Long,byval  formindex as long) As Long 
然后根据formindex传进来的值判断要怎么做。
 
 

Answer 12

我想你的问题主要就是因为键盘钩子是当前进程共用的，所以你不知道：
①如何在多个窗体的无序 BeginHook/EndHook 中只需要一对 SetWindowsHookEx/UnhookWindowsHookEx。
②在 HookFunc 中应该调用哪个窗体的 OnEnter。修改如下
'Module
Option ExplicitPrivate Const WH_KEYBOARD As Long = 2
Private Const VK_RETURN As Long = &HDPrivate Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
        (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" _
        (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As LongPublic ActiveForm   As Form '当前活动窗体Private lHookCount  As Long 'BeginHook/EndHook 计数
Private hHook       As LongPublic Sub BeginHook()
    If lHookCount = 0 Then '仅第一个需要执行挂钩
        hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf HookFunc, 0, App.ThreadID)
        Debug.Print "SetWindowsHookEx()"
    End If
    lHookCount = lHookCount + 1
End SubPublic Sub EndHook()
    lHookCount = lHookCount - 1
    If lHookCount = 0 Then '仅最后一个才执行解除挂钩
        UnhookWindowsHookEx hHook
        Debug.Print "UnhookWindowsHookEx()"
    End If
End SubPublic Function HookFunc(ByVal ncode As Long, ByVal Key As Long, ByVal Shift As Long) As Long
    If (Key = VK_RETURN) And (Not ActiveForm Is Nothing) Then
        ActiveForm.OnEnter Shift
        HookFunc = 1
    Else
        HookFunc = CallNextHookEx(hHook, ncode, Key, Shift)
    End If
End Function'Form
Option ExplicitPublic Sub OnEnter(ByVal Shift As Long)
    MsgBox Shift, , Me.Caption  '区分出调用了哪个实例的 OnEnter"
End SubPrivate Sub Form_Activate()
    Set ActiveForm = Me
End SubPrivate Sub Form_Deactivate()
    Set ActiveForm = Nothing
End SubPrivate Sub Form_Load()
    Me.Caption = "hWnd = &H" & Hex(Me.hWnd) '用来标记不同的窗体实例
    BeginHook
End SubPrivate Sub Form_Unload(Cancel As Integer)
    If ActiveForm Is Me Then
        Set ActiveForm = Nothing
    End If
    EndHook
End Sub

Answer 13

直接加入去看不到效果，真的太难了。完整程序如下，求真正高手帮忙：
'模块： ########################################################################Option ExplicitPublic mk1(100000) As Integer '窗体名称，用来判断是否打开
Public mk3 As Double '用来对打开的窗体进行转换是哪个
Public mk4 As Double '用来对打开的窗体进行转换是哪个
Public hooked As Boolean '是否有钩子的判断Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Dim hHook As Long
Private objFrm As Form1
Public Sub BeginHook(frm As Form1)
    Set objFrm = frm
    '调用API函数设置钩子函数，2表示键盘钩子
    hHook = SetWindowsHookEx(2, AddressOf HookFunc, 0, App.ThreadID)
End Sub
Public Function HookFunc(ByVal ncode As Long, ByVal Key As Long, ByVal Shift As Long) As Long
    '如果按键是回车就调用Form里面的函数，13是VK_ENTER的值
    If Key = 17 Then
        objFrm.OnEnter Shift
        '返回1表示此消息已经被处理过，并且不调用CallNext...屏蔽后续处理
        HookFunc = 1
    Else
        '不是回车键就调用默认的处理
        HookFunc = CallNextHookEx(hHook, ncode, Key, Shift)
    End If
End Function
Public Sub EndHook()
    '调用API卸载掉键盘钩子
    UnhookWindowsHookEx hHook
End Sub
'form2: 一个treeview ############################################################################
Dim newfrm(100) As Form1Private Sub form_load()
For I = 1 To 25
TreeView1.Nodes.Add , tvwChild, "p" & CStr(I), "图书目录索引第" & CStr(I) & "页", 0
Next I
End Sub
Private Sub TreeView1_Click()
 mk4 = Right(TreeView1.SelectedItem.Key, Len(TreeView1.SelectedItem.Key) - 1) '用关键字作为窗体名称
   If Not mk1(mk4) Then '判断是否已打开此窗体，如果没有打开
    mk1(mk4) = True '在全局变量中设置此窗体已打开标志
    mk3 = mk4 '将ID值传给全局变量，form1中接收以判断是哪个的ID      Set newfrm(mk4) = New Form1
      newfrm(mk4).Show
      newfrm(mk4).Caption = TreeView1.SelectedItem.Text
End IfEnd Sub'form1: 一个textbox，一个Dhtmledit,一个command ##########################################################################
Dim kis
Dim ss
Private Const WM_PASTE = &H302
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Sub form_load()
  If Not hooked Then
     BeginHook Me ' 设置钩子函数
   hooked = True
End IfEnd SubPrivate Sub Form_Unload(Cancel As Integer)
  mk1(mk4) = False '退出时将此窗体情况设为非打开状态##########################################
    flag = True
      For ss = LBound(mk1) To UBound(mk1)
      flag = flag And Not (mk1(ss))
      If Not (flag) Then
        Exit Sub
         Else
         EndHook '退出前卸载掉钩子
        End If
   Next ssEnd Sub
' 钩子函数会调用此函数通知按键按下
Public Sub OnEnter(ByVal Shift As Long)
  If Shift = -1055064063 And kis = "0" Then '只允许键盘响应一次
   kis = "1"
     Call comm
   Else
    kis = "0"
   End If
End SubFunction comm()
 Text1.Text = "操作的是我"
End FunctionPrivate Sub Command1_Click()
Call comm
End Sub

Answer 14

重新搞了一个，真的可行呀。请高手再说明一下，如何实现选择enter和ctrl操作有效？

Answer 15

不明白你的意思。
而且 OnEnter 中更改了 kis 变量的值看不出什么作用。