vb别写QQ群发器实例

[vb]代码库

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

[代码运行效果截图]