Es kann Ihnen schwindelig werden, aber solange Sie über VB-Kenntnisse verfügen und dieses Ding wollen, müssen Sie es sorgfältig studieren.
modHook.bas
Option explizit
Öffentliche Deklarationsfunktion 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)
Public Declare Sub keybd_event Lib user32 (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Public Datas() als String
Öffentliche NUM solange
Öffentlicher OldHook solange
Öffentlicher LngClsPtr solange
Öffentliche Funktion BackHook(ByVal nCode As Long, ByVal wParam As Long, ByVal lparam As Long) As Long
Wenn nCode < 0, dann
BackHook = CallNextHookEx(OldHook, nCode, wParam, lparam)
Exit-Funktion
Ende wenn
ResolvePointer(LngClsPtr).RiseEvent (lparam)
CallNextHookEx(OldHook, nCode, wParam, lparam) aufrufen
Funktion beenden
Private Funktion ResolvePointer(ByVal lpObj As Long) As ClsHook
Dimmen Sie oSH als ClsHook
CopyMemory oSH, lpObj, 4&
Setzen Sie ResolvePointer = oSH
CopyMemory oSH, 0&, 4&
Funktion beenden
ClsHook.cls
Option explizit
Öffentliches Ereignis KeyDown(KeyCode als Ganzzahl, Verschiebung als Ganzzahl)
Privater Typ EVENTMSG
wMsg So lange
lParamLow So lange
lParamHigh As Long
msgTime As Long
hWndMsg So lange
Endtyp
Private Const WH_JOURNALRECORD = 0
Private Const WM_KEYDOWN = &H100
Private Deklarationsfunktion SetWindowsHookEx Lib user32.dll Alias SetWindowsHookExA (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Deklarationsfunktion UnhookWindowsHookEx Lib user32.dll (ByVal hHook As Long) As Long
Privat Deklarieren Sie die Funktion GetAsyncKeyState Lib user32.dll (ByVal vKey As Long) als Ganzzahl
Öffentlicher Sub SetHook()
OldHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf BackHook, App.hInstance, 0)
Sub beenden
Public Sub UnHook()
Call UnhookWindowsHookEx(OldHook)
Sub beenden
Friend Function RiseEvent(ByVal lparam As Long) As Long
Dim Msg As EVENTMSG
Dimmen Sie IntShift als Ganzzahl
Dimmen Sie IntCode als Ganzzahl
CopyMemory Msg, ByVal lparam, Len(Msg)
IntShift = 0
Wählen Sie Case Msg.wMsg aus
Fall WM_KEYDOWN
Wenn GetAsyncKeyState(vbKeyShift) dann IntShift = (IntShift Or 1)
Wenn GetAsyncKeyState(vbKeyControl) dann IntShift = (IntShift Or 2)
Wenn GetAsyncKeyState(vbKeyMenu) dann IntShift = (IntShift Or 4)
IntCode = Msg.lParamLow und &HFF
Debug.Print Msg.lParamLow
Debug.Print &HFF
RaiseEvent KeyDown(IntCode, IntShift)
Endauswahl
Funktion beenden
Private Sub Class_Initialize()
LngClsPtr = ObjPtr(Me)
Sub beenden
form1.frm
Option explizit
Dimmen Sie den WithEvents-Hook als ClsHook
Private Deklarationsfunktion MapVirtualKeyEx Lib user32 Alias MapVirtualKeyExA (ByVal uCode As Long, ByVal uMapType As Long, ByVal dwhkl As Long) As Long
Private Deklarationsfunktion GetKeyboardLayout Lib user32 (ByVal dwLayout As Long) As Long
Private Deklarationsfunktion GetForegroundWindow Lib user32 () As Long
Private Deklarationsfunktion GetWindowThreadProcessId Lib user32 (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Sub Hook_KeyDown(KeyCode als Ganzzahl, Verschiebung als Ganzzahl)
DimStrCodeAsString
StrCode = CodeToString(KeyCode)
Wenn StrCode = [Umschalt] oder StrCode = [Alt] oder StrCode = [Strg], dann
Wenn Shift = vbAltMask + vbCtrlMask, dann StrCode = [Alt + Strg]
Wenn Shift = vbAltMask + vbShiftMask, dann StrCode = [Alt + Shift]
Wenn Shift = vbCtrlMask + vbShiftMask, dann StrCode = [Strg + Shift]
Wenn Shift = vbCtrlMask + vbShiftMask + vbAltMask, dann StrCode = [Strg + Umschalt + Alt]
Anders
Wenn Shift = vbShiftMask, dann StrCode = [Shift] + & StrCode
Wenn Shift = vbCtrlMask, dann StrCode = [Strg] + & StrCode
Wenn Shift = vbAltMask, dann StrCode = [Alt] + & StrCode
Wenn Shift = vbAltMask + vbCtrlMask, dann StrCode = [Alt + Strg] + & StrCode
Wenn Shift = vbAltMask + vbShiftMask, dann StrCode = [Alt + Shift] + & StrCode
Wenn Shift = vbCtrlMask + vbShiftMask, dann StrCode = [Strg + Shift] + & StrCode
Wenn Shift = vbCtrlMask + vbShiftMask + vbAltMask, dann StrCode = [Strg + Shift +Alt] + & StrCode
Ende wenn
If LCase(StrCode) = LCase(HotKey) Then ' Dieser Abschnitt ist eine einfache Funktion nach dem Tastatur-HOOK, die zum Ausblenden und Anzeigen des Ausgangsfensters dient.
Wenn App.TaskVisible = False, dann
Me.Show
App.TaskVisible = True
Anders
Ich.Verstecke
App.TaskVisible = Falsch
Ende wenn
Ende wenn
Sub beenden
Private Funktion CodeToString(nCode As Integer) als String
DimStrKeyAsString
Wählen Sie Case nCode aus
Fall vbKeyBack: StrKey = BackSpace
Fall vbKeyTab: StrKey = Tab
Fall vbKeyClear: StrKey = Clear
Fall vbKeyReturn: StrKey = Enter
Fall vbKeyShift: StrKey = Shift
Fall vbKeyControl: StrKey = Strg
Fall vbKeyMenu: StrKey = Alt
Fall vbKeyPause: StrKey = Pause
Fall vbKeyCapital: StrKey = CapsLock
Fall vbKeyEscape: StrKey = ESC
Fall vbKeySpace: StrKey = LEERTASTE
Fall vbKeyPageUp: StrKey = PAGE UP
Fall vbKeyPageDown: StrKey = PAGE DOWN
Fall vbKeyEnd: StrKey = END
Fall vbKeyHome: StrKey = HOME
Fall vbKeyLeft: StrKey = NACH-LINKS-PFEIL
Fall vbKeyUp: StrKey = PFEIL NACH OBEN
Fall vbKeyRight: StrKey = PFEIL NACH RECHTS
Fall vbKeyDown: StrKey = Pfeil nach unten
Fall vbKeySelect: StrKey = SELECT
Fall vbKeyPrint: StrKey = BILDSCHIRM DRUCKEN
Fall vbKeyExecute: StrKey = EXECUTE
Fall vbKeySnapshot: StrKey = SNAPSHOT
Fall vbKeyInsert: StrKey = INS
Fall vbKeyDelete: StrKey = DEL
Fall vbKeyHelp: StrKey = HELP
Fall vbKeyNumlock: StrKey = NUM LOCK
Fall vbKey0 bis vbKey9: StrKey = Chr$(nCode)
Fall vbKeyA Zu vbKeyZ: StrKey = LCase(Chr$(nCode)) 'MapVirtualKeyEx(nCode, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0))))
Fall vbKeyF1 bis vbKeyF16: StrKey = F & CStr(nCode - 111)
Fall vbKeyNumpad0 Zu vbKeyNumpad9: StrKey = Numpad & CStr(nCode - 96)
Fall vbKeyMultiply: StrKey = Numpad {*}
Fall vbKeyAdd: StrKey = Numpad {+}
Fall vbKeySeparator: StrKey = Numpad {ENTER}
Fall vbKeySubtract: StrKey = Numpad {-}
Fall vbKeyDecimal: StrKey = Numpad {.}
Fall vbKeyDivide: StrKey = Numpad {/}
Fall anders
StrKey = Chr$(MapVirtualKeyEx(nCode, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0)))) & Str(MapVirtualKeyEx(nCode, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0))))
Endauswahl
CodeToString = [ & StrKey & ]
Funktion beenden