| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1826 人关注过本帖
标题:[原创]QQ尾巴模拟
只看楼主 加入收藏
redice
Rank: 3Rank: 3
等 级:新手上路
威 望:6
帖 子:902
专家分:0
注 册:2006-12-11
结帖率:72.73%
收藏
 问题点数:0 回复次数:19 
[原创]QQ尾巴模拟

声明:该程序不会对你的系统造成影响(没有修改注册表和任何文件)
运行后症状:程序将不断向你当前聊天的好友发送信息 关闭程序,停止发送

BIId4BIH.rar (3.2 KB) [原创]QQ尾巴模拟




多于十人顶 发源码
搜索更多相关主题的帖子: 模拟 尾巴 
2007-04-21 15:21
b13690976754
Rank: 1
等 级:新手上路
威 望:2
帖 子:835
专家分:7
注 册:2006-11-9
收藏
得分:0 
沙发 我第一个~

If Dir(\"alive\") <> \"\" And Dir(\"ideal\") <> \" Then Print \"strive\" End If
2007-04-21 15:24
b13690976754
Rank: 1
等 级:新手上路
威 望:2
帖 子:835
专家分:7
注 册:2006-11-9
收藏
得分:0 
师傅。这个程序 我以前也编过类似的。。。还有其他功能吗?

If Dir(\"alive\") <> \"\" And Dir(\"ideal\") <> \" Then Print \"strive\" End If
2007-04-21 15:26
redice
Rank: 3Rank: 3
等 级:新手上路
威 望:6
帖 子:902
专家分:0
注 册:2006-12-11
收藏
得分:0 
回复:(b13690976754)[em09] 师傅。这个程序 我以前...

哦 说说 你是如何实现的
叫我redice 吧,我们都在学习中 相互交流是应该的嘛


鲲鹏数据 - 专业Web数据采集服务提供者
http://www.
2007-04-21 15:29
b13690976754
Rank: 1
等 级:新手上路
威 望:2
帖 子:835
专家分:7
注 册:2006-11-9
收藏
得分:0 


Dim a As Integer
Dim b As Integer
Private Sub Command1_Click()
a = InputBox("Time", "", "")
Timer1.Interval = Val(a) * 1000
End Sub

Private Sub Timer1_Timer()
b = b + 1
SendKeys "自动刷开始:第一" & b & "回合"
SendKeys "^{Enter}"
SendKeys "刷Q第" & b & "次"
SendKeys "^{Enter}"
SendKeys "时间为" & a & "秒,还可以加快"
SendKeys "{Enter}"
End Sub

[此贴子已经被作者于2007-4-21 15:48:32编辑过]


If Dir(\"alive\") <> \"\" And Dir(\"ideal\") <> \" Then Print \"strive\" End If
2007-04-21 15:45
redice
Rank: 3Rank: 3
等 级:新手上路
威 望:6
帖 子:902
专家分:0
注 册:2006-12-11
收藏
得分:0 
那如果我设置的发送快捷键不是"^{Enter}" 该如何实现呢?

鲲鹏数据 - 专业Web数据采集服务提供者
http://www.
2007-04-21 16:01
redice
Rank: 3Rank: 3
等 级:新手上路
威 望:6
帖 子:902
专家分:0
注 册:2006-12-11
收藏
得分:0 
另外 如果当前运行的程序是记事本 会发生什么呢??想过吗?

鲲鹏数据 - 专业Web数据采集服务提供者
http://www.
2007-04-21 16:02
b13690976754
Rank: 1
等 级:新手上路
威 望:2
帖 子:835
专家分:7
注 册:2006-11-9
收藏
得分:0 
没想过 当时只是针对QQ聊天窗口的

If Dir(\"alive\") <> \"\" And Dir(\"ideal\") <> \" Then Print \"strive\" End If
2007-04-21 16:05
starwork
Rank: 1
等 级:新手上路
帖 子:15
专家分:0
注 册:2007-1-14
收藏
得分:0 
支持一下,很少来论坛,来了一定要多顶

2007-04-21 17:05
redice
Rank: 3Rank: 3
等 级:新手上路
威 望:6
帖 子:902
专家分:0
注 册:2006-12-11
收藏
得分:0 

哈哈 没人来顶

我还是把源代码发出来 希望对大家有所启发


Private Declare GetForegroundWindow Lib "user32" () As Long
Private Declare GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare 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 sendmessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare SetFocuss Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long
Private Declare GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Const BM_CLICK = &HF5
Private Const GW_Child = 5
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDNEXT = 2
Private Sub Form_Load()
Timer1.Interval = 200
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
On Error Resume Next
Dim thewindow As Long
Dim sText As String * 255
Dim TextObj As Long
Dim thewindow_title As String

thewindow = GetForegroundWindow '获得当前窗口句柄

If thewindow = 0 Then Exit Sub
thewindow_title = Left$(sText, GetWindowText(thewindow, sText, 255)) '得到聊天窗口标题~

If InStr(thewindow_title, "聊天中") <> 0 Or InStr(thewindow_title, "- 群") <> 0 Or InStr(thewindow_title, "查看消息") <> 0 Then
TextObj = FindWindowEx(thewindow, 0, "#32770", vbNullString) '通用对话框的类
Me.Caption = TextObj
If TextObj = 0 Then Exit Sub
SetFocuss TextObj
SendKeys "轻风工作室RedIce"
send TextObj
Else
Exit Sub
End If
End Sub

Private Sub send(thehwnd As Long)
Dim temhwnd As Long
Dim sText As String * 255
temhwnd = GetWindow(thehwnd, GW_Child)
temhwnd = GetWindow(temhwnd, GW_HWNDFIRST)
While temhwnd <> 0
DoEvents
Title = Left$(sText, GetWindowText(temhwnd, sText, 255))
If InStr(Title, "发送") Then
sendmessage temhwnd, BM_CLICK, 0&, 0&
Exit Sub
End If
temhwnd = GetWindow(temhwnd, GW_HWNDNEXT)
Wend
End Sub

欢迎大家质疑



鲲鹏数据 - 专业Web数据采集服务提供者
http://www.
2007-04-23 22:01
快速回复:[原创]QQ尾巴模拟
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.051626 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved