home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / CodeHelp_A1935969282005.psc / CHCore / cHook.cls < prev    next >
Text File  |  2005-09-08  |  9KB  |  177 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 = "cHook"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
  15. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  16. '==================================================================================================
  17. 'cHook - module-less, IDE safe, machine code hooking thunk
  18. '
  19. 'Paul_Caton@hotmail.com
  20. 'Copyright free, use and abuse as you see fit.
  21. '
  22. 'v1.00 20030107 First cut..........................................................................
  23. 'v1.01 20030901 Changes to allow some global, system-wide hooks....................................
  24. 'v1.02 20031118 Allow control over callback gating
  25. '               Use global memory for the machine code buffer
  26. '               Reform the assembler...............................................................
  27. 'v1.03 20040118 Use EbMode for breakpoint/stop detection rather than callback gating
  28. '               Further reform the assembler for greater speed and smaller size
  29. '               Made InIDE public..................................................................
  30. '
  31. '==================================================================================================
  32. Option Explicit
  33.  
  34. Private Declare Function SetWindowsHookEx Lib "user32.dll" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
  35. Private Declare Function UnhookWindowsHookEx Lib "user32.dll" (ByVal hHook As Long) As Long
  36.  
  37. Private nAddrHook As Long                                   'Address of the hook thunk
  38. Private hHook     As Long                                   'Hook handle
  39.  
  40. '============================================
  41. 'Class creation/destruction
  42. '============================================
  43.  
  44. 'Build the hook thunk into allocated memory
  45. Private Sub Class_Initialize()
  46. Const PATCH_01  As Long = 17                                'Code buffer offset to the location of the relative address to EbMode
  47. Const PATCH_03  As Long = 71                                'Relative address of UnhookWindowsHookEx
  48. Const PATCH_05  As Long = 101                               'Relative address of CallNextHookEx
  49. Const FUNC_EBM  As String = "EbMode"                        'VBA's EbMode function allows the machine code thunk to know if the IDE has stopped or is on a breakpoint
  50. Const FUNC_UWH  As String = "UnhookWindowsHookEx"           'We use CallWindowProc to call the original WndProc
  51. Const FUNC_CNH  As String = "CallNextHookEx"                'SetWindowLong allows the cSubclasser machine code thunk to unsubclass the subclasser itself if it detects via the EbMode function that the IDE has stopped
  52. Const MOD_VBA5  As String = "vba5"                          'Location of the EbMode function if running VB5
  53. Const MOD_VBA6  As String = "vba6"                          'Location of the EbMode function if running VB6
  54. Const MOD_USER  As String = "user32"                        'Location of the KillTimer function
  55.   Dim i         As Long                                     'Loop index
  56.   Dim nLen      As Long                                     'String lengths
  57.   Dim sHex      As String                                   'Hex code string
  58.   Dim sCode     As String                                   'Binary code string
  59.   
  60.   'Store the hex pair machine code representation in sHex
  61.   sHex = "5589E583C4F831D28955FC8955F8EB0EE8xxxxx01x83F802742085C07423E82A000000837DF800750AE828000000E83A0000008B45FCC9C20C00E817000000EBF268xxxxx02xE8xxxxx03xEBE631D24AE820000000C3FF7510FF750CFF750868xxxxx04xE8xxxxx05x8945FCC331D2E801000000C38D4510508D450C508D4508508D45FC508D45F85052B8xxxxx06x508B00FF501CC3"
  62.   nLen = Len(sHex)                                          'Length of hex pair string
  63.   
  64.   'Convert the string from hex pairs to bytes and store in the ASCII string opcode buffer
  65.   For i = 1 To nLen Step 2                                  'For each pair of hex characters
  66.     sCode = sCode & ChrB$(Val("&H" & Mid$(sHex, i, 2)))     'Convert a pair of hex characters to a byte and append to the ASCII string
  67.   Next i                                                    'Next pair
  68.   
  69.   nLen = LenB(sCode)                                        'Get the machine code length
  70.   nAddrHook = GlobalAlloc(0, nLen)                          'Allocate fixed memory for machine code buffer
  71.   
  72.   'Copy the code to allocated memory
  73.   Call CopyMemory(ByVal nAddrHook, ByVal StrPtr(sCode), nLen)
  74.   
  75.   If InIDE Then
  76.     'Patch the jmp (EB0E) with two nop's (90) enabling the IDE breakpoint/stop checking code
  77.     Call CopyMemory(ByVal nAddrHook + 14, &H9090, 2)
  78.     
  79.     i = AddrFunc(MOD_VBA6, FUNC_EBM)                        'Get the address of EbMode in vba6.dll
  80.     If i = 0 Then                                           'Found?
  81.       i = AddrFunc(MOD_VBA5, FUNC_EBM)                      'VB5 perhaps, try vba5.dll
  82.     End If
  83.  
  84.     Debug.Assert i                                          'Ensure the EbMode function was found
  85.     Call PatchRel(PATCH_01, i)                              'Patch the relative address to the EbMode api function
  86.   End If
  87.  
  88.   'Patch the the runtime values that are known
  89.   Call PatchRel(PATCH_03, AddrFunc(MOD_USER, FUNC_UWH))     'Relative address of UnhookWindowsHookEx
  90.   Call PatchRel(PATCH_05, AddrFunc(MOD_USER, FUNC_CNH))     'Relative address of CallNextHookEx
  91. End Sub
  92.  
  93. 'Unhook if required and release the allocated memory
  94. Private Sub Class_Terminate()
  95.   Call UnHook                                               'UnHook if the hook thunk is active
  96.   Call GlobalFree(nAddrHook)                                'Release the allocated memory
  97. End Sub
  98.  
  99. '============================================
  100. 'Public interface
  101. '============================================
  102.  
  103. 'Set the hook
  104. Public Function Hook(ByVal Owner As IHook, ByVal HookType As Long, Optional ByVal bThread As Boolean = True) As Boolean
  105. Const PATCH_02  As Long = 66                                'Hook handle for UnhookWindowsHookEx
  106. Const PATCH_04  As Long = 96                                'Hook handle for CallNextHookEx
  107. Const PATCH_06  As Long = 139                               'Address of the owner object
  108.   Dim nThreadID As Long                                     'App.ThreadID
  109.   
  110.   If hHook = 0 Then
  111.     If bThread Then                                         'Validate the parameters with regard to hook type vs thread or system hooking
  112.     
  113.       Select Case HookType
  114.       Case WH_JOURNALPLAYBACK, WH_JOURNALRECORD, WH_SYSMSGFILTER
  115.         Debug.Assert False                                  'Inapropriate thread hooks
  116.       End Select
  117.       
  118.       nThreadID = App.ThreadID
  119.     End If
  120.     
  121.     Call PatchVal(PATCH_06, ObjPtr(Owner))                  'Owner object address
  122.     
  123.     'Set the hook
  124.     hHook = SetWindowsHookEx(HookType, nAddrHook, App.hInstance, nThreadID)
  125.     
  126.     If hHook <> 0 Then
  127.       Hook = True
  128.       Call PatchVal(PATCH_02, hHook)                        'Hook handle for UnhookWindowsHookEx
  129.       Call PatchVal(PATCH_04, hHook)                        'Hook handle for CallNextHookEx
  130.     End If
  131.   End If
  132.   
  133.   Debug.Assert Hook
  134. End Function
  135.  
  136. 'Return whether we're running in the IDE. Public for general utility purposes
  137. Public Function InIDE() As Boolean
  138.     #If IN_ADDIN = 0 Then
  139.         InIDE = (GetModuleHandle("vba6") <> 0)
  140.     #End If
  141. End Function
  142.  
  143. 'Call this method to unhook
  144. Public Function UnHook() As Boolean
  145.   If hHook <> 0 Then
  146.     If UnhookWindowsHookEx(hHook) <> 0 Then     'Unhook the hook
  147.       UnHook = True                                         'Success
  148.       hHook = 0                                             'Hook inactive
  149.     End If
  150.   End If
  151. End Function
  152.  
  153. '============================================
  154. 'Private interface
  155. '============================================
  156.  
  157. 'Return the address of the passed function in the passed dll
  158. Private Function AddrFunc(ByVal sDLL As String, _
  159.                           ByVal sProc As String) As Long
  160.   AddrFunc = GetProcAddress(A_GetModuleHandle(sDLL), sProc)
  161.   
  162.   'You may want to comment out the following line if you're using vb5 else the EbMode
  163.   'GetProcAddress will stop here everytime because we look in vba6.dll first
  164.   Debug.Assert AddrFunc
  165. End Function
  166.  
  167. 'Patch the machine code buffer offset with the relative address to the target address
  168. Private Sub PatchRel(ByVal nOffset As Long, ByVal nTargetAddr As Long)
  169.   Call CopyMemory(ByVal (nAddrHook + nOffset), nTargetAddr - nAddrHook - nOffset - 4, 4)
  170. End Sub
  171.  
  172. 'Patch the machine code buffer offset with the passed value
  173. Private Sub PatchVal(ByVal nOffset As Long, ByVal nValue As Long)
  174.   Call CopyMemory(ByVal (nAddrHook + nOffset), nValue, 4)
  175. End Sub
  176.  
  177.