获取QQ群用户列表

窗体源码:

Private Sub Form_Load()
   EnumWindows AddressOf EnumWindowsProc, ByVal 0&
End Sub

模块(modGetListViewText)源码:
Option Explicit

Private Const MEM_RELEASE = &H8000

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 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

Public 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
   Dim strArr() As String, itemString As String
       
   ReDim strBuffer(MAX_LVMSTRING)
   pHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, ProcessID)
   ReDim myItem(100)
   For j = 0 To SendMessage(hWindow, LVM_GETITEMCOUNT, 0, 0) - 1
       For i = 0 To 99
           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


模块(modPublic)源码:
Option Explicit
Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5
Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Boolean
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long

Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
   Dim h As Long, strArr() As String, pid As Long, i As Integer
   If InStr(GetWindowCaption(hwnd), "情报局 - 群") Then
       FindControlHwndByClsName hwnd, "SysListView32", h
       GetWindowThreadProcessId hwnd, pid
       If h <> 0 Then
           strArr = GetListViewTextArray(h, pid)
           For i = 0 To UBound(strArr)
               MsgBox strArr(i)
           Next
       End If
   End If
   EnumWindowsProc = True
End Function

Private Function GetWindowCaption(ByVal hwnd As Long) As String
   Dim strText As String, ret As Long
   ret = GetWindowTextLength(hwnd)
   If ret > 0 Then
       strText = Space(ret)
       GetWindowText hwnd, strText, ret + 1
       strText = Left(strText, ret)
       GetWindowCaption = strText
   Else
       GetWindowCaption = ""
   End If
End Function

Private Function FindControlHwndByCaption(ByVal nHwnd As Long, ByVal findStr As String, outHwnd As Long)
   Dim fHwnd As Long, myStr As String, sHwnd As Long
   fHwnd = GetWindow(nHwnd, GW_CHILD)
   If fHwnd = 0 Then Exit Function
   Do While fHwnd > 0
       myStr = String(100, Chr$(0))
       GetWindowText fHwnd, myStr, 100
       
       If Left(myStr, InStr(myStr, Chr$(0)) - 1) = findStr Then
           outHwnd = fHwnd
           Exit Function
       End If
       sHwnd = GetWindow(fHwnd, GW_CHILD)
       If sHwnd > 0 Then
           FindControlHwndByCaption fHwnd, findStr, outHwnd
       End If
       fHwnd = GetWindow(fHwnd, GW_HWNDNEXT)
   Loop
End Function

Private Function FindControlHwndByClsName(ByVal nHwnd As Long, ByVal clsName As String, outHwnd As Long)
   Dim fHwnd As Long, myStr As String, sHwnd As Long, ret As Long, iss As Boolean
   fHwnd = GetWindow(nHwnd, GW_CHILD)
   If fHwnd = 0 Then Exit Function
   Do While fHwnd > 0
       myStr = String(100, Chr$(0))
       GetClassName fHwnd, myStr, 100
       If Left(myStr, InStr(myStr, Chr$(0)) - 1) = clsName Then
           outHwnd = fHwnd
           Exit Function
       End If
       sHwnd = GetWindow(fHwnd, GW_CHILD)
       If sHwnd > 0 Then
           FindControlHwndByClsName fHwnd, clsName, outHwnd
       End If
       fHwnd = GetWindow(fHwnd, GW_HWNDNEXT)
   Loop
End Function

你可能感兴趣的:(qq)