Finns det någon funktion för att läsa av tangentbordet som inte kräver att fönstret är markerat?
Jag har provat med KeyHook men det funkade inte.

Tacksam för svar!


/ Peter Larsson

Hej!

Ä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

//Tomas

Först en LowLevel hook fungerar endast med NT 4 och senare.
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>

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).