Object getElementsByTagName IE7 Bug

本文介绍了一个有趣的IE7浏览器Bug,当通过JavaScript访问<object>元素的.all或getElementsByTagName("*")属性时,返回的节点集总是空的。文中提供了一个简单的HTML示例及解决此问题的一种方法。

摘要生成于 C知道 ,由 DeepSeek-R1 满血版支持, 前往体验 >

转载自: http://ejohn.org/blog/object-getelementsbytagname-ie7-bug/

So here's a fun bug to keep you entertained this weekend. Personally, this is the first purely-JavaScript bug that I've seen in IE7 (More due to the lack of anything changing than the quality of the code.)

Summary:
When accessing the .all or .getElementsByTagName("*") properties on the DOM representation of an <object> element, the resulting NodeSet will always be empty.

Proof of Concept:
HTML:

<object>
  <param name="name" value="value"/>
  <param name="name2" value="value2"/>
  <param name="name3" value="value3"/>
</object>

JavaScript:

var obj = document. getElementsByTagName ( "object" ) [ 0 ];
// => <object/>
obj. all
// => []
obj. getElementsByTagName ( "*" )
// => []
obj. getElementsByTagName ( "param" )
// => [ <param/>, <param/>, <param/> ]
obj. firstChild
// => <param/>
 

Andrea has done some fantastic work in tracking this bug down and providing a fix for it.

So far, my quick-and-dirty kludge is just to replace "*" with "param" and hope that the user is actually using an object to hold params, and not some other crazy combination.

Which reminds me - has anyone ever seen an example of an <object> element containing non-param elements on a real, live, web page - somewhere in the wild? The HTML spec says that the <object> element can contain any HTML, but that sounds a little bit too crazy for my tastes.


这是现在的代码,虽然能够拉取数据成功,但是时间过长而且更新表格的时候直接卡死,需要进行优化 ' === 增强稳定性的主抓取过程 === Private Sub CommandButton1_Click() On Error GoTo ErrorHandler Dim objIEApp As Object, objIEDoc As Object, objIETable As Object Dim objClip As Object, objSheet As Worksheet, objBuglist As Worksheet Dim startTime As Double, retryCount As Integer ' 禁用Excel功能提升稳定性 Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual ' 初始化设置 Set objSheet = Sheets("Bugzilla") Set objBuglist = Sheets("account") retryCount = 0 RetryPoint: ' === 关键改进1:增强IE实例创建 === Set objIEApp = CreateStableIEInstance() If objIEApp Is Nothing Then MsgBox "无法创建Internet Explorer实例", vbCritical GoTo CleanExit End If With objIEApp .Visible = True ' 调试时可见 ' === 关键改进2:带重试机制的导航 === .Navigate "https://logincas.tp-link.com:8443/login?service=http://bugzilla.tp-link.com/" If Not WaitForCompleteLoad(objIEApp, "登录页面", 30) Then retryCount = retryCount + 1 If retryCount <= 3 Then .Quit Set objIEApp = Nothing GoTo RetryPoint Else MsgBox "登录页面加载失败,请检查网络连接", vbExclamation GoTo CleanExit End If End If Set objIEDoc = .Document ' === 关键改进3:安全元素访问 === If Not SetElementValue(objIEDoc, "username", objBuglist.Range("A3").value) Then LogError "无法设置用户名字段" GoTo CleanExit End If If Not SetElementValue(objIEDoc, "password", objBuglist.Range("B3").value) Then LogError "无法设置密码字段" GoTo CleanExit End If ' 提交登录表单 startTime = Timer Do On Error Resume Next .Document.forms(0).submit On Error GoTo ErrorHandler If Timer - startTime > 15 Then Exit Do ' 15秒超时 DoEvents Loop While .Busy Or .readyState <> 4 ' === 关键改进4:增强登录等待 === If Not WaitForCompleteLoad(objIEApp, "登录后页面", 30) Then MsgBox "登录过程超时", vbExclamation GoTo CleanExit End If ' 导航到目标页面 .Navigate objBuglist.Range("B1").value If Not WaitForCompleteLoad(objIEApp, "目标页面", 300) Then MsgBox "目标页面加载超时", vbExclamation GoTo CleanExit End If ' 更新文档对象引用 Set objIEDoc = .Document ' === 关键改进5:增强表格定位 === Set objIETable = FindBuglistTable(objIEDoc) If objIETable Is Nothing Then SaveHTMLForDebugging objIEDoc, "C:\Temp\bugzilla_debug.html" MsgBox "未找到表格元素,已保存页面HTML用于调试", vbExclamation GoTo CleanExit End If ' 处理表格数据 ProcessBuglistTable objIETable, objSheet End With ' 初始化schedule表 InitializeScheduleSheet CleanExit: SafeCleanup objIEApp Set objClip = Nothing Application.ScreenUpdating = True Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Sheets("schedule").Activate Exit Sub ErrorHandler: HandleAutomationError Err.Number, Err.Description Resume CleanExit End Sub ' === 关键增强函数 === ' 创建稳定的IE实例 Private Function CreateStableIEInstance() As Object On Error Resume Next Dim ieApp As Object ' 尝试连接到现有IE实例 Set ieApp = GetObject("InternetExplorer.Application") If ieApp Is Nothing Then ' 创建新实例 Set ieApp = CreateObject("InternetExplorer.Application") End If ' 配置IE设置 If Not ieApp Is Nothing Then With ieApp .Silent = True ' 禁止脚本错误提示 .Visible = True .Navigate "about:blank" ' 初始化实例 Do While .Busy Or .readyState <> 4 DoEvents Loop End With End If Set CreateStableIEInstance = ieApp End Function ' 增强的页面加载等待 Private Function WaitForCompleteLoad(ie As Object, pageName As String, timeoutSeconds As Integer) As Boolean Dim startTime As Double startTime = Timer Do While ie.Busy Or ie.readyState <> 4 DoEvents If Timer - startTime > timeoutSeconds Then WaitForCompleteLoad = False Exit Function End If Loop ' 额外等待确保完全加载 Dim extraWait As Double extraWait = Timer + 2 ' 额外等待2秒 Do While Timer < extraWait DoEvents Loop WaitForCompleteLoad = True End Function ' 安全设置元素值(返回是否成功) Private Function SetElementValue(doc As Object, elementName As String, value As String) As Boolean On Error Resume Next Dim element As Object ' 尝试多种方式获取元素 Set element = doc.getElementById(elementName) If element Is Nothing Then Set element = doc.getElementsByName(elementName)(0) If element Is Nothing Then Set element = doc.querySelector("[name='" & elementName & "']") If Not element Is Nothing Then element.value = value SetElementValue = True Else Debug.Print "未找到元素: " & elementName SetElementValue = False End If End Function ' 查找表格的多种方法 Private Function FindBuglistTable(doc As Object) As Object On Error Resume Next Dim table As Object ' 尝试多种定位方式 Set table = doc.getElementById("buglist_table") If table Is Nothing Then Set table = doc.getElementsByClassName("buglist")(0) If table Is Nothing Then Set table = doc.querySelector("table.buglist") If table Is Nothing Then Set table = doc.querySelector("table[id*='bug']") If table Is Nothing Then ' 尝试查找第一个表格 Dim tables As Object Set tables = doc.getElementsByTagName("table") If tables.Length > 0 Then Set table = tables(0) End If Set FindBuglistTable = table End Function ' 处理表格数据 Private Sub ProcessBuglistTable(table As Object, targetSheet As Worksheet) On Error Resume Next Dim objClip As Object, LocaleID As Long Set objClip = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") objClip.SetText table.outerHTML objClip.PutInClipboard targetSheet.Select targetSheet.Range("A1").Select ' 语言设置处理 LocaleID = Application.LanguageSettings.LanguageID(msoLanguageIDUI) Select Case LocaleID Case 2052, 1028 targetSheet.PasteSpecial "Unicode 文本", xlPasteAll Case Else targetSheet.PasteSpecial "Unicode Text", xlPasteAll End Select ' 清除剪贴板 objClip.SetText "" objClip.PutInClipboard Set objClip = Nothing End Sub ' 初始化schedule表 Private Sub InitializeScheduleSheet() On Error Resume Next If Sheets("schedule").cells(2, 1) = "" Then Sheets("Bugzilla").Range("A2:A" & Sheets("Bugzilla").cells(rows.Count, "A").End(xlUp).row).Copy Sheets("schedule").Range("A2") AddHyperlinks 2 End If End Sub ' 添加超链接 Private Sub AddHyperlinks(startRow As Long) On Error Resume Next Dim ws As Worksheet, lastRow As Long, i As Long Set ws = Sheets("schedule") lastRow = ws.cells(ws.rows.Count, "A").End(xlUp).row For i = startRow To lastRow If ws.Hyperlinks.Count >= i Then ws.Hyperlinks(i).Address = "http://bugzilla.tp-link.com/" & ws.Hyperlinks(i).Address End If Next End Sub ' 安全清理资源 Private Sub SafeCleanup(ieApp As Object) On Error Resume Next If Not ieApp Is Nothing Then If Not ieApp.Document Is Nothing Then ieApp.Quit End If Set ieApp = Nothing End If End Sub ' 错误处理程序 Private Sub HandleAutomationError(errNumber As Long, errDescription As String) Dim errMsg As String Select Case errNumber Case -2147352319 ' 自动化错误 errMsg = "IE自动化错误 (0x80020101):" & vbCrLf & _ "可能原因:" & vbCrLf & _ "1. IE安全设置阻止自动化" & vbCrLf & _ "2. 页面未完全加载" & vbCrLf & _ "3. 对象已被释放" Case 462 ' 远程服务器不存在或不可用 errMsg = "远程服务器错误 (462):" & vbCrLf & _ "IE实例可能已关闭" Case Else errMsg = "错误 " & errNumber & ": " & errDescription End Select ' 添加解决方案提示 errMsg = errMsg & vbCrLf & vbCrLf & "解决方案:" & vbCrLf & _ "1. 检查IE安全设置" & vbCrLf & _ "2. 增加页面加载等待时间" & vbCrLf & _ "3. 以管理员身份运行Excel" MsgBox errMsg, vbCritical, "自动化错误" End Sub ' 日志记录 Private Sub LogError(message As String) Debug.Print "[" & Now & "] ERROR: " & message End Sub ' 保存HTML用于调试 Private Sub SaveHTMLForDebugging(doc As Object, filePath As String) On Error Resume Next Dim fso As Object, ts As Object Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.CreateTextFile(filePath, True) ts.Write doc.DocumentElement.outerHTML ts.Close End Sub ' ===== 辅助函数 ===== ' 获取稳定的IE实例 Private Function GetStableIEInstance() As Object On Error Resume Next Dim ieApp As Object ' 尝试连接到现有IE实例 Set ieApp = GetObject("InternetExplorer.Application") If ieApp Is Nothing Then ' 创建新实例 Set ieApp = CreateObject("InternetExplorer.Application") End If ' 配置IE设置 If Not ieApp Is Nothing Then With ieApp .Silent = True ' 禁止脚本错误提示 .Visible = True .Navigate "about:blank" ' 初始化实例 Do While .Busy Or .readyState <> 4 DoEvents Loop End With End If Set GetStableIEInstance = ieApp End Function ' ===== 优化后的数据同步过程 ===== Private Sub CommandButton3_Click() On Error GoTo ErrorHandler Application.ScreenUpdating = False Dim srcSheet As Worksheet, scheSheet As Worksheet Set srcSheet = Sheets("Bugzilla") Set scheSheet = Sheets("schedule") ' 检查源数据是否存在 If srcSheet.Range("A2") = "" Then MsgBox "Bugzilla工作表没有数据可复制", vbExclamation Exit Sub End If Dim lastRowSrc As Long, lastRowSche As Long lastRowSrc = srcSheet.cells(srcSheet.rows.Count, "A").End(xlUp).row lastRowSche = scheSheet.cells(scheSheet.rows.Count, "A").End(xlUp).row ' 如果schedule工作表为空,复制整个范围 If lastRowSche < 2 Then srcSheet.Range("A2:A" & lastRowSrc).Copy scheSheet.Range("A2") add_http 2 lastRowSche = scheSheet.cells(scheSheet.rows.Count, "A").End(xlUp).row End If ' 同步数据 Dim i As Long, j As Long, matchFound As Boolean For i = 2 To lastRowSrc matchFound = False For j = 2 To lastRowSche If scheSheet.cells(j, 1).value = srcSheet.cells(i, 1).value Then ' 更新现有行 With scheSheet .cells(j, 2).value = srcSheet.cells(i, 2).value .cells(j, 3).value = srcSheet.cells(i, 3).value .cells(j, 4).value = srcSheet.cells(i, 8).value .cells(j, 5).value = srcSheet.cells(i, 9).value .cells(j, 6).value = srcSheet.cells(i, 4).value .cells(j, 7).value = srcSheet.cells(i, 5).value .cells(j, 8).value = srcSheet.cells(i, 6).value End With matchFound = True Exit For End If Next j ' 添加新行 If Not matchFound Then lastRowSche = lastRowSche + 1 srcSheet.Range("A" & i).Copy scheSheet.Range("A" & lastRowSche) With scheSheet .cells(lastRowSche, 1).value = srcSheet.cells(i, 1).value .cells(lastRowSche, 2).value = srcSheet.cells(i, 2).value .cells(lastRowSche, 3).value = srcSheet.cells(i, 3).value .cells(lastRowSche, 4).value = srcSheet.cells(i, 8).value .cells(lastRowSche, 5).value = srcSheet.cells(i, 9).value .cells(lastRowSche, 6).value = srcSheet.cells(i, 4).value .cells(lastRowSche, 7).value = srcSheet.cells(i, 5).value .cells(lastRowSche, 8).value = srcSheet.cells(i, 6).value End With End If Next i MsgBox "数据同步完成!", vbInformation CleanExit: Application.ScreenUpdating = True Exit Sub ErrorHandler: MsgBox "同步错误: " & Err.Description, vbCritical Resume CleanExit End Sub ' ===== 保留原始功能 ===== Function add_http(i As Long) On Error Resume Next For x = i To Sheets("schedule").cells(rows.Count, "A").End(xlUp).row Sheets("schedule").Hyperlinks(x).Address = "http://bugzilla.tp-link.com/" & Sheets("schedule").Hyperlinks(x).Address Next End Function Private Sub CommandButton2_Click() Dim OutLookObj As Outlook.Application Dim MailObj As MailItem Dim src, sche src = "account" sche = "schedule" Set objSheet = Sheets(src) Set objsche = Sheets(sche) Send = "" CC = "" i = 6 Do Until objSheet.cells(i, 1) = "" Send = Send & objSheet.cells(i, 1) & ";" i = i + 1 Loop i = 6 Do Until objSheet.cells(i, 2) = "" CC = CC & objSheet.cells(i, 2) & ";" i = i + 1 Loop Set OutLookObj = New Outlook.Application '创建一个OutLook应用对象 Set MailObj = OutLookObj.CreateItem(olMailItem) '创建一个邮件对象Mailobj Range("A1:H3").Select With MailObj .To = Send '收件人 .CC = CC '抄送 .subject = objSheet.Range("C6").value '标题 .HTMLBody = getVal(2) .Display .Send '发送 End With Set OutLookObj = Nothing Set MailObj = Nothing End Sub Function getVal(ByVal j As Integer) As String Dim i As Integer i = 1 k = 2 getVal = "" getVal = "<table border=" & "'1'" & " style=" & "'border-right: black thin solid; border-top: black thin solid; border-left: black thin solid; border-bottom: black thin solid'" & ">" getVal = getVal & "<tr>" Do Until cells(1, i) = "" getVal = getVal & "<td align=" & "'left'" & " height=" & "'57'" & " style=" & "'width: 250px; background-color: lightskyblue; font-size: 9pt;'" & " valign=" & "'top'" & ">" getVal = getVal & cells(1, i) & "</td>" i = i + 1 Loop getVal = getVal & "</tr>" i = 1 Do Until cells(k, 1) = "" If Not Sheets("schedule").rows(k).Hidden Then Do Until cells(k, i) = "" getVal = getVal & "<td align=" & "'left'" & " style=" & "'width: 239px;background-color: white;'" & " valign=" & "'top'" & ">" getVal = getVal & cells(k, i) & "</td>" i = i + 1 Loop End If k = k + 1 i = 1 getVal = getVal & "</tr>" Loop getVal = getVal & "</tr></table>" End Function
最新发布
08-12
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值