关于QQ自动发送消息源码修改高手帮帮忙吧

tianzeshengsi 2009-04-15 12:45:20

这个源代码现在不好使了高手帮我修改下哦

Private Const EM_REPLACESEL = 194
Private Const BM_CLICK = 245
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 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 GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch 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 '申明api和常量

Private Sub Command1_Click()
If List1.ListCount = 0 Then
MsgBox "您还没有打开聊天对话框！", , "提示"
Exit Sub
End If
Dim qqhwnd As Long, qqtexthwnd As Long, buhwnd As Long
qqhwnd = FindWindow("#32770", List1.Text)
qqhwnd = FindWindowEx(qqhwnd, 0, "#32770", vbNullString)
qqtexthwnd = FindWindowEx(qqhwnd, 0, "AfxWnd42", vbNullString)
qqtexthwnd = FindWindowEx(qqhwnd, qqtexthwnd, "AfxWnd42", vbNullString)
qqtexthwnd = FindWindowEx(qqtexthwnd, 0, "RichEdit20A", vbNullString)
SendMessage qqtexthwnd, EM_REPLACESEL, 0, ByVal Text1.Text
buhwnd = FindWindowEx(qqhwnd, 0, "Button", "发送(S)")
SendMessage buhwnd, BM_CLICK, 0, 0
End Sub

Private Sub Command2_Click()
Dim qqhwnd As Long, qqtexthwnd As Long, buhwnd As Long
If List1.ListCount = 0 Then
MsgBox "您还没有打开聊天对话框！", , "提示"
Exit Sub
Else
Dim i As Integer
For i = 0 To List1.ListCount
List1.ListIndex = i
qqhwnd = FindWindow("#32770", List1.Text)
qqhwnd = FindWindowEx(qqhwnd, 0, "#32770", vbNullString)
qqtexthwnd = FindWindowEx(qqhwnd, 0, "AfxWnd42", vbNullString)
qqtexthwnd = FindWindowEx(qqhwnd, qqtexthwnd, "AfxWnd42", vbNullString)
qqtexthwnd = FindWindowEx(qqtexthwnd, 0, "RichEdit20A", vbNullString)
SendMessage qqtexthwnd, EM_REPLACESEL, 0, ByVal Text1.Text
buhwnd = FindWindowEx(qqhwnd, 0, "Button", "发送(S)")
SendMessage buhwnd, BM_CLICK, 0, 0
Next
End If
End Sub

Private Sub Command4_Click()
List1.Clear ' 先清空列表框
Dim qqname As String * 255
Dim qqhwnd As Long
qqhwnd = FindWindowEx(0, 0, "#32770", vbNullString)
qqname = String(255, Chr(0))
GetWindowText qqhwnd, qqname, Len(qqname) - 1
Do Until qqhwnd = 0
If InStr(qqname, "聊天中") > 0 Or InStr(qqname, "群") > 0 Or InStr(qqname, "交谈中") Then
List1.AddItem qqname
End If
qqhwnd = FindWindowEx(0, qqhwnd, "#32770", vbNullString)
qqname = String(255, Chr(0))
GetWindowText qqhwnd, qqname, Len(qqname) - 1
Loop
If List1.ListCount = 0 Then
MsgBox "您还没有打开聊天对话框！", , "提示"
End If
End Sub

Private Sub command5_Click()
If command5.Caption = "自动发送" Then
Timer1.Interval = Slider1.Value
Timer1.Enabled = True
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
Slider1.Enabled = False
command5.Caption = "取消自动"
Else
Timer1.Enabled = False
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
Slider1.Enabled = True
command5.Caption = "自动发送"

End If
End Sub

Private Sub Form_Load()
Timer1.Enabled = False
List1.Clear ' 先清空列表框
Dim qqname As String * 255
Dim qqhwnd As Long
qqhwnd = FindWindowEx(0, 0, "#32770", vbNullString)
qqname = String(255, Chr(0))
GetWindowText qqhwnd, qqname, Len(qqname) - 1
Do Until qqhwnd = 0
If InStr(qqname, "聊天中") > 0 Or InStr(qqname, "群") > 0 Or InStr(qqname, "交谈中") Then
List1.AddItem qqname
End If
qqhwnd = FindWindowEx(0, qqhwnd, "#32770", vbNullString)
qqname = String(255, Chr(0))
GetWindowText qqhwnd, qqname, Len(qqname) - 1
Loop
If List1.ListCount = 0 Then
MsgBox "您还没有打开聊天对话框！", , "提示"
End If
End Sub

Private Sub Timer1_Timer()
If List1.ListCount = 0 Then
MsgBox "您还没有打开聊天对话框！", , "提示"
Timer1.Enabled = False
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
Slider1.Enabled = True
command5.Caption = "自动发送"

Exit Sub

End If
Dim qqhwnd As Long, qqtexthwnd As Long, buhwnd As Long
qqhwnd = FindWindow("#32770", List1.Text)
qqhwnd = FindWindowEx(qqhwnd, 0, "#32770", vbNullString)
qqtexthwnd = FindWindowEx(qqhwnd, 0, "AfxWnd42", vbNullString)
qqtexthwnd = FindWindowEx(qqhwnd, qqtexthwnd, "AfxWnd42", vbNullString)
qqtexthwnd = FindWindowEx(qqtexthwnd, 0, "RichEdit20A", vbNullString)
SendMessage qqtexthwnd, EM_REPLACESEL, 0, ByVal Text1.Text
buhwnd = FindWindowEx(qqhwnd, 0, "Button", "发送(S)")
SendMessage buhwnd, BM_CLICK, 0, 0
End Sub

...全文