Option Explicit

Private Declare Function GetVersionEx Lib "kernel32" Alias _
    "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
    ByVal bScan As Byte, ByVal dwFlags As Long, _
    ByVal dwExtraInfo As Long)
Private Declare Function GetKeyState Lib "user32" (ByVal _
    nVirtKey As Long) As Integer
Private Declare Function GetKeyboardState Lib "user32" (ByVal _
    lppbKeyState As String) As Long
Private Declare Function SetKeyboardState Lib "user32" (ByVal _
    lppbKeyState As String) As Long

Private Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
End Type

Const VK_CAPITAL = &H14
Const VK_NUMLOCK = &H90
Const VK_SCROLL = &H91
Const KEYEVENTF_EXTENDEDKEY = &H1
Const KEYEVENTF_KEYUP = &H2
Const VER_PLATFORM_WIN32_NT = 2
Const VER_PLATFORM_WIN32_WINDOWS = 1

Private Sub Form_Load()
  Timer1_Timer
End Sub

Private Sub cmdKey_Click(Index As Integer)
  Dim Key As Integer
  Dim o As OSVERSIONINFO

  Select Case Index
    Case 0
      Key = VK_NUMLOCK
    Case 1
      Key = VK_CAPITAL
    Case 2
      Key = VK_SCROLL
    Case 3
      Unload Me
      Exit Sub
  End Select

  o.dwOSVersionInfoSize = Len(o)
  GetVersionEx o

  If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then ' Win9x
     Dim keys(0 To 255) As Byte
     GetKeyboardState keys(0) ' Keyboardzustand empfangen
     If GetKeyState(Key) = 0 Then keys(Key) = 1 Else keys(Key) = 0
     SetKeyboardState keys(0) 'Keyboardzustand senden
  ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then ' NT, XP usw.
     keybd_event Key, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
     keybd_event Key, &H45, KEYEVENTF_EXTENDEDKEY Or _
        KEYEVENTF_KEYUP, 0
  End If
End Sub

Private Sub Timer1_Timer()
  Dim Aus As Long, Tasten(0 To 2) As Integer, i As Integer

  Aus = RGB(0, 128, 0)
  Tasten(0) = VK_NUMLOCK
  Tasten(1) = VK_CAPITAL
  Tasten(2) = VK_SCROLL

  For i = 0 To 2
    If GetKeyState(Tasten(i)) = 0 Then
       shpKeys(i).FillColor = Aus
    Else
       shpKeys(i).FillColor = vbGreen
    End If
  Next
End Sub