Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( ByVal lpClassName As String , ByVal lpWindowName As String ) As Long |
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( ByVal hwnd As Long , ByVal wMsg As Long , ByVal wParam As Long , lParam As Any) As Long |
Private Declare Function GetWindow Lib "user32" ( ByVal hwnd As Long , ByVal wCmd As Long ) As Long |
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" ( ByVal hwnd As Long , ByVal lpClassName As String , ByVal nMaxCount As Long ) As Long |
Private Declare Function SetForegroundWindow Lib "user32" ( ByVal hwnd As Long ) As Long |
Private Declare Function ShowWindow Lib "user32" ( ByVal hwnd As Long , ByVal nCmdShow As Long ) As Long |
Private Declare Sub Sleep Lib "kernel32" ( ByVal dwMilliseconds As Long ) |
Private Declare Function SendInput Lib "user32.dll" ( ByVal nInputs As Long , pInputs As GENERALINPUT, ByVal cbSize As Long ) As Long |
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long ) |
Const WM_GETTEXT = &HD |
Const GW_HWNDNEXT = 2 |
Const SW_RESTORE = 9 |
Const VK_CONTROL = &H11 |
Const VK_V = 86 |
Const VK_RETURN = &HD |
Const KEYEVENTF_KEYUP = &H2 |
Const INPUT_KEYBOARD = 1 |
Private Type KEYBDINPUT |
wVk As Integer |
wScan As Integer |
dwFlags As Long |
time As Long |
dwExtraInfo As Long |
End Type |
Private Type GENERALINPUT |
dwType As Long |
xi(0 To 23) As Byte |
End Type |
Dim a As Integer |
Private Sub Check1_Click() |
Dim i As Integer |
For i = 0 To List1.ListCount - 1 |
List1.Selected(i) = True |
Next |
End Sub |
Private Sub Command2_Click() |
List1.Clear |
Dim hwnd As Long |
hwnd = 1 |
Dim i As Integer |
Dim S As String |
Dim str As String |
S = String (512, Chr(0)) |
hwnd = FindWindow( "TXGuiFoundation" , vbNullString) |
'遍历窗体 |
While (hwnd) |
GetClassName hwnd, ByVal S, Len(S) '取得窗口的类名 |
'如果是QQ进程相关的窗体 |
If Left(S, InStr(S, Chr(0)) - 1) = "TXGuiFoundation" Then |
'取得窗体的标题 |
SendMessage hwnd, WM_GETTEXT, Len(S), ByVal S |
str = Left(S, InStr(S, Chr(0)) - 1) |
'过滤掉不需要的窗体,剩下的就是聊天窗口了(此处过滤可能不完整,如启动QQ时弹出的新闻框就没有过滤,根据需要修改) |
If Trim(str) <> "" And LCase(Left(Trim(str), 6)) <> "qq2009" And LCase(Trim(str)) <> "txfloatingwnd" And LCase(Trim(str)) <> "txmenuwindow" Then |
'将聊天的窗口名称,窗口句柄加入到List1中 |
List1.AddItem S, 0 |
List1.ItemData(0) = hwnd |
End If |
End If |
hwnd = GetWindow(hwnd, GW_HWNDNEXT) |
Wend |
If List1.ListCount > 0 Then List1.ListIndex = 0 |
End Sub |
'根据选中列表中的某个对应的聊天窗口,发送信息 |
Private Sub Command1_Click() |
For a = 0 To List1.ListCount - 1 |
If List1.Selected(a) = True Then |
'On Error Resume Next |
If List1.ListCount < 1 Then Exit Sub |
If Trim(Text1.Text) = "" Then |
MsgBox "发送内容不能为空" |
Exit Sub |
End If |
'将text1中要发送的内容拷贝到剪贴板 |
Clipboard.Clear |
Clipboard.SetText Text1.Text |
Dim hwnd As Long |
hwnd = 0 |
'设置要发送的窗体 |
hwnd = List1.ItemData(a) |
If hwnd = 0 Then Exit Sub |
ShowWindow hwnd, SW_RESTORE '如果窗口最小化,则将其恢复 |
SetForegroundWindow hwnd '置窗口到前台 |
'定义发送按键结构变量 |
Dim GInput(0 To 3) As GENERALINPUT |
Dim KInput As KEYBDINPUT |
'构造CTRL+V |
KInput.wVk = VK_CONTROL |
KInput.dwFlags = 0 |
GInput(0).dwType = INPUT_KEYBOARD |
CopyMemory GInput(0).xi(0), KInput, Len(KInput) |
KInput.wVk = VK_V |
KInput.dwFlags = 0 |
GInput(1).dwType = INPUT_KEYBOARD |
CopyMemory GInput(1).xi(0), KInput, Len(KInput) |
KInput.wVk = VK_CONTROL |
KInput.dwFlags = KEYEVENTF_KEYUP |
GInput(2).dwType = INPUT_KEYBOARD |
CopyMemory GInput(2).xi(0), KInput, Len(KInput) |
KInput.wVk = VK_V |
KInput.dwFlags = KEYEVENTF_KEYUP |
GInput(3).dwType = INPUT_KEYBOARD |
CopyMemory GInput(3).xi(0), KInput, Len(KInput) |
SendInput 4, GInput(0), Len(GInput(0)) '发送CTRL+V |
'构造CTRL+RETURN |
KInput.wVk = VK_CONTROL |
KInput.dwFlags = 0 |
GInput(0).dwType = INPUT_KEYBOARD |
CopyMemory GInput(0).xi(0), KInput, Len(KInput) |
KInput.wVk = VK_RETURN |
KInput.dwFlags = 0 |
GInput(1).dwType = INPUT_KEYBOARD |
CopyMemory GInput(1).xi(0), KInput, Len(KInput) |
KInput.wVk = VK_CONTROL |
KInput.dwFlags = KEYEVENTF_KEYUP |
GInput(2).dwType = INPUT_KEYBOARD |
CopyMemory GInput(2).xi(0), KInput, Len(KInput) |
KInput.wVk = VK_RETURN |
KInput.dwFlags = KEYEVENTF_KEYUP |
GInput(3).dwType = INPUT_KEYBOARD |
CopyMemory GInput(3).xi(0), KInput, Len(KInput) |
SendInput 4, GInput(0), Len(GInput(0)) '发送CTRL+RETURN |
End If |
Sleep 1000 |
Next |
End Sub |
Private Sub Form_Load() |
Text1.Text = "" |
End Sub |
Private Sub Option1_Click() |
Text1.Text = "" |
Text1.Text = Option1.Caption |
End Sub |
Private Sub Option2_Click() |
Text1.Text = "" |
Text1.Text = Option2.Caption |
End Sub |
Private Sub Option3_Click() |
Text1.Text = "" |
Text1.Text = Option3.Caption |
End Sub |
Private Sub Option4_Click() |
Text1.Text = "" |
Text1.Text = Option4.Caption |
End Sub |
Private Sub Option5_Click() |
Dim i As Integer |
For i = 0 To List1.ListCount - 1 |
List1.Selected(i) = True |
Next |
End Sub |
Private Sub Option6_Click() |
Dim i As Integer |
For i = 0 To List1.ListCount - 1 |
List1.Selected(i) = False |
Next |
End Sub |
Private Sub Timer1_Timer() |
Label1.Caption = Now() |
End Sub |
初级程序员
by: cxtrj 发表于:2018-08-25 18:27:25 顶(0) | 踩(0) 回复
很好的代码
回复评论