Foxtable(狐表)用户栏目专家坐堂 → 能给QQ发信息么?


  共有10652人关注过本帖树形打印复制链接

主题:能给QQ发信息么?

帅哥哟,离线,有人找我吗?
lihe60
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:狐神 帖子:6887 积分:43621 威望:0 精华:0 注册:2009/3/2 14:07:00
能给QQ发信息么?  发帖心情 Post By:2012/7/19 15:57:00 [只看该作者]

能给QQ发信息么?注意,不是发邮箱。

 回到顶部
帅哥哟,离线,有人找我吗?
狐狸爸爸
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:管理员 帖子:47497 积分:251403 威望:0 精华:91 注册:2008/6/17 17:14:00
  发帖心情 Post By:2012/7/19 15:59:00 [只看该作者]

不知道,你搜搜百度vb.net给QQ发信息。

 回到顶部
帅哥哟,离线,有人找我吗?
lihe60
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:狐神 帖子:6887 积分:43621 威望:0 精华:0 注册:2009/3/2 14:07:00
  发帖心情 Post By:2012/7/20 7:40:00 [只看该作者]

如果你已经开启QQ就可以
这样写
Shell Environ("PROGRAMFILES") & "\Internet Explorer\iexplore.exe  " & "Tencent://Message/?Menu=YES&Exe=&Uin=" & Text1.Text, vbNormalFocus
Text1.Text就是你输入想要聊天的对象的QQ号
不需要加对方为好友就可以聊天
如果没有就回谈出无效网页

 

 

如何转换成狐表可执行的语句?


 回到顶部
帅哥哟,离线,有人找我吗?
lihe60
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:狐神 帖子:6887 积分:43621 威望:0 精华:0 注册:2009/3/2 14:07:00
  发帖心情 Post By:2012/7/20 7:52:00 [只看该作者]

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 Long
Private 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 = 9
Const 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)) <> "qq2010" 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


 回到顶部
帅哥哟,离线,有人找我吗?
lihe60
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:狐神 帖子:6887 积分:43621 威望:0 精华:0 注册:2009/3/2 14:07:00
  发帖心情 Post By:2012/7/20 7:59:00 [只看该作者]

http://www.cnblogs.com/flourish/articles/189302.html

 回到顶部
帅哥哟,离线,有人找我吗?
hanxuntx
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:九尾狐 帖子:2609 积分:16926 威望:0 精华:11 注册:2011/9/20 16:13:00
  发帖心情 Post By:2012/7/20 9:19:00 [只看该作者]

试验成功了吗?

期待更完整的例子。

是不是只有加为好友才可以

那能不能给qq传文件呢?

 

这个功能其实很重要

因为现在很多公司靠qq做业务联系的

但是这些qq号有保密的需求

不想让操作员看到

 

如果能实现的话,这个功能非常实用


 回到顶部
帅哥哟,离线,有人找我吗?
lihe60
  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:狐神 帖子:6887 积分:43621 威望:0 精华:0 注册:2009/3/2 14:07:00
  发帖心情 Post By:2012/7/20 10:35:00 [只看该作者]

我的意思是问有没有高手转换成狐表可执行的语句。


 回到顶部
帅哥哟,离线,有人找我吗?
  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:三尾狐 帖子:732 积分:5491 威望:0 精华:14 注册:2011/8/28 12:49:00
  发帖心情 Post By:2012/7/20 12:20:00 [只看该作者]

Dim ObjIE As New Windows.Forms.WebBrowser

ObjIE.Navigate("tencent://message/?uin=QQ号码")

ObjIE.Dispose()

 

'可以用以上代码打开与某个人的QQ会话窗口,将里面的QQ号码替换为实际的QQ号就可以了,但是不能自动发消息的

我在这里用过这个东西

http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&Id=16302

 

[此贴子已经被作者于2012-7-20 12:23:49编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
lihe60
  9楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:狐神 帖子:6887 积分:43621 威望:0 精华:0 注册:2009/3/2 14:07:00
  发帖心情 Post By:2012/7/20 13:03:00 [只看该作者]

这个能打开QQ窗口,若能直接发信息就OK了。


 回到顶部
帅哥哟,离线,有人找我吗?
lihe60
  10楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:狐神 帖子:6887 积分:43621 威望:0 精华:0 注册:2009/3/2 14:07:00
  发帖心情 Post By:2012/7/20 13:29:00 [只看该作者]

以下是引用lihe60在2012-7-20 7:52:00的发言:

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 Long
Private 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 = 9
Const 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)) <> "qq2010" 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

这组代码发,有哪位高手可转换成狐表可执行的语句?


 回到顶部
总数 16 1 2 下一页