home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / EXCEL_like2080408212007.psc / flexgrid / menu / cHookingThunk.cls next >
Text File  |  2002-11-09  |  9KB  |  226 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "cHookingThunk"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. '==============================================================================
  15. ' cHookingThunk.cls
  16. '
  17. '   Subclassing Thunk (SuperClass V2) Project
  18. '   Portions copyright (c) 2002 by Paul Caton <Paul_Caton@hotmail.com>
  19. '   Portions copyright (c) 2002 by Vlad Vissoultchev <wqweto@myrealbox.com>
  20. '
  21. '   The WindowHooks Thunk single class file
  22. '
  23. ' Modifications:
  24. '
  25. ' 2002-10-01    WQW     Initial implementation
  26. '
  27. '==============================================================================
  28. Option Explicit
  29. Private Const MODULE_NAME As String = "cHookingThunk"
  30.  
  31. '==============================================================================
  32. ' API
  33. '==============================================================================
  34.  
  35. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
  36. Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
  37. Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
  38. Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
  39. Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
  40. 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
  41. Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
  42.  
  43. '==============================================================================
  44. ' Constants and member variables
  45. '==============================================================================
  46.  
  47. '--- data block in asm module is placed at this origin
  48. Private Const DATA_ORG                  As Long = &H100
  49. Private Const STR_ASM_OPCODES           As String = "&H83EC8B55 &HE860F8C4 &H0 &HCEB815B &H83004010 &H401110BB &H2E740000 &H111093FF &HF8830040 &HC7097502 &H1F845 &H4EEB0000 &H1675C085 &H1100B3FF &H93FF0040 &H40110C &H110483C7 &H40 &H938B0000 &H401104 &H2A74D285 &H4589C033 &HFC4589F8 &H10458D53 &HC458D50 &H8458D50 &HFC458D50 &HF8458D50 &H28B5250 &H5B2050FF &HF87D83 &HFF535375 &H75FF1075 &H875FF0C &H1100B3FF &H93FF0040 &H401108 &HFC45895B &HF87D83 &HBB833375 &H401110 &HFF0B7400 &H40111093 &H2F88300 &H938B1F74 &H401104 &H1574D285 &H1075FF53 &HFF0C75FF &H458D0875 &H8B5250FC &H1C50FF02 &H458B615B &HCC2C9FC"
  50. Private Const STR_MODULE_USER32         As String = "user32"
  51. Private Const STR_MODULE_VBA6           As String = "vba6"
  52. Private Const STR_MODULE_VBA5           As String = "vba5"
  53. Private Const STR_CALLNEXTHOOKEX        As String = "CallNextHookEx"
  54. Private Const STR_UNHOOKWINDOWSHOOKEX   As String = "UnhookWindowsHookEx"
  55. Private Const STR_EBMODE                As String = "EbMode"
  56.  
  57. Private m_uThunk                    As UcsThunk
  58. Private m_vTag                      As Variant
  59. Private m_eHookType                 As HookType
  60. #If DebugMode Then
  61.     Private m_sDebugID              As String
  62. #End If
  63.  
  64. '--- layout matches declarations in the asm module
  65. Private Type UcsData
  66.     CurrentHook                     As Long
  67.     SinkInterface                   As IHookingSink
  68.     AddrCallNextHookEx              As Long
  69.     AddrUnhookWindowsHookEx         As Long
  70.     AddrEbMode                      As Long
  71. End Type
  72.  
  73. Private Type UcsThunk
  74.     Code(0 To DATA_ORG \ 4 - 1)     As Long
  75.     Data                            As UcsData
  76. End Type
  77.  
  78. '==============================================================================
  79. ' Properties
  80. '==============================================================================
  81.  
  82. Property Get HookType() As HookType
  83.     HookType = m_eHookType
  84. End Property
  85.  
  86. Property Get ThunkAddress() As Long
  87.     ThunkAddress = VarPtr(m_uThunk.Code(0))
  88. End Property
  89.  
  90. Property Get Tag() As Variant
  91.     If IsObject(m_vTag) Then
  92.         Set Tag = m_vTag
  93.     Else
  94.         Tag = m_vTag
  95.     End If
  96. End Property
  97.  
  98. Property Let Tag(vValue As Variant)
  99.     m_vTag = vValue
  100. End Property
  101.  
  102. Property Set Tag(ByVal oValue As Object)
  103.     Set m_vTag = oValue
  104. End Property
  105.  
  106. '--- lParam cast helpers
  107. Public Property Get CWPSTRUCT(ByVal lParam As Long) As CWPSTRUCT
  108.     CopyMemory VarPtr(CWPSTRUCT), lParam, LenB(CWPSTRUCT)
  109. End Property
  110.  
  111. Public Property Get CWPRETSTRUCT(ByVal lParam As Long) As CWPRETSTRUCT
  112.     CopyMemory VarPtr(CWPRETSTRUCT), lParam, LenB(CWPRETSTRUCT)
  113. End Property
  114.  
  115. Public Property Get CBT_CREATEWND(ByVal lParam As Long) As CBT_CREATEWND
  116.     CopyMemory VarPtr(CBT_CREATEWND), lParam, LenB(CBT_CREATEWND)
  117. End Property
  118.  
  119. Public Property Get CREATESTRUCT(ByVal lParam As Long) As CREATESTRUCT
  120.     CopyMemory VarPtr(CREATESTRUCT), lParam, LenB(CREATESTRUCT)
  121. End Property
  122.  
  123. Public Property Get MSG(ByVal lParam As Long) As MSG
  124.     CopyMemory VarPtr(MSG), lParam, LenB(MSG)
  125. End Property
  126.  
  127. Public Property Get EVENTMSG(ByVal lParam As Long) As EVENTMSG
  128.     CopyMemory VarPtr(EVENTMSG), lParam, LenB(EVENTMSG)
  129. End Property
  130.  
  131. Public Property Get KBDLLHOOKSTRUCT(ByVal lParam As Long) As KBDLLHOOKSTRUCT
  132.     CopyMemory VarPtr(KBDLLHOOKSTRUCT), lParam, LenB(KBDLLHOOKSTRUCT)
  133. End Property
  134.  
  135. Public Property Get MOUSEHOOKSTRUCT(ByVal lParam As Long) As MOUSEHOOKSTRUCT
  136.     CopyMemory VarPtr(MOUSEHOOKSTRUCT), lParam, LenB(MOUSEHOOKSTRUCT)
  137. End Property
  138.  
  139. Public Property Get MSLLHOOKSTRUCT(ByVal lParam As Long) As MSLLHOOKSTRUCT
  140.     CopyMemory VarPtr(MSLLHOOKSTRUCT), lParam, LenB(MSLLHOOKSTRUCT)
  141. End Property
  142.  
  143. Public Property Get RECT(ByVal lParam As Long) As RECT
  144.     CopyMemory VarPtr(RECT), lParam, LenB(RECT)
  145. End Property
  146.  
  147. Public Property Get STR(ByVal lpsz As Long) As String
  148.     If lpsz <> 0 Then
  149.         STR = String(lstrlen(lpsz), 0)
  150.         lstrcpy STR, lpsz
  151.     End If
  152. End Property
  153.  
  154. '==============================================================================
  155. ' Methods
  156. '==============================================================================
  157.  
  158. Public Function Hook( _
  159.             ByVal HookType As HookType, _
  160.             ByVal Sink As IHookingSink) As Boolean
  161.     With m_uThunk.Data
  162.         '--- state check
  163.         If .CurrentHook <> 0 Then
  164.             Exit Function
  165.         End If
  166.         '--- init member var
  167.         m_eHookType = HookType
  168.         '--- store a reference (AddRef'd)
  169.         Set .SinkInterface = Sink
  170.         '--- store CallNextHookEx & UnhookWindowsHookEx API function entry points
  171.         .AddrCallNextHookEx = pvGetProcAddr(STR_MODULE_USER32, STR_CALLNEXTHOOKEX)
  172.         .AddrUnhookWindowsHookEx = pvGetProcAddr(STR_MODULE_USER32, STR_UNHOOKWINDOWSHOOKEX)
  173.         '--- store EbMode VBAx.DLL API function entry point
  174.         .AddrEbMode = pvGetProcAddr(STR_MODULE_VBA6, STR_EBMODE)
  175.         If .AddrEbMode = 0 Then
  176.             .AddrEbMode = pvGetProcAddr(STR_MODULE_VBA5, STR_EBMODE)
  177.         End If
  178.         '--- set hook
  179.         .CurrentHook = SetWindowsHookEx(HookType, ThunkAddress, App.hInstance, App.ThreadID)
  180.         '--- success (or failure)
  181.         Hook = (.CurrentHook <> 0)
  182.     End With
  183. End Function
  184.  
  185. Public Function Unhook() As Boolean
  186.     With m_uThunk.Data
  187.         '--- state check
  188.         If .CurrentHook = 0 Then
  189.             Exit Function
  190.         End If
  191.         '--- unhook
  192.         Call UnhookWindowsHookEx(.CurrentHook)
  193.         '--- reference is Release'd
  194.         Set .SinkInterface = Nothing
  195.         '--- can call Hook later yet again
  196.         .CurrentHook = 0
  197.     End With
  198.     '--- success
  199.     Unhook = True
  200. End Function
  201.  
  202. Private Function pvGetProcAddr(sModule As String, sFunction As String) As Long
  203.     pvGetProcAddr = GetProcAddress(GetModuleHandle(sModule), sFunction)
  204. End Function
  205.  
  206. Private Sub Class_Initialize()
  207.     Dim lIdx            As Long
  208.     Dim vOpcode         As Variant
  209.     
  210.     '--- extract code
  211.     For Each vOpcode In Split(STR_ASM_OPCODES)
  212.         m_uThunk.Code(lIdx) = vOpcode
  213.         lIdx = lIdx + 1
  214.     Next
  215.     #If DebugMode Then
  216.         DebugInit m_sDebugID, MODULE_NAME
  217.     #End If
  218. End Sub
  219.  
  220. Private Sub Class_Terminate()
  221.     Unhook
  222.     #If DebugMode Then
  223.         DebugTerm m_sDebugID
  224.     #End If
  225. End Sub
  226.