- Код: Выделить всё
Option Explicit
Public Event KeyDown(ByVal KeyCode As Long)
Private Const WM_KEYDOWN As Long = &H100
Private Const cNull As Long = &H0
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Const AsmMain As String = "558BEC83C4FC8D45FC50FF7514FF7510FF750CFF75086800000000B800000000FFD08B45FCC9C21000"
' 0 1 2 3 4 5 6 7 8 9 A B C D E F
' ---------------------------------------------------
'| 55 8B EC 83 C4 FC 8D 45 FC 50 FF 75 14 FF 75 10
'| FF 75 0C FF 75 08 68 00 00 00 00 B8 00 00 00 00
'| FF D0 8B 45 FC C9 C2 10 00
Private OldCtl As Long, OldCtl1 As Long
Private ASM_Ctl() As Byte
Private ASM() As Byte
Dim mHwnd As Long, mHwnd1 As Long
'адрес этой функции получается по номеру ProcNumber
Public Function winProc0(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case uMsg
Case WM_KEYDOWN
RaiseEvent KeyDown(wParam)
End Select
winProc0 = CallWindowProc(OldCtl, hWnd, uMsg, wParam, lParam)
End Function
'адрес этой функции получается по номеру ProcNumber
Public Function winProc1(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
' Select Case uMsg
' Case WM_KEYDOWN
' RaiseEvent KeyDown(wParam)
' End Select
winProc1 = CallWindowProc(OldCtl, hWnd, uMsg, wParam, lParam)
End Function
Public Function Hook(ByVal hWnd As Long)
mHwnd = hWnd
Call StartSubclass(hWnd, OldCtl, 0)
End Function
Private Sub StartSubclass(ByVal hWnd As Long, _
ByRef OldWndProc As Long, _
ByVal ProcNumber As Long)
Dim lng As Long
Dim tPtr As Long
ASM = ASM_Ctl
Call CopyMemory(tPtr, ByVal ObjPtr(Me), 4&)
Call CopyMemory(lng, ByVal tPtr + &H1C + (4& * ProcNumber), 4&)
Call CopyMemory(ASM(23), ObjPtr(Me), 4&)
Call CopyMemory(ASM(28), lng, 4&)
OldWndProc = SetWindowLong(hWnd, &HFFFC, VarPtr(ASM(0)))
' ProcNumber - номер функции в этом классе, начиная сверху по порядку вниз...
End Sub
Public Sub Unhook()
If OldCtl Then Call SetWindowLong(mHwnd, &HFFFC, OldCtl)
End Sub
Private Sub Class_Initialize()
Dim lng As Long
Dim tPtr As Long
lng = Len(AsmMain) \ 2&
ReDim ASM_Ctl(cNull To lng - vbNull)
For lng = cNull To lng - vbNull
ASM_Ctl(lng) = Val("&H" & Mid$(AsmMain, (lng) * 2& + vbNull, 2&))
Next
End Sub
Private Sub Class_Terminate()
Call Unhook
End Sub
Вот только очень хотелось было бы понять, что именно делает эта ассемберная вставка и можно ли вообще так делать? А то код очень удобный, а пользоваться им - боязно...
Да и проверит не на чем 
В любом случае, надеюсь, это окажется полезным тем, кто в этом понимает 
):
(сижу на модеме - прям прошлый век, ей-богу)