У вас может закружиться голова, но пока вы знаете знания VB и хотите эту вещь, вам придется внимательно ее изучить.
modHook.bas
Опция явная
Публичное объявление функции CallNextHookEx Lib user32.dll (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lparam As Any) Как долго
Public Declare Sub CopyMemory Lib kernel32 Псевдоним RtlMoveMemory (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
Публичное объявление подключаемого ключа bd_event Lib user32 (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Публичные данные() как строка
Публичное число NUM до тех пор, пока
Публичный OldHook до тех пор, пока
Публичный LngClsPtr как длинный
Открытая функция BackHook (ByVal nCode до тех пор, пока ByVal wParam, ByVal lparam до тех пор, пока)
Если nCode < 0 Тогда
BackHook = CallNextHookEx(OldHook, nCode, wParam, lparam)
Выход из функции
Конец, если
ResolvePointer(LngClsPtr).RiseEvent (lparam)
Вызов CallNextHookEx(OldHook, nCode, wParam, lparam)
Конечная функция
Частная функция ResolvePointer (ByVal lpObj до тех пор, пока) как ClsHook
Dim oSH как ClsHook
Копирование памяти oSH, lpObj, 4&
Установите ResolvePointer = oSH
Копироватьпамять oSH, 0&, 4&
Конечная функция
ClsHook.cls
Опция явная
Открытое событие KeyDown (KeyCode как целое число, сдвиг как целое число)
Частный тип EVENTMSG
wMsg как долго
lParamLow до тех пор, пока
lParamHigh до тех пор, пока
msgTime как долго
hWndMsg как долго
Тип окончания
Частная константа WH_JOURNALRECORD = 0
Частная константа WM_KEYDOWN = &H100
Частная функция объявления SetWindowsHookEx Lib user32.dll Псевдоним SetWindowsHookExA (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Частная функция объявления UnhookWindowsHookEx Lib user32.dll (ByVal hHook As Long) до тех пор, пока
Частная функция объявления GetAsyncKeyState Lib user32.dll (ByVal vKey As Long) как целое число
Публичная подпрограмма SetHook()
OldHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf BackHook, App.hInstance, 0)
Конец субтитра
Публичный саб отсоединить()
Вызов UnhookWindowsHookEx(OldHook)
Конец субтитра
Дружественная функция RiseEvent (ByVal lparam до тех пор, пока) до тех пор, пока
Удалить сообщение как EVENTMSG
Dim IntShift как целое число
Dim IntCode как целое число
CopyMemory Msg, ByVal lparam, Len(Msg)
ИнтШифт = 0
Выберите случай Msg.wMsg
Случай WM_KEYDOWN
Если GetAsyncKeyState(vbKeyShift), то IntShift = (IntShift или 1)
Если GetAsyncKeyState(vbKeyControl), то IntShift = (IntShift или 2)
Если GetAsyncKeyState(vbKeyMenu), то IntShift = (IntShift или 4)
IntCode = Msg.lParamLow и &HFF
Debug.Print Msg.lParamLow
Отладка.Печать &HFF
RaiseEvent KeyDown(IntCode, IntShift)
Конец выбора
Конечная функция
Частный подкласс_Initialize()
LngClsPtr = ObjPtr(Me)
Конец субтитра
form1.frm
Опция явная
Хук Dim WithEvents как ClsHook
Частная функция объявления MapVirtualKeyEx Lib user32 Псевдоним MapVirtualKeyExA (ByVal uCode As Long, ByVal uMapType As Long, ByVal dwhkl As Long) As Long
Частная функция объявления GetKeyboardLayout Lib user32 (ByVal dwLayout As Long) As Long
Частная функция объявления GetForegroundWindow Lib user32 () как долго
Частная функция объявления GetWindowThreadProcessId Lib user32 (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Частный Sub Hook_KeyDown (KeyCode как целое число, сдвиг как целое число)
Тусклый StrCode как строка
StrCode = CodeToString(KeyCode)
Если StrCode = [Shift] Или StrCode = [Alt] Или StrCode = [Ctrl] Тогда
Если Shift = vbAltMask + vbCtrlMask Тогда StrCode = [Alt + Ctrl]
Если Shift = vbAltMask + vbShiftMask Тогда StrCode = [Alt + Shift]
Если Shift = vbCtrlMask + vbShiftMask Тогда StrCode = [Ctrl + Shift]
Если Shift = vbCtrlMask + vbShiftMask + vbAltMask, то StrCode = [Ctrl + Shift +Alt]
Еще
Если Shift = vbShiftMask Тогда StrCode = [Shift] + & StrCode
Если Shift = vbCtrlMask Тогда StrCode = [Ctrl] + & StrCode
Если Shift = vbAltMask Тогда StrCode = [Alt] + & StrCode
Если Shift = vbAltMask + vbCtrlMask Тогда StrCode = [Alt + Ctrl] + & StrCode
Если Shift = vbAltMask + vbShiftMask Тогда StrCode = [Alt + Shift] + & StrCode
Если Shift = vbCtrlMask + vbShiftMask Тогда StrCode = [Ctrl + Shift] + & StrCode
Если Shift = vbCtrlMask + vbShiftMask + vbAltMask Тогда StrCode = [Ctrl + Shift +Alt] + & StrCode
Конец, если
If LCase(StrCode) = LCase(HotKey) then ' Этот раздел представляет собой простую функцию после HOOK клавиатуры, которая предназначена для скрытия и отображения окна from.
Если App.TaskVisible = False Тогда
Me.Show
App.TaskVisible = Истина
Еще
Я.Скрыть
App.TaskVisible = Ложь
Конец, если
Конец, если
Конец субтитра
Частная функция CodeToString (nCode как целое число) как строка
Dim StrKey как строка
Выберите регистровый nкод
Случай vbKeyBack: StrKey = BackSpace
Случай vbKeyTab: StrKey = Tab
Случай vbKeyClear: StrKey = Очистить
Случай vbKeyReturn: StrKey = Enter
Случай vbKeyShift: StrKey = Shift
Случай vbKeyControl: StrKey = Ctrl
Случай vbKeyMenu: StrKey = Alt
Случай vbKeyPause: StrKey = Пауза
Случай vbKeyCapital: StrKey = CapsLock
Случай vbKeyEscape: StrKey = ESC
Случай vbKeySpace: StrKey = ПРОБЕЛ
Случай vbKeyPageUp: StrKey = PAGE UP
Случай vbKeyPageDown: StrKey = PAGE DOWN
Случай vbKeyEnd: StrKey = END
Случай vbKeyHome: StrKey = HOME
Случай vbKeyLeft: StrKey = СТРЕЛКА ВЛЕВО
Случай vbKeyUp: StrKey = СТРЕЛКА ВВЕРХ
Случай vbKeyRight: StrKey = СТРЕЛКА ВПРАВО
Случай vbKeyDown: StrKey = СТРЕЛКА ВНИЗ
Случай vbKeySelect: StrKey = SELECT
Случай vbKeyPrint: StrKey = ПЕЧАТЬ ЭКРАНА
Случай vbKeyExecute: StrKey = EXECUTE
Случай vbKeySnapshot: StrKey = SNAPSHOT
Случай vbKeyInsert: StrKey = INS
Случай vbKeyDelete: StrKey = DEL
Случай vbKeyHelp: StrKey = HELP
Случай vbKeyNumlock: StrKey = NUM LOCK
Случай от vbKey0 до vbKey9: StrKey = Chr$(nCode)
Случай vbKeyA для vbKeyZ: StrKey = LCase(Chr$(nCode)) 'MapVirtualKeyEx(nCode, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0))))
Случай от vbKeyF1 до vbKeyF16: StrKey = F & CStr(nCode - 111)
Случай от vbKeyNumpad0 до vbKeyNumpad9: StrKey = Numpad & CStr(nCode - 96)
Случай vbKeyMultiply: StrKey = Numpad {*}
Случай vbKeyAdd: StrKey = Numpad {+}
Случай vbKeySeparator: StrKey = Numpad {ENTER}
Случай vbKeySubtract: StrKey = Numpad {-}
Случай vbKeyDecimal: StrKey = Numpad {.}
Случай vbKeyDivide: StrKey = Numpad {/}
Другое дело
StrKey = Chr$(MapVirtualKeyEx(nCode, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0)))) & Str(MapVirtualKeyEx(nCode, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0))))
Конец выбора
CodeToString = [ & StrKey & ]
Конечная функция