从以往子类化跟踪MouseLeave深入讨论VB6的自定义Hook类
之前发过一篇博文,是关于VB6中跟踪鼠标移出事件的示例(http://www.cnblogs.com/alexywt/p/5891827.html)
随着业务状况的不断发展,提出了更多的挑战和问题.
其一:子类化在VB6的IDE调试阶段会出现崩溃情况,需要实现子类化的无崩溃调试;
其一:我的窗体或自定义控件中可能有很多控件需要跟踪鼠标移出事件;甚至可能会通过代码来动态添加控件,要监听移出事件,通常是用WithEvents,但VB6的该关键字不支持数组对象的事件跟踪.也就是说要找到一种方式来批量处理大量控件的鼠标移出事件.
我对原来的Hooker类进行了改进,使其能适应调试模式,而不至于造成IDE崩溃:废话不多说,直接上修改过之后的类模块代码如下,其中关键部分在GetWndProcAddress过程中对LogMode分类进行处理,该过程的代码源自"嗷嗷叫的老马"http://www.cnblogs.com/pctgl/articles/1586841.html
Option Explicit Private Const WM_MOUSELEAVE = &H2A3&
Private Const WM_MOUSEMOVE = &H200
Private Const TME_LEAVE = &H2& Private Type TRACKMOUSEEVENTTYPE
cbSize As Long
dwFlags As Long
hwndTrack As Long
dwHoverTime As Long
End Type Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, Optional ByVal Length As Long = )
Private 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
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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal lpMem As Long) As Long
Private Declare Function TrackMouseEvent Lib "user32" (lpEventTrack As TRACKMOUSEEVENTTYPE) As Long Private Type ThisClassSet
s_srcWndProcAddress As Long
s_Hwnd As Long
s_BlockProtect As Long
n_heapAlloc As Long
End Type Private LinkProc() As Long
Private PG As ThisClassSet
Private mMouseLeaveTracking As Boolean
Private mHookObject As Object Public Event GetWindowMessage(Result As Long, ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long)
Public Event MouseLeave() Private Sub HookProc(Result As Long, ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long)
Dim tTrackML As TRACKMOUSEEVENTTYPE '一个移开事件结构声明
'子类化接口过程
RaiseEvent GetWindowMessage(Result, cHwnd, Message, wParam, lParam)
Select Case Message
Case WM_MOUSEMOVE
If Not mMouseLeaveTracking Then
mMouseLeaveTracking = True
'initialize structure
tTrackML.cbSize = Len(tTrackML)
tTrackML.hwndTrack = cHwnd
tTrackML.dwFlags = TME_LEAVE
'start the tracking
TrackMouseEvent tTrackML
End If
Case WM_MOUSELEAVE
RaiseEvent MouseLeave
mMouseLeaveTracking = False
End Select
Result = CallWindowProc(PG.s_srcWndProcAddress, ByVal cHwnd&, ByVal Message&, ByVal wParam&, ByVal lParam&)
End Sub Private Function GetWndProcAddress(ByVal OrgWindowProc As Long, ByVal SinceCount As Long) As Long
' 地址指针 = GetWndProcAddress( 取第 N 个公共函数(属性) =或= 所有公共函数个数 + 第 N 个私有函数的函数地址)
Dim mePtr As Long
Dim jmpAddress As Long
Dim i As Long mePtr = ObjPtr(Me)
CopyMemory jmpAddress, ByVal mePtr,
CopyMemory jmpAddress, ByVal jmpAddress + (SinceCount - ) * + &H1C, If App.LogMode = Then ReDim LinkProc() As Long LinkProc() = &H83EC8B55
LinkProc() = &H75FFFCC4
LinkProc() = &H1075FF14
LinkProc() = &HFF0C75FF
LinkProc() = &HB90875
LinkProc() = &HFF000010
LinkProc() = &H1F883D1
LinkProc() = &H4D8D1575
LinkProc() = &H6851FC
LinkProc() = &HB8000020
LinkProc() = &H3000
LinkProc() = &H458BD0FF
LinkProc() = &HB807EBFC
LinkProc() = &H4000
LinkProc() = &HC2C9D0FF
LinkProc() = &H10 CopyMemory ByVal VarPtr(LinkProc()) + , GetProcAddress(GetModuleHandle("vba6.dll"), "EbMode"), & ' Label Sign: 0100000
CopyMemory ByVal VarPtr(LinkProc()) + , ObjPtr(Me), & ' Label Sign: 0200000
LinkProc() = jmpAddress ' Label Sign: 0300000
LinkProc() = PG.s_srcWndProcAddress ' Label Sign: 0400000 PG.n_heapAlloc = HeapAlloc(GetProcessHeap, &H8, &)
CopyMemory ByVal PG.n_heapAlloc, LinkProc(), &
VirtualProtect ByVal PG.n_heapAlloc, ByVal &, ByVal &H40&, PG.s_BlockProtect
GetWndProcAddress = PG.n_heapAlloc Else
ReDim LinkProc()
LinkProc() = &H83EC8B55
LinkProc() = &H75FFFCC4
LinkProc() = &H1075FF14
LinkProc() = &HFF0C75FF
LinkProc() = &H458D0875
LinkProc() = &H6850FC
LinkProc() = &HB8000010
LinkProc() = &H2000
LinkProc() = &H458BD0FF
LinkProc() = &H10C2C9FC CopyMemory ByVal VarPtr(LinkProc()) + , ObjPtr(Me), & ' Label Sign: 0100000
LinkProc() = jmpAddress ' Label Sign: 0200000
VirtualProtect ByVal VarPtr(LinkProc()), ByVal &, ByVal &H40&, PG.s_BlockProtect
GetWndProcAddress = VarPtr(LinkProc()) End If End Function Public Function StartHook(HookObject As Object) As Long
Dim cHwnd As Long
Set mHookObject = HookObject
cHwnd = HookObject.hWnd
'设置指定窗口的子类化
PG.s_Hwnd = cHwnd
PG.s_srcWndProcAddress = GetWindowLong(cHwnd, ByVal -&)
SetWindowLong ByVal cHwnd, ByVal -&, ByVal GetWndProcAddress(PG.s_srcWndProcAddress, )
StartHook = PG.s_srcWndProcAddress
End Function Public Property Get HookObject() As Object
Set HookObject = mHookObject
End Property Public Sub UnHook()
'取消窗口子类化
SetWindowLong ByVal PG.s_Hwnd&, ByVal -&, ByVal PG.s_srcWndProcAddress&
Set mHookObject = Nothing
End Sub Private Sub Class_Terminate()
If PG.n_heapAlloc Then
UnHook
VirtualProtect ByVal PG.n_heapAlloc, ByVal &, ByVal PG.s_BlockProtect, PG.s_BlockProtect
HeapFree GetProcessHeap, ByVal &, PG.n_heapAlloc
PG.n_heapAlloc =
End If
End Sub
实现批量跟踪事件的思路是:在窗体上建立一个函数,来处理多个控件的指定事件
那么问题来了,我们子类化只能针对一个控件实施,假如我们直接在窗体上一个一个控件去子类化并写事件处理函数的话,也就背离了我的目的,因为这样的话有多少个控件就有很多个事件处理函数要写,我们的目的是只要一个函数来处理.
解决的方案是再建立一个包装器类,该类要完成2个事情,其一将需子类化的对象完成子类化,其二将调用的那个窗体中的事件处理函数与子类化关联,使之子类化回调函数即为该窗体中的自定义函数.
那么问题又来了,包装器类的第一个功能很容易实现,我们可以直接在该包装器类内实例化一个CHooker对象,然后调用其StartHook即可,那么要如何关联窗体中的自定义函数了?
因为该自定义函数在窗体中,是不可能通过AddressOf来取得其地址调用的,我们这里通过建立代理类实现
在VB.net中我们用代理用的很频繁,那么在VB6中要怎么做了?
首先我们建立一个接口类IMouseLeaveCallBack,代码如下
Public Sub MouseLeave(Hooker As CHooker) End Sub
然后在建立代理类CMouseLeaveDelegate,代码如下所示,其关键是在初始化类过程中传递一个类型为IMouseLeaveCallBack的对象进去,随后在mHooker的MouseLeave事件回调中执行该IMouseLeaveCallBack对象的MouseLeave方法,并将mHooker传递给它,以便实现IMouseLeaveCallBack接口的类通过mHooker的HookObject得到发生鼠标移出事件的控件是谁.
Private WithEvents mHooker As CHooker
Private mDelegate As IMouseLeaveCallBack Public Sub InitClass(HookedObject As Object, DelegateObject As IMouseLeaveCallBack)
Set mHooker = New CHooker
mHooker.StartHook HookedObject
Set mDelegate = DelegateObject
End Sub Private Sub Class_Terminate()
If mHooker Is Nothing Then Exit Sub
mHooker.UnHook
Set mHooker = Nothing
End Sub Private Sub mHooker_MouseLeave()
mDelegate.MouseLeave mHooker
End Sub
通过前面的处理之后,我们就可以在窗体上实现IMouseLeaveCallBack接口,并写该接口MouseLeave过程的实现代码了.
我的示例很简单,目的是为窗体上的按钮及图片框设置鼠标移动时背景色及鼠标离开后的背景色
其中鼠标移动背景色我是一个一个控件处理,这种方式非常麻烦,如果你想一个函数搞定所有控件的鼠标移动事件,可以参考鼠标移出事件的处理方式.这里我就是用来对比批量处理与单个单个处理的应用效果.
建立一个窗体,在窗体上建立一个按钮,一个PictureBox,我就只用了2个控件,注意按钮的Style要设置成Graphical,否则设置背景色无效.
在窗体中输入如下所示代码,这里我通过一个数组保存所有需要进行Hook的控件,以便能通过一个For循环遍历实施Hook.
Implements IMouseLeaveCallBack Private mHookedObjects( To ) As Object
Private mMouseLeaveHandles( To ) As CMouseLeaveDelegate Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command1.BackColor = RGB(, , )
End Sub Private Sub Form_Load()
Set mHookedObjects() = Me.Command1
Set mHookedObjects() = Me.Picture1
For i = To
Set mMouseLeaveHandles(i) = New CMouseLeaveDelegate
mMouseLeaveHandles(i).InitClass mHookedObjects(i), Me
Next
End Sub Private Sub IMouseLeaveCallBack_MouseLeave(Hooker As CHooker)
Hooker.HookObject.BackColor = RGB(, , )
End Sub Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture1.BackColor = RGB(, , )
End Sub
从以往子类化跟踪MouseLeave深入讨论VB6的自定义Hook类的更多相关文章
- 窗口的子类化与超类化——子类化是窗口实例级别的,超类化是在窗口类(WNDCLASS)级别的
1. 子类化 理论:子类化是这样一种技术,它允许一个应用程序截获发往另一个窗口的消息.一个应用程序通过截获属于另一个窗口的消息,从而实现增加.监视或者修改那个窗口的缺省行为.子类化是用来改变或者扩展一 ...
- Win32中安全的子类化(翻译)
关于子类化的话题虽然有些旧,但它至今仍然不失为一种开发Windows的强有力技术,在MFC的内核.甚至.NET的内核中都离不开它,希望本连载能对Windows开发的爱好者有所帮助. 原文标题:Safe ...
- C++ 中超类化和子类化
超类化和子类化没有具体的代码,其实是一种编程技巧,在MFC和WTL中可以有不同的实现方法. 窗口子类化: 原理就是改变一个已创建窗口类的窗口过程函数.通过截获已创建窗口的消息,从而实现监视或修改已创建 ...
- MFC_1.3 控件子类化 消息反射
控件子类化 如果想要在默认的控件类中添加一些功能,就需要子类化一个控件类 在类内可以响应控件所有的消息,并且可以添加自己的函数和数据 通过类向导子类化控件的步骤 打开类向导,创建一个 MFC 类,不要 ...
- 眼见为实(2):介绍Windows的窗口、消息、子类化和超类化
眼见为实(2):介绍Windows的窗口.消息.子类化和超类化 这篇文章本来只是想介绍一下子类化和超类化这两个比较“生僻”的名词.为了叙述的完整性而讨论了Windows的窗口和消息,也简要讨论了进程和 ...
- VB6史无前例的子类化之透明按钮
[原创文章,转发请保留版权信息] 作者:mezstd 文章地址:http://www.cnblogs.com/imez/p/3299728.html 效果图: 请原谅笔者无耻地称之为史无前例,至少在笔 ...
- C++ 中超类化和子类化常用API
在windows平台上,使用C++实现子类化和超类化常用的API并不多,由于这些API函数的详解和使用方法,网上一大把.本文仅作为笔记,简单的记录一下. 子类化:SetWindowLong,GetWi ...
- 窗口 超类化 子类化 HOOK
body { font-family: Bitstream Vera Sans Mono; font-size: 11pt; line-height: 1.5; } html, body { colo ...
- 深入理解MFC子类化
子类化,通俗来讲就是用自己的窗口处理函数来处理特定消息,并将自己其他消息还给标准(默认)窗口处理函数.在SDK中,通过SetWindowLong来指定一个自定义窗口处理函数:SetWindowLong ...
随机推荐
- Spring应用上下文中Bean的生命周期
Bean装载到Spring应用上下文的生命周期,如图: Bean在Spring容器中从创建到销毁经历了若干个阶段,每一阶段都可以对Spring如何管理Bean进行个性化定制,以下我们通过代码去验证生命 ...
- unity Editor的使用
1.首先定义一个需要控制数值的类,类中定义若干个变量 using UnityEngine;using System.Collections; using UnityEngine; using Syst ...
- pl/sql 导出oracle表结构
tools->export tables 是导出表结构还有数据 tools->export user objects是导出表结构 可以用tools->export tables ...
- loadrunner入门篇-Vuser发生器
Vuser 发生器(Visual User Generator,VuGen),主要通过捕获客户端向服务器发送的HTTP请求,将这些请求录制成脚本,在回放时将捕获的HTTP请求再次发送,以达到模拟客户行 ...
- UI培训怎么学才高效
随着互联网科技的爆炸式发展,UI设计越来越受到我们的青睐,绝大部分企业已成立U设计部门来提高自身影响力,但现在许多从事UI设计的人,都是从零基础过度过来的,他们不乏大牛,在阿里巴巴,在腾讯等国内一流企 ...
- R语言入门(二)基础语法
1.help可以提供帮助,如help(nchar), help("[["),或者用?nchar也能获取帮助.example(nchar)可以获取到某个主题的使用方法. 2.ncha ...
- iOS 调试心得
修复 bug 占用我们日常开发的大部分时间,熟练的使用调试工具可以给我们节约大部分的时间. LLDB 的常用命令 expression expresion 是一个非常常用的命令,我们可以通过这个命令来 ...
- 使用curl操作InfluxDB
这里列举几个简单的示例代码,更多信息请参考InfluxDB官方文档: https://docs.influxdata.com/influxdb/v1.1/ 环境: CentOS6.5_x64Influ ...
- C#:查询某年(1900-2100)某月的日历
using System;using System.Collections.Generic;public class Program { /********************主函数 ...
- Linux下随机生成密码的命令总结
有时候经常为如何设置一个安全.符合密码复杂度的密码而绞尽脑汁,说实话,这实在是一个体力活而且浪费时间,更重要的是设置密码的时候经常纠结.终于有一天实在忍不住了,于是学习.整理了一下如何使用Linux下 ...