Attribute VB_Name = "ModGetListView"
'*************************************************************************
'**模 块 名：ModGetListView
'**说    明：取得其它程序中ListView控件的内容
'**创 建 人：马大哈
'**日    期：2006年3月18日
'**描    述：摘于网络
'**版    本：V1.0
'*************************************************************************
Option Explicit

Public Const MEM_RELEASE = &H8000

Private Const LVM_FIRST As Long = &H1000
Private Const LVM_GETITEMCOUNT = (LVM_FIRST + 4)
Private Const LVM_GETITEMSTATE As Long = (LVM_FIRST + 44)

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 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 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 IsWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long

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 pMyItemMemory       As Long
    Dim pStrBufferMemory    As Long
    Dim strBuffer()         As Byte
    Dim index               As Long
    Dim tmpString           As String
    Dim strLength           As Long
    
    ReDim strBuffer(MAX_LVMSTRING)
    
    pHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, ProcessID)
    pStrBufferMemory = VirtualAllocEx(pHandle, 0, MAX_LVMSTRING, MEM_COMMIT, PAGE_READWRITE)
        
    myItem.mask = LVIF_TEXT
    myItem.iSubItem = pColumn
    myItem.pszText = pStrBufferMemory
    myItem.cchTextMax = MAX_LVMSTRING
    
    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)
      
    For index = LBound(strBuffer) To UBound(strBuffer)
        If Chr(strBuffer(index)) = vbNullChar Then Exit For
        tmpString = tmpString & Chr(strBuffer(index))
    Next index
    
    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

Public Function GetListviewItemEx(ByVal hWindow 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 pMyItemMemory       As Long
    Dim pStrBufferMemory    As Long
    Dim strBuffer()         As Byte
    Dim index               As Long
    Dim tmpString           As String
    Dim strLength           As Long
    Dim ProcessID           As Long
    Dim tmpI                As Long
    
    GetWindowThreadProcessId hWindow, ProcessID
    
    ReDim strBuffer(MAX_LVMSTRING)
    
    pHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, ProcessID)
    pStrBufferMemory = VirtualAllocEx(pHandle, 0, MAX_LVMSTRING, MEM_COMMIT, PAGE_READWRITE)
        
    myItem.mask = LVIF_TEXT
    myItem.iSubItem = pColumn
    myItem.pszText = pStrBufferMemory
    myItem.cchTextMax = MAX_LVMSTRING
    
    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)
      
    For index = LBound(strBuffer) To UBound(strBuffer)
        If Chr(strBuffer(index)) = vbNullChar Then Exit For
        tmpString = tmpString & Chr(strBuffer(index))
    Next index
    
    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 GetListviewItemEx = tmpString

End Function

Public Function GetListviewItemEx2(ByVal hWindow 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 pMyItemMemory       As Long
    Dim pStrBufferMemory    As Long
    Dim strBuffer()         As Byte
    Dim index               As Long
    Dim tmpString           As String
    Dim strLength           As Long
    Dim ProcessID           As Long
    Dim tmpI                As Long
    Dim tmpJ                As Long
    
    tmpJ = SendMessage(hWindow, LVM_GETITEMSTATE, ByVal pRow, ByVal 1)
    Debug.Print "LVM_GETITEMSTATE = " & tmpJ
    
    If tmpJ = 0 Then Exit Function          '没被选中的话,就返回
    
    GetWindowThreadProcessId hWindow, ProcessID
    
    ReDim strBuffer(MAX_LVMSTRING)
    
    pHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, ProcessID)
    pStrBufferMemory = VirtualAllocEx(pHandle, 0, MAX_LVMSTRING, MEM_COMMIT, PAGE_READWRITE)
        
    myItem.mask = LVIF_TEXT
    myItem.iSubItem = pColumn
    myItem.pszText = pStrBufferMemory
    myItem.cchTextMax = MAX_LVMSTRING
    
    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)           '在这里卡了不少时间,晕
    
    result = VirtualFreeEx(pHandle, pStrBufferMemory, 0, MEM_RELEASE)
    result = VirtualFreeEx(pHandle, pMyItemMemory, 0, MEM_RELEASE)
    
    result = CloseHandle(pHandle)
    
    If Len(tmpString) > 0 Then GetListviewItemEx2 = tmpString

End Function

Public Function GetLVItemm(ByVal hWindow As Long) As String
    '返回指定句柄的LV控件被选中项的内容(呃.....好难念.....)
    Dim tmpI As Long, tmpJ As Long
    Dim tmpStr As String
    
    If IsWindow(hWindow) = 0 Then Exit Function
    tmpI = SendMessage(hWindow, LVM_GETITEMCOUNT, ByVal 0, ByVal 0)
    Debug.Print "ItemCount = " & tmpI       '项总数
    
    For tmpJ = 0 To tmpI                    '穷举............由于在里面也只是SendMessage,应该不会有占资源的现象
        tmpStr = GetListviewItemEx2(hWindow, 0, tmpJ)
        If tmpStr <> "" Then Exit For
    Next tmpJ
    GetLVItemm = tmpStr
End Function