-
Notifications
You must be signed in to change notification settings - Fork 2
/
cSubClass.cls
899 lines (797 loc) · 48 KB
/
cSubClass.cls
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "c_SubClass"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'-----------------------------------
'Autor: Paul Caton
'-----------------------------------
Option Explicit
''WM_CONTEXTMENU, WM_LBUTTONUP, WM_NCACTIVATE, WM_ACTIVATE, WM_COMMAND788792
Public Enum eMsgWhen 'When to callback
MSG_BEFORE = 1 'Callback before the original WndProc
MSG_AFTER = 2 'Callback after the original WndProc
MSG_BEFORE_AFTER = MSG_BEFORE Or MSG_AFTER 'Callback before and after the original WndProc
End Enum
Public Enum ssc_eMsg
ALL_MESSAGES = -1&
WM_NULL = &H0&
WM_CREATE = &H1&
WM_DESTROY = &H2&
WM_MOVE = &H3&
WM_SIZE = &H5&
WM_ACTIVATE = &H6&
WM_SETFOCUS = &H7&
WM_KILLFOCUS = &H8&
WM_ENABLE = &HA&
WM_SETREDRAW = &HB&
WM_SETTEXT = &HC&
WM_GETTEXT = &HD&
WM_GETTEXTLENGTH = &HE&
WM_PAINT = &HF&
WM_CLOSE = &H10&
WM_QUERYENDSESSION = &H11&
WM_QUIT = &H12&
WM_QUERYOPEN = &H13&
WM_ERASEBKGND = &H14&
WM_SYSCOLORCHANGE = &H15&
WM_ENDSESSION = &H16&
WM_SHOWWINDOW = &H18&
WM_WININICHANGE = &H1A&
WM_SETTINGCHANGE = &H1A&
WM_DEVMODECHANGE = &H1B&
WM_ACTIVATEAPP = &H1C&
WM_FONTCHANGE = &H1D&
WM_TIMECHANGE = &H1E&
WM_CANCELMODE = &H1F&
WM_SETCURSOR = &H20&
WM_MOUSEACTIVATE = &H21&
WM_CHILDACTIVATE = &H22&
WM_QUEUESYNC = &H23&
WM_GETMINMAXINFO = &H24&
WM_PAINTICON = &H26&
WM_ICONERASEBKGND = &H27&
WM_NEXTDLGCTL = &H28&
WM_SPOOLERSTATUS = &H2A&
WM_DRAWITEM = &H2B&
WM_MEASUREITEM = &H2C&
WM_DELETEITEM = &H2D&
WM_VKEYTOITEM = &H2E&
WM_CHARTOITEM = &H2F&
WM_SETFONT = &H30&
WM_GETFONT = &H31&
WM_SETHOTKEY = &H32&
WM_GETHOTKEY = &H33&
WM_QUERYDRAGICON = &H37&
WM_COMPAREITEM = &H39&
WM_GETOBJECT = &H3D&
WM_COMPACTING = &H41&
WM_WINDOWPOSCHANGING = &H46&
WM_WINDOWPOSCHANGED = &H47&
WM_POWER = &H48&
WM_COPYDATA = &H4A&
WM_CANCELJOURNAL = &H4B&
WM_NOTIFY = &H4E&
WM_INPUTLANGCHANGEREQUEST = &H50&
WM_INPUTLANGCHANGE = &H51&
WM_TCARD = &H52&
WM_HELP = &H53&
WM_USERCHANGED = &H54&
WM_NOTIFYFORMAT = &H55&
WM_CONTEXTMENU = &H7B&
WM_STYLECHANGING = &H7C&
WM_STYLECHANGED = &H7D&
WM_DISPLAYCHANGE = &H7E&
WM_GETICON = &H7F&
WM_SETICON = &H80&
WM_NCCREATE = &H81&
WM_NCDESTROY = &H82&
WM_NCCALCSIZE = &H83&
WM_NCHITTEST = &H84&
WM_NCPAINT = &H85&
WM_NCACTIVATE = &H86&
WM_GETDLGCODE = &H87&
WM_SYNCPAINT = &H88&
WM_NCMOUSEMOVE = &HA0&
WM_NCLBUTTONDOWN = &HA1&
WM_NCLBUTTONUP = &HA2&
WM_NCLBUTTONDBLCLK = &HA3&
WM_NCRBUTTONDOWN = &HA4&
WM_NCRBUTTONUP = &HA5&
WM_NCRBUTTONDBLCLK = &HA6&
WM_NCMBUTTONDOWN = &HA7&
WM_NCMBUTTONUP = &HA8&
WM_NCMBUTTONDBLCLK = &HA9&
WM_KEYFIRST = &H100&
WM_KEYDOWN = &H100&
WM_KEYUP = &H101&
WM_CHAR = &H102&
WM_DEADCHAR = &H103&
WM_SYSKEYDOWN = &H104&
WM_SYSKEYUP = &H105&
WM_SYSCHAR = &H106&
WM_SYSDEADCHAR = &H107&
WM_KEYLAST = &H108&
WM_IME_STARTCOMPOSITION = &H10D&
WM_IME_ENDCOMPOSITION = &H10E&
WM_IME_COMPOSITION = &H10F&
WM_IME_KEYLAST = &H10F&
WM_INITDIALOG = &H110&
WM_COMMAND = &H111&
WM_SYSCOMMAND = &H112&
WM_TIMER = &H113&
WM_HSCROLL = &H114&
WM_VSCROLL = &H115&
WM_INITMENU = &H116&
WM_INITMENUPOPUP = &H117&
WM_MENUSELECT = &H11F&
WM_MENUCHAR = &H120&
WM_ENTERIDLE = &H121&
WM_MENURBUTTONUP = &H122&
WM_MENUDRAG = &H123&
WM_MENUGETOBJECT = &H124&
WM_UNINITMENUPOPUP = &H125&
WM_MENUCOMMAND = &H126&
WM_CTLCOLORMSGBOX = &H132&
WM_CTLCOLOREDIT = &H133&
WM_CTLCOLORLISTBOX = &H134&
WM_CTLCOLORBTN = &H135&
WM_CTLCOLORDLG = &H136&
WM_CTLCOLORSCROLLBAR = &H137&
WM_CTLCOLORSTATIC = &H138&
WM_MOUSEFIRST = &H200&
WM_MOUSEMOVE = &H200&
WM_LBUTTONDOWN = &H201&
WM_LBUTTONUP = &H202&
WM_LBUTTONDBLCLK = &H203&
WM_RBUTTONDOWN = &H204&
WM_RBUTTONUP = &H205&
WM_RBUTTONDBLCLK = &H206&
WM_MBUTTONDOWN = &H207&
WM_MBUTTONUP = &H208&
WM_MBUTTONDBLCLK = &H209&
WM_MOUSEWHEEL = &H20A&
WM_PARENTNOTIFY = &H210&
WM_ENTERMENULOOP = &H211&
WM_EXITMENULOOP = &H212&
WM_NEXTMENU = &H213&
WM_SIZING = &H214&
WM_CAPTURECHANGED = &H215&
WM_MOVING = &H216&
WM_DEVICECHANGE = &H219&
WM_MDICREATE = &H220&
WM_MDIDESTROY = &H221&
WM_MDIACTIVATE = &H222&
WM_MDIRESTORE = &H223&
WM_MDINEXT = &H224&
WM_MDIMAXIMIZE = &H225&
WM_MDITILE = &H226&
WM_MDICASCADE = &H227&
WM_MDIICONARRANGE = &H228&
WM_MDIGETACTIVE = &H229&
WM_MDISETMENU = &H230&
WM_ENTERSIZEMOVE = &H231&
WM_EXITSIZEMOVE = &H232&
WM_DROPFILES = &H233&
WM_MDIREFRESHMENU = &H234&
WM_IME_SETCONTEXT = &H281&
WM_IME_NOTIFY = &H282&
WM_IME_CONTROL = &H283&
WM_IME_COMPOSITIONFULL = &H284&
WM_IME_SELECT = &H285&
WM_IME_CHAR = &H286&
WM_IME_REQUEST = &H288&
WM_IME_KEYDOWN = &H290&
WM_IME_KEYUP = &H291&
WM_MOUSEHOVER = &H2A1&
WM_MOUSELEAVE = &H2A3&
WM_CUT = &H300&
WM_COPY = &H301&
WM_PASTE = &H302&
WM_CLEAR = &H303&
WM_UNDO = &H304&
WM_RENDERFORMAT = &H305&
WM_RENDERALLFORMATS = &H306&
WM_DESTROYCLIPBOARD = &H307&
WM_DRAWCLIPBOARD = &H308&
WM_PAINTCLIPBOARD = &H309&
WM_VSCROLLCLIPBOARD = &H30A&
WM_SIZECLIPBOARD = &H30B&
WM_ASKCBFORMATNAME = &H30C&
WM_CHANGECBCHAIN = &H30D&
WM_HSCROLLCLIPBOARD = &H30E&
WM_QUERYNEWPALETTE = &H30F&
WM_PALETTEISCHANGING = &H310&
WM_PALETTECHANGED = &H311&
WM_HOTKEY = &H312&
WM_PRINT = &H317&
WM_PRINTCLIENT = &H318&
WM_THEMECHANGED = &H31A&
WM_HANDHELDFIRST = &H358&
WM_HANDHELDLAST = &H35F&
WM_AFXFIRST = &H360&
WM_AFXLAST = &H37F&
WM_PENWINFIRST = &H380&
WM_PENWINLAST = &H38F&
WM_USER = &H400&
WM_APP = &H8000&
WM_UPDATEUISTATE = &H128&
WM_CHANGEUISTATE = &H127&
End Enum
Private Enum eThunkType
SubclassThunk = 0
HookThunk = 1
CallbackThunk = 2
End Enum
Private z_IDEflag As Long 'Flag indicating we are in IDE
Private z_ScMem As Long 'Thunk base address
Private z_scFunk As Collection 'hWnd/thunk-address collection
Private z_hkFunk As Collection 'hook/thunk-address collection
Private z_cbFunk As Collection 'callback/thunk-address collection
Private Const IDX_INDEX As Long = 2 'index of the subclassed hWnd OR hook type
Private Const IDX_CALLBACKORDINAL As Long = 22 ' Ubound(callback thunkdata)+1, index of the callback
Private Const IDX_WNDPROC As Long = 9 'Thunk data index of the original WndProc
Private Const IDX_BTABLE As Long = 11 'Thunk data index of the Before table
Private Const IDX_ATABLE As Long = 12 'Thunk data index of the After table
Private Const IDX_PARM_USER As Long = 13 'Thunk data index of the User-defined callback parameter data index
Private Const IDX_UNICODE As Long = 75 'Must be Ubound(subclass thunkdata)+1; index for unicode support
'Private Const ALL_MESSAGES As Long = -1 'All messages callback
Private Const MSG_ENTRIES As Long = 32 'Number of msg table entries. Set to 1 if using ALL_MESSAGES for all subclassed windows
Private Declare Sub RtlMoveMemory Lib "kernel32" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Private Declare Function IsBadCodePtr Lib "kernel32" (ByVal lpfn As Long) As Long
Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long
Private Declare Function GetModuleHandleW Lib "kernel32" (ByVal lpModuleName As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function CallWindowProcA Lib "user32" (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 CallWindowProcW Lib "user32" (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 GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function IsWindowUnicode Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function SendMessageA Lib "user32.dll" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function SendMessageW Lib "user32.dll" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowLongW Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Event WindowProc(bHandled As Boolean, lReturn As Long, hwnd As Long, uMsg As ssc_eMsg, wParam As Long, lParam As Long)
Private Sub Class_Terminate()
Terminate
scb_TerminateCallbacks
End Sub
'-The following routines are exclusively for the Subclass routines----------------------------
Public Function Subclass(ByVal lng_hWnd As Long, _
Optional ByVal lParamUser As Long = 0, _
Optional ByVal nOrdinal As Long = 1, _
Optional ByVal oCallback As Object = Nothing, _
Optional ByVal bIdeSafety As Boolean = True, _
Optional ByVal bUnicode As Boolean = False) As Boolean 'Subclass the specified window handle
'*************************************************************************************************
'* lng_hWnd - Handle of the window to subclass
'* lParamUser - Optional, user-defined callback parameter
'* nOrdinal - Optional, ordinal index of the callback procedure. 1 = last private method, 2 = second last private method, etc.
'* oCallback - Optional, the object that will receive the callback. If undefined, callbacks are sent to this object's instance
'* bIdeSafety - Optional, enable/disable IDE safety measures. NB: you should really only disable IDE safety in a UserControl for design-time subclassing
'* bUnicode - Optional, if True, Unicode API calls will be made to the window vs ANSI calls
'*************************************************************************************************
'* cSelfSub - self-subclassing class template
'* Paul_Caton@hotmail.com
'* Copyright free, use and abuse as you see fit.
'*
'* v1.0 Re-write of the SelfSub/WinSubHook-2 submission to Planet Source Code............ 20060322
'* v1.1 VirtualAlloc memory to prevent Data Execution Prevention faults on Win64......... 20060324
'* v1.2 Thunk redesigned to handle unsubclassing and memory release...................... 20060325
'* v1.3 Data array scrapped in favour of property accessors.............................. 20060405
'* v1.4 Optional IDE protection added
'* User-defined callback parameter added
'* All user routines that pass in a hWnd get additional validation
'* End removed from zError.......................................................... 20060411
'* v1.5 Added nOrdinal parameter to Subclass
'* Switched machine-code array from Currency to Long................................ 20060412
'* v1.6 Added an optional callback target object
'* Added an IsBadCodePtr on the callback address in the thunk prior to callback..... 20060413
'*************************************************************************************************
' Subclassing procedure must be declared identical to the one at the end of this class (Sample at Ordinal #1)
' \\LaVolpe - reworked routine a bit, revised the ASM to allow auto-unsubclass on WM_DESTROY
Dim z_Sc(0 To IDX_UNICODE) As Long 'Thunk machine-code initialised here
Const CODE_LEN As Long = 4 * IDX_UNICODE 'Thunk length in bytes
Const MEM_LEN As Long = CODE_LEN + (8 * (MSG_ENTRIES)) 'Bytes to allocate per thunk, data + code + msg tables
Const PAGE_RWX As Long = &H40& 'Allocate executable memory
Const MEM_COMMIT As Long = &H1000& 'Commit allocated memory
Const MEM_RELEASE As Long = &H8000& 'Release allocated memory flag
Const IDX_EBMODE As Long = 3 'Thunk data index of the EbMode function address
Const IDX_CWP As Long = 4 'Thunk data index of the CallWindowProc function address
Const IDX_SWL As Long = 5 'Thunk data index of the SetWindowsLong function address
Const IDX_FREE As Long = 6 'Thunk data index of the VirtualFree function address
Const IDX_BADPTR As Long = 7 'Thunk data index of the IsBadCodePtr function address
Const IDX_OWNER As Long = 8 'Thunk data index of the Owner object's vTable address
Const IDX_CALLBACK As Long = 10 'Thunk data index of the callback method address
Const IDX_EBX As Long = 16 'Thunk code patch index of the thunk data
Const GWL_WNDPROC As Long = -4 'SetWindowsLong WndProc index
Const WNDPROC_OFF As Long = &H38 'Thunk offset to the WndProc execution address
Const SUB_NAME As String = "Subclass" 'This routine's name
Dim nAddr As Long
Dim nID As Long
Dim nMyID As Long
If IsWindow(lng_hWnd) = 0 Then 'Ensure the window handle is valid
zError SUB_NAME, "Invalid window handle"
Exit Function
End If
nMyID = GetCurrentProcessId 'Get this process's ID
GetWindowThreadProcessId lng_hWnd, nID 'Get the process ID associated with the window handle
If nID <> nMyID Then 'Ensure that the window handle doesn't belong to another process
zError SUB_NAME, "Window handle belongs to another process"
Exit Function
End If
If oCallback Is Nothing Then Set oCallback = Me 'If the user hasn't specified the callback owner
nAddr = zAddressOf(oCallback, nOrdinal) 'Get the address of the specified ordinal method
If nAddr = 0 Then 'Ensure that we've found the ordinal method
zError SUB_NAME, "Callback method not found"
Exit Function
End If
z_ScMem = VirtualAlloc(0, MEM_LEN, MEM_COMMIT, PAGE_RWX) 'Allocate executable memory
If z_ScMem <> 0 Then 'Ensure the allocation succeeded
If z_scFunk Is Nothing Then Set z_scFunk = New Collection 'If this is the first time through, do the one-time initialization
On Error GoTo CatchDoubleSub 'Catch double subclassing
z_scFunk.Add z_ScMem, "h" & lng_hWnd 'Add the hWnd/thunk-address to the collection
On Error GoTo 0
' \\Tai Chi Minh Ralph Eastwood - fixed bug where the MSG_AFTER was not being honored
' \\LaVolpe - modified thunks to allow auto-unsubclassing when WM_DESTROY received
z_Sc(14) = &HD231C031: z_Sc(15) = &HBBE58960: z_Sc(16) = &H12345678: z_Sc(17) = &HF63103FF: z_Sc(18) = &H750C4339: z_Sc(19) = &H7B8B4A38: z_Sc(20) = &H95E82C: z_Sc(21) = &H7D810000: z_Sc(22) = &H228&: z_Sc(23) = &HC70C7500: z_Sc(24) = &H20443: z_Sc(25) = &H5E90000: z_Sc(26) = &H39000000: z_Sc(27) = &HF751475: z_Sc(28) = &H25E8&: z_Sc(29) = &H8BD23100: z_Sc(30) = &H6CE8307B: z_Sc(31) = &HFF000000: z_Sc(32) = &H10C2610B: z_Sc(33) = &HC53FF00: z_Sc(34) = &H13D&: z_Sc(35) = &H85BE7400: z_Sc(36) = &HE82A74C0: z_Sc(37) = &H2&: z_Sc(38) = &H75FFE5EB: z_Sc(39) = &H2C75FF30: z_Sc(40) = &HFF2875FF: z_Sc(41) = &H73FF2475: z_Sc(42) = &H1053FF24: z_Sc(43) = &H811C4589: z_Sc(44) = &H13B&: z_Sc(45) = &H39727500:
z_Sc(46) = &H6D740473: z_Sc(47) = &H2473FF58: z_Sc(48) = &HFFFFFC68: z_Sc(49) = &H873FFFF: z_Sc(50) = &H891453FF: z_Sc(51) = &H7589285D: z_Sc(52) = &H3045C72C: z_Sc(53) = &H8000&: z_Sc(54) = &H8920458B: z_Sc(55) = &H4589145D: z_Sc(56) = &HC4816124: z_Sc(57) = &H4&: z_Sc(58) = &H8B1862FF: z_Sc(59) = &H853AE30F: z_Sc(60) = &H810D78C9: z_Sc(61) = &H4C7&: z_Sc(62) = &H28458B00: z_Sc(63) = &H2975AFF2: z_Sc(64) = &H2873FF52: z_Sc(65) = &H5A1C53FF: z_Sc(66) = &H438D1F75: z_Sc(67) = &H144D8D34: z_Sc(68) = &H1C458D50: z_Sc(69) = &HFF3075FF: z_Sc(70) = &H75FF2C75: z_Sc(71) = &H873FF28: z_Sc(72) = &HFF525150: z_Sc(73) = &H53FF2073: z_Sc(74) = &HC328C328
z_Sc(IDX_EBX) = z_ScMem 'Patch the thunk data address
z_Sc(IDX_INDEX) = lng_hWnd 'Store the window handle in the thunk data
z_Sc(IDX_BTABLE) = z_ScMem + CODE_LEN 'Store the address of the before table in the thunk data
z_Sc(IDX_ATABLE) = z_ScMem + CODE_LEN + ((MSG_ENTRIES + 1) * 4) 'Store the address of the after table in the thunk data
z_Sc(IDX_OWNER) = ObjPtr(oCallback) 'Store the callback owner's object address in the thunk data
z_Sc(IDX_CALLBACK) = nAddr 'Store the callback address in the thunk data
z_Sc(IDX_PARM_USER) = lParamUser 'Store the lParamUser callback parameter in the thunk data
' \\LaVolpe - validate unicode request & cache unicode usage
If bUnicode Then bUnicode = (IsWindowUnicode(lng_hWnd) <> 0&)
z_Sc(IDX_UNICODE) = bUnicode 'Store whether the window is using unicode calls or not
' \\LaVolpe - added extra parameter "bUnicode" to the zFnAddr calls
z_Sc(IDX_FREE) = zFnAddr("kernel32", "VirtualFree", bUnicode) 'Store the VirtualFree function address in the thunk data
z_Sc(IDX_BADPTR) = zFnAddr("kernel32", "IsBadCodePtr", bUnicode) 'Store the IsBadCodePtr function address in the thunk data
Debug.Assert zInIDE
If bIdeSafety = True And z_IDEflag = 1 Then 'If the user wants IDE protection
z_Sc(IDX_EBMODE) = zFnAddr("vba6", "EbMode", bUnicode) 'Store the EbMode function address in the thunk data
End If
' \\LaVolpe - use ANSI for non-unicode usage, else use WideChar calls
If bUnicode Then
z_Sc(IDX_CWP) = zFnAddr("user32", "CallWindowProcW", bUnicode) 'Store CallWindowProc function address in the thunk data
z_Sc(IDX_SWL) = zFnAddr("user32", "SetWindowLongW", bUnicode) 'Store the SetWindowLong function address in the thunk data
z_Sc(IDX_UNICODE) = 1
RtlMoveMemory z_ScMem, VarPtr(z_Sc(0)), CODE_LEN 'Copy the thunk code/data to the allocated memory
nAddr = SetWindowLongW(lng_hWnd, GWL_WNDPROC, z_ScMem + WNDPROC_OFF) 'Set the new WndProc, return the address of the original WndProc
Else
z_Sc(IDX_CWP) = zFnAddr("user32", "CallWindowProcA", bUnicode) 'Store CallWindowProc function address in the thunk data
z_Sc(IDX_SWL) = zFnAddr("user32", "SetWindowLongA", bUnicode) 'Store the SetWindowLong function address in the thunk data
RtlMoveMemory z_ScMem, VarPtr(z_Sc(0)), CODE_LEN 'Copy the thunk code/data to the allocated memory
nAddr = SetWindowLongA(lng_hWnd, GWL_WNDPROC, z_ScMem + WNDPROC_OFF) 'Set the new WndProc, return the address of the original WndProc
End If
If nAddr = 0 Then 'Ensure the new WndProc was set correctly
zError SUB_NAME, "SetWindowLong failed, error #" & Err.LastDllError
GoTo ReleaseMemory
End If
'Store the original WndProc address in the thunk data
RtlMoveMemory z_ScMem + IDX_WNDPROC * 4, VarPtr(nAddr), 4& ' z_Sc(IDX_WNDPROC) = nAddr
Subclass = True 'Indicate success
Else
zError SUB_NAME, "VirtualAlloc failed, error: " & Err.LastDllError
End If
Exit Function 'Exit Subclass
CatchDoubleSub:
zError SUB_NAME, "Window handle is already subclassed"
ReleaseMemory:
VirtualFree z_ScMem, 0, MEM_RELEASE 'Subclass has failed after memory allocation, so release the memory
End Function
'Terminate all subclassing
Public Sub Terminate()
' can be made public. Releases all subclassing
' can be removed and zTerminateThunks can be called directly
zTerminateThunks SubclassThunk
End Sub
'UnSubclass the specified window handle
Public Sub UnSubclass(ByVal lng_hWnd As Long)
' can be made public. Releases a specific subclass
' can be removed and zUnThunk can be called directly
zUnThunk lng_hWnd, SubclassThunk
End Sub
'Add the message value to the window handle's specified callback table
Public Sub AddMsg(ByVal lng_hWnd As Long, ByVal uMsg As ssc_eMsg, Optional ByVal When As eMsgWhen = MSG_AFTER)
' Note: can be removed if not needed and zAddMsg can be called directly
If IsBadCodePtr(zMap_VFunction(lng_hWnd, SubclassThunk)) = 0 Then 'Ensure that the thunk hasn't already released its memory
If When And MSG_BEFORE Then 'If the message is to be added to the before original WndProc table...
zAddMsg uMsg, IDX_BTABLE 'Add the message to the before table
End If
If When And MSG_AFTER Then 'If message is to be added to the after original WndProc table...
zAddMsg uMsg, IDX_ATABLE 'Add the message to the after table
End If
End If
End Sub
'Delete the message value from the window handle's specified callback table
Public Sub DelMsg(ByVal lng_hWnd As Long, ByVal uMsg As ssc_eMsg, Optional ByVal When As eMsgWhen = MSG_AFTER)
' Note: can be removed if not needed and zDelMsg can be called directly
If IsBadCodePtr(zMap_VFunction(lng_hWnd, SubclassThunk)) = 0 Then 'Ensure that the thunk hasn't already released its memory
If When And MSG_BEFORE Then 'If the message is to be deleted from the before original WndProc table...
zDelMsg uMsg, IDX_BTABLE 'Delete the message from the before table
End If
If When And MSG_AFTER Then 'If the message is to be deleted from the after original WndProc table...
zDelMsg uMsg, IDX_ATABLE 'Delete the message from the after table
End If
End If
End Sub
'Call the original WndProc
Private Function ssc_CallOrigWndProc(ByVal lng_hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
' Note: can be removed if you do not use this function inside of your window procedure
If IsBadCodePtr(zMap_VFunction(lng_hWnd, SubclassThunk)) = 0 Then 'Ensure that the thunk hasn't already released its memory
If zData(IDX_UNICODE) Then
ssc_CallOrigWndProc = CallWindowProcW(zData(IDX_WNDPROC), lng_hWnd, uMsg, wParam, lParam) 'Call the original WndProc of the passed window handle parameter
Else
ssc_CallOrigWndProc = CallWindowProcA(zData(IDX_WNDPROC), lng_hWnd, uMsg, wParam, lParam) 'Call the original WndProc of the passed window handle parameter
End If
End If
End Function
'Get the subclasser lParamUser callback parameter
Private Function zGet_lParamUser(ByVal hWnd_Hook_ID As Long, vType As eThunkType) As Long
'Note: can be removed if you never need to retrieve/update your user-defined paramter. See Subclass
If vType <> CallbackThunk Then
If IsBadCodePtr(zMap_VFunction(hWnd_Hook_ID, vType)) = 0 Then 'Ensure that the thunk hasn't already released its memory
zGet_lParamUser = zData(IDX_PARM_USER) 'Get the lParamUser callback parameter
End If
End If
End Function
'Let the subclasser lParamUser callback parameter
Private Sub zSet_lParamUser(ByVal hWnd_Hook_ID As Long, vType As eThunkType, newValue As Long)
'Note: can be removed if you never need to retrieve/update your user-defined paramter. See Subclass
If vType <> CallbackThunk Then
If IsBadCodePtr(zMap_VFunction(hWnd_Hook_ID, vType)) = 0 Then 'Ensure that the thunk hasn't already released its memory
zData(IDX_PARM_USER) = newValue 'Set the lParamUser callback parameter
End If
End If
End Sub
'Add the message to the specified table of the window handle
Private Sub zAddMsg(ByVal uMsg As Long, ByVal nTable As Long)
Dim nCount As Long 'Table entry count
Dim nBase As Long 'Remember z_ScMem
Dim i As Long 'Loop index
nBase = z_ScMem 'Remember z_ScMem so that we can restore its value on exit
z_ScMem = zData(nTable) 'Map zData() to the specified table
If uMsg = ALL_MESSAGES Then 'If ALL_MESSAGES are being added to the table...
nCount = ALL_MESSAGES 'Set the table entry count to ALL_MESSAGES
Else
nCount = zData(0) 'Get the current table entry count
If nCount >= MSG_ENTRIES Then 'Check for message table overflow
zError "zAddMsg", "Message table overflow. Either increase the value of Const MSG_ENTRIES or use ALL_MESSAGES instead of specific message values"
GoTo Bail
End If
For i = 1 To nCount 'Loop through the table entries
If zData(i) = 0 Then 'If the element is free...
zData(i) = uMsg 'Use this element
GoTo Bail 'Bail
ElseIf zData(i) = uMsg Then 'If the message is already in the table...
GoTo Bail 'Bail
End If
Next i 'Next message table entry
nCount = i 'On drop through: i = nCount + 1, the new table entry count
zData(nCount) = uMsg 'Store the message in the appended table entry
End If
zData(0) = nCount 'Store the new table entry count
Bail:
z_ScMem = nBase 'Restore the value of z_ScMem
End Sub
'Delete the message from the specified table of the window handle
Private Sub zDelMsg(ByVal uMsg As Long, ByVal nTable As Long)
Dim nCount As Long 'Table entry count
Dim nBase As Long 'Remember z_ScMem
Dim i As Long 'Loop index
nBase = z_ScMem 'Remember z_ScMem so that we can restore its value on exit
z_ScMem = zData(nTable) 'Map zData() to the specified table
If uMsg = ALL_MESSAGES Then 'If ALL_MESSAGES are being deleted from the table...
zData(0) = 0 'Zero the table entry count
Else
nCount = zData(0) 'Get the table entry count
For i = 1 To nCount 'Loop through the table entries
If zData(i) = uMsg Then 'If the message is found...
zData(i) = 0 'Null the msg value -- also frees the element for re-use
GoTo Bail 'Bail
End If
Next i 'Next message table entry
zError "zDelMsg", "Message &H" & Hex$(uMsg) & " not found in table"
End If
Bail:
z_ScMem = nBase 'Restore the value of z_ScMem
End Sub
'-SelfCallback code------------------------------------------------------------------------------------
'-The following routines are exclusively for the scb_SetCallbackAddr routines----------------------------
Private Function scb_SetCallbackAddr(ByVal nParamCount As Long, _
Optional ByVal nOrdinal As Long = 1, _
Optional ByVal oCallback As Object = Nothing, _
Optional ByVal bIdeSafety As Boolean = True) As Long 'Return the address of the specified callback thunk
'*************************************************************************************************
'* nParamCount - The number of parameters that will callback
'* nOrdinal - Callback ordinal number, the final private method is ordinal 1, the second last is ordinal 2, etc...
'* oCallback - Optional, the object that will receive the callback. If undefined, callbacks are sent to this object's instance
'* bIdeSafety - Optional, set to false to disable IDE protection.
'*************************************************************************************************
' Callback procedure must return a Long even if, per MSDN, the callback procedure is a Sub vs Function
' The number of parameters are dependent on the individual callback procedures
Const MEM_LEN As Long = IDX_CALLBACKORDINAL * 4 + 4 'Memory bytes required for the callback thunk
Const PAGE_RWX As Long = &H40& 'Allocate executable memory
Const MEM_COMMIT As Long = &H1000& 'Commit allocated memory
Const SUB_NAME As String = "scb_SetCallbackAddr" 'This routine's name
Const INDX_OWNER As Long = 0
Const INDX_CALLBACK As Long = 1
Const INDX_EBMODE As Long = 2
Const INDX_BADPTR As Long = 3
Const INDX_EBX As Long = 5
Const INDX_PARAMS As Long = 12
Const INDX_PARAMLEN As Long = 17
Dim z_Cb() As Long 'Callback thunk array
Dim nCallback As Long
If z_cbFunk Is Nothing Then
Set z_cbFunk = New Collection 'If this is the first time through, do the one-time initialization
Else
On Error Resume Next 'Catch already initialized?
z_ScMem = z_cbFunk.Item("h" & nOrdinal) 'Test it
If Err = 0 Then
scb_SetCallbackAddr = z_ScMem + 16 'we had this one, just reference it
Exit Function
End If
On Error GoTo 0
End If
If nParamCount < 0 Then ' validate parameters
zError SUB_NAME, "Invalid Parameter count"
Exit Function
End If
If oCallback Is Nothing Then Set oCallback = Me 'If the user hasn't specified the callback owner
nCallback = zAddressOf(oCallback, nOrdinal) 'Get the callback address of the specified ordinal
If nCallback = 0 Then
zError SUB_NAME, "Callback address not found."
Exit Function
End If
z_ScMem = VirtualAlloc(0, MEM_LEN, MEM_COMMIT, PAGE_RWX) 'Allocate executable memory
If z_ScMem = 0& Then
zError SUB_NAME, "VirtualAlloc failed, error: " & Err.LastDllError ' oops
Exit Function
End If
z_cbFunk.Add z_ScMem, "h" & nOrdinal 'Add the callback/thunk-address to the collection
ReDim z_Cb(0 To IDX_CALLBACKORDINAL) As Long 'Allocate for the machine-code array
' Create machine-code array
z_Cb(4) = &HBB60E089: z_Cb(6) = &H73FFC589: z_Cb(7) = &HC53FF04: z_Cb(8) = &H7B831F75: z_Cb(9) = &H20750008: z_Cb(10) = &HE883E889: z_Cb(11) = &HB9905004: z_Cb(13) = &H74FF06E3: z_Cb(14) = &HFAE2008D: z_Cb(15) = &H53FF33FF: z_Cb(16) = &HC2906104: z_Cb(18) = &H830853FF: z_Cb(19) = &HD87401F8: z_Cb(20) = &H4589C031: z_Cb(21) = &HEAEBFC
z_Cb(INDX_BADPTR) = zFnAddr("kernel32", "IsBadCodePtr", False)
z_Cb(INDX_OWNER) = ObjPtr(oCallback) 'Set the Owner
z_Cb(INDX_CALLBACK) = nCallback 'Set the callback address
z_Cb(IDX_CALLBACKORDINAL) = nOrdinal 'Cache ordinal used for zTerminateThunks
Debug.Assert zInIDE
If bIdeSafety = True And z_IDEflag = 1 Then 'If the user wants IDE protection
z_Cb(INDX_EBMODE) = zFnAddr("vba6", "EbMode", False) 'EbMode Address
End If
z_Cb(INDX_PARAMS) = nParamCount 'Set the parameter count
z_Cb(INDX_PARAMLEN) = nParamCount * 4 'Set the number of stck bytes to release on thunk return
'\\LaVolpe - redirect address to proper location in virtual memory. Was: z_Cb(INDX_EBX) = VarPtr(z_Cb(INDX_OWNER))
z_Cb(INDX_EBX) = z_ScMem 'Set the data address relative to virtual memory pointer
RtlMoveMemory z_ScMem, VarPtr(z_Cb(INDX_OWNER)), MEM_LEN 'Copy thunk code to executable memory
scb_SetCallbackAddr = z_ScMem + 16 'Thunk code start address
End Function
Private Sub scb_ReleaseCallback(ByVal nOrdinal As Long)
' can be made public. Releases a specific callback
' can be removed and zUnThunk can be called directly
zUnThunk nOrdinal, CallbackThunk
End Sub
Public Sub scb_TerminateCallbacks()
' can be made public. Releases all callbacks
' can be removed and zTerminateThunks can be called directly
zTerminateThunks CallbackThunk
End Sub
'========================================================================
' COMMON USE ROUTINES
'-The following routines are used for each of the three types of thunks
'========================================================================
'Map zData() to the thunk address for the specified window handle
Private Function zMap_VFunction(ByVal vFuncTarget As Long, vType As eThunkType) As Long
' vFuncTarget is one of the following, depending on vType
' - Subclassing: the hWnd of the window subclassed
' - Hooking: the hook type created
' - Callbacks: the ordinal of the callback
Dim thunkCol As Collection
If vType = CallbackThunk Then
Set thunkCol = z_cbFunk
ElseIf vType = HookThunk Then
Set thunkCol = z_hkFunk
ElseIf vType = SubclassThunk Then
Set thunkCol = z_scFunk
Else
zError "zMap_Vfunction", "Invalid thunk type passed"
Exit Function
End If
If thunkCol Is Nothing Then
zError "zMap_VFunction", "Thunk hasn't been initialized"
Else
On Error GoTo Catch
z_ScMem = thunkCol("h" & vFuncTarget) 'Get the thunk address
zMap_VFunction = z_ScMem
End If
Exit Function 'Exit returning the thunk address
Catch:
zError "zMap_VFunction", "Thunk type for ID of " & vFuncTarget & " does not exist"
End Function
'Error handler
Private Sub zError(ByVal sRoutine As String, ByVal sMsg As String)
' \\LaVolpe - Note. These two lines can be rem'd out if you so desire. But don't remove the routine
App.LogEvent TypeName(Me) & "." & sRoutine & ": " & sMsg, vbLogEventTypeError
'MsgBox sMsg & ".", vbExclamation + vbApplicationModal, "Error in " & TypeName(Me) & "." & sRoutine
'Debug.Print "Error in " & TypeName(Me) & "." & sRoutine & "> " & sMsg
End Sub
'Return the address of the specified DLL/procedure
Private Function zFnAddr(ByVal sDLL As String, ByVal sProc As String, ByVal asUnicode As Boolean) As Long
If asUnicode Then
zFnAddr = GetProcAddress(GetModuleHandleW(StrPtr(sDLL)), sProc) 'Get the specified procedure address
Else
zFnAddr = GetProcAddress(GetModuleHandleA(sDLL), sProc) 'Get the specified procedure address
End If
Debug.Assert zFnAddr 'In the IDE, validate that the procedure address was located
' ^^ FYI VB5 users. Search for zFnAddr("vba6", "EbMode") and replace with zFnAddr("vba5", "EbMode")
End Function
'Return the address of the specified ordinal method on the oCallback object, 1 = last private method, 2 = second last private method, etc
Private Function zAddressOf(ByVal oCallback As Object, ByVal nOrdinal As Long) As Long
' Note: used both in subclassing and hooking routines
Dim bSub As Byte 'Value we expect to find pointed at by a vTable method entry
Dim bVal As Byte
Dim nAddr As Long 'Address of the vTable
Dim i As Long 'Loop index
Dim j As Long 'Loop limit
RtlMoveMemory VarPtr(nAddr), ObjPtr(oCallback), 4 'Get the address of the callback object's instance
If Not zProbe(nAddr + &H1C, i, bSub) Then 'Probe for a Class method
If Not zProbe(nAddr + &H6F8, i, bSub) Then 'Probe for a Form method
' \\LaVolpe - Added propertypage offset
If Not zProbe(nAddr + &H710, i, bSub) Then 'Probe for a PropertyPage method
If Not zProbe(nAddr + &H7A4, i, bSub) Then 'Probe for a UserControl method
Exit Function 'Bail...
End If
End If
End If
End If
i = i + 4 'Bump to the next entry
j = i + 1024 'Set a reasonable limit, scan 256 vTable entries
Do While i < j
RtlMoveMemory VarPtr(nAddr), i, 4 'Get the address stored in this vTable entry
If IsBadCodePtr(nAddr) Then 'Is the entry an invalid code address?
RtlMoveMemory VarPtr(zAddressOf), i - (nOrdinal * 4), 4 'Return the specified vTable entry address
Exit Do 'Bad method signature, quit loop
End If
RtlMoveMemory VarPtr(bVal), nAddr, 1 'Get the byte pointed to by the vTable entry
If bVal <> bSub Then 'If the byte doesn't match the expected value...
RtlMoveMemory VarPtr(zAddressOf), i - (nOrdinal * 4), 4 'Return the specified vTable entry address
Exit Do 'Bad method signature, quit loop
End If
i = i + 4 'Next vTable entry
Loop
End Function
'Probe at the specified start address for a method signature
Private Function zProbe(ByVal nStart As Long, ByRef nMethod As Long, ByRef bSub As Byte) As Boolean
Dim bVal As Byte
Dim nAddr As Long
Dim nLimit As Long
Dim nEntry As Long
nAddr = nStart 'Start address
nLimit = nAddr + 32 'Probe eight entries
Do While nAddr < nLimit 'While we've not reached our probe depth
RtlMoveMemory VarPtr(nEntry), nAddr, 4 'Get the vTable entry
If nEntry <> 0 Then 'If not an implemented interface
RtlMoveMemory VarPtr(bVal), nEntry, 1 'Get the value pointed at by the vTable entry
If bVal = &H33 Or bVal = &HE9 Then 'Check for a native or pcode method signature
nMethod = nAddr 'Store the vTable entry
bSub = bVal 'Store the found method signature
zProbe = True 'Indicate success
Exit Do 'Return
End If
End If
nAddr = nAddr + 4 'Next vTable entry
Loop
End Function
Private Function zInIDE() As Long
' This is only run in IDE; it is never run when compiled
z_IDEflag = 1
zInIDE = z_IDEflag
End Function
Private Property Get zData(ByVal nIndex As Long) As Long
' retrieves stored value from virtual function's memory location
RtlMoveMemory VarPtr(zData), z_ScMem + (nIndex * 4), 4
End Property
Private Property Let zData(ByVal nIndex As Long, ByVal nValue As Long)
' sets value in virtual function's memory location
RtlMoveMemory z_ScMem + (nIndex * 4), VarPtr(nValue), 4
End Property
Private Sub zUnThunk(ByVal thunkID As Long, ByVal vType As eThunkType)
' Releases a specific subclass, hook or callback
' thunkID depends on vType:
' - Subclassing: the hWnd of the window subclassed
' - Hooking: the hook type created
' - Callbacks: the ordinal of the callback
Const IDX_SHUTDOWN As Long = 1
Const MEM_RELEASE As Long = &H8000& 'Release allocated memory flag
If zMap_VFunction(thunkID, vType) Then
Select Case vType
Case SubclassThunk
If IsBadCodePtr(z_ScMem) = 0 Then 'Ensure that the thunk hasn't already released its memory
zData(IDX_SHUTDOWN) = 1 'Set the shutdown indicator
zDelMsg ALL_MESSAGES, IDX_BTABLE 'Delete all before messages
zDelMsg ALL_MESSAGES, IDX_ATABLE 'Delete all after messages
'\\LaVolpe - Force thunks to replace original window procedure handle. Without this, app can crash when a window is subclassed multiple times simultaneously
If zData(IDX_UNICODE) Then 'Force window procedure handle to be replaced
SendMessageW thunkID, 0&, 0&, ByVal 0&
Else
SendMessageA thunkID, 0&, 0&, ByVal 0&
End If
End If
z_scFunk.Remove "h" & thunkID 'Remove the specified thunk from the collection
Case HookThunk
If IsBadCodePtr(z_ScMem) = 0 Then 'Ensure that the thunk hasn't already released its memory
zData(IDX_SHUTDOWN) = 1 'Set the shutdown indicator
zData(IDX_ATABLE) = 0 ' want no more After messages
zData(IDX_BTABLE) = 0 ' want no more Before messages
End If
z_hkFunk.Remove "h" & thunkID 'Remove the specified thunk from the collection
Case CallbackThunk
If IsBadCodePtr(z_ScMem) = 0 Then 'Ensure that the thunk hasn't already released its memory
VirtualFree z_ScMem, 0, MEM_RELEASE 'Release allocated memory
End If
z_cbFunk.Remove "h" & thunkID 'Remove the specified thunk from the collection
End Select
End If
End Sub
Private Sub zTerminateThunks(ByVal vType As eThunkType)
' Removes all thunks of a specific type: subclassing, hooking or callbacks
Dim i As Long
Dim thunkCol As Collection
Select Case vType
Case SubclassThunk
Set thunkCol = z_scFunk
Case HookThunk
Set thunkCol = z_hkFunk
Case CallbackThunk
Set thunkCol = z_cbFunk
Case Else
Exit Sub
End Select
If Not (thunkCol Is Nothing) Then 'Ensure that hooking has been started
With thunkCol
For i = .Count To 1 Step -1 'Loop through the collection of hook types in reverse order
z_ScMem = .Item(i) 'Get the thunk address
If IsBadCodePtr(z_ScMem) = 0 Then 'Ensure that the thunk hasn't already released its memory
Select Case vType
Case SubclassThunk
zUnThunk zData(IDX_INDEX), SubclassThunk 'Unsubclass
Case HookThunk
zUnThunk zData(IDX_INDEX), HookThunk 'Unhook
Case CallbackThunk
zUnThunk zData(IDX_CALLBACKORDINAL), CallbackThunk ' release callback
End Select
End If
Next i 'Next member of the collection
End With
Set thunkCol = Nothing 'Destroy the hook/thunk-address collection
End If
End Sub
'- ordinal #1
Private Sub WndProc(ByVal bBefore As Boolean, _
ByRef bHandled As Boolean, _
ByRef lReturn As Long, _
ByVal hwnd As Long, _
ByVal uMsg As ssc_eMsg, _
ByVal wParam As Long, _
ByVal lParam As Long, _
ByRef lParamUser As Long)
'Debug.Print uMsg, wParam, wParam
'esto esta mal!!
RaiseEvent WindowProc(bHandled, lReturn, hwnd, uMsg, wParam, lParam)
End Sub