获取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 > t>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


 
目前有0条回应
Comment
Trackback
你目前的身份是游客,请输入昵称和电邮!