声明:该程序不会对你的系统造成影响(没有修改注册表和任何文件)
运行后症状:程序将不断向你当前聊天的好友发送信息 关闭程序,停止发送
多于十人顶 发源码
声明:该程序不会对你的系统造成影响(没有修改注册表和任何文件)
运行后症状:程序将不断向你当前聊天的好友发送信息 关闭程序,停止发送
哈哈 没人来顶
我还是把源代码发出来 希望对大家有所启发
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
欢迎大家质疑