VB6获取Chrome地址栏的URL信息

时间:2021-06-24 14:01:13

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

 

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

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

VB6获取Chrome地址栏的URL信息

 

实现代码如下:

  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