您的位置：程序门 -> vb -> 基础类

向qq聊天窗口的文本框写入字符的方法

[收藏此页] [打印本页]选择字色：背景色：字体：[大][中][小]

向qq聊天窗口的文本框写入字符的方法[已结贴,结贴人:hd378]

发表于：2007-05-19 18:21:32 楼主

由于以前qq消息尾巴病毒的流行，腾讯使用了一些技术，使得现在的qq聊天窗口屏蔽了wm_settext消息

这样的话，要利用程序自动向qq聊天窗口发送文本就比较难了。不过经过测试发现，wm_char消息没有被qq屏蔽。因此，可以使用这个消息把字符发送到聊天窗口。不过要注意的是，发送中文的话，要发送2次，也就是高低2个字节，不然会乱码的。

declare function sendmessage lib "user32 " alias "sendmessagea " （byval hwnd as long, byval wmsg as long, byval wparam as long, lparam as any) as long
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
declare function getwindowtext lib "user32 " alias "getwindowtexta " （byval hwnd as long, byval lpstring as string, byval cch as long) as long
declare function postmessage lib "user32 " alias "postmessagea " （byval hwnd as long, byval wmsg as long, byval wparam as long, lparam as any) as long
declare function setwindowtext lib "user32 " alias "setwindowtexta " （byval hwnd as long, byval lpstring as string) as long

public const wm_char = &h102
public const wm_settext = &hc
public const wm_lbuttondown = &h201
public const wm_lbuttonup = &h202
public const bm_click = &hf5
public const wm_gettext = &hd

sub setqqtext（byval fhwnd as long, byval mystr as string)

' 向聊天窗口的文本框写入消息。fhwnd 是那个文本框的句柄，mystr 是你要写入的消息
dim mydata（) as byte, i as long, tmp_k as long
i = 0
mydata = strconv（mystr, vbfromunicode)
tmp_k = ubound（mydata)
while i <= tmp_k
if mydata（i) < 128 then
postmessage fhwnd, wm_char, mydata（i), 0&
i = i + 1
else
postmessage fhwnd, wm_char, mydata（i), 0&
postmessage fhwnd, wm_char, mydata（i + 1), 0&
i = i + 2
end if
wend
end sub

顺便再附上几段代码，是关于如何找到qq那个文本框的句柄的。

function myfindwindowex（wname as string, fhwnd as long, temphnd as long) as long
dim mystr as string * 255
do
temphnd = findwindowex（fhwnd, temphnd, vbnullstring, vbnullstring)
getwindowtext temphnd, mystr, len（mystr) - 1
if instr（1, mystr, wname) > 0 then
myfindwindowex = temphnd
exit function
else
myfindwindowex = 0
end if
loop until temphnd = 0
end function

先用上面的函数找到qq消息窗口的句柄，像这样 qqhwnd=myfindwindowex（ "聊天中 ",0,0)

再用下面的函数找到qq文本输入框的句柄，像这样，传入qq消息窗口的句柄 qqtexthwnd=myfindqqchattext（qqhwnd)

function myfindqqchattext（byval fhwnd as long) as long
'获得qq聊天窗口的文本输入框句柄
dim tmp_hwnd as long
tmp_hwnd = mycheckwindow（fhwnd, 4)
tmp_hwnd = mycheckwindow（tmp_hwnd, 23)
tmp_hwnd = mycheckwindow（tmp_hwnd, 1)
myfindqqchattext = tmp_hwnd
end function

function mycheckwindow（fhwnd as long, myno as long) as long
dim mycheck as long
mycheckwindow = 0
for mycheck = 1 to myno
mycheckwindow = findwindowex（fhwnd, mycheckwindow, vbnullstring, vbnullstring)
next
end function

然后就可以写入消息了。写入消息后，还可以自动按下发送按钮来发送消息

找到发送按钮的句柄 qqsendhwnd=myfindqqchatsend（qqhwnd)

function myfindqqchatsend（byval fhwnd as long) as long
'获得qq聊天窗口的发送按钮句柄
dim tmp_hwnd as long
tmp_hwnd = mycheckwindow（fhwnd, 4)
tmp_hwnd = mycheckwindow（tmp_hwnd, 17)
myfindqqchatsend = tmp_hwnd
end function

再模拟按下发送键 myclickbotton qqsendhwnd

sub myclickbotton（byval fhwnd as long)
'按下某个按钮
postmessage fhwnd, bm_click, 0&, 0&
end sub

差不多就是这样了。有什么问题可以联系我，qq：511795070

发表于：2007-05-20 16:03:081楼得分:0

关注

发表于：2007-05-20 18:35:182楼得分:0

讲一下核心的问题吧

发表于：2007-05-20 22:38:123楼得分:0

mark

发表于：2007-05-20 22:59:394楼得分:0

http://community.csdn.net/expert/topic/5545/5545084.xml?temp=.9980127

发表于：2007-05-21 08:02:495楼得分:0

mark

发表于：2007-05-21 11:13:316楼得分:0

因为经典，所以mark！

发表于：2007-05-21 12:04:307楼得分:0

呵呵,雷锋帖

发表于：2007-05-23 21:08:178楼得分:3

来个简单的
declare function findwindowexa lib "user32 " （byval hwnd1 as long, byval hwnd2 as long, _
byval lpsz1 as string, byval lpsz2 as string) as long
declare function sendmessagea lib "user32 " （byval hwnd as long, byval wmsg as long, _
byval wparam as long, lparam as any) as long
declare function getwindowtexta lib "user32 " （byval hwnd as long, byval lpstring as string, _
byval cch as long) as long
const em_replacesel = &hc2
const bm_click = &hf5

sub test（)
dim hwnd as long
dim title as string
hwnd = findwindowexa（0, 0, "#32770 ", vbnullstring)
do while hwnd > 0
hwnd = findwindowexa（0&, hwnd, "#32770 ", vbnullstring)
title = space（255)
getwindowtexta hwnd, title, 256
if （title like "*聊天中* ") or （title like "*群* ") or （title like "*會話中* ") then
sendmsg hwnd, "qq消息群發 "
end if
loop
end sub

function sendmsg（hwnd as long, meg as string)
dim hwnd1 as long
dim hwnd2 as long
hwnd1 = findwindowexa（hwnd, 0, "#32770 ", vbnullstring)
hwnd2 = findwindowexa（hwnd1, 0, "button ", "發送（s) ")
hwnd1 = findwindowexa（hwnd1, hwnd2, "afxwnd42 ", vbnullstring)
hwnd1 = findwindowexa（hwnd1, 0, "richedit ", vbnullstring)

sendmessagea hwnd1, em_replacesel, 0, byval meg
sendmessagea hwnd2, bm_click, 0, byval 0
end function

发表于：2007-07-17 22:12:589楼得分:0

mark

发表于：2007-07-17 23:03:1910楼得分:2

更简单的
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 const em_replacesel = &hc2

private sub command1_click（)
dim h as long, h1 as long, h2 as long
h = findwindow（ "#32770 ", "与 *** 聊天中 ") ' '***换成和你聊天人的网名
h = findwindowex（h, 0, "#32770 ", " ")
h1 = findwindowex（h, 0, "afxwnd42 ", " ")
h2 = findwindowex（h1, 0, "richedit20a ", " ")
dim i as integer
do while h2 = 0 and i < 100
h1 = findwindowex（h, h1, "afxwnd42 ", " ")
h2 = findwindowex（h1, 0, "richedit20a ", " ")
i = i + 1
loop
sendmessage h2, em_replacesel, 0, byval "哈哈，这个好用，qq忘记屏备这个了 "
end sub

其他资讯