16,550
社区成员
发帖
与我相关
我的任务
分享模块:
引用oleacc.dll
Option Explicit
'BY 小江
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hwnd As Long, ByVal dwId As Long, riid As Type_GUID, ppvObject As Object) 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 Const CHILDID_SELF As Long = &H0&
Private Const OBJID_CLIENT As Long = &HFFFFFFFC
Private Type Type_GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
'*************************************************************************
'**函 数 名:GetFirefoxURL
'**输 入:sVersion(String) -火狐的版本,目前我只试过“1.6a1、3.0.5”。
'**输 出:(String) -网址
'*************************************************************************
Public Function GetFirefoxURL(sVersion As String) As String
Dim hFirefoxWnd As Long
Dim hClildWnd As Long
Dim udtIA As IAccessible
Dim udtNewIA As IAccessible
Dim tmpLoad As IAccessible
Dim tg As Type_GUID
Dim lRet As Long
Dim lStart As Long
Dim udtChildIA() As Variant
Dim lCount As Long
Dim lNewCount As Long
Dim i As Long
hFirefoxWnd = FindWindow("MozillaUIWindowClass", vbNullString)
If hFirefoxWnd = 0 Then
MsgBox "没有打开火狐!", vbCritical, "警告"
Exit Function
End If
hClildWnd = FindWindowEx(hFirefoxWnd, 0, "MozillaWindowClass", vbNullString)
Debug.Print Hex$(hClildWnd)
'以下部分代码参考了《Advanced Microsoft Visual Basic 6.0 Second Edition》第16章Microsoft Active Accessibility部分
'定义IAccessible对象的GUID{618736E0-3C3D-11CF-810C-00AA00389B71}
With tg
.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
lRet = AccessibleObjectFromWindow(hFirefoxWnd, OBJID_CLIENT, tg, udtIA)
lCount = udtIA.accChildCount
Debug.Print lCount
ReDim udtChildIA(lCount - 1) As Variant
lRet = AccessibleChildren(udtIA, lStart, lCount - 1, udtChildIA(0), lNewCount)
If sVersion = "1.6" Then
For i = 0 To lNewCount - 1
If IsObject(udtChildIA(i)) = True Then
Set tmpLoad = udtChildIA(i)
If tmpLoad.accRole(CHILDID_SELF) = 22 And tmpLoad.accChildCount = 3 Then
Set udtNewIA = tmpLoad
lCount = tmpLoad.accChildCount
Exit For
End If
End If
Next i
ReDim udtChildIA(lCount - 1) As Variant
lRet = AccessibleChildren(udtNewIA, lStart, lCount - 1, udtChildIA(0), lNewCount)
End If
For i = 0 To lNewCount - 1
If IsObject(udtChildIA(i)) = True Then
Set tmpLoad = udtChildIA(i)
If tmpLoad.accChildCount = 8 Then
Set udtNewIA = tmpLoad
lCount = tmpLoad.accChildCount
Exit For
End If
End If
Next i
ReDim udtChildIA(lCount - 1) As Variant
lRet = AccessibleChildren(udtNewIA, lStart, lCount, udtChildIA(0), lNewCount)
For i = 0 To lNewCount - 1
If IsObject(udtChildIA(i)) = True Then
Set tmpLoad = udtChildIA(i)
If tmpLoad.accName(CHILDID_SELF) = "地址" Then
Set udtNewIA = tmpLoad
lCount = tmpLoad.accChildCount
GetFirefoxURL = tmpLoad.accValue(CHILDID_SELF)
Exit For
End If
End If
Next i
If sVersion = "3.0.5" Then
ReDim udtChildIA(lCount - 1) As Variant
lRet = AccessibleChildren(udtNewIA, lStart, lCount, udtChildIA(0), lNewCount)
For i = 0 To lNewCount - 1
If IsObject(udtChildIA(i)) = True Then
Set tmpLoad = udtChildIA(i)
If tmpLoad.accName(CHILDID_SELF) = "地址" Then
GetFirefoxURL = tmpLoad.accValue(CHILDID_SELF)
Exit For
End If
End If
Next i
End If
End Function
form1
Option Explicit
Private Sub Command1_Click()
Text1.Text = GetFirefoxURL("3.0.5")
End Sub
Private Sub Form_Load()
Text1.Text = GetFirefoxURL("3.0.5")
End Sub