VB6获取Chrome地址栏的URL信息

上篇写到了获取IE8浏览器URL的一般方法,那这篇就写下chrome的URL怎么获取。事实上,早期的chrome版本可以通过跟IE8差不多方式获取到URL信息。但是,现在chrome的控件都是DirectUI画出来的,所有就没有一般意义上hwnd可以取。网上搜索了下,大多数都倾向于使用MSAA(Microsoft Active Accessibility)这种途径来实现。感兴趣的同学可以搜索下MSAA,这是一个很有用的技术(因为不懂,我也就不多说了)。

 

基于MSAA思想,windows下的UI程序都可以提供一种可供遍历访问的接口。而界面上各个控件都处于类似于树的逻辑结构中,这使得第三方自动化控制成为了可能。而MSAA是以COM形式存在,使用时只需要在“引用”中添加即可,非常方便。

可能初次接触MSAA的同学还不能很好理解,关于UI结构的说明。但仔细思考下,本文这样的遍历和上篇根据hwnd的遍历其实原理上是差不多的。

 

实现代码如下:

  1 '使用IAccessible接口之前,请先引用Accessibility(oleacc.dll)
  2 '代码参考了很多网上代码,多数原作者无从考究,在此也就不列出了(请见谅)
  3 '@Advanced Miscrosoft Visual Basci 6.0
  4 'code by lichmama from cnblogs.com
  5 Private Type UUID
  6     Data1 As Long
  7     Data2 As Integer
  8     Data3 As Integer
  9     Data4(7) As Byte
 10 End Type
 11  
 12 Private Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hwnd As Long, _
 13     ByVal dwObjectID As Long, _
 14     ByRef riid As UUID, _
 15     ByRef ppvObject As Any) As Long
 16      
 17 Private Declare Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As IAccessible, _
 18     ByVal iChildStart As Long, _
 19     ByVal cChildren As Long, _
 20     rgvarChildren As Variant, _
 21     pcObtained As Long) As Long
 22     
 23 '其实这一部分对整个程序来说没什么作用,在此列出仅仅方便别人查阅
 24 Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
 25     ByVal lpWindowName As String) As Long
 26     
 27 Private Enum NVADIRConstants
 28     NAVDIR_MIN = 0
 29     NAVDIR_UP = 1
 30     NAVDIR_DOWN = 2
 31     NAVDIR_LEFT = 3
 32     NAVDIR_RIGHT = 4
 33     NAVDIR_NEXT = 5
 34     NAVDIR_PREVIOUS = 6
 35     NAVIDR_FIRSTCHILD = 7
 36     NAVDIR_LASTCHILD = 8
 37     NAVDIR_MAX = 9
 38 End Enum
 39 
 40 'IAccessible Object Types
 41 Private Const CHILDID_SELF As Long = 0&
 42 Private Const ROLE_SYSTEM_TITLEBAR As Long = &H1&
 43 Private Const ROLE_SYSTEM_MENUBAR As Long = &H2&
 44 Private Const ROLE_SYSTEM_SCROLLBAR As Long = &H3&
 45 Private Const ROLE_SYSTEM_GRIP As Long = &H4&
 46 Private Const ROLE_SYSTEM_SOUND As Long = &H5&
 47 Private Const ROLE_SYSTEM_CURSOR As Long = &H6&
 48 Private Const ROLE_SYSTEM_CARET As Long = &H7&
 49 Private Const ROLE_SYSTEM_ALERT As Long = &H8&
 50 Private Const ROLE_SYSTEM_WINDOW As Long = &H9&
 51 Private Const ROLE_SYSTEM_CLIENT As Long = &HA&
 52 Private Const ROLE_SYSTEM_MENUPOPUP As Long = &HB&
 53 Private Const ROLE_SYSTEM_MENUITEM As Long = &HC&
 54 Private Const ROLE_SYSTEM_TOOLTIP As Long = &HD&
 55 Private Const ROLE_SYSTEM_APPLICATION As Long = &HE&
 56 Private Const ROLE_SYSTEM_DOCUMENT As Long = &HF&
 57 Private Const ROLE_SYSTEM_PANE As Long = &H10&
 58 Private Const ROLE_SYSTEM_CHART As Long = &H11&
 59 Private Const ROLE_SYSTEM_DIALOG As Long = &H12&
 60 Private Const ROLE_SYSTEM_BORDER As Long = &H13&
 61 Private Const ROLE_SYSTEM_GROUPING As Long = &H14&
 62 Private Const ROLE_SYSTEM_SEPARATOR As Long = &H15&
 63 Private Const ROLE_SYSTEM_TOOLBAR As Long = &H16&
 64 Private Const ROLE_SYSTEM_STATUSBAR As Long = &H17&
 65 Private Const ROLE_SYSTEM_TABLE As Long = &H18&
 66 Private Const ROLE_SYSTEM_COLUMNHEADER As Long = &H19&
 67 Private Const ROLE_SYSTEM_ROWHEADER As Long = &H1A&
 68 Private Const ROLE_SYSTEM_COLUMN As Long = &H1B&
 69 Private Const ROLE_SYSTEM_ROW As Long = &H1C&
 70 Private Const ROLE_SYSTEM_CELL As Long = &H1D&
 71 Private Const ROLE_SYSTEM_LINK As Long = &H1E&
 72 Private Const ROLE_SYSTEM_HELPBALLOON As Long = &H1F&
 73 Private Const ROLE_SYSTEM_CHARACTER As Long = &H20&
 74 Private Const ROLE_SYSTEM_LIST As Long = &H21&
 75 Private Const ROLE_SYSTEM_LISTITEM As Long = &H22&
 76 Private Const ROLE_SYSTEM_OUTLINE As Long = &H23&
 77 Private Const ROLE_SYSTEM_OUTLINEITEM As Long = &H24&
 78 Private Const ROLE_SYSTEM_PAGETAB As Long = &H25&
 79 Private Const ROLE_SYSTEM_PROPERTYPAGE As Long = &H26&
 80 Private Const ROLE_SYSTEM_INDICATOR As Long = &H27&
 81 Private Const ROLE_SYSTEM_GRAPHIC As Long = &H28&
 82 Private Const ROLE_SYSTEM_STATICTEXT As Long = &H29&
 83 Private Const ROLE_SYSTEM_TEXT As Long = &H2A&
 84 Private Const ROLE_SYSTEM_PUSHBUTTON As Long = &H2B&
 85 Private Const ROLE_SYSTEM_CHECKBUTTON As Long = &H2C&
 86 Private Const ROLE_SYSTEM_RADIOBUTTON As Long = &H2D&
 87 Private Const ROLE_SYSTEM_COMBOBOX As Long = &H2E&
 88 Private Const ROLE_SYSTEM_DROPLIST As Long = &H2F&
 89 Private Const ROLE_SYSTEM_PROGRESSBAR As Long = &H30&
 90 Private Const ROLE_SYSTEM_DIAL As Long = &H31&
 91 Private Const ROLE_SYSTEM_HOTKEYFIELD As Long = &H32&
 92 Private Const ROLE_SYSTEM_SLIDER As Long = &H33&
 93 Private Const ROLE_SYSTEM_SPINBUTTON As Long = &H34&
 94 Private Const ROLE_SYSTEM_DIAGRAM As Long = &H35&
 95 Private Const ROLE_SYSTEM_ANIMATION As Long = &H36&
 96 Private Const ROLE_SYSTEM_EQUATION As Long = &H37&
 97 Private Const ROLE_SYSTEM_BUTTONDROPDOWN As Long = &H38&
 98 Private Const ROLE_SYSTEM_BUTTONMENU As Long = &H39&
 99 Private Const ROLE_SYSTEM_BUTTONDROPDOWNGRID As Long = &H3A&
100 Private Const ROLE_SYSTEM_WHITESPACE As Long = &H3B&
101 Private Const ROLE_SYSTEM_PAGETABLIST As Long = &H3C&
102 Private Const ROLE_SYSTEM_CLOCK As Long = &H3D&
103 Private IID_IAccessible As UUID
104 Private Declare Function GetTickCount Lib "kernel32" () As Long
105 
106 Private Sub Form_Initialize()
107     With IID_IAccessible
108         .Data1 = &H618736E0
109         .Data2 = &H3C3D
110         .Data3 = &H11CF
111         .Data4(0) = &H81
112         .Data4(1) = &HC
113         .Data4(2) = &H0
114         .Data4(3) = &HAA
115         .Data4(4) = &H0
116         .Data4(5) = &H38
117         .Data4(6) = &H9B
118         .Data4(7) = &H71
119     End With
120 End Sub
121 
122 'using like: GetChromeUrl(FindWindow("Chrome_WidgetWin_1", vbNullString))
123 Private Function GetChromeUrl(ByVal hwnd As Long) As String
124     Dim objAcc As IAccessible
125 
126     Call AccessibleObjectFromWindow(hwnd, 0&, IID_IAccessible, objAcc)
127     If objAcc Is Nothing Then
128         Debug.Print "access failed"
129         Exit Function
130     End If
131     
132     GetChromeUrl = ViewAcc(objAcc)
133 End Function
134 
135 Private Function ViewAcc(ByVal objAcc As IAccessible) As String
136     On Error Resume Next
137     If objAcc.accName(CHILDID_SELF) = "地址和搜索栏" Then
138         ViewAcc = "http://" & objAcc.accValue(CHILDID_SELF)
139         Exit Function
140     ElseIf objAcc.accChildCount = 0 Then
141         Exit Function
142     End If
143     
144     Dim kids() As Variant
145     Dim kidscount As Long
146     Dim realcount As Long
147     
148     kidscount = objAcc.accChildCount
149     ReDim kids(kidscount - 1) As Variant
150     Call AccessibleChildren(objAcc, 0&, kidscount, kids(0), realcount)
151     For i = 0 To realcount - 1
152         If TypeName(kids(i)) = "IAccessible" Then
153             ViewAcc = ViewAcc(kids(i))
154             If ViewAcc <> "" Then Exit For
155         End If
156     Next
157 End Function

 

运行下看看效果:

1 Private Sub Command1_Click()
2     For i = 1 To 10
3         o = GetTickCount()
4         Debug.Print GetChromeUrl(FindWindow("Chrome_WidgetWin_1", vbNullString))
5         Debug.Print GetTickCount() - o & "ms"
6     Next
7 End Sub

看来这递归的效率有点低 

http://www.cnblogs.com/lichmama/p/3824888.html
453ms
http://www.cnblogs.com/lichmama/p/3824888.html
422ms
http://www.cnblogs.com/lichmama/p/3824888.html
391ms
http://www.cnblogs.com/lichmama/p/3824888.html
406ms
http://www.cnblogs.com/lichmama/p/3824888.html
406ms
http://www.cnblogs.com/lichmama/p/3824888.html
391ms
http://www.cnblogs.com/lichmama/p/3824888.html
406ms
http://www.cnblogs.com/lichmama/p/3824888.html
406ms
http://www.cnblogs.com/lichmama/p/3824888.html
407ms
http://www.cnblogs.com/lichmama/p/3824888.html
390ms
posted @ 2014-07-04 18:05  lichmama  阅读(2862)  评论(0编辑  收藏  举报