在QQ2008中,可以用VB自动向QQ聊天窗口中填入信息,并且发送出去,但是QQ2009不能用了。
求一下完整的功能实现,谢谢高手们获取QQ聊天窗口,然后将所有开启的聊天窗口加入到列表1中。
然后可以在列表1中选择一个窗口,然后填入想要发送的东西,点击发送按钮。
VB就会将发送的文字填入到这个选定的聊天窗口中,并且发送。

解决方案 »

  1.   

    使要发送信息的QQ聊天窗口置前(成为活动窗口)
    然后使用:
    SendKeys "信息内容"
    SendKeys "%S"OK.
      

  2.   

    按LZ要求写的,不知是否是你想要的:'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''''''''''  程序功能:       向QQ2009聊天窗口中发送文本,并发送消息
    ''''''''''  程序测试环境:   Vista SP1 + QQ 2009 SP1
    ''''''''''  测试结果:       通过,其它环境没有测试
    ''''''''''  代码优化:       没有
    ''''''''''  编写:           zhanghuacheng
    ''''''''''  时间:           2009/6/25
    ''''''''''  如何使用:
    ''''''''''      1、新建一个工程,在窗体设计器中添加:list1、text1、button1、button2控件
    ''''''''''      2、将下面所有代码拷贝到窗体代码中
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''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 GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As LongPrivate Declare Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As GENERALINPUT, ByVal cbSize As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)Const WM_GETTEXT = &HD
    Const GW_HWNDNEXT = 2
    Const SW_RESTORE = 9Const VK_CONTROL = &H11
    Const VK_V = 86
    Const VK_RETURN = &HD
    Const KEYEVENTF_KEYUP = &H2
    Const INPUT_KEYBOARD = 1
    Private Type KEYBDINPUT
      wVk As Integer
      wScan As Integer
      dwFlags As Long
      time As Long
      dwExtraInfo As Long
    End Type
    Private Type GENERALINPUT
      dwType As Long
      xi(0 To 23) As Byte
    End Type
    '刷新列表,取得所有的QQ聊天窗口
    Private Sub Command2_Click()
        List1.Clear
        
        Dim hwnd As Long
        hwnd = 1
        
        Dim i As Integer
        Dim S As String
        Dim str As String
        S = String(512, Chr(0))
          
        hwnd = FindWindow("TXGuiFoundation", vbNullString)
        '遍历窗口
        While (hwnd)
            GetClassName hwnd, ByVal S, Len(S) '取得窗口的类名
            '如果是QQ程序相关的窗口
            If Left(S, InStr(S, Chr(0)) - 1) = "TXGuiFoundation" Then
            
                '取得窗口的标题
                SendMessage hwnd, WM_GETTEXT, Len(S), ByVal S
                str = Left(S, InStr(S, Chr(0)) - 1)
                
                '过滤掉不需要的窗口,剩下的就是聊天窗口了(此处过滤可能不完整,如启动QQ时弹出的新闻框就没有过滤,根据需要修改)
                If Trim(str) <> "" And LCase(Left(Trim(str), 6)) <> "qq2009" And LCase(Trim(str)) <> "txfloatingwnd" And LCase(Trim(str)) <> "txmenuwindow" Then
                    '将聊天的窗口名称、窗口句柄加入到list1中
                    List1.AddItem S, 0
                    List1.ItemData(0) = hwnd
                    
                End If
        
            End If
            hwnd = GetWindow(hwnd, GW_HWNDNEXT)
        
        Wend
        If List1.ListCount > 0 Then List1.ListIndex = 0
      
    End Sub'根据选中列表中的某个对应的聊天窗口,发送消息
    Private Sub Command1_Click()
      
        'On Error Resume Next
        If List1.ListCount < 1 Then Exit Sub
        
        If Trim(Text1.Text) = "" Then
            MsgBox "发送内容不能为空!"
            Exit Sub
        End If
        
        '将text1中要发送的内容拷贝到剪贴板
        Clipboard.Clear
        Clipboard.SetText Text1.Text
        
        
        Dim hwnd As Long
        hwnd = 0
        '设置要发送的窗口
        hwnd = List1.ItemData(List1.ListIndex)
        If hwnd = 0 Then Exit Sub    ShowWindow hwnd, SW_RESTORE '如果窗口最小化,则将其恢复
        SetForegroundWindow hwnd    '置窗口到前台    '定义发送按键结构变量
        Dim GInput(0 To 3) As GENERALINPUT
        Dim KInput As KEYBDINPUT
        
        '构造CTRL+V
        KInput.wVk = VK_CONTROL
        KInput.dwFlags = 0
        GInput(0).dwType = INPUT_KEYBOARD
        CopyMemory GInput(0).xi(0), KInput, Len(KInput)
        
        KInput.wVk = VK_V
        KInput.dwFlags = 0
        GInput(1).dwType = INPUT_KEYBOARD
        CopyMemory GInput(1).xi(0), KInput, Len(KInput)
        
        KInput.wVk = VK_CONTROL
        KInput.dwFlags = KEYEVENTF_KEYUP
        GInput(2).dwType = INPUT_KEYBOARD
        CopyMemory GInput(2).xi(0), KInput, Len(KInput)
        
        KInput.wVk = VK_V
        KInput.dwFlags = KEYEVENTF_KEYUP
        GInput(3).dwType = INPUT_KEYBOARD
        CopyMemory GInput(3).xi(0), KInput, Len(KInput)
        
        SendInput 4, GInput(0), Len(GInput(0))  '发送Ctrl+V
      
         '构造CTRL+RETURN
        KInput.wVk = VK_CONTROL
        KInput.dwFlags = 0
        GInput(0).dwType = INPUT_KEYBOARD
        CopyMemory GInput(0).xi(0), KInput, Len(KInput)
        
        KInput.wVk = VK_RETURN
        KInput.dwFlags = 0
        GInput(1).dwType = INPUT_KEYBOARD
        CopyMemory GInput(1).xi(0), KInput, Len(KInput)
        
        KInput.wVk = VK_CONTROL
        KInput.dwFlags = KEYEVENTF_KEYUP
        GInput(2).dwType = INPUT_KEYBOARD
        CopyMemory GInput(2).xi(0), KInput, Len(KInput)
        
        KInput.wVk = VK_RETURN
        KInput.dwFlags = KEYEVENTF_KEYUP
        GInput(3).dwType = INPUT_KEYBOARD
        CopyMemory GInput(3).xi(0), KInput, Len(KInput)
        
        SendInput 4, GInput(0), Len(GInput(0))  '发送Ctrl+Return
      
      
    End Sub