zoukankan      html  css  js  c++  java
  • 获取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
  • 相关阅读:
    如何只通过Sandboxed Solution启动一个定时执行的操作
    创建与SharePoint 2010风格一致的下拉菜单 (续) 整合Feature Custom Action框架
    创建与SharePoint 2010风格一致的下拉菜单
    《SharePoint 2010 应用程序开发指南》第二章预览
    SharePoint 2013 App 开发 (1) 什么是SharePoint App?
    使用Jscex增强SharePoint 2010 JavaScript Client Object Model (JSOM)
    搜索范围的管理
    SharePoint 2010 服务应用程序(Service Application)架构(1)
    SharePoint 2010 服务应用程序(Service Application)架构(2)
    SharePoint 2013 App 开发 (2) 建立开发环境
  • 原文地址:https://www.cnblogs.com/szyicol/p/599726.html
Copyright © 2011-2022 走看看