[嗷嗷叫的老马]的子类化模块，我想在里边增加过程和函数，结果非法操作。求解释....

admin6677 · 发表于 2015-6-26 14:45:38

Option Explicit
'*************************************************************************
'**模块名：cSubClass
'**说明：通用子类化模块,拦截本进程指定句柄的消息
'**创建人：嗷嗷叫的老马
'**日期：2008年11月13日
'**版本：V1.0
'**备注：PctGL版本,代码更精简,执行效率更高.
'** 原帖地址: http://www.cnblogs.com/pctgl/articles/1586841.html
'*************************************************************************
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, Optional ByVal Length As Long = 4)
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 Type ThisClassSet
s_srcWndProcAddress As Long
s_Hwnd As Long
End Type
Dim PG As ThisClassSet
Dim LinkProc() As Long
Event GetWindowMessage(Result As Long, ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long)
Private Sub MsgHook(Result As Long, ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long)
'子类化接口过程
RaiseEvent GetWindowMessage(Result, cHwnd, Message, wParam, lParam)
End Sub
Private Function GetWndProcAddress(ByVal SinceCount As Long) As Long
' 地址指针＝ GetWndProcAddress( 取第 N 个公共函数（属性） =或= 所有公共函数个数 + 第 N 个私有函数的函数地址）
Dim mePtr As Long
Dim jmpAddress As Long
mePtr = ObjPtr(Me)
CopyMemory jmpAddress, ByVal mePtr, 4
CopyMemory jmpAddress, ByVal jmpAddress + (SinceCount - 1) * 4 + &H1C, 4
ReDim LinkProc(10)
LinkProc(0) = &H83EC8B55
LinkProc(1) = &HFC8B14EC
LinkProc(2) = &H56FC758D
LinkProc(3) = &H3308758D
LinkProc(4) = &HFC04B1C9
LinkProc(5) = &HFF68A5F3
LinkProc(6) = &HB8FFFFFF
LinkProc(7) = &HFFFFFFFF
LinkProc(8) = &H48BD0FF
LinkProc(9) = &H10C2C924
CopyMemory ByVal VarPtr(LinkProc(5)) + 3, mePtr, 4
CopyMemory ByVal VarPtr(LinkProc(7)), jmpAddress, 4
GetWndProcAddress = VarPtr(LinkProc(0))
VirtualProtect ByVal VarPtr(LinkProc(0)), 44, &H40, mePtr
End Function
Function CallDefaultWindowProc(ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'调用窗口默认处理过程
CallDefaultWindowProc = CallWindowProc(PG.s_srcWndProcAddress, ByVal cHwnd&, ByVal Message&, ByVal wParam&, ByVal lParam&)
End Function
Function SetMsgHook(ByVal cHwnd As Long) As Long
'设置指定窗口的子类化
PG.s_Hwnd = cHwnd
PG.s_srcWndProcAddress = SetWindowLong(ByVal cHwnd, ByVal -4&, ByVal GetWndProcAddress(4))
SetMsgHook = PG.s_srcWndProcAddress
End Function
Sub SetMsgUnHook()
'取消窗口子类化
SetWindowLong ByVal PG.s_Hwnd&, ByVal -4&, ByVal PG.s_srcWndProcAddress&
End Sub
' 00151BEA 55 PUSH EBP
' 00151BEB 8BEC MOV EBP,ESP
' 00151BED 83EC 10 SUB ESP,14
' 00151BF0 8BFC MOV EDI,ESP
' 00151BF2 8D75 FC LEA ESI,DWORD PTR SS:[EBP-4]
' 00151BF5 56 PUSH ESI
' 00151BF6 8D75 08 LEA ESI,DWORD PTR SS:[EBP+8]
' 00151BF9 33C9 XOR ECX,ECX
' 00151BFB B1 04 MOV CL,4
' 00151BFD FC CLD
' 00151BFE F3:A5 REP MOVS DWORD PTR ES:[EDI],DWORD PTR DS>
' 00151C00 68 00100000 PUSH 1000
' 00151C05 B8 00200000 MOV EAX,2000
' 00151C0A FFD0 CALL EAX
' 00401234 8B0424 MOV EAX,DWORD PTR SS:[ESP]
' 00151C10 C9 LEAVE
' 00151C11 C2 1000 RETN 10

复制代码

我在前面加函数，和在后面加函数，都有异常。谁能改改，改成能随便增加函数和过程的？

admin6677 · 发表于 2015-6-26 17:19:12

貌似把 68行的改成
PG.s_srcWndProcAddress = SetWindowLong(ByVal cHwnd, ByVal -4&, ByVal GetWndProcAddress(函数/过程总数量))

就没有异常了。

wtywtykk · 发表于 2015-6-26 20:01:20

取第 N 个公共函数（属性） =或= 所有公共函数个数 + 第 N 个私有函数的函数地址对应起来了么
我之前实现过一个，加函数不用改动但要有一个模块辅助

wtywtykk · 发表于 2015-6-27 23:43:10

Option Explicit
Private Const WM_DESTROY As Long = &H2
Private Const WM_NCPAINT = &H85
Private Const WM_MOUSEWHEEL = &H20A
Private Const GWL_WNDPROC = (-4)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length 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 Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (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
Public Sub GridHook(hwnd As Long, Obj As Long)
If GetProp(hwnd, "OrigProcAddr") = 0 Then
SetProp hwnd, "OrigProcAddr", SetWindowLong(hwnd, GWL_WNDPROC, AddressOf GridProc)
SetProp hwnd, "ObjPtr", Obj
End If
End Sub
Private Function GridProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case uMsg
Case WM_DESTROY
SetWindowLong hwnd, GWL_WNDPROC, GetProp(hwnd, "OrigProcAddr")
RemoveProp hwnd, "OrigProcAddr"
RemoveProp hwnd, "ObjPtr"
Case WM_MOUSEWHEEL
Dim CtrlObj As Object
Dim CtrlPtr As Long
CtrlPtr = GetProp(hwnd, "ObjPtr")
CopyMemory CtrlObj, CtrlPtr, 4
CtrlObj.OnScroll -wParam \ Abs(wParam)
CopyMemory CtrlObj, 0, 4
End Select
GridProc = CallWindowProc(GetProp(hwnd, "OrigProcAddr"), hwnd, uMsg, wParam, lParam)
End Function

复制代码

其实没啥特殊的。。。。就是改一下object的指针

这段代码是用来响应滚轮用的，改成其他消息也行

		自动登录	找回密码
密码			立即注册

VBGood网站全文搜索

[嗷嗷叫的老马]的子类化模块，我想在里边增加过程和函数，结果非法操作。求解释....

点评

点评

评分