Finns det någon funktion för att läsa av tangentbordet som inte kräver att fönstret är markerat? Hej! Först en LowLevel hook fungerar endast med NT 4 och senare. Kolla in min Keylogger under Tips&Tricks Api Keyboard, den använder GetAsyncKeystate, kan kolla tangentbordet oavsett vilket program som har fokus eller är aktiverat (och med MYCKET enklare kod än andra poster här).Läsa av tangetbordet
Jag har provat med KeyHook men det funkade inte.
Tacksam för svar!
/ Peter LarssonSv: Läsa av tangetbordet
Är det tangentens keycode du är ute efter? i så fall kan du testa detta:
Option Explicit
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Form1.Caption = "KeyCode = " & KeyCode & ", Shift=" & Shift
End Sub
//TomasSv: Läsa av tangetbordet
Lägger in hooken före message kön i windows. Fångar all text och skriver den till en textbox.
<code>
Option Explicit
Public Const HC_ACTION = 0
Public Const WM_KEYDOWN = &H100
Public Const WM_SYSKEYDOWN = &H104
Public Const WH_KEYBOARD_LL = 13
Public Type KBDLLHOOKSTRUCT
vkCode As Long
scanCode As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private isHooked As Boolean
Private hHook As Long
Private blnDoNothing As Boolean
Private keystruc As KBDLLHOOKSTRUCT
Public Sub SetKeyHook()
If isHooked Then
'Do nothing
Else
hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf KeyboardProc, App.hInstance, 0)
End If
End Sub
Public Sub RemoveKeyHook()
Dim lngDummy As Long
lngDummy = UnhookWindowsHookEx(hHook)
isHooked = False
End Sub
Public Function KeyboardProc(ByVal uCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If (uCode = HC_ACTION) Then
If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Then
CopyMemory keystruc, ByVal lParam, Len(keystruc)
Form1.Text1.Text = Form1.Text1.Text & Chr(keystruc.vkCode)
End If
End If
KeyboardProc = CallNextHookEx(0, uCode, wParam, ByVal lParam)
End Function
</code>
Sedan en SystemWide hook ska fungera i 98, ej bekräftat hade bara XP att testa emot. Lägger in en hook efter message kön. Visar en MsgBox när 'W' skrivs.
<code>
Option Explicit
Public Const HC_ACTION = 0
Public Const WH_KEYBOARD = 2
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private isHooked As Boolean
Private hHook As Long
Private blnDoNothing As Boolean
Public Sub SetKeyHook()
If isHooked Then
'Do nothing
Else
hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeyboardProc, 0, App.ThreadID)
End If
End Sub
Public Sub RemoveKeyHook()
Dim lngDummy As Long
lngDummy = UnhookWindowsHookEx(hHook)
isHooked = False
End Sub
Public Function KeyboardProc(ByVal uCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If (uCode = HC_ACTION) Then
If Hex$(wParam) = "57" Then
MsgBox "Wohoo!"
End If
End If
KeyboardProc = CallNextHookEx(hHook, uCode, wParam, lParam)
End Function
</code>Sv: Läsa av tangetbordet