1 Option Explicit
2 Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, Optional ByVal Length As Long = 4)
3 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
4 Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
5 Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
6 Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
7 Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
8 Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
9 Private Declare Function GetProcessHeap Lib "kernel32" () As Long
10 Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
11 Private Declare Function HeapDestroy Lib "kernel32" (ByVal hHeap As Long) As Long
12
13 Private Type ThisClassSet
14 s_srcWndProcAddress As Long
15 s_Hwnd As Long
16
17 n_heapAlloc As Long
18 End Type
19 Dim LinkProc(29) As Long
20 Dim PG As ThisClassSet
21
22 Event GetWindowMessage(Result As Long, ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long)
23
24 Private Sub MsgHook(Result As Long, ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long)
25 '子类化接口过程
26 RaiseEvent GetWindowMessage(Result, cHwnd, Message, wParam, lParam)
27 End Sub
28
29 Private Function GetWndProcAddress(ByVal OrgWindowProc As Long, ByVal SinceCount As Long) As Long
30 ' 地址指针 ＝ GetWndProcAddress( 取第 N 个公共函数（属性） =或= 所有公共函数个数 + 第 N 个私有函数的函数地址）
31 Dim mePtr As Long
32 Dim jmpAddress As Long
33 Dim i As Long
34 Dim Protlng As Long
35
36 mePtr = ObjPtr(Me)
37 CopyMemory jmpAddress, ByVal mePtr, 4
38 CopyMemory jmpAddress, ByVal jmpAddress + (SinceCount - 1) * 4 + &H1C, 4
39
40
41 LinkProc(0) = &H83EC8B55
42 LinkProc(1) = &H75FFFCC4
43 LinkProc(2) = &H1075FF14
44 LinkProc(3) = &HFF0C75FF
45 LinkProc(4) = &HB80875
46 LinkProc(5) = &HB000040
47 LinkProc(6) = &HB94575C0
48 LinkProc(7) = &H1000&
49 LinkProc(8) = &H830C458B
50 LinkProc(9) = &H87502F8
51 LinkProc(10) = &H1C7&
52 LinkProc(11) = &H1BEB0000
53 LinkProc(12) = &H863D&
54 LinkProc(13) = &H8B077500
55 LinkProc(14) = &H1891045
56 LinkProc(15) = &H5A3D0DEB
57 LinkProc(16) = &H75000010
58 LinkProc(17) = &H101C706
59 LinkProc(18) = &H83000000
60 LinkProc(19) = &H2750139
61 LinkProc(20) = &H680EEB
62 LinkProc(21) = &HB8000020
63 LinkProc(22) = &H3000&
64 LinkProc(23) = &H13EBD0FF
65 LinkProc(24) = &H50FC458D
66 LinkProc(25) = &H500068
67 LinkProc(26) = &H6000B800
68 LinkProc(27) = &HD0FF0000
69 LinkProc(28) = &HC9FC458B
70 LinkProc(29) = &H10C2&
71
72 i = App.LogMode
73 CopyMemory ByVal VarPtr(LinkProc(4)) + 3, i, 4& ' Label Sign: 0400000
74 CopyMemory ByVal VarPtr(LinkProc(25)) + 1, mePtr, 4& ' Label Sign: 0500000
75 CopyMemory ByVal VarPtr(LinkProc(26)) + 2, jmpAddress, 4& ' Label Sign: 0600000
76
77 If i Then
78 i = VarPtr(LinkProc(0))
79 Protlng = 120
80 Else
81 PG.n_heapAlloc = HeapAlloc(GetProcessHeap, &H8, 128&)
82 CopyMemory ByVal PG.n_heapAlloc + 120&, 1&, 4
83 LinkProc(7) = PG.n_heapAlloc + 120 ' Label Sign: 0100000
84 CopyMemory ByVal VarPtr(LinkProc(20)) + 3, OrgWindowProc, 4& ' Label Sign: 0200000
85 LinkProc(22) = GetProcAddress(GetModuleHandle("user32.dll"), "CallWindowProcA") ' Label Sign: 0300000
86
87 CopyMemory ByVal PG.n_heapAlloc&, LinkProc(0), 120&
88 i = PG.n_heapAlloc
89 Protlng = 128
90 End If
91
92 VirtualProtect ByVal i&, Protlng, &H40, mePtr
93 GetWndProcAddress = i
94 End Function
95
96 Function CallDefaultWindowProc(ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
97 '调用窗口默认处理过程
98 CallDefaultWindowProc = CallWindowProc(PG.s_srcWndProcAddress, ByVal cHwnd&, ByVal Message&, ByVal wParam&, ByVal lParam&)
99 End Function
100
101 Function SetMsgHook(ByVal cHwnd As Long) As Long
102 '设置指定窗口的子类化
103 PG.s_Hwnd = cHwnd
104 PG.s_srcWndProcAddress = GetWindowLong(cHwnd, ByVal -4&)
105 SetWindowLong ByVal cHwnd, ByVal -4&, ByVal GetWndProcAddress(PG.s_srcWndProcAddress, 4)
106 SetMsgHook = PG.s_srcWndProcAddress
107 End Function
108
109 Sub SetMsgUnHook()
110 '取消窗口子类化
111 SetWindowLong ByVal PG.s_Hwnd&, ByVal -4&, ByVal PG.s_srcWndProcAddress&
112 End Sub
113
114 Private Sub Class_Terminate()
115 ' If PG.n_heapAlloc Then HeapDestroy (PG.n_heapAlloc)
116 ' 还有最后这一点小瑕疵，应该把这个内存释放代码放到内嵌的汇编代码中去释放，懒得弄了，这会有一点的内存浪费
117 End Sub
118
119
120 ''ComCallBack proc hWnd,Msg,wParam,lParam
121 ''
122 '' LOCAL Result
123 '' push lParam
124 '' push wParam
125 '' push Msg
126 '' push hWnd
127 ''
128 '' mov eax,4000h ; 调试模式, app.logmode
129 '' .if !eax
130 '' mov ecx,1000h ; 临时存储区
131 '' mov eax, Msg
132 '' .if eax == WM_DESTROY
133 '' mov dword ptr [ecx],0
134 ''
135 '' .elseif eax==WM_NCACTIVATE
136 '' mov eax, wParam
137 '' mov [ecx], eax
138 '' .elseif eax == 0105ah
139 '' mov dword ptr [ecx],1
140 '' .endif
141 ''
142 '' .if dword ptr [ecx] ==1
143 '' jmp @F
144 '' .endif
145 ''
146 '' push 2000h ; 默认窗口处理函数地址
147 '' mov eax,3000h ; callwindowproc 函数地址
148 '' Call eax
149 ''
150 '' .else
151 '' @@:
152 '' lea eax, Result
153 '' push eax
154 '' push 5000h ; objptr(me)
155 '' mov eax, 6000h ; me.subentry
156 '' Call eax
157 '' mov eax, Result
158 '' .endif
159 ''ExitProc: ret
160 ''
161 ''ComCallBack endp
162