key_event 键盘模拟（转集）

''键盘表

'VB中的键码 '常数'键码值'描述

Const vbKeyLButton = 1 '鼠标左键

Const vbKeyRButton = 2 '鼠标右键

Const vbKeyCancel = 3 'CANCEL 键

Const vbKeyMButton = 4 '鼠标中键

Const vbKeyBack = 8 'Backspace 键

Const vbKeyTab = 9 'TAB 键

Const vbKeyClear = 12 'CLEAR 键

Const vbKeyReturn = 13 'Enter 键

Const vbKeyShift = 16 'Shift 键

Const vbKeyConterol = 17 'Ctrl 键

Const vbKeyMenu = 18 '菜单键

Const vbKeyPause = 19 'PAUSE 键

Const vbKeyCapital = 20 'CAPS 'LOCK 键

Const vbKeyEscape = 27 'ESC 键

Const vbKeySpace = 32 'SPACEBAR 键

Const vbKeyPageUp = 33 'PAGEUP 键

Const vbKeyPageDown = 34 'PAGEDOWN 键

Const vbKeyEnd = 35 'END 键

Const vbKeyHome = 36 'HOME 键

Const vbKeyLeft = 37 'LEFT 'ARROW 键←

Const vbKeyUp = 38 'UP 'ARROW 键↑

Const vbKeyRight = 39 'RIGHT 'ARROW 键→

Const vbKeyDown = 40 'DOWN 'ARROW 键↓

Const vbKeySelect = 41 'SELECT 键

Const vbKeyPrint = 42 'PRINT 'SCREEN 键

Const vbKeyExecute = 43 'EXECUTE 键

Const vbKeySnapshot = 44 'SNAP 'SHOT 键

Const vbKeyInser = 45 'INSERT 键

Const vbKeyDelete = 46 'DELETE 键

Const vbKeyHelp = 47 'HELP 键

Const vbKey0 = 48 '0 键

Const vbKey1 = 49 '1 键

Const vbKey2 = 50 '2 键

Const vbKey3 = 51 '3 键

Const vbKey4 = 52 '4 键

Const vbKey5 = 53 '5 键

Const vbKey6 = 54 '6 键

Const vbKey7 = 55 '7 键

Const vbKey8 = 56 '8 键

Const vbKey9 = 57 '9 键

Const vbKeyA = 65 'A 键

Const vbKeyB = 66 'B 键

Const vbKeyC = 67 'C 键

Const vbKeyD = 68 'D 键

Const vbKeyE = 69 'E 键

Const vbKeyF = 70 'F 键

Const vbKeyG = 71 'G 键

Const vbKeyH = 72 'H 键

Const vbKeyI = 73 'I 键

Const vbKeyJ = 74 'J 键

Const vbKeyK = 75 'K 键

Const vbKeyL = 76 'L 键

Const vbKeyM = 77 'M 键

Const vbKeyN = 78 'N 键

Const vbKeyO = 79 'O 键

Const vbKeyP = 80 'P 键

Const vbKeyQ = 81 'Q 键

Const vbKeyR = 82 'R 键

Const vbKeyS = 83 'S 键

Const vbKeyT = 84 'T 键

Const vbKeyU = 85 'U 键

Const vbKeyV = 86 'V 键

Const vbKeyW = 87 'W 键

Const vbKeyX = 88 'X 键

Const vbKeyY = 89 'Y 键

Const vbKeyZ = 90 'Z 键

Const vbKeyNum0 = 96 '0 键 '(在数字小键盘上)

Const vbKeyNum1 = 97 '1 键 '(在数字小键盘上)

Const vbKeyNum2 = 98 '2 键 '(在数字小键盘上)

Const vbKeyNum3 = 99 '3 键 '(在数字小键盘上)

Const vbKeyNum4 = 100 '4 键 '(在数字小键盘上)

Const vbKeyNum5 = 101 '5 键 '(在数字小键盘上)

Const vbKeyNum6 = 102 '6 键 '(在数字小键盘上)

Const vbKeyNum7 = 103 '7 键 '(在数字小键盘上)

Const vbKeyNum8 = 104 '8 键 '(在数字小键盘上)

Const vbKeyNum9 = 105 '9 键 '(在数字小键盘上)

Const vbKeyMultiply = 106 '乘号(*) 键

Const vbKeyAdd = 107 '加号(+) 键

Const vbKeySeparator = 108 'Enter键(在数字小键盘上)

Const vbKeySubtract = 109 '减号(-) 键

Const vbKeyDecimal = 110 '小数点(.) 键

Const vbKeyDivide = 111 '除号(/) 键

Const vbKeyF1 = 112 'F1 键

Const vbKeyF2 = 113 'F2 键

Const vbKeyF3 = 114 'F3 键

Const vbKeyF4 = 115 'F4 键

Const vbKeyF5 = 116 'F5 键

Const vbKeyF6 = 117 'F6 键

Const vbKeyF7 = 118 'F7 键

Const vbKeyF8 = 119 'F8 键

Const vbKeyF9 = 120 'F9 键

Const vbKeyF10 = 121 'F10 键

Const vbKeyF11 = 122 'F11 键

Const vbKeyF12 = 123 'F12 键

Const vbKeyF13 = 124 'F13 键

Const vbKeyF14 = 125 'F14 键

Const vbKeyF15 = 126 'F15 键

Const vbKeyF16 = 127 'F16 键

Const vbKeyNumlock = 144 'NUM 'LOCK 键 '

''

Const KEYEVENTF_KEYUP = &H2

''

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal Scan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Long) As Integer

Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long '计算扫描码

Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Integer) As Integer '这个比较正确

''休眠

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

''输入法相关

Private Declare Function GetKeyboardLayoutList Lib "user32" (ByVal nBuff As Long, lpList As Long) As Long '所有输入法

Private Declare Function ImmGetDescription Lib "imm32.dll" Alias "ImmGetDescriptionA" (ByVal hkl As Long, ByVal lpsz As String, ByVal uBufLen As Long) As Long

Private Declare Function ImmIsIME Lib "imm32.dll" (ByVal hkl As Long) As Long '中文输入法

Private Declare Function ActivateKeyboardLayout Lib "user32" (ByVal hkl As Long, ByVal flags As Long) As Long '使用输入法

Private Declare Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long '取输入法 '0当前

Private Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long

Private Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Long

Const KLF_REORDER = &H8

Private NoOfKBDLayout As Long, i As Long, j As Long

Private hKB(24) As Long, BuffLen As Long

Private Buff As String

Private RetStr As String

Private RetCount As Long

Private kln As String

Private hCurKBDLayout As Variant

''换成英文输入法

Private Sub set_kb_en()

Buff = String(255, 0)

hCurKBDLayout = GetKeyboardLayout(0) '取得目前的输入法

NoOfKBDLayout = GetKeyboardLayoutList(25, hKB(0)) '取得所有输入法

For i = 1 To NoOfKBDLayout

If ImmIsIME(hKB(i - 1)) = 1 Then '中文输入法

BuffLen = 255

RetCount = ImmGetDescription(hKB(i - 1), Buff, BuffLen)

RetStr = Left(Buff, RetCount)

Debug.Print i & ":" & RetStr

Else

RetStr = "English (American)" '英文输入法

Debug.Print i, RetStr

ActivateKeyboardLayout GetKeyboardLayout(hKB(i - 1)), 0 '使用英文输入法

End If

Next

End Sub

''换成原输入法

Private Sub set_kb_re()

'ActivateKeyboardLayout hCurKBDLayout, 0 '恢复原来的输入法

End Sub

''输入一个字符 ,一串字符

Public Function set_key(key_char As String)

Dim isUper As Boolean, isCapital As Boolean, isShift As Boolean

Dim key_CH As String

key_CH = Left(key_char, 1)

isCapital = GetKeyState(vbKeyCapital) '大写状态

'相异就得SHIFT，针对字母

isShift = IIf(Asc(key_CH) >= 65 And Asc(key_CH) <= 90 And isCapital = False, True, False)

isShift = isShift Or IIf(Asc(key_CH) >= Asc("a") And Asc(key_CH) <= Asc("z") And isCapital = True, True, False)

If Len(key_char) = 0 Then Call set_kb_re: Exit Function '无字符退出

key_CH = Asc(UCase(key_CH)) 'vkey

'hCurKBDLayout = GetKeyboardLayout(0) '取得目前的输入法

'Debug.Print ImmGetDescription(hCurKBDLayout, Buff, 255)

'If key_CH < 128 Then Debug.Print IMEStatus()

If isUper Xor isCapital Then '锁定与字符状态相异则用SHIFT

keybd_event vbKeyShift, MapVirtualKey(vbKeyShift, 0), 0, 0

Sleep 5

End If

keybd_event key_CH, MapVirtualKey(key_CH, 0), 0, 0

Sleep 10

''弹起

keybd_event key_CH, MapVirtualKey(key_CH, 0), KEYEVENTF_KEYUP, 0

Sleep 5

If isUper Xor isCapital Then '锁定与字符状态相异则用SHIFT

keybd_event vbKeyShift, MapVirtualKey(vbKeyShift, 0), KEYEVENTF_KEYUP, 0

Sleep 5

End If

If Len(key_char) = 1 Then set_key = Chr(key_CH): Call set_kb_re: Exit Function '单字符退出

set_key = Chr(key_CH) & set_key(Mid(key_char, 2)) '多字符继续

End Function