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的遍历其实原理上是差不多的。

实现代码如下：

 '使用IAccessible接口之前，请先引用Accessibility(oleacc.dll)
 '代码参考了很多网上代码，多数原作者无从考究，在此也就不列出了（请见谅）
 '@Advanced Miscrosoft Visual Basci 6.0
 'code by lichmama from cnblogs.com
 Private Type UUID
     Data1 As Long
     Data2 As Integer
     Data3 As Integer
     Data4() As Byte
 End Type

 Private Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hwnd As Long, _
     ByVal dwObjectID As Long, _
     ByRef riid As UUID, _
     ByRef ppvObject As Any) As Long

 Private Declare Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As IAccessible, _
     ByVal iChildStart As Long, _
     ByVal cChildren As Long, _
     rgvarChildren As Variant, _
     pcObtained As Long) As Long

 '其实这一部分对整个程序来说没什么作用，在此列出仅仅方便别人查阅
 Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
     ByVal lpWindowName As String) As Long

 Private Enum NVADIRConstants
     NAVDIR_MIN =
     NAVDIR_UP =
     NAVDIR_DOWN =
     NAVDIR_LEFT =
     NAVDIR_RIGHT =
     NAVDIR_NEXT =
     NAVDIR_PREVIOUS =
     NAVIDR_FIRSTCHILD =
     NAVDIR_LASTCHILD =
     NAVDIR_MAX =
 End Enum

 'IAccessible Object Types
 Private Const CHILDID_SELF As Long = &
 Private Const ROLE_SYSTEM_TITLEBAR As Long = &H1&
 Private Const ROLE_SYSTEM_MENUBAR As Long = &H2&
 Private Const ROLE_SYSTEM_SCROLLBAR As Long = &H3&
 Private Const ROLE_SYSTEM_GRIP As Long = &H4&
 Private Const ROLE_SYSTEM_SOUND As Long = &H5&
 Private Const ROLE_SYSTEM_CURSOR As Long = &H6&
 Private Const ROLE_SYSTEM_CARET As Long = &H7&
 Private Const ROLE_SYSTEM_ALERT As Long = &H8&
 Private Const ROLE_SYSTEM_WINDOW As Long = &H9&
 Private Const ROLE_SYSTEM_CLIENT As Long = &HA&
 Private Const ROLE_SYSTEM_MENUPOPUP As Long = &HB&
 Private Const ROLE_SYSTEM_MENUITEM As Long = &HC&
 Private Const ROLE_SYSTEM_TOOLTIP As Long = &HD&
 Private Const ROLE_SYSTEM_APPLICATION As Long = &HE&
 Private Const ROLE_SYSTEM_DOCUMENT As Long = &HF&
 Private Const ROLE_SYSTEM_PANE As Long = &H10&
 Private Const ROLE_SYSTEM_CHART As Long = &H11&
 Private Const ROLE_SYSTEM_DIALOG As Long = &H12&
 Private Const ROLE_SYSTEM_BORDER As Long = &H13&
 Private Const ROLE_SYSTEM_GROUPING As Long = &H14&
 Private Const ROLE_SYSTEM_SEPARATOR As Long = &H15&
 Private Const ROLE_SYSTEM_TOOLBAR As Long = &H16&
 Private Const ROLE_SYSTEM_STATUSBAR As Long = &H17&
 Private Const ROLE_SYSTEM_TABLE As Long = &H18&
 Private Const ROLE_SYSTEM_COLUMNHEADER As Long = &H19&
 Private Const ROLE_SYSTEM_ROWHEADER As Long = &H1A&
 Private Const ROLE_SYSTEM_COLUMN As Long = &H1B&
 Private Const ROLE_SYSTEM_ROW As Long = &H1C&
 Private Const ROLE_SYSTEM_CELL As Long = &H1D&
 Private Const ROLE_SYSTEM_LINK As Long = &H1E&
 Private Const ROLE_SYSTEM_HELPBALLOON As Long = &H1F&
 Private Const ROLE_SYSTEM_CHARACTER As Long = &H20&
 Private Const ROLE_SYSTEM_LIST As Long = &H21&
 Private Const ROLE_SYSTEM_LISTITEM As Long = &H22&
 Private Const ROLE_SYSTEM_OUTLINE As Long = &H23&
 Private Const ROLE_SYSTEM_OUTLINEITEM As Long = &H24&
 Private Const ROLE_SYSTEM_PAGETAB As Long = &H25&
 Private Const ROLE_SYSTEM_PROPERTYPAGE As Long = &H26&
 Private Const ROLE_SYSTEM_INDICATOR As Long = &H27&
 Private Const ROLE_SYSTEM_GRAPHIC As Long = &H28&
 Private Const ROLE_SYSTEM_STATICTEXT As Long = &H29&
 Private Const ROLE_SYSTEM_TEXT As Long = &H2A&
 Private Const ROLE_SYSTEM_PUSHBUTTON As Long = &H2B&
 Private Const ROLE_SYSTEM_CHECKBUTTON As Long = &H2C&
 Private Const ROLE_SYSTEM_RADIOBUTTON As Long = &H2D&
 Private Const ROLE_SYSTEM_COMBOBOX As Long = &H2E&
 Private Const ROLE_SYSTEM_DROPLIST As Long = &H2F&
 Private Const ROLE_SYSTEM_PROGRESSBAR As Long = &H30&
 Private Const ROLE_SYSTEM_DIAL As Long = &H31&
 Private Const ROLE_SYSTEM_HOTKEYFIELD As Long = &H32&
 Private Const ROLE_SYSTEM_SLIDER As Long = &H33&
 Private Const ROLE_SYSTEM_SPINBUTTON As Long = &H34&
 Private Const ROLE_SYSTEM_DIAGRAM As Long = &H35&
 Private Const ROLE_SYSTEM_ANIMATION As Long = &H36&
 Private Const ROLE_SYSTEM_EQUATION As Long = &H37&
 Private Const ROLE_SYSTEM_BUTTONDROPDOWN As Long = &H38&
 Private Const ROLE_SYSTEM_BUTTONMENU As Long = &H39&
 Private Const ROLE_SYSTEM_BUTTONDROPDOWNGRID As Long = &H3A&
 Private Const ROLE_SYSTEM_WHITESPACE As Long = &H3B&
 Private Const ROLE_SYSTEM_PAGETABLIST As Long = &H3C&
 Private Const ROLE_SYSTEM_CLOCK As Long = &H3D&
 Private IID_IAccessible As UUID
 Private Declare Function GetTickCount Lib "kernel32" () As Long

 Private Sub Form_Initialize()
     With IID_IAccessible
         .Data1 = &H618736E0
         .Data2 = &H3C3D
         .Data3 = &H11CF
         .Data4() = &H81
         .Data4() = &HC
         .Data4() = &H0
         .Data4() = &HAA
         .Data4() = &H0
         .Data4() = &H38
         .Data4() = &H9B
         .Data4() = &H71
     End With
 End Sub

 'using like: GetChromeUrl(FindWindow("Chrome_WidgetWin_1", vbNullString))
 Private Function GetChromeUrl(ByVal hwnd As Long) As String
     Dim objAcc As IAccessible

     Call AccessibleObjectFromWindow(hwnd, &, IID_IAccessible, objAcc)
     If objAcc Is Nothing Then
         Debug.Print "access failed"
         Exit Function
     End If

     GetChromeUrl = ViewAcc(objAcc)
 End Function

 Private Function ViewAcc(ByVal objAcc As IAccessible) As String
     On Error Resume Next
     If objAcc.accName(CHILDID_SELF) = "地址和搜索栏" Then
         ViewAcc = "http://" & objAcc.accValue(CHILDID_SELF)
         Exit Function
     ElseIf objAcc.accChildCount =  Then
         Exit Function
     End If

     Dim kids() As Variant
     Dim kidscount As Long
     Dim realcount As Long

     kidscount = objAcc.accChildCount
     ReDim kids(kidscount - ) As Variant
     Call AccessibleChildren(objAcc, &, kidscount, kids(), realcount)
     For i =  To realcount -
         If TypeName(kids(i)) = "IAccessible" Then
             ViewAcc = ViewAcc(kids(i))
             If ViewAcc <> "" Then Exit For
         End If
     Next
 End Function

运行下看看效果：

 Private Sub Command1_Click()
     For i =  To
         o = GetTickCount()
         Debug.Print GetChromeUrl(FindWindow("Chrome_WidgetWin_1", vbNullString))
         Debug.Print GetTickCount() - o & "ms"
     Next
 End Sub

看来这递归的效率有点低

http://www.cnblogs.com/lichmama/p/.html
453ms
http://www.cnblogs.com/lichmama/p/.html
422ms
http://www.cnblogs.com/lichmama/p/.html
391ms
http://www.cnblogs.com/lichmama/p/.html
406ms
http://www.cnblogs.com/lichmama/p/.html
406ms
http://www.cnblogs.com/lichmama/p/.html
391ms
http://www.cnblogs.com/lichmama/p/.html
406ms
http://www.cnblogs.com/lichmama/p/.html
406ms
http://www.cnblogs.com/lichmama/p/.html
407ms
http://www.cnblogs.com/lichmama/p/.html
390ms