获取QQ搜索结果 -- VB

VB编程 blackfeather

 

获取QQ搜索出来的结果,腾讯并没有提供保存成文本的功能。某大哥需要这个,就写了一个,基本原理就是获取远程进程中的listview的值。在VBGOOD中找的一个Function,然后直接引用了,不知道原作者是谁,就没有加版权。。。代码中注释很全(老师教育我们写代码要加注释),很容易看懂。

本来想做一个模块出来,但是发懒了,直接贴出来完成工程得了。。。

 

 程序截图:

 

 完整源代码下载地址:          获取QQ搜索结果

注:此代码只能工作在QQ08正式版。

 

我看到的代码最原始的是获取任务管理器的进程列表,需要先打开任务管理器,然后点中进程那个标签,运行代码就能获取到。我也贴出来代码:

    
Option Explicit

Private Const LVM_FIRST = &H1000
Private Const LVM_GETITEMCOUNT = (LVM_FIRST + 4)

Private Const LVM_GETITEM = (LVM_FIRST + 5)
Private Const LVM_GETSTRINGWIDTH = (LVM_FIRST + 17)
Private Const LVM_GETCOLUMN = (LVM_FIRST + 25)
Private Const LVM_GETITEMTEXT = (LVM_FIRST + 45)
Private Const LVM_GETHEADER = LVM_FIRST + 31
Private Const WC_HEADERA = "SysHeader32"
Private Const WC_HEADER = WC_HEADERA
Private Const HDM_FIRST = &H1200 '// Header messages
Private Const HDM_GETITEMCOUNT = (HDM_FIRST + 0)
Private Const HDM_ORDERTOINDEX = (HDM_FIRST + 15)

Private Const PROCESS_QUERY_INFORMATION = 1024
Private Const PROCESS_VM_OPERATION = &H8
Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_VM_WRITE = &H20
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const MAX_LVMSTRING As Long = 255 '可根椐读取数据长度设置适当的数值
Private Const MEM_COMMIT = &H1000
Private Const MEM_RELEASE = &H8000
Private Const PAGE_READWRITE = &H4
Private Const LVIF_TEXT As Long = &H1

Private Type LV_ITEMA
    mask As Long
    iItem As Long
    iSubItem As Long
    state As Long
    stateMask As Long
    pszText As Long
    cchTextMax As Long
    iImage As Long
    lParam As Long
    iIndent As Long
End Type

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
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 Sub Command1_Click()
    Dim lngHwnd As Long
    Dim lngHwnd1 As Long
    Dim lngHeaderHwnd As Long
    Dim lngPId As Long
    Dim lngRows As Long
    Dim lngCols As Long
    Dim lngRow As Long
    Dim lngCol As Long
    Dim strItem As String

    lngHwnd1 = FindWindow(vbNullString, "Windows 任务管理器") '获取任务管理器窗口句柄
    lngHwnd1 = FindWindowEx(lngHwnd1, 0, "#32770", "") '获取选项卡句柄
    lngHwnd = FindWindowEx(lngHwnd1, 0, "SysListView32", "进程") '获取进程列表框句柄
    Debug.Print lngHwnd
   
    lngHeaderHwnd = SendMessage(lngHwnd, LVM_GETHEADER, 0, 0) '获取ListView表头句柄
    lngRows = SendMessage(lngHwnd, LVM_GETITEMCOUNT, 0, 0) '获取ListView项目数
   
    If lngHeaderHwnd > 0 Then
        lngCols = SendMessage(lngHeaderHwnd, HDM_GETITEMCOUNT, 0, 0) '获取ListView表头项目数
    Else
        lngCols = 1
    End If
    GetWindowThreadProcessId lngHwnd, lngPId '获取与指定窗口关联在一起的一个进程和线程标识符
    For lngRow = 0 To lngRows - 1
        strItem = ""
        For lngCol = 0 To lngCols - 1
            strItem = strItem & vbTab & GetListviewItem(lngHwnd, lngPId, lngCol, lngRow)
        Next
        Debug.Print strItem
    Next
End Sub

Public Function GetListviewItem(ByVal hWindow As Long, ByVal ProcessID As Long, ByVal pColumn As Long, ByVal pRow As Long) As String
    Dim Result As Long
    Dim myItem As LV_ITEMA
    Dim pHandle As Long
    Dim pStrBufferMemory As Long
    Dim pMyItemMemory As Long
    Dim strBuffer() As Byte
    Dim Index As Long
    Dim tmpString As String
    Dim strLength As Long

    '******************************
    '为动态数组变量重新分配存储空间
    '******************************
    ReDim strBuffer(MAX_LVMSTRING)

    '*****************************************************************************************************
    '打开一个现有进程的句柄,返回值Long,如执行成功,返回进程句柄;零表示失败。会设置GetLastError
    'Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
    '参数 类型及说明
    'dwDesiredAccess Long,指定这个句柄要求的访问方法。指定API32.TXT文件中以PROCESS_???开头的一个或多个常数
    'bInheritHandle Long,如句柄能够由子进程继承,则为TRUE
    'dwProcessId Long,要打开那个进程的进程标识符
    '*****************************************************************************************************
    pHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, ProcessID)

    '*****************************************************************************************************
    'VirtualAllocEx(目标进程的句柄,0,内存区域的大小,分配类型,新分配内存的存取保护类型)返回所分配页面的基址
    '*****************************************************************************************************
    pStrBufferMemory = VirtualAllocEx(pHandle, 0, MAX_LVMSTRING, MEM_COMMIT, PAGE_READWRITE)

    '*************************************************
    '初始化LV_ITEM 结构
    'MyItem.iSubItem 列的索引号
    'myItem.pszText 数据内容(此处是一个分配的内存地址)
    '*************************************************
    myItem.mask = LVIF_TEXT
    myItem.iSubItem = pColumn
    myItem.pszText = pStrBufferMemory
    myItem.cchTextMax = MAX_LVMSTRING

    '***********************************************************
    '把这个结构写入远程进程process's 存储量
    'WriteProcessMemory(目标进程的句柄,地址,写入的数据,字节数,0)
    '***********************************************************
    pMyItemMemory = VirtualAllocEx(pHandle, 0, Len(myItem), MEM_COMMIT, PAGE_READWRITE)
    Result = WriteProcessMemory(pHandle, pMyItemMemory, myItem, Len(myItem), 0)

    '********************************
    '发送消息,得到项目信息和写入内存
    '********************************
    Result = SendMessage(hWindow, LVM_GETITEMTEXT, pRow, ByVal pMyItemMemory)
    Result = ReadProcessMemory(pHandle, pStrBufferMemory, strBuffer(0), MAX_LVMSTRING, 0)
    Result = ReadProcessMemory(pHandle, pMyItemMemory, myItem, Len(myItem), 0)

    '************************
    '把字节列阵变成串和送回它
    '************************

    tmpString = StrConv(strBuffer, vbUnicode)
    If InStr(tmpString, Chr$(0)) > 0 Then
        tmpString = Left$(tmpString, InStr(tmpString, Chr$(0)) - 1)
    End If

    tmpString = Trim$(tmpString)

    '****************************
    '释放分配的内存和关闭进程句柄
    '****************************
    Result = VirtualFreeEx(pHandle, pStrBufferMemory, 0, MEM_RELEASE)
    Result = VirtualFreeEx(pHandle, pMyItemMemory, 0, MEM_RELEASE)

    Result = CloseHandle(pHandle)

    If Len(tmpString) > 0 Then GetListviewItem = tmpString

End Function

 

剩下的就是大家自由发挥的时间了。谢谢支持本人的小博!~

 

 

评论列表:

张三
……这个,很强大。虽然看不懂,不过貌似比QQ自带的强
张三2009/12/7 17:58:59 回复
CHENOE
您好!我是CHENOE安全实验室的负责人,想寻求合作。不知您是否能够留下您的联系方式(QQ)。
CHENOE2009/11/27 22:30:56 回复

发表评论: