Isso pode deixá-lo tonto, mas contanto que você conheça o VB e queira isso, você deve estudá-lo com cuidado.
modHook.bas
Opção Explícita
Função de declaração pública CallNextHookEx Lib user32.dll (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lparam As Any) As Long
Public Declare Sub CopyMemory Lib kernel32 Alias RtlMoveMemory (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
Declaração pública Sub keybd_event Lib user32 (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Dados públicos() como string
Público NUM Enquanto
OldHook público enquanto
LngClsPtr público enquanto
Função pública BackHook (ByVal nCode As Long, ByVal wParam As Long, ByVal lparam As Long) As Long
Se nCode <0 então
BackHook = CallNextHookEx(OldHook, nCode, wParam, lparam)
Função de saída
Terminar se
ResolvePointer(LngClsPtr).RiseEvent (lparam)
Chame CallNextHookEx(OldHook, nCode, wParam, lparam)
Função final
Função privada ResolvePointer (ByVal lpObj As Long) As ClsHook
Dim oSH como ClsHook
CopiarMemória oSH, lpObj, 4&
Definir ResolvePointer = oSH
CopiarMemória oSH, 0&, 4&
Função final
ClsHook.cls
Opção Explícita
Evento público KeyDown (KeyCode como inteiro, Shift como inteiro)
Tipo privado EVENTMSG
wMsg tão longo
lParamLow As Long
lParamHigh As Long
msgTempo tão longo
hWndMsg tão longo
Tipo final
Const privada WH_JOURNALRECORD = 0
Const privada WM_KEYDOWN = &H100
Função de declaração privada SetWindowsHookEx Lib user32.dll Alias SetWindowsHookExA (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Função de declaração privada UnhookWindowsHookEx Lib user32.dll (ByVal hHook As Long) As Long
Função de declaração privada GetAsyncKeyState Lib user32.dll (ByVal vKey As Long) como número inteiro
Subconjunto público()
OldHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf BackHook, App.hInstance, 0)
Finalizar sub
Sub público desenganchar()
Chame UnhookWindowsHookEx(OldHook)
Finalizar sub
Função de amigo RiseEvent (ByVal lparam As Long) As Long
Dim Msg como EVENTMSG
Dim IntShift como inteiro
Dim IntCode como inteiro
CopyMemory Msg, ByVal lparam, Len(Msg)
IntShift = 0
Selecione Caso Msg.wMsg
Caso WM_KEYDOWN
Se GetAsyncKeyState(vbKeyShift) Então IntShift = (IntShift ou 1)
Se GetAsyncKeyState(vbKeyControl) Então IntShift = (IntShift Ou 2)
Se GetAsyncKeyState(vbKeyMenu) Então IntShift = (IntShift ou 4)
IntCode = Msg.lParamLow e &HFF
Debug.Print Msg.lParamLow
Depurar.Imprimir &HFF
RaiseEvent KeyDown (IntCode, IntShift)
Finalizar seleção
Função final
Subclasse Privada_Initialize()
LngClsPtr = ObjPtr(Me)
Finalizar sub
formulário1.frm
Opção Explícita
Dim WithEvents Gancho como ClsHook
Função de declaração privada MapVirtualKeyEx Lib user32 Alias MapVirtualKeyExA (ByVal uCode As Long, ByVal uMapType As Long, ByVal dwhkl As Long) As Long
Função de declaração privada GetKeyboardLayout Lib user32 (ByVal dwLayout As Long) As Long
Função de declaração privada GetForegroundWindow Lib user32 () As Long
Função de declaração privada GetWindowThreadProcessId Lib user32 (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Sub Hook_KeyDown (KeyCode como inteiro, Shift como inteiro)
DimStrCodeAsString
StrCode = CodeToString(KeyCode)
Se StrCode = [Shift] Ou StrCode = [Alt] Ou StrCode = [Ctrl] Então
Se Shift = vbAltMask + vbCtrlMask Então StrCode = [Alt + Ctrl]
Se Shift = vbAltMask + vbShiftMask Então StrCode = [Alt + Shift]
Se Shift = vbCtrlMask + vbShiftMask Então StrCode = [Ctrl + Shift]
Se Shift = vbCtrlMask + vbShiftMask + vbAltMask Então StrCode = [Ctrl + Shift + Alt]
Outro
Se Shift = vbShiftMask Então StrCode = [Shift] + & StrCode
Se Shift = vbCtrlMask Então StrCode = [Ctrl] + & StrCode
Se Shift = vbAltMask Então StrCode = [Alt] + & StrCode
Se Shift = vbAltMask + vbCtrlMask Então StrCode = [Alt + Ctrl] + & StrCode
Se Shift = vbAltMask + vbShiftMask Então StrCode = [Alt + Shift] + & StrCode
Se Shift = vbCtrlMask + vbShiftMask Então StrCode = [Ctrl + Shift] + & StrCode
Se Shift = vbCtrlMask + vbShiftMask + vbAltMask Então StrCode = [Ctrl + Shift + Alt] + & StrCode
Terminar se
If LCase(StrCode) = LCase(HotKey) Then ' Esta seção é uma função simples após o teclado HOOK, que serve para ocultar e exibir a janela de.
Se App.TaskVisible = Falso então
Eu.Mostrar
App.TaskVisible = Verdadeiro
Outro
Eu.Ocultar
App.TaskVisible = Falso
Terminar se
Terminar se
Finalizar sub
Função privada CodeToString (nCode como inteiro) como string
DimStrKeyAsString
Selecione Caso nCode
Caso vbKeyBack: StrKey = BackSpace
Caso vbKeyTab: StrKey = Tab
Caso vbKeyClear: StrKey = Limpar
Caso vbKeyReturn: StrKey = Enter
Caso vbKeyShift: StrKey = Shift
Caso vbKeyControl: StrKey = Ctrl
Caso vbKeyMenu: StrKey = Alt
Caso vbKeyPause: StrKey = Pausa
Caso vbKeyCapital: StrKey = CapsLock
Caso vbKeyEscape: StrKey = ESC
Caso vbKeySpace: StrKey = BARRA DE ESPAÇO
Caso vbKeyPageUp: StrKey = PAGE UP
Caso vbKeyPageDown: StrKey = PAGE DOWN
Caso vbKeyEnd: StrKey = END
Caso vbKeyHome: StrKey = HOME
Caso vbKeyLeft: StrKey = SETA ESQUERDA
Caso vbKeyUp: StrKey = SETA PARA CIMA
Caso vbKeyRight: StrKey = SETA PARA A DIREITA
Caso vbKeyDown: StrKey = SETA PARA BAIXO
Caso vbKeySelect: StrKey = SELECT
Caso vbKeyPrint: StrKey = IMPRIMIR TELA
Caso vbKeyExecute: StrKey = EXECUTAR
Caso vbKeySnapshot: StrKey = INSTANTÂNEO
Caso vbKeyInsert: StrKey = INS
Caso vbKeyDelete: StrKey = DEL
Caso vbKeyHelp: StrKey = AJUDA
Caso vbKeyNumlock: StrKey = NUM LOCK
Caso vbKey0 para vbKey9: StrKey = Chr$(nCode)
Caso vbKeyA para vbKeyZ: StrKey = LCase(Chr$(nCode)) 'MapVirtualKeyEx(nCode, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0))))
Caso vbKeyF1 para vbKeyF16: StrKey = F & CStr(nCode - 111)
Caso vbKeyNumpad0 para vbKeyNumpad9: StrKey = Numpad & CStr (nCode - 96)
Caso vbKeyMultiply: StrKey = Numpad {*}
Caso vbKeyAdd: StrKey = Numpad {+}
Caso vbKeySeparator: StrKey = Numpad {ENTER}
Caso vbKeySubtract: StrKey = Numpad {-}
Caso vbKeyDecimal: StrKey = Numpad {.}
Caso vbKeyDivide: StrKey = teclado numérico {/}
Outro caso
StrKey = Chr$(MapVirtualKeyEx(nCode, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0)))) & Str(MapVirtualKeyEx(nCode, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0))))
Finalizar seleção
CodeToString = [ & StrKey & ]
Função final