VB VBA遍历指定窗体所有控件

2017-09-20 08:00:00
硬软兼得的博客
转贴
944

用VB 遍历 指定程序窗口下 所有控件的句柄及控件中的文字

就是读取另一个程序里标签显示的文字代码...
当前前提是知道窗口句柄以及控件句柄才能读取到

1. 标签有句柄,是由 SetWindowText 实现的(其实从底层一点看,还是发送了 WM_SETTEXT 消息),
例如VC、Masm 32 的程序。这种情况好解决,GetWindowText 或 发送WM_GETTEXT消息就OK了;

2. TextOut 画上去的(例如 VB 就是这样的)。这种情况要 hook TextOut;


GetWindowText()或SendMessage()都无法取得vb程序的label的文字,因为vb的label没有handle, 但大家发现 KingSoft CIBA 可以取得vb的label值,这是因为 KingSoft CIBA 拦下了Win32API中的textOut函数


用VB调用API函数 遍历窗口下所有控件及取它的文本内容


Private Const GW_CHILD = 5
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDNEXT = 2

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


Private Sub FillChild(hWndParent As Long)
Dim hWndChild As Long
Dim szCaption As String
Dim buffer As String
Dim i As Long

hWndChild = GetWindow(hWndParent, GW_CHILD)
If (hWndChild = 0) Then Exit Sub
hWndChild = GetWindow(hWndChild, GW_HWNDFIRST)
If hWndChild = 0 Then Exit Sub

While (hWndChild <> 0)
szCaption = String$(255, 0)
GetClassName hWndChild, szCaption, 250
szCaption = Left$(szCaption, InStr(szCaption, String$(1, 0)) - 1)
buffer = CStr(hWndChild) & "--" & szCaption
i = GetWindowTextLength(hWndChild)
szCaption = String$(255, 0)
GetWindowText hWndChild, szCaption, 250
szCaption = Left$(szCaption, i)
buffer = buffer & "--" & szCaption

List1.AddItem buffer
FillChild hWndChild
hWndChild = GetWindow(hWndChild, GW_HWNDNEXT)
Wend
End Sub

Private Sub GetChildWindow(hwnd As Long)
Dim szCaption As String
Dim buffer As String

Dim i As Long


List1.Clear
szCaption = String$(255, 0)
GetClassName hwnd, szCaption, 250
szCaption = Left$(szCaption, InStr(szCaption, String$(1, 0)) - 1)

buffer = CStr(hwnd)
buffer = buffer & "--" & szCaption
i = GetWindowTextLength(hwnd)
szCaption = String$(255, 0)
GetWindowText hwnd, szCaption, 250
szCaption = Left$(szCaption, i)
buffer = buffer & "--" & szCaption
List1.AddItem buffer
FillChild hwnd
End Sub

调用方法
GetChildWindow hwnd'hwnd是指定的窗口句柄

结果以

窗体句柄--窗体类名称--窗体Text

形式列在列表框List1中,没时间放到TreeView里了

只能获取有句柄项的内容,VB的Label是获取不到的,这个只能做拦截
VC的STATIC上内容可以被获取
Text的内容也无法获取,这个要靠 WM_GETTEXT来获取
Button的内容可获取

 

 

 

===

 

添加一个按钮,一个listview,代码如下,保证好用

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
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 GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long


Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type
Private Type mType '自定义数据类型
   fhwnd As Long '窗口句柄
   fText As String * 255 '窗口标题
   fRect As RECT '窗口矩形
   pHwnd As Long '父窗句柄
   pText As String * 255 '父窗标题
End Type

Private Sub mGetAllWindow(m_Type() As mType) '获取控件信息,写成SUB了,其实用FUNCTION返回值也可以,只是函数里面定义就多了,总的来看需要2个mType数组,这样做只需要一个,占用空间小了

   Dim Wndback As Long '上一个被查找的目标句柄
   Dim i As Long '数组控制
   Do
        ReDim Preserve m_Type(i)
        DoEvents
        m_Type(i).fhwnd = FindWindowEx(0, Wndback, vbNullString, vbNullString) '获取hwnd,第一个参数指定为0,查找桌面子窗口,第2个参数是开始查找的窗口,第34个参数使函数查找所有窗口
        If m_Type(i).fhwnd = 0 Then '=0时已经查找一遍了,退出
            Exit Sub
        Else '否则获取控件相关消息
            GetWindowText m_Type(i).fhwnd, m_Type(i).fText, 255 '获取标题
            GetWindowRect m_Type(i).fhwnd, m_Type(i).fRect '获取RECT
            m_Type(i).pHwnd = GetParent(m_Type(i).fhwnd) '获取父HWND
            GetWindowText m_Type(i).pHwnd, m_Type(i).pText, 255 '获取父标题
        End If
        Wndback = m_Type(i).fhwnd '保存上一个查的句柄
        i = i + 1
   Loop
End Sub

Private Sub Command1_Click()
   Dim cType() As mType
   mGetAllWindow cType()
   Dim i As Long
   ListView1.ListItems.Clear
   For i = LBound(cType) To UBound(cType)
     ListView1.ListItems.Add , "a" & i, cType(i).fhwnd
     ListView1.ListItems("a" & i).SubItems(1) = cType(i).fText
     ListView1.ListItems("a" & i).SubItems(2) = cType(i).fRect.Left
     ListView1.ListItems("a" & i).SubItems(3) = cType(i).fRect.Bottom
     ListView1.ListItems("a" & i).SubItems(4) = cType(i).fRect.Top
     ListView1.ListItems("a" & i).SubItems(5) = cType(i).fRect.Right
     ListView1.ListItems("a" & i).SubItems(6) = cType(i).pHwnd
     ListView1.ListItems("a" & i).SubItems(7) = cType(i).pText
   Next
End Sub

Private Sub Form_Load()
   ListView1.ColumnHeaders.Add , , "句柄", 1200
   ListView1.ColumnHeaders.Add , , "标题", 2800
   ListView1.ColumnHeaders.Add , , "Rect.Left", 800
   ListView1.ColumnHeaders.Add , , "Rect.Bottom", 800
   ListView1.ColumnHeaders.Add , , "Rect.Top", 800
   ListView1.ColumnHeaders.Add , , "Rect.Right", 800
   ListView1.ColumnHeaders.Add , , "父窗句柄", 1200
   ListView1.ColumnHeaders.Add , , "父窗标题", 2800
   ListView1.View = lvwReport
   ListView1.FullRowSelect = True
   Command1.Caption = "刷新"
End Sub
 

EnumWindows
getwindowtext
分享