5个回答
展开全部
可参考以下:
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 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()
On Error GoTo ErrorHandler
Dim HFindWnd As Long
Dim QQHwnd As Long, AHwnd As Long, THwnd As Long, RHwnd As Long
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 (500)
Me.Caption = "正在发送QQ消息,请稍候..."
For i = 0 To List1.ListCount - 1
List1.Selected(i) = True
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 = "正在发送第" & i + 1 & "个QQ消息窗口"
SendMessage THwnd, EM_REPLACESEL, 0, ByVal Text1.Text
RHwnd = FindWindowEx(QQHwnd, 0, "Button", "发送(S)")
SendMessage RHwnd, BM_CLICK, 0, 0
DoEvents
Sleep (500)
Next i
Me.Caption = "一共发送了" & i & "个QQ消息窗口"
List1.Clear
List1.AddItem ("已完成所有消息发送")
ErrorHandler:
End Sub
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 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()
On Error GoTo ErrorHandler
Dim HFindWnd As Long
Dim QQHwnd As Long, AHwnd As Long, THwnd As Long, RHwnd As Long
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 (500)
Me.Caption = "正在发送QQ消息,请稍候..."
For i = 0 To List1.ListCount - 1
List1.Selected(i) = True
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 = "正在发送第" & i + 1 & "个QQ消息窗口"
SendMessage THwnd, EM_REPLACESEL, 0, ByVal Text1.Text
RHwnd = FindWindowEx(QQHwnd, 0, "Button", "发送(S)")
SendMessage RHwnd, BM_CLICK, 0, 0
DoEvents
Sleep (500)
Next i
Me.Caption = "一共发送了" & i & "个QQ消息窗口"
List1.Clear
List1.AddItem ("已完成所有消息发送")
ErrorHandler:
End Sub
展开全部
如果你已经开启QQ就可以
这样写
Shell Environ("PROGRAMFILES") & "\Internet Explorer\iexplore.exe " & "Tencent://Message/?Menu=YES&Exe=&Uin=" & Text1.Text, vbNormalFocus
Text1.Text就是你输入想要聊天的对象的QQ号
不需要加对方为好友就可以聊天
如果没有就回谈出无效网页
这样写
Shell Environ("PROGRAMFILES") & "\Internet Explorer\iexplore.exe " & "Tencent://Message/?Menu=YES&Exe=&Uin=" & Text1.Text, vbNormalFocus
Text1.Text就是你输入想要聊天的对象的QQ号
不需要加对方为好友就可以聊天
如果没有就回谈出无效网页
本回答被提问者采纳
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
哈哈!这个程序首先用到两个重要的知识,一个是WMI编程知识;另一个就是Tencent://语句的使用;两方面没问题了就可以轻松完成程序!WMI编程实现查找进程列表中是否有QQ.exe应用程序,如果有的话,则调用Tencent语句,打开调用的qq进行留言;如果没有则启动qq.exe,当然这需要编程实现!挺简单
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
呵呵,这个算是有点难度的问题了,并且分数不多。
嗯,说说思路吧,如果用vb实现的话,得使用api钩子函数,待获得句柄之后,使用sendmessage函数来做。
嗯,说说思路吧,如果用vb实现的话,得使用api钩子函数,待获得句柄之后,使用sendmessage函数来做。
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
不是个简单的问题.
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询