获取QQ群用户列表

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 '窗口缺省
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
EnumWindows AddressOf EnumWindowsProc, ByVal 0&
End Sub
modGetListViewText.bas
Attribute VB_Name = "modGetListViewText"
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
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, 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
modPublic.bas
Attribute VB_Name = "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