home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Real_Jigsa2028661132006.psc / cSuperClass.cls < prev    next >
Text File  |  2006-10-26  |  11KB  |  224 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 = "cSuperClass"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. '------------------------------------------------------------------------------------------------------------------------------------------------------------------------
  15. 'Name.......... cSuperClass
  16. 'File.......... cSuperClass.cls
  17. 'Dependencies.. Requires iSuperClass as the model implementation interface.
  18. 'Description... A novel window subclassing class that echews the use of a module by dynamically
  19. '               assembling machine code.
  20. 'Author........ Paul_Caton@hotmail.com
  21. 'Date.......... June, 13th 2002
  22. 'Copyright..... None.
  23. '
  24. 'v1.00 20020613 First cut......................................................................
  25. '
  26. 'v1.01 20020621 Decided to split the single interface iSuperClass_Message into two,
  27. '               iSuperClass_After and iSuperClass_Before. This is slightly more efficient
  28. '               in that the more common *AFTER* the previous WndProc subclassing mode
  29. '               was receiving a redundant parameter (lHandled) also, it reminds the
  30. '               user in which of the two modes the message was added (AddMsg)..................
  31. '
  32. '               Optimized the assembler opcodes a bit.
  33. '               Now using EIP relative calls.
  34. '               WNDPROC_FILTERED is now 10 bytes shorter and slightly faster
  35. '               WNDPROC_ALL is now 20 bytes shorter and slightly faster........................
  36. '
  37. 'v1.02 20020627 Spotted that you could UnSubclass and still receive 1 more callback which
  38. '               could stop an unload or worse. Scenario: you AddMsg WM_NCLBUTTONDOWN and
  39. '               click on the close button, the message goes to default processing first which
  40. '               tells the form to unload wherein you call UnSubclass; at this point default
  41. '               processing ends and execution returns to our WndProc who now wants to call
  42. '               iSuperClass_After. The solution is to patch the WndProc code in UnSubclass
  43. '               so that a return is patched between def processing and the call to
  44. '               iSubClass_After................................................................
  45. '
  46. 'v1.03 20020627 Added the AllMsgs mode of operation
  47. '               I'm now reasonably confident that cSuperClass is immune to the IDE End button,
  48. '               I think this is because the WndProc remains executable after the End button....
  49. '
  50. 'v1.04 20020701 Added a couple of assembler optimizations to WndProc.asm
  51. '               Zeroed lReturn before calling iSuperClass_Before
  52. '               Fixed a few comments...........................................................
  53. '
  54. 'v1.05 20020702 Cleaned up patching in SubClass
  55. '               Cleaned up patching in Unsubclass
  56. '               Re-inserted the commented out code to crash the app............................
  57. '
  58.  
  59. Option Explicit
  60.  
  61. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  62. Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  63. Private Declare Function htonl Lib "ws2_32.dll" (ByVal hostlong As Long) As Long
  64. Private Declare Function IsWindow Lib "User32" (ByVal hWnd As Long) As Long
  65. Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  66.  
  67. Private Const GWL_WNDPROC       As Long = (-4)      'Get/Set the WndProc address with GetWindowLong/SetWindowLong
  68. Private Const BUF_TOP           As Long = 511       'Max offset in opcode buffer. Requires 136 + (# Messages * 11)
  69. Private Const OFFSET_BEFORE     As Long = 3         'Offset into the opcode bytes for the BEFORE default processing code
  70. Private Const OFFSET_AFTER      As Long = 65        'Offset into the opcode bytes for the AFTER default processing code
  71. Private Const CODE_RETURN       As Long = &H10C2C9  'Leave-return opcode sequence
  72. Private Const OPCODE_CMP_EAX    As String = "3D"    'Opcode for cmp eax,????????
  73. Private Const OPCODE_JE         As String = "0F84"  'Opcode for je with a 4 byte relative offset.
  74. Private Const WNDPROC_ALL       As String = "558BEC83C4FCFF7514FF7510FF750CFF7508E8wnd_proc8945FCFF7514FF7510FF750CFF75088D45FC50B8ptrOwner8BC88B0950FF511C8B45FCC9C21000"
  75. Private Const WNDPROC_FILTERED  As String = "558BEC83C4F8EB6AC745FC000000008D45FC50C745F8000000008D45F850B8ptrOwner8BC88B0950FF5120837DF800753AFF7514FF7510FF750CFF7508E8wnd_procC9C21000E8wnd_proc8945FCFF7514FF7510FF750CFF75088D45FC50B8ptrOwner8BC88B0950FF511C8B45FCC9C210008B450CFF7514FF751050FF7508"
  76. Private Const MSG_UNHANDLED     As String = "E8wnd_procC9C21000"
  77.  
  78. Private Type tCode
  79.   Buf(0 To BUF_TOP) As Byte       'Opcode buffer
  80. End Type
  81.  
  82. Private Type tCodeBuf
  83.   Code              As tCode      'WndProc opcodes
  84.   nBuf              As Long       'Opcode buffer index
  85. End Type
  86.  
  87. Private All         As Boolean    'All messages?
  88. Private Running     As Boolean    'Is the subclasser running?
  89. Private hWnd        As Long       'Window being subclassed
  90. Private WndProcPrev As Long       'The address of the existing WndProc
  91. Private pCode       As Long       'Pointer to the WndProc opcode buffer
  92. Private CodeBuf     As tCodeBuf   'Opcode buffer
  93.  
  94. 'Add a message to those that will call back either before or after the existing WndProc.
  95. Public Sub AddMsg(MsgNum As Long, Optional Before As Boolean = False)
  96.   Debug.Assert (Running = False)                        'You don't add messages whilst the subclasser is running
  97.   
  98.   With CodeBuf
  99.     If .nBuf = 0 Then                                   'If the buffer is empty (first msg to be added)
  100.     
  101.       Call AddCode(WNDPROC_FILTERED)                    'Add the filtered mode WndProc opcodes
  102.     End If
  103.     
  104.     Call AddCode(OPCODE_CMP_EAX & Hex8(htonl(MsgNum)))  'Add the opcodes to compare the MsgNum
  105.     
  106.     'Add the opcodes to jump if matched
  107.     Call AddCode(OPCODE_JE & Hex8(htonl(Not (.nBuf - IIf(Before, OFFSET_BEFORE, OFFSET_AFTER)))))
  108.   End With
  109. End Sub
  110.  
  111. 'Subclass the passed window handle.
  112. Public Sub Subclass(hWndSub As Long, Owner As iSuperClass, Optional AllMsgs As Boolean = False)
  113.   Dim pOwner  As Long                                   'Object address of the owner
  114.   Dim nPos    As Long                                   'Buf pos temporary
  115.   
  116.   All = AllMsgs
  117.   
  118.   With CodeBuf
  119.     Debug.Assert (Running = False)                      'Subclasser already running
  120.     Debug.Assert (IsWindow(hWndSub))                    'Invalid hWnd
  121.     Debug.Assert (Not All And .nBuf > 0) Or _
  122.                  (All And .nBuf = 0)                    'Either filtered mode but no messages added OR All message mode but messages added.
  123.     hWnd = hWndSub                                      'Save the window handle
  124.     WndProcPrev = GetWindowLong(hWnd, GWL_WNDPROC)      'Save the address of the current WndProc
  125.     pOwner = ObjPtr(Owner)                              'Get the address of the owner
  126.     pCode = VarPtr(.Code.Buf(0))                        'Get the address of our WndProc code
  127.     
  128.     If AllMsgs Then
  129.     
  130.       Call AddCode(WNDPROC_ALL)                         'Add the All messages WndProc opcodes
  131.       Call PatchOffset(19)                              'Patch the WndProcPrev call
  132.       Call PatchValue(43, pOwner)                       'Patch the owner
  133.     Else
  134.     
  135.       Call PatchValue(31, pOwner)                       'Patch the owner
  136.       Call PatchOffset(62)                              'Patch the BEFORE WndProcPrev call
  137.       Call PatchOffset(71)                              'Patch the AFTER WndProcPrev call
  138.       Call PatchValue(95, pOwner)                       'Patch the owner
  139.       
  140.       nPos = .nBuf + 1                                  'Save the buf pos
  141.       Call AddCode(MSG_UNHANDLED)                       'Add the trailing unhandled WndProcPrev call
  142.       Call PatchOffset(nPos)                            'Patch the WndProcPrev call
  143.     End If
  144.   End With
  145.   
  146.   'Debug support: uncomment the line below to crash the application which will (assuming VS is setup correctly)
  147.   'allow you into the VS debugger where you can examine the generated opcodes and trace execution.
  148.   'Don't call the Crash routine inside the IDE :)
  149.   '
  150.   'Call Crash
  151.   
  152.   Call SetWindowLong(hWnd, GWL_WNDPROC, pCode)          'Set our WndProc in place of the original
  153.   Running = True
  154. End Sub
  155.  
  156. 'Unsubclass the window
  157. Public Sub UnSubclass()
  158.   If Running Then
  159.     If All Then
  160.       
  161.       Call PatchValue(23, CODE_RETURN)                  'Patch a Leave-Return after default processing and before iSuperClass_After
  162.     Else
  163.     
  164.       CodeBuf.Code.Buf(7) = &H29                        'Patch the WndProc entrance to jump to default processing JIC
  165.       Call PatchValue(75, CODE_RETURN)                  'Patch a Leave-Return after default processing and before iSuperClass_After
  166.     End If
  167.     
  168.     Call SetWindowLong(hWnd, GWL_WNDPROC, WndProcPrev)  'Restore the previous WndProc
  169.     CodeBuf.nBuf = 0                                    'Reset the opcode buffer
  170.     Running = False                                     'Not running
  171.   End If
  172. End Sub
  173.  
  174. Private Sub Class_Terminate()
  175.   If Running Then UnSubclass                            'Unsubclass if the Subclasser is running
  176. End Sub
  177.  
  178. 'Translate the passed hex string character pairs to bytes and stuff into the opcode buffer.
  179. Private Sub AddCode(sOps As String)
  180.   Dim i As Long
  181.   Dim j As Long
  182.   
  183.   With CodeBuf
  184.     j = Len(sOps)                                       'Get length of opcode string
  185.     Debug.Assert (.nBuf + (j \ 2) <= BUF_TOP)           'Opcode buffer overflow, increase value of BUF_TOP
  186.     
  187.     For i = 1 To j Step 2                               'For each pair of hex chars
  188.       
  189.       .Code.Buf(.nBuf) = Val("&H" & Mid$(sOps, i, 2))   'Convert from hex to byte, add to buffer at index
  190.       .nBuf = .nBuf + 1                                 'Bump the opcode buffer index
  191.     Next i
  192.   End With
  193. End Sub
  194.  
  195. 'Return an 8 character hex representation of the passed 32 bit value
  196. Private Function Hex8(lValue As Long) As String
  197.   Dim s As String
  198.   
  199.   s = Hex$(lValue)
  200.   Hex8 = String$(8 - Len(s), "0") & s
  201. End Function
  202.  
  203. 'Patch the passed code buffer offset with the passed value
  204. Private Sub PatchValue(nOffset As Long, nValue As Long)
  205.   Call CopyMemory(ByVal (pCode + nOffset), nValue, 4)
  206. End Sub
  207.  
  208. 'Patch the passed code buffer offset with the relative offset to the previous WndProc
  209. Private Sub PatchOffset(nOffset As Long)
  210.   Call CopyMemory(ByVal (pCode + nOffset), WndProcPrev - pCode - nOffset - 4, 4)
  211. End Sub
  212.  
  213. 'Debug Support:
  214. '
  215. 'Crash the app allowing us into the debugger to examine opcodes
  216. 'Private Sub Crash()
  217. '  Dim bCrash As Boolean
  218. '
  219. '  bCrash = True
  220. '  If bCrash Then Call CopyMemory(ByVal 0, &HFFFFFFFF, 1)
  221. 'End Sub
  222.  
  223.  
  224.