请问如何做这样一个工具:
鼠标在当前网页的某个文档元素上按下中键(或者右键也可),可以将鼠标位置所在的网页元素的ID或者Title输出到一个window窗口的文本框里?提供一下思路也可。
鼠标在当前网页的某个文档元素上按下中键(或者右键也可),可以将鼠标位置所在的网页元素的ID或者Title输出到一个window窗口的文本框里?提供一下思路也可。
解决方案 »
- [求助]谁能拖动(无标题栏)的(椭圆形)的EXCEL工作表?
- VB窗体操作问题!等线等待
- 班主请将以下贴删除,那是我的贴,已经不用了,谢谢
- VB+sql
- 关于串口通讯中的开始位
- 关于‘Word’‘Excel’的导入问题
- 如何在MSHFlexGrid里显示图片?(图片阵列)
- Select INTO 问题
- 在线等待。Crystal Report9.0问题,急!
- <SCRIPT src="xxx.js"></SCRIPT> 如何获取xxx.js里面的内容??
- 关于vbscript中的结构中使用动态数组的问题
- 大虾救急啦!Dim Buff() As Byte 转为Dim StrA As String怎么转
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
'**模 块 名: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