VB 获取外部LISTVIEW内容

VERSION 5.00
Begin VB.Form frmMain
   Caption         =   "Form1"
   ClientHeight    =   3090
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3090
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1
      Caption         =   "Command1"
      Height          =   975
      Left            =   1320
      TabIndex        =   0
      Top             =   1080
      Width           =   2415
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Const MEM_RELEASE = &H8000

Private Const LVM_FIRST = &H1000
Private Const LVM_GETHEADER = LVM_FIRST + 31
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 HDM_FIRST = &H1200
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 PAGE_READWRITE = &H4
Private Const LVIF_TEXT As Long = &H1

Private Const LVM_GETCOLUMNCOUNT = &HF11B

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 GetCurrentProcessId Lib "kernel32" () As Long

Private Function GetListViewTextArray(ByVal hWindow As Long, ByVal ProcessID 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
    Dim i As Integer, sum As Integer, j As Integer, hCount As Long
    Dim strArr() As String, itemString As String
    hCount = SendMessage(hWindow, LVM_GETHEADER, 0, 0)
    If hCount > 0 Then
        hCount = SendMessage(hCount, HDM_GETITEMCOUNT, 0, 0)
    Else
        hCount = 0
    End If
    ReDim strBuffer(MAX_LVMSTRING)
    pHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, ProcessID)
    ReDim myItem(hCount)
    For j = 0 To SendMessage(hWindow, LVM_GETITEMCOUNT, 0, 0) - 1
        For i = 0 To hCount
            pStrBufferMemory = VirtualAllocEx(pHandle, 0, MAX_LVMSTRING, MEM_COMMIT, PAGE_READWRITE)
            myItem(i).mask = LVIF_TEXT
            myItem(i).iSubItem = i
            myItem(i).pszText = pStrBufferMemory
            myItem(i).cchTextMax = MAX_LVMSTRING
            pMyItemMemory = VirtualAllocEx(pHandle, 0, Len(myItem(i)), MEM_COMMIT, PAGE_READWRITE)
            result = WriteProcessMemory(pHandle, pMyItemMemory, myItem(i), Len(myItem(i)), 0)
            result = SendMessage(hWindow, LVM_GETITEMTEXT, j, ByVal pMyItemMemory)
            If result = 0 Then
                result = VirtualFreeEx(pHandle, pStrBufferMemory, 0, MEM_RELEASE)
                result = VirtualFreeEx(pHandle, pMyItemMemory, 0, MEM_RELEASE)
                Exit For
            End If
            result = ReadProcessMemory(pHandle, pStrBufferMemory, strBuffer(0), MAX_LVMSTRING, 0)
            result = ReadProcessMemory(pHandle, pMyItemMemory, myItem(i), Len(myItem(i)), 0)
            tmpString = StrConv(strBuffer, vbUnicode)
            tmpString = Left(tmpString, InStr(tmpString, vbNullChar) - 1)
            itemString = itemString & tmpString & ","
            result = VirtualFreeEx(pHandle, pStrBufferMemory, 0, MEM_RELEASE)
            result = VirtualFreeEx(pHandle, pMyItemMemory, 0, MEM_RELEASE)
        Next
        ReDim Preserve strArr(0 To sum)
        strArr(j) = Left(itemString, Len(itemString) - 1)
        sum = sum + 1
        itemString = ""
    Next
    result = CloseHandle(pHandle)
    GetListViewTextArray = strArr
End Function

Private Sub Command1_Click()
    Dim itemStr() As String, i As Integer
   
    itemStr = GetListViewTextArray(frmListView.lvTest.hwnd, GetCurrentProcessId)

    For i = 0 To UBound(itemStr)
        MsgBox itemStr(i)
    Next
End Sub

Private Sub Form_Load()
    frmListView.Show
End Sub

 

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmListView
   Caption         =   "测试窗体"
   ClientHeight    =   5730
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   7425
   LinkTopic       =   "Form2"
   ScaleHeight     =   5730
   ScaleWidth      =   7425
   StartUpPosition =   3  '窗口缺省
   Begin MSComctlLib.ListView lvTest
      Height          =   4695
      Left            =   360
      TabIndex        =   0
      Top             =   480
      Width           =   6495
      _ExtentX        =   11456
      _ExtentY        =   8281
      View            =   3
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
End
Attribute VB_Name = "frmListView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Form_Load()
    With lvTest
        .ColumnHeaders.Add , , "序号"
        .ColumnHeaders.Add , , "名称"
        .ColumnHeaders.Add , , "性别"
        .ColumnHeaders.Add , , "年龄"
    End With
    AddToListview "陈辉", "男", "24"
    AddToListview "张三", "男", "22"
    AddToListview "李四", "女", "20"
    AddToListview "王二", "男", "31"
    AddToListview "麻子", "女", "18"
End Sub

Private Sub AddToListview(ByVal sName As String, sSex As String, ByVal sAge As String)
    Dim item As ListItem
    Set item = lvTest.ListItems.Add(, , CStr(lvTest.ListItems.Count + 1))
    item.SubItems(1) = sName
    item.SubItems(2) = sSex
    item.SubItems(3) = sAge
End Sub