Question

如何用VB或读取QQ消息

如题，怎么用VB读出别人发过来的消息，不用QQ,用别的聊天软件也可以，最好能弄飞信的，这样就可以实现用手机遥控电脑或者自动回复短信了。弄的好的加分

Answer 1

VB读取QQ消息，依次读取QQ消息窗口
01 Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
02 Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVallpWindowName As String) As Long
03 Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVallpString As String, ByVal cch As Long) As Long
04 Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVallpClassName As String, ByVal nMaxCount As Long) As Long
05 Private Const GW_CHILD = 5
06 Private Const GW_HWNDNEXT = 2
07 Private Sub Command1_Click()
08 Dim hWin As Long
09 Dim strText As String
10 Dim strClass As String
11 Dim arr(1 To 5) As String
12 Dim flag As Integer
13 Dim length As Integer
14 flag = 1
15 List1.Clear
16 '第一个QQ消息窗口
17 hWin = FindWindow("CTXOPConntion_Class", vbNullString)
18 If hWin = 0 Then Exit Sub
19 Do
20 strText = String$(50, vbNullChar)
21 GetWindowText hWin, strText, Len(strText)
22 strText = Left$(strText, InStr(strText, vbNullChar) - 1)
23 If InStr(strText, "OP_") = 1 Then
24 strText = Mid$(strText, 4)
25 List1.AddItem strText
26 arr(flag) = strText
27 flag = flag + 1
28 End If
29 Do
30 '下一个窗口
31 hWin = GetWindow(hWin, GW_HWNDNEXT)
32 If hWin = 0 Then Exit Do
33 strClass = String$(50, vbNullChar)
34 GetClassName hWin, strClass, Len(strClass)
35 strClass = Left$(strClass, InStr(strClass, vbNullChar) - 1)
36 Loop While strClass <> "CTXOPConntion_Class"
37 Loop While hWin
38 List1.Text = strText
39 End Sub

Answer 2

建议去学一下基本的网络编程知识

Answer 3

先获取聊天回复框的句柄即可

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 Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Declare Sub RtlMoveMemory Lib "KERNEL32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy 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

Public Function GetText(ByVal hWndNow As Long) As String
Dim hLength As Long
Dim bArr() As Byte, bArr2() As Byte
hLength = SendMessage(hWndNow, WM_GETTEXTLENGTH, 0, 0)
If hLength > 0 Then
ReDim bArr(hLength + 1) As Byte, bArr2(hLength - 1) As Byte
Call RtlMoveMemory(bArr(0), hLength, 2)
Call SendMessage(hWndNow, WM_GETTEXT, hLength + 1, bArr(0))
Call RtlMoveMemory(bArr2(0), bArr(0), hLength)
GetText = StrConv(bArr2, vbUnicode)
Else
GetText = 〃〃
End If
End Function

Private Sub Command1_Click()
Dim qqhwnd&
find:
qqhwnd = FindWindowEx(0&, qqhwnd&, "#32770", vbNullString)
If qqhwnd = 0 Then MsgBox "No Msg": End
If Not (GetText(qqhwnd) Like "与**交谈中" Or GetText(qqhwnd) Like "* － 群") Then
GoTo find
End If
Dim chldhwnd&
chldhwnd& = FindWindowEx(qqhwnd&, 0, "#32770", vbNullString)
chldhwnd& = FindWindowEx(chldhwnd&, 0, "RichEdit20A", vbNullString)
MsgBox GetText(chldhwnd&)
End Sub