hur.cn - 华软网

 热门搜索

[求助]查看火狐浏览器中网址的VB代码转换成VC++代码

  作者:未知    来源:网络    更新时间:2010/12/10
下面的VB代码主要实现,猎取火狐浏览器中输入的网址,
不太清楚是否用到第三方控件...

VB">模块:       
引用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 

---华软 网友回答---
火狐官网上有利用IAccessible动态猎取DOM接口的示例,猎取到DOM接口后剩下的很简单
---华软网友回复---
引用 1 楼 bdzwj 的回复:
火狐官网上有利用IAccessible动态猎取DOM接口的示例,猎取到DOM接口后剩下的很简单


有链接么?
---华软网友回复---
  class="deleted_message"> 该回复于2010-12-10 11:26:50被版主删除
---华软网友回复---
做成Firefox的插件,参照XPCOM
https://developer.mozilla.org/en/How_to_build_a_binary_XPCOM_component_using_Visual_Studio
---华软网友回复---
引用 4 楼 oyljerry 的回复:
做成Firefox的插件,参照XPCOM
https://developer.mozilla.org/en/How_to_build_a_binary_XPCOM_component_using_Visual_Studio

学习下
---华软网友回复---
  class="deleted_message"> 该回复于2010-12-10 16:21:23被版主删除        
华软声明:本内容来自网络,如有侵犯您版权请来信指出,本站立即删除。