获取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
剩下的就是大家自由发挥的时间了。谢谢支持本人的小博!~