程序代码:
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 MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) _
As Long
Const KEYEVENTF_KEYUP = &H2 '释放按键
Const vbKeyControl = &H11 '释放按键
Const vbKeyA = &H65 '释放按键
Const vbKeyC = &H67 '释放按键
Const vbKeyV = &H86 '释放按键
Private Function Shell_Ex(ExeName As String) As Boolean '异步执行外部程序
Dim Id As Long, Name As String
Name = Mid(ExeName, InStrRev(ExeName, "\") + 1)
Id = Shell(ExeName, vbNormalFocus)
On Error Resume Next
Dim objWMIService, colProcessList, objProcess
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Do
Shell_Ex = True
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name='" & Name & "' and handle='" & Id & "'")
For Each objProcess In colProcessList
Shell_Ex = False
Exit For
Next
DoEvents
Loop Until Shell_Ex = True
Set objProcess = Nothing
Set colProcessList = Nothing
Set objWMIService = Nothing
End Function
Private Sub OpenUrl(Url As String)
ShellExecute Me.hwnd, "Open", Url, 0, 0, 0
End Sub
Private Sub OpenNotePad()
Shell_Ex "c:\windows\notepad.exe"
End Sub
Private Sub AllSelect()
keybd_event vbKeyControl, 0, 0, 0 '按下Ctrl键
keybd_event vbKeyA, 0, 0, 0 '按下A键
keybd_event vbKeyA, 0, KEYEVENTF_KEYUP, 0 '释放A键
keybd_event vbKeyControl, 0, KEYEVENTF_KEYUP, 0 '释放Ctrl键
End Sub
Private Sub AllCopy()
keybd_event vbKeyControl, 0, 0, 0 '按下Ctrl键
keybd_event vbKeyC, 0, 0, 0 '按下C键
keybd_event vbKeyC, 0, KEYEVENTF_KEYUP, 0 '释放C键
keybd_event vbKeyControl, 0, KEYEVENTF_KEYUP, 0 '释放Ctrl键
End Sub
Private Function GetHandle(Title As String) As Long
Dim hWindow: hWindow = FindWindow(vbNullString, Title)
If hWindow Then '如果获取句柄成功
GetHandle = FindWindowEx(hWindow, 0, "Edit", vbNullString)
End If
End Function
Private Sub AllPaste(hwnd As Long)
PostMessage Me.hwnd, WM_KEYDOWN, vbKeyControl, MapVirtualKey(vbKeyControl, 0) ' 模拟按下 Ctrl 键
PostMessage Me.hwnd, WM_KEYDOWN, vbKeyV, MapVirtualKey(vbKeyV, 0) ' 模拟按下 V 键
PostMessage Me.hwnd, WM_KEYUP, vbKeyV, MapVirtualKey(vbKeyV, 0) ' 模拟抬起 V 键
PostMessage Me.hwnd, WM_KEYUP, vbKeyControl, MapVirtualKey(vbKeyControl, 0) ' 模拟抬起 Ctrl 键
End Sub
Private Sub Form_Load()
'Dim Url:Url=InputBox("请输入URL:")
Dim Url As String '这里一定要定义为String类型,否则IDE会崩溃
Url = InputBox("请输入URL:")
OpenUrl Url
AllSelect
AllCopy
OpenNotePad
AllPaste GetHandle("无标题 - 记事本")
End Sub
这段代码理论上能运行,我没测试过