首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

各位各位,大家有什么好方法获取在线QQ号合和昵称?小弟我用枚举托盘托标然后判断前三位,但是有小毛病

2013-03-17 
各位各位,大家有什么好方法获取在线QQ号合和昵称?我用枚举托盘托标然后判断前三位,但是有小毛病!根据下面

各位各位,大家有什么好方法获取在线QQ号合和昵称?我用枚举托盘托标然后判断前三位,但是有小毛病!
根据下面枚举托盘托标方法(网传),可以得到托盘句柄 lngHwnd,托盘图标文字strtext,然后用left函数判断前三位是否为"QQ:",如果是,就说明是QQ的句柄,再输出其 strtext 即可得到规则如  "QQ: qq昵称(qq号码)" 这样的一段字符串,然后将这个字符串用函数分离即可得到对应的QQ号码和名字,but,问题出来了,假如你只有一个QQ在线,刚好,这个QQ又有别人发信息给你,也就是有头像在闪烁,那么,再次得到该 托盘句柄不变,但是,得到的托盘托标strtext却成了空值了,无法显示出登陆的QQ号和昵称了
个人感觉,应该是腾讯对信息加密保护的问题吧。大家有其他办法获取在线的QQ号和昵称吗?求方法!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!或者有办法改这段代码让QQ有头像在闪烁的情况下也能获取也可以,求!!!!!!!!!!!













Option Explicit
Private Declare Function OpenProcess Lib "KERNEL32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "KERNEL32" (ByVal hObject As Long) As Long
Private Const READ_CONTROL As Long = &H20000
Private Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000
Private Const STANDARD_RIGHTS_READ As Long = (READ_CONTROL)
Private Const STANDARD_RIGHTS_EXECUTE As Long = (READ_CONTROL)
Private Const STANDARD_RIGHTS_ALL As Long = &H1F0000
Private Const STANDARD_RIGHTS_WRITE As Long = (READ_CONTROL)
Private Const SYNCHRONIZE As Long = &H100000
Private Const PROCESS_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)
Private Const PROCESS_TERMINATE As Long = (&H1)
Private Declare Function GetWindowThreadProcessId Lib "user32.dll" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Const WM_USER As Long = &H400
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 Const TB_BUTTONCOUNT As Long = (WM_USER + 24)
Private Const TB_HIDEBUTTON As Long = (WM_USER + 4)
Private Const TB_GETBUTTON As Long = (WM_USER + 23)
Private Const TB_GETBITMAP As Long = (WM_USER + 44)
Private Const TB_DELETEBUTTON As Long = (WM_USER + 22)
Private Const TB_ADDBUTTONS As Long = (WM_USER + 20)
Private Const TB_INSERTBUTTON As Long = (WM_USER + 21)
Private Const TB_ISBUTTONHIDDEN As Long = (WM_USER + 12)
Private Const ILD_NORMAL As Long = &H0
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function WriteProcessMemory Lib "kernel32.dll" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long


Private Declare Function ReadProcessMemory Lib "kernel32.dll" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32.dll" (ByVal hProcess As Long, lpAddress As Any, ByRef dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32.dll" (ByVal hProcess As Long, lpAddress As Any, ByRef dwSize As Long, ByVal dwFreeType As Long) As Long
Private Const PROCESS_VM_OPERATION As Long = (&H8)
Private Const PROCESS_VM_READ As Long = (&H10)
Private Const PROCESS_VM_WRITE As Long = (&H20)
Private Const MEM_RESERVE As Long = &H2000
Private Const MEM_COMMIT As Long = &H1000
Private Const MEM_RELEASE As Long = &H8000
Private Const PAGE_READWRITE As Long = &H4
Private strText As String

Private Sub Form_Load()



    Dim lngTemp As Long
    Dim lngTray
    Dim lngPID As Long
    Dim lngPID2 As Long
    Dim hProcess As Long
    Dim lngProcess As Long
    Dim lngAddress As Long
    Dim lngCount As Long
    Dim lngButtons As Long
    Dim ret As Long
    Dim lngTextAdr As Long
    Dim lngHwndAdr As Long
    Dim lngButtonID As Long
    Dim hIcon As Long
    Dim lngHwnd As Long
    Dim lpFileName As String * 1024
    Dim i As Long
    Dim strBuff(1024) As Byte
  
    Dim lngTrayDC As Long
    lngTemp = FindWindow("Shell_TrayWnd", vbNullString)
    lngTemp = FindWindowEx(lngTemp, 0, "TrayNotifyWnd", vbNullString)
    lngTemp = FindWindowEx(lngTemp, 0, "SysPager", vbNullString)
    lngTray = FindWindowEx(lngTemp, 0, "ToolbarWindow32", vbNullString)
    Debug.Print "lngTray="; lngTray
    ret = GetWindowThreadProcessId(lngTray, lngPID)
    hProcess = OpenProcess(PROCESS_ALL_ACCESS Or PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0, lngPID)
    lngAddress = VirtualAllocEx(hProcess, ByVal 0&, ByVal 4096&, MEM_COMMIT, PAGE_READWRITE)
    lngButtons = SendMessage(lngTray, TB_BUTTONCOUNT, 0, 0)

    For i = 0 To lngButtons - 1
        ret = SendMessage(lngTray, TB_GETBUTTON, ByVal i, ByVal lngAddress)


        ret = ReadProcessMemory(hProcess, ByVal lngAddress + 16, ByVal VarPtr(lngTextAdr), ByVal 4, ByVal 0&)
        If lngTextAdr <> -1 Then
            ret = ReadProcessMemory(hProcess, ByVal lngTextAdr, ByVal VarPtr(strBuff(0)), ByVal 1024, ByVal 0&)
            ret = ReadProcessMemory(hProcess, ByVal lngAddress + 12, ByVal VarPtr(lngHwndAdr), ByVal 4, ByVal 0&)
            ret = ReadProcessMemory(hProcess, ByVal lngHwndAdr, ByVal VarPtr(lngHwnd), ByVal 4, ByVal 0&)
            ret = ReadProcessMemory(hProcess, ByVal lngAddress + 4, ByVal VarPtr(lngButtonID), ByVal 4, ByVal 0&)

            strText = ConverNull(strBuff)
            'lngHwnd
            
            'strText 托盘图标文字
            List1.AddItem lngHwnd & " - " & strText
        End If
    Next i
    VirtualFreeEx hProcess, ByVal lngAddress, ByVal 4096&, MEM_RELEASE
    CloseHandle hProcess
End Sub
Function ConverNull(ByVal s As String) As String
    Dim nullpos As Long
    nullpos = InStr(s, Chr$(0))
    If nullpos > 0 Then
        ConverNull = Left(s, nullpos - 1)
    Else
        ConverNull = s
    End If
End Function

[解决办法]
楼上是否有好的方法,拿出来大家分享一下多好
[解决办法]
楼上,你的楼上就是我,楼主本人,代码已贴出来了,就那个代码能直接获取到在线QQ号和昵称
[解决办法]
如果不是非要用QQ的话,可以试试WEBQQ,网上有很多WEBQQ的协议
[解决办法]
这个确实不好办。。。

热点排行