VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
查看: 1942|回复: 3

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

[复制链接]
发表于 2015-6-26 14:45:38 | 显示全部楼层 |阅读模式
  1. Option Explicit

  2. '*************************************************************************
  3. '**模 块 名:cSubClass
  4. '**说    明:通用子类化模块,拦截本进程指定句柄的消息
  5. '**创 建 人:嗷嗷叫的老马
  6. '**日    期:2008年11月13日
  7. '**版    本:V1.0
  8. '**备    注:PctGL版本,代码更精简,执行效率更高.
  9. '**          原帖地址: http://www.cnblogs.com/pctgl/articles/1586841.html
  10. '*************************************************************************

  11. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, Optional ByVal Length As Long = 4)
  12. 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
  13. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  14. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  15. Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long

  16. Private Type ThisClassSet
  17.     s_srcWndProcAddress     As Long
  18.     s_Hwnd                  As Long
  19. End Type

  20. Dim PG                      As ThisClassSet
  21. Dim LinkProc()              As Long

  22. Event GetWindowMessage(Result As Long, ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long)

  23. Private Sub MsgHook(Result As Long, ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long)
  24.     '子类化接口过程
  25.     RaiseEvent GetWindowMessage(Result, cHwnd, Message, wParam, lParam)
  26. End Sub

  27. Private Function GetWndProcAddress(ByVal SinceCount As Long) As Long
  28. '   地址指针 = GetWndProcAddress( 取第 N 个公共函数(属性)  =或= 所有公共函数个数 + 第 N 个私有函数的函数地址)
  29.     Dim mePtr As Long
  30.     Dim jmpAddress As Long
  31.     mePtr = ObjPtr(Me)
  32.     CopyMemory jmpAddress, ByVal mePtr, 4
  33.     CopyMemory jmpAddress, ByVal jmpAddress + (SinceCount - 1) * 4 + &H1C, 4

  34.     ReDim LinkProc(10)
  35.     LinkProc(0) = &H83EC8B55
  36.     LinkProc(1) = &HFC8B14EC
  37.     LinkProc(2) = &H56FC758D
  38.     LinkProc(3) = &H3308758D
  39.     LinkProc(4) = &HFC04B1C9
  40.     LinkProc(5) = &HFF68A5F3
  41.     LinkProc(6) = &HB8FFFFFF
  42.     LinkProc(7) = &HFFFFFFFF
  43.     LinkProc(8) = &H48BD0FF
  44.     LinkProc(9) = &H10C2C924
  45.    
  46.     CopyMemory ByVal VarPtr(LinkProc(5)) + 3, mePtr, 4
  47.     CopyMemory ByVal VarPtr(LinkProc(7)), jmpAddress, 4
  48.     GetWndProcAddress = VarPtr(LinkProc(0))
  49.     VirtualProtect ByVal VarPtr(LinkProc(0)), 44, &H40, mePtr
  50. End Function

  51. Function CallDefaultWindowProc(ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  52.     '调用窗口默认处理过程
  53.     CallDefaultWindowProc = CallWindowProc(PG.s_srcWndProcAddress, ByVal cHwnd&, ByVal Message&, ByVal wParam&, ByVal lParam&)
  54. End Function

  55. Function SetMsgHook(ByVal cHwnd As Long) As Long
  56.     '设置指定窗口的子类化
  57.     PG.s_Hwnd = cHwnd
  58.     PG.s_srcWndProcAddress = SetWindowLong(ByVal cHwnd, ByVal -4&, ByVal GetWndProcAddress(4))
  59.     SetMsgHook = PG.s_srcWndProcAddress
  60. End Function

  61. Sub SetMsgUnHook()
  62.     '取消窗口子类化
  63.     SetWindowLong ByVal PG.s_Hwnd&, ByVal -4&, ByVal PG.s_srcWndProcAddress&
  64. End Sub

  65. '    00151BEA    55              PUSH EBP
  66. '    00151BEB    8BEC            MOV EBP,ESP
  67. '    00151BED    83EC 10         SUB ESP,14
  68. '    00151BF0    8BFC            MOV EDI,ESP
  69. '    00151BF2    8D75 FC         LEA ESI,DWORD PTR SS:[EBP-4]
  70. '    00151BF5    56              PUSH ESI
  71. '    00151BF6    8D75 08         LEA ESI,DWORD PTR SS:[EBP+8]
  72. '    00151BF9    33C9            XOR ECX,ECX
  73. '    00151BFB    B1 04           MOV CL,4
  74. '    00151BFD    FC              CLD
  75. '    00151BFE    F3:A5           REP MOVS DWORD PTR ES:[EDI],DWORD PTR DS>
  76. '    00151C00    68 00100000     PUSH 1000
  77. '    00151C05    B8 00200000     MOV EAX,2000
  78. '    00151C0A    FFD0            CALL EAX
  79. '    00401234    8B0424          MOV EAX,DWORD PTR SS:[ESP]
  80. '    00151C10    C9              LEAVE
  81. '    00151C11    C2 1000         RETN 10
复制代码
我在前面加函数,和在后面加函数,都有异常。谁能改改,改成能随便增加函数和过程的?

点评

你添加的函数只能是Friend类型的,这样应该就没有问题  发表于 2015-6-26 15:42
 楼主| 发表于 2015-6-26 17:19:12 | 显示全部楼层
貌似把 68行的改成
PG.s_srcWndProcAddress = SetWindowLong(ByVal cHwnd, ByVal -4&, ByVal GetWndProcAddress(函数/过程总数量))

就没有异常了。
回复 支持 反对

使用道具 举报

发表于 2015-6-26 20:01:20 | 显示全部楼层
取第 N 个公共函数(属性)  =或= 所有公共函数个数 + 第 N 个私有函数的函数地址对应起来了么
我之前实现过一个,加函数不用改动但要有一个模块辅助

点评

把你代码贡献出来,嘻嘻  发表于 2015-6-27 21:27
回复 支持 反对

使用道具 举报

发表于 2015-6-27 23:43:10 | 显示全部楼层
  1. Option Explicit

  2. Private Const WM_DESTROY As Long = &H2
  3. Private Const WM_NCPAINT = &H85
  4. Private Const WM_MOUSEWHEEL = &H20A

  5. Private Const GWL_WNDPROC = (-4)
  6. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  7. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  8. 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
  9. Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
  10. Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
  11. Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long

  12. Public Sub GridHook(hwnd As Long, Obj As Long)
  13.     If GetProp(hwnd, "OrigProcAddr") = 0 Then
  14.        SetProp hwnd, "OrigProcAddr", SetWindowLong(hwnd, GWL_WNDPROC, AddressOf GridProc)
  15.        SetProp hwnd, "ObjPtr", Obj
  16.     End If
  17. End Sub

  18. Private Function GridProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  19.     Select Case uMsg
  20.     Case WM_DESTROY
  21.         SetWindowLong hwnd, GWL_WNDPROC, GetProp(hwnd, "OrigProcAddr")
  22.         RemoveProp hwnd, "OrigProcAddr"
  23.         RemoveProp hwnd, "ObjPtr"
  24.     Case WM_MOUSEWHEEL
  25.         Dim CtrlObj As Object
  26.         Dim CtrlPtr As Long
  27.         CtrlPtr = GetProp(hwnd, "ObjPtr")
  28.         CopyMemory CtrlObj, CtrlPtr, 4
  29.         CtrlObj.OnScroll -wParam \ Abs(wParam)
  30.         CopyMemory CtrlObj, 0, 4
  31.     End Select
  32.     GridProc = CallWindowProc(GetProp(hwnd, "OrigProcAddr"), hwnd, uMsg, wParam, lParam)
  33. End Function
复制代码
其实没啥特殊的。。。。就是改一下object的指针这段代码是用来响应滚轮用的,改成其他消息也行

评分

参与人数 1威望 +3 人气 +3 收起 理由
admin6677 + 3 + 3 很给力

查看全部评分

回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2022-7-1 20:56

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表