vb QQ消息辅助连发软件代码(vb)

vb QQ消息辅助连发软件代码(vb)
2009年12月27日
  用到了一些API,但都是简单的
  原理是找到qq聊天句柄,然后不停想起发送信息
  QQ2009hook了findwindow
  所以者只有2008 才能用了
  代码如下:
  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 SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  Private Const WM_GETTEXT = &HD
  Private Const EM_REPLACESEL = &HC2
  Private Const BM_CLICK = &HF5
  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
  Private Function GetWinText(ByVal WinHwnd As Long) As String
  Dim lLen As Long
  GetWinText = String(255, Chr(0))
  lLen = SendMessage(WinHwnd, WM_GETTEXT, Len(GetWinText), ByVal GetWinText)
  GetWinText = Left(GetWinText, lLen)
  End Function
  Private Sub Command1_Click()
  ShellExecute 0, "open", "tencent://message/?uin=" + Text1.Text, "", "", 1
  End Sub
  Private Sub Command2_Click()
  List1.Clear
  Me.Caption = "正在获取发送列表,请稍候..."
  HFindWnd = FindWindowEx(0, 0, "#32770", vbNullString)
  Do While HFindWnd 0
  If InStr(GetWinText(HFindWnd), "聊天中") > 0 Or InStr(GetWinText(HFindWnd), " - ") > 0 Or InStr(GetWinText(HFindWnd), "群") > 0 Or InStr(GetWinText(HFindWnd), "交谈中") > 0 Or InStr(GetWinText(HFindWnd), "正在输入") > 0 Or InStr(GetWinText(HFindWnd), " - ") > 0 Then
  List1.AddItem GetWinText(HFindWnd)
  End If
  HFindWnd = FindWindowEx(0, HFindWnd, "#32770", vbNullString)
  DoEvents
  Loop
  If List1.ListCount = 0 Then
  Me.Caption = "无法获取QQ消息窗口列表"
  Exit Sub
  End If
  Me.Caption = "获取发送列表完成"
  Sleep 1000
  Me.Caption = "QQ消息发送器(支持QQ2008)"
  End Sub
  Private Sub Command3_Click()
  If Timer1.Interval = 0 Then
  If Text3.Text <= 100 Then
  m = MsgBox("发送时间请大于100毫秒!", 64, "提示")
  Text1.Text = 2000
  Else
  a = MsgBox("窗体会被最小化,你可以干别的!", 64, "提示")
  Me.WindowState = 1
  Timer1.Interval = Text3.Text
  Command3.Caption = "暂停"
  End If
  Else
  Me.Caption = "QQ消息发送器(支持QQ2008)"
  Timer1.Interval = 0
  Command3.Caption = "开始"
  End If
  End Sub
  Private Sub Command4_Click()
  Unload Me
  End Sub
  Private Sub Timer1_Timer()
  QQHwnd = FindWindow("#32770", List1.Text)
  QQHwnd = FindWindow("#32770", List1.Text)
  Do
  If QQHwnd = 0 Then
  QQHwnd = FindWindow("#32770", List1.Text)
  End If
  AHwnd = FindWindowEx(QQHwnd, AHwnd, "AfxWnd42", vbNullString)
  If AHwnd = 0 Then
  QQHwnd = FindWindowEx(QQHwnd, 0, "#32770", vbNullString)
  End If
  THwnd = FindWindowEx(AHwnd, 0, "RichEdit20A", vbNullString)
  DoEvents
  Loop While THwnd = 0
  Me.Caption = "正在发送中......"
  SendMessage THwnd, EM_REPLACESEL, 0, ByVal Text1.Text
  RHwnd = FindWindowEx(QQHwnd, 0, "Button", "发送(S)")
  SendMessage RHwnd, BM_CLICK, 0, 0
  End Sub
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值