VB6获取Chrome地址栏的URL信息

‘使用IAccessible接口之前，请先引用Accessibility(oleacc.dll)
‘代码参考了很多网上代码，多数原作者无从考究，在此也就不列出了（请见谅）
‘@Advanced Miscrosoft Visual Basci 6.0
Private Type UUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) 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 Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, _
    ByVal hWndChildAfter As Long, _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long

Private Enum NVADIRConstants
    NAVDIR_MIN = 0
    NAVDIR_UP = 1
    NAVDIR_DOWN = 2
    NAVDIR_LEFT = 3
    NAVDIR_RIGHT = 4
    NAVDIR_NEXT = 5
    NAVDIR_PREVIOUS = 6
    NAVIDR_FIRSTCHILD = 7
    NAVDIR_LASTCHILD = 8
    NAVDIR_MAX = 9
End Enum

Private Const CHILDID_SELF As Long = 0&
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 Sub Form_Initialize()
    With IID_IAccessible
        .Data1 = &H618736E0
        .Data2 = &H3C3D
        .Data3 = &H11CF
        .Data4(0) = &H81
        .Data4(1) = &HC
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H38
        .Data4(6) = &H9B
        .Data4(7) = &H71
    End With
End Sub
 
 
Private Function GetChromeUrl(ByVal hwnd As Long) As String
    ‘参数需传入chrome主窗体的hwnd
    Dim flags(5, 1) As Long
    Dim temp As Variant
    Dim kids() As Variant
    Dim kidscount As Long
    Dim realcount As Long
    Dim objacc As Accessibility.IAccessible
     
    ‘flags=((9,2),(10,2),(10,5),(10,3),(22,8),(20,36))
    ‘此二维数组代表，每一阶段窗体的ROLE_SYSTEM_*和子窗体数
    ‘程序根据这个来获取地址栏最终的（UI结构上的）路径
    flags(0, 0) = 9: flags(0, 1) = 2
    flags(1, 0) = 10: flags(1, 1) = 2
    flags(2, 0) = 10: flags(2, 1) = 5
    flags(3, 0) = 10: flags(3, 1) = 3
    flags(4, 0) = 22: flags(4, 1) = 8
    flags(5, 0) = 20: flags(5, 1) = 36
    Call AccessibleObjectFromWindow(hwnd, 0&, IID_IAccessible, objacc)
    If objacc Is Nothing Then
        Debug.Print "access failed"
        Exit Function
    End If
    Set temp = objacc
    
    ‘我花了大部分的时间用在，构建这个循环结构上
    ‘使用AccExplorer可以看到一个程序UI上结构
    ‘基于此，但也请在使用代码前先确认下chrome的UI结构，就可以构造一个相对规律的路径检索机制
    Dim j As Long
    Dim i As Long
    For j = 0 To 5
        Set objacc = temp
        realcount = 0
        kidscount = objacc.accChildCount
        ReDim kids(kidscount - 1) As Variant
        Call AccessibleChildren(objacc, 0&, kidscount, kids(0), realcount)
        For i = 0 To realcount - 1
            Set temp = kids(i)
            If temp.accRole(CHILDID_SELF) = flags(j, 0) And temp.accChildCount = flags(j, 1) Then
                Exit For
            End If
        Next
    Next
    
    ‘返回地址栏中url
    GetChromeUrl = "http://" & temp.accValue(CHILDID_SELF)
End Function