vb,如何控制键盘上的ctrl+c组合健和ctrl+v组合健,VB代码如何编写

2024年11月30日 20:31
有2个网友回答
网友(1):

如果你是想模拟按键的话还比较简单,一种方法是用 keybd_event 来模拟,给个例子:

Option Explicit

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

Private Const VK_ADD As Long = &H6B '加号键
Private Const VK_APPS As Long = &H5D 'Applications 键(相当于鼠标右键)
Private Const VK_BACK As Long = &H8 'BackSpace 键
Private Const VK_CAPITAL As Long = &H14 'Caps Lock 键(大小写转换键)
Private Const VK_CANCEL As Long = &H3 'Ctrl + Break 过程
Private Const VK_CONTROL As Long = &H11
Private Const VK_DECIMAL As Long = &H6E '小数点号键
Private Const VK_DELETE As Long = &H2E
Private Const VK_DIVIDE As Long = &H6F '除号键
Private Const VK_DOWN As Long = &H28
Private Const VK_END As Long = &H23
Private Const VK_ESCAPE As Long = &H1B
Private Const VK_F1 As Long = &H70
Private Const VK_F10 As Long = &H79
Private Const VK_F11 As Long = &H7A
Private Const VK_F12 As Long = &H7B
Private Const VK_F2 As Long = &H71
Private Const VK_F3 As Long = &H72
Private Const VK_F4 As Long = &H73
Private Const VK_F5 As Long = &H74
Private Const VK_F6 As Long = &H75
Private Const VK_F7 As Long = &H76
Private Const VK_F8 As Long = &H77
Private Const VK_F9 As Long = &H78
Private Const VK_HOME As Long = &H24
Private Const VK_INSERT As Long = &H2D
Private Const VK_LCONTROL As Long = &HA2
Private Const VK_LEFT As Long = &H25
Private Const VK_LMENU As Long = &HA4 '左 Alt 键
Private Const VK_LSHIFT As Long = &HA0
Private Const VK_LWIN As Long = &H5B
Private Const VK_MENU As Long = &H12 'Alt 键
Private Const VK_MULTIPLY As Long = &H6A '乘号键
Private Const VK_NEXT As Long = &H22 '下翻页键
Private Const VK_NUMLOCK As Long = &H90
Private Const VK_NUMPAD0 As Long = &H60
Private Const VK_NUMPAD1 As Long = &H61
Private Const VK_NUMPAD2 As Long = &H62
Private Const VK_NUMPAD3 As Long = &H63
Private Const VK_NUMPAD4 As Long = &H64
Private Const VK_NUMPAD5 As Long = &H65
Private Const VK_NUMPAD6 As Long = &H66
Private Const VK_NUMPAD7 As Long = &H67
Private Const VK_NUMPAD8 As Long = &H68
Private Const VK_NUMPAD9 As Long = &H69
Private Const VK_PAUSE As Long = &H13
Private Const VK_PRINT As Long = &H2A
Private Const VK_PRIOR As Long = &H21 '上翻页键
Private Const VK_RCONTROL As Long = &HA3
Private Const VK_RETURN As Long = &HD '回车键
Private Const VK_RIGHT As Long = &H27
Private Const VK_RMENU As Long = &HA5 '右 Alt 键
Private Const VK_RSHIFT As Long = &HA1
Private Const VK_RWIN As Long = &H5C
Private Const VK_SCROLL As Long = &H91 'Scroll Lock 键
Private Const VK_SEPARATOR As Long = &H6C '小键盘上的回车键
Private Const VK_SHIFT As Long = &H10
Private Const VK_SLEEP As Long = &H5F '休眠键
Private Const VK_SNAPSHOT As Long = &H2C 'Print Screen 键
Private Const VK_SPACE As Long = &H20
Private Const VK_SUBTRACT As Long = &H6D '减号键
Private Const VK_TAB As Long = &H9
Private Const VK_UP As Long = &H26
Private Const VK_OEM_1 As Long = &HBA 'Windows 2000:对于 US 标准键盘,是“;:”键
Private Const VK_OEM_2 As Long = &HBF 'Windows 2000:对于 US 标准键盘,是“/?”键
Private Const VK_OEM_3 As Long = &HC0 'Windows 2000:对于 US 标准键盘,是“`~”键
Private Const VK_OEM_4 As Long = &HDB 'Windows 2000:对于 US 标准键盘,是“[{”键
Private Const VK_OEM_5 As Long = &HDC 'Windows 2000:对于 US 标准键盘,是“\|”键
Private Const VK_OEM_6 As Long = &HDD 'Windows 2000:对于 US 标准键盘,是“]}”键
Private Const VK_OEM_7 As Long = &HDE 'Windows 2000:对于 US 标准键盘,是“单/双引号”键
Private Const VK_OEM_COMMA As Long = &HBC 'Windows 2000:对于任何国家/地区,是“,”键
Private Const VK_OEM_MINUS As Long = &HBD 'Windows 2000:对于任何国家/地区,是“-”键
Private Const VK_OEM_PERIOD As Long = &HBE 'Windows 2000:对于任何国家/地区,是“.”键
Private Const VK_OEM_PLUS As Long = &HBB 'Windows 2000:对于任何国家/地区,是“+”键

Private Const KEYEVENTF_KEYUP = &H2

'根据指定的映射类型,执行不同的扫描码和字符转换,0—— wCode是个虚拟键码。函数返回相应的扫描码
Private Declare Function MapVirtualKey Lib "user32" _
Alias "MapVirtualKeyA" _
(ByVal wCode As Long, _
ByVal wMapType As Long) _
As Long

Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Form_click()
If Clipboard.GetFormat(vbCFText) Then
keybd_event VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0 '起动ctrl
keybd_event Asc("V"), MapVirtualKey(Asc("V"), 0), 0, 0 '模拟按下"V"键,此处为ascll码
keybd_event Asc("V"), MapVirtualKey(Asc("V"), 0), KEYEVENTF_KEYUP, 0 '撤消按下的V键
keybd_event VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KEYEVENTF_KEYUP, 0 '撤消ctrl

'以下两句主要是为了换行看清楚,可以删除
keybd_event VK_RETURN, MapVirtualKey(VK_RETURN, 0), 0, 0 '模拟回车
keybd_event VK_RETURN, MapVirtualKey(VK_RETURN, 0), KEYEVENTF_KEYUP, 0 '撤消回车
Else
MsgBox "剪切板内容不是文本格式"
End If
End Sub

如果你是要感知这个事件的话,那就比较麻烦了,要用到钩子了

Option Explicit

Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long)
'模拟按键
Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Public Type KEYMSGS
vKey As Long '虚拟码 (and &HFF)
sKey As Long '扫描码
flag As Long '键按下:128 抬起:0
time As Long 'Window运行时间
End Type

Public Type MOUSEMSGS
X As Long 'x座标
Y As Long 'y座标
a As Long
b As Long
time As Long 'Window运行时间
End Type

Public Type POINTAPI
X As Long
Y As Long
End Type

Public Const WH_KEYBOARD_LL = 13
Public Const WH_MOUSE_LL = 14
Public Const Alt_Down = &H20

'消息
Public Const HC_ACTION = 0
Public Const HC_SYSMODALOFF = 5
Public Const HC_SYSMODALON = 4

'键盘消息
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105

'鼠标消息
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
Public Const WM_MBUTTONDBLCLK = &H209
Public Const WM_MOUSEACTIVATE = &H21
Public Const WM_MOUSEFIRST = &H200
Public Const WM_MOUSELAST = &H209
Public Const WM_MOUSEWHEEL = &H20A

Public Declare Function GetKeyNameText Lib "user32" Alias "GetKeyNameTextA" (ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public strKeyName As String * 255
Public Declare Function GetActiveWindow Lib "user32" () As Long
Public keyMsg As KEYMSGS
Public MouseMsg As MOUSEMSGS
Public lHook(1) As Long

'模拟鼠标
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_ABSOLUTE = &H8000 ' absolute move
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) 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)

Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOACTIVATE = &H10
'Public Const SWP_SHOWWINDOW = &H40

'Public Declare Function SetWindowPos Lib "user32" (ByValhwnd As Long, ByVal h_WndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

'鼠标钩子
Public Function CallMouseHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim pt As POINTAPI

If code = HC_ACTION Then
CopyMemory MouseMsg, lParam, LenB(MouseMsg)

' Form1.txtMsg(1).Text = "X=" + Str(MouseMsg.X) + " Y=" + Str(MouseMsg.Y)
' Form1.txtHwnd(1) = Format(wParam, "0")
' Call frmKeyShow.FlashMouse("X=" + Str(MouseMsg.X) + " Y=" + Str(MouseMsg.Y))

If wParam = WM_MBUTTONDOWN Then '把中键改为左键
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
CallMouseHookProc = 1
End If

If wParam = WM_MBUTTONUP Then
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
CallMouseHookProc = 1
End If

End If

If code <> 0 Then
CallMouseHookProc = CallNextHookEx(0, code, wParam, lParam)
End If

End Function

'键盘钩子
Public Function CallKeyHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lKey As Long
Dim strKeyName As String * 255
Dim strLen As Long

If code = HC_ACTION Then
CopyMemory keyMsg, lParam, LenB(keyMsg)
Select Case wParam
Case WM_SYSKEYDOWN, WM_KEYDOWN, WM_SYSKEYUP, WM_KEYUP:

lKey = keyMsg.sKey And &HFF '扫描码
lKey = lKey * 65536
strLen = GetKeyNameText(lKey, strKeyName, 250)

' Call frmKeyShow.FlashMessage("键名:" + Left(strKeyName, strLen) + " 虚拟码:" + Format(keyMsg.vKey And &HFF, "0"))
' Call frmKeyShow.FlashKeyShow(keyMsg.vKey And &HFF)

Call ErrRecord("按下" & Left(strKeyName, strLen) & "键")

' If (GetKeyState(vbKeyControl) And &H8000) Then
' Form1.txtHwnd(0) = Form1.txtHwnd(0) + "Ctrl "
' End If
'
' If (keyMsg.flag And Alt_Down) <> 0 Then
' Form1.txtHwnd(0) = Form1.txtHwnd(0) + "Alt "
' End If
'
' If (GetKeyState(vbKeyShift) And &H8000) Then
' Form1.txtHwnd(0) = Form1.txtHwnd(0) + "Shift"
' End If

'keyMsg.vKey And &HFF 虚拟码
'lKey / 65536 扫描码

' If (keyMsg.vKey And &HFF) = vbKeyY Then '把Y键替换为N
' If wParam = WM_SYSKEYDOWN Or wParam = WM_KEYDOWN Then
' keybd_event vbKeyN, 0, 0, 0
' End If
' CallKeyHookProc = 1 '屏蔽按键
' End If

End Select
End If

If code <> 0 Then
CallKeyHookProc = CallNextHookEx(0, code, wParam, lParam)
End If
End Function

网友(2):

我给你两个最简单的方法,自己摸索的,比网上现有的方法都要方便

一种情况是复制,粘贴的操作用来代替这两个组合键
Private Sub Command1_Click()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
Clipboard.Clear
Clipboard.SetText Text1.Text, vbCFText
End Sub

Private Sub Command2_Click()
If Clipboard.GetFormat(vbCFText) Then
Text2.Text = Clipboard.GetText
End If
End Sub

另一种是用键的虚拟输出来实现,主要是函数sendkeys的使用
Private Sub Command1_Click()
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
SendKeys "^c" '等效于Ctrl+C
End Sub

Private Sub Command2_Click()
Text2.SetFocus
SendKeys "^v" '等效于Ctrl+V
End Sub

比一比差距就出来了吧