VB VBA遍历指定窗体所有控件
- 2017-09-20 08:00:00
- 硬软兼得的博客 转贴
- 12272
用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
Access数据库自身
- office课程播放地址及课程明细
- Excel Word PPT Access VBA等Office技巧学习平台
- 将( .accdb) 文件格式数据库转换为早期版本(.mdb)的文件格式
- 将早期的数据库文件格式(.mdb)转换为 (.accdb) 文件格式
- KB5002984:配置 Jet Red Database Engine 数据库引擎和访问连接引擎以阻止对远程数据库的访问(remote table)
- Access 365 /Access 2019 数据库中哪些函数功能和属性被沙箱模式阻止(如未启动宏时)
- Access Runtime(运行时)最全的下载(2007 2010 2013 2016 2019 Access 365)
Access Activex第三方控件
- Activex控件或Dll 在某些电脑无法正常注册的解决办法(regsvr32注册时卡住)
- office使用部分控件时提示“您没有使用该ActiveX控件许可的问题”的解决方法
- RTF文件(富文本格式)的一些解析
- Access树控件(treeview) 64位Office下出现横向滚动条不会自动定位的解决办法
- Access中国树控件 在win10电脑 节点行间距太小的解决办法
- EXCEL 2019 64位版(Office 2019 64位)早就支持64位Treeview 树控件 ListView列表等64位MSCOMMCTL.OCX控件下载
- VBA或VB6调用WebService(直接Post方式)并解析返回的XML
Access ADP Sql Server等
- 早期PB程序连接Sqlserver出现错误
- MMC 不能打开文件C:/Program Files/Microsoft SQL Server/80/Tools/Binn/SQL Server Enterprise Manager.MSC 可能是由于文件不存在,不是一个MMC控制台,或者用后来的MMC版
- sql server连接不了的解决办法
- localhost与127.0.0.1区别
- Roych的浅谈数据库开发系列(Sql Server)
- sqlserver 自动备份对备份目录没有存取权限的解决办法
- 安装Sql server 2005 express 和SQLServer2005 Express版企业管理器 SQLServer2005_SSMSEE
文章分类
联系我们
联系人: | 王先生 |
---|---|
Email: | 18449932@qq.com |
QQ: | 18449932 |
微博: | officecn01 |