请问如何做这样一个工具:
鼠标在当前网页的某个文档元素上按下中键(或者右键也可),可以将鼠标位置所在的网页元素的ID或者Title输出到一个window窗口的文本框里?提供一下思路也可。

解决方案 »

  1.   

    引用Microsoft HTML Object LibraryPrivate WithEvents m_oDoc As HTMLDocumentPrivate Sub Form_Load()
        WebBrowser1.Navigate2 "www.google.cn"
    End SubPrivate Sub m_oDoc_onmouseup()
        Dim oEvent As CEventObj
        Set oEvent = m_oDoc.parentWindow.event
        
        Dim oElement As IHTMLElement
        With oEvent
            If .Button = vbRightButton Then
                Set oElement = .srcElement
                With oElement
                    Debug.Print .tagName, .Id, .Title, .innerHTML
                End With
            End If
        End With
    End SubPrivate Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
        Set m_oDoc = pDisp.Document
    End Sub
      

  2.   

    我这里收藏了个好东东:可以对其它进程的IE窗口内容进行查看.原本我是用它来取网页星号的,现在用它来也可以实现你的要求.保存到一个模块里,引用"".然后调用GetPassword就可以了:tmpI = GetPassword(hwnd,mx,my)'*************************************************************************
    '**模 块 名:ModGetIEObject
    '**说    明:根据句柄得到IHTMLDocument对象
    '**创 建 人:马大哈
    '**日    期:2003年12月17日
    '**描    述:国外高手所写
    '**版    本:V1.0
    '*************************************************************************
    Option Explicit  '
      '   Requires:   reference   to   "Microsoft   HTML   Object   Library"
      '
        
    Private Type UUID
          Data1   As Long
          Data2   As Integer
          Data3   As Integer
          Data4(0 To 7)       As Byte
    End Type
      
    Private Declare Function GetClassName Lib "user32" _
          Alias "GetClassNameA" ( _
          ByVal hwnd As Long, _
          ByVal lpClassName As String, _
          ByVal nMaxCount As Long) As Long
      
    Private Declare Function EnumChildWindows Lib "user32" ( _
          ByVal hWndParent As Long, _
          ByVal lpEnumFunc As Long, _
          lParam As Long) As Long
      
    Private Declare Function RegisterWindowMessage Lib "user32" _
          Alias "RegisterWindowMessageA" ( _
          ByVal lpString As String) As Long
      
    Private Declare Function SendMessageTimeout Lib "user32" _
          Alias "SendMessageTimeoutA" ( _
          ByVal hwnd As Long, _
          ByVal msg As Long, _
          ByVal wParam As Long, _
          lParam As Any, _
          ByVal fuFlags As Long, _
          ByVal uTimeout As Long, _
          lpdwResult As Long) As Long
                  
    Private Const SMTO_ABORTIFHUNG = &H2
      
    Private Declare Function ObjectFromLresult Lib "oleacc" ( _
          ByVal lResult As Long, _
          riid As UUID, _
          ByVal wParam As Long, _
          ppvObject As Any) As Long
      
    Private Declare Function FindWindow Lib "user32" _
          Alias "FindWindowA" ( _
          ByVal lpClassName As String, _
          ByVal lpWindowName As String) As Long
      
    '
    '   IEDOMFromhWnd
    '
    '   Returns   the   IHTMLDocument   interface   from   a   WebBrowser   window
    '
    '   hWnd   -   Window   handle   of   the   control
    '
    Function IEDOMFromhWnd(ByVal hwnd As Long) As IHTMLDocument
    Dim IID_IHTMLDocument     As UUID
    Dim hWndChild     As Long
    Dim lRes     As Long
    Dim lMsg     As Long
    Dim hr     As Long
      
          If hwnd <> 0 Then
                If Not IsIEServerWindow(hwnd) Then
                      '   Find   a   child   IE   server   window
                      EnumChildWindows hwnd, AddressOf EnumChildProc, hwnd
                End If
                  
                If hwnd <> 0 Then
                      '   Register   the   message
                      lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
                      '   Get   the   object   pointer
                      Call SendMessageTimeout(hwnd, lMsg, 0, 0, _
                                      SMTO_ABORTIFHUNG, 1000, lRes)
                      If lRes Then
                            '   Initialize   the   interface   ID
                            With IID_IHTMLDocument
                                  .Data1 = &H626FC520
                                  .Data2 = &HA41E
                                  .Data3 = &H11CF
                                  .Data4(0) = &HA7
                                  .Data4(1) = &H31
                                  .Data4(2) = &H0
                                  .Data4(3) = &HA0
                                  .Data4(4) = &HC9
                                  .Data4(5) = &H8
                                  .Data4(6) = &H26
                                  .Data4(7) = &H37
                            End With
                            '   Get   the   object   from   lRes
                            hr = ObjectFromLresult(lRes, IID_IHTMLDocument, _
                                              0, IEDOMFromhWnd)
                      End If
                End If
          End If
    End Function
      
    Private Function IsIEServerWindow(ByVal hwnd As Long) As Boolean
    Dim lRes     As Long
    Dim sClassName     As String
      
          '   Initialize   the   buffer
          sClassName = String$(100, 0)
          '   Get   the   window   class   name
          lRes = GetClassName(hwnd, sClassName, Len(sClassName))
          sClassName = Left$(sClassName, lRes)
          IsIEServerWindow = StrComp(sClassName, _
                                                "Internet   Explorer_Server", _
                                                vbTextCompare) = 0
    End Function
      
    '
    '   Copy   this   function   to   a   .bas   module
    '
    Function EnumChildProc(ByVal hwnd As Long, lParam As Long) As Long
          If IsIEServerWindow(hwnd) Then
                lParam = hwnd
          Else
                EnumChildProc = 1
          End If
    End FunctionFunction GetPassword(ByVal hwnd As Long, ByVal cx As Long, ByVal cy As Long)
        '我写了这个函数来取得密码,嘿嘿
        Dim Doc As IHTMLDocument
        Dim Ele As IHTMLElement
        
        Set Doc = IEDOMFromhWnd(hwnd)
        Set Ele = Doc.elementFromPoint(cx, cy)
        If Ele.Type = "password" Then
              GetPassword = Ele.Value
        End If
        Debug.Print "Id = " & Ele.id & " /Title = " & Ele.Title & " /Type = " & Ele.Type
    End Function