经典VBS操作记住免得丢了

'----------用鼠标抓网页元素***(子皮作品)-----------
'----------大家继续修改哈!!增加更多功能------------
'本意是想动态获得鼠标处网页源码,可惜VBS中不知道怎么实现,高手可以继续改
'JS我不太懂，置顶不完善，JS高手可以改更酷一点的发上来，呵呵

WebNumberx = 1:Allie = ""
Set SHApp = CreateObject("Shell.Application")
For Each SHWin In SHApp.Windows
If LCase(Right(SHWin.FullName, 12)) = "iexplore.exe" Then
Allie = Allie & WebNumberx & ") " & SHWin.locationname & vbcrlf
WebNumberx = WebNumberx + 1
End if
Next
Set SHApp = Nothing

ca = InputBox(Allie,"请输入要抓的网页编号","")

WebNumberx = 1
Set SHApp = CreateObject("Shell.Application")
For Each SHWin In SHApp.Windows
If LCase(Right(SHWin.FullName, 12)) = "iexplore.exe" Then
If WebNumberx = Int(ca) Then Set x = SHWin:Exit For
WebNumberx = WebNumberx + 1
End if
Next
Set SHApp = Nothing

Set WMI=GetObject("WinMgmts:")
Set Objs=WMI.InstancesOf("Win32_Process")
i = 1
For Each Obj In Objs
If LCase(Obj.name) = "iexplore.exe" Then
If i = Int(ca) Then x_pid = obj.ProcessID:Exit For
i = i + 1
End if
Next
Set Objs = Nothing:Set WMI = Nothing

CreateObject("WScript.Shell").AppActivate x_pid, False
Wsh.sleep 300

While x.busy or x.readystate<>4:wsh.sleep 100:Wend

Set v = x.document.createElement("div")
v.setAttribute "id","xxx"
v.setAttribute "value",""
v.setAttribute "type","hidden"
x.Document.appendChild(v)

Set v = x.document.createElement("div")
v.setAttribute "id","yyy"
v.setAttribute "value",""
v.setAttribute "type","hidden"
x.Document.appendChild(v)


js = js & "function mousePosition(ev){" & vbCrLf
js = js & "if(ev.pageX || ev.pageY){" & vbCrLf
js = js & "return {x:ev.pageX, y:ev.pageY};" & vbCrLf
js = js & "}" & vbCrLf
js = js & "return {" & vbCrLf
js = js & "x:ev.clientX + document.body.scrollLeft - document.body.clientLeft," & vbCrLf
js = js & "y:ev.clientY + document.body.scrollTop - document.body.clientTop" & vbCrLf
js = js & "};" & vbCrLf
js = js & "}" & vbCrLf
js = js & "function mouseMove(ev){" & vbCrLf
js = js & "ev = ev || window.event;" & vbCrLf
js = js & "var mousePos = mousePosition(ev);" & vbCrLf
js = js & "document.getElementById('xxx').value = mousePos.x;" & vbCrLf
js = js & "document.getElementById('yyy').value = mousePos.y;" & vbCrLf

js = js & "}" & vbCrLf

js = js & "document.onmousemove = mouseMove;" & vbCrLf

x.Document.parentWindow.execScript js, "javascript"

set oIE = WScript.CreateObject("InternetExplorer.Application","Event_")
With oIE
.MenuBar = 0
.StatusBar = 0
.AddressBar = 0
.ToolBar = 0
.Height = 410
.Width = 300
.Navigate "about:blank"
.Visible = 1
.Document.Write ""
.Document.Write "x:
"
.Document.Write "y:
复制
"
.Document.Write "源码:
"
.Document.Write ""
End With

Set oIE.Document.getElementById("btn").OnClick = GetRef("aaa")

Do
oIE.Document.getElementById("input1").value = x.Document.getelementbyid("xxx").Value
oIE.Document.getElementById("input2").value = x.Document.getelementbyid("yyy").Value

Set ym = x.Document.selection
If Not (ym Is Nothing) Then
Set ymm = ym.createRange
If Not (ymm Is Nothing) Then
If ymm.htmlText <> oIE.Document.getElementById("input3").value then
oIE.Document.getElementById("input3").value = ymm.htmlText
End if
End If
End If
Set ym = Nothing:Set ymm = nothing
wsh.sleep 20
Loop

Sub aaa
Set IE=CreateObject("InternetExplorer.Application")
IE.Navigate("about:blank")
IE.document.parentwindow.clipboardData.SetData "text",oIE.Document.getElementById("input3").value
IE.Quit
Set IE = nothing
End Sub

Sub Event_OnQuit
Set oIE = Nothing: Set x = Nothing
WScript.Quit
End Sub

WebNumberx = 1:Allie = ""
Set SHApp = CreateObject("Shell.Application")
For Each SHWin In SHApp.Windows
If LCase(Right(SHWin.FullName, 12)) = "iexplore.exe" Then
Allie = Allie & WebNumberx & ") " & SHWin.locationname & vbcrlf
WebNumberx = WebNumberx + 1
End if
Next
Set SHApp = Nothing

ca = InputBox(Allie,"请输入要抓的网页编号","")

WebNumberx = 1
Set SHApp = CreateObject("Shell.Application")
For Each SHWin In SHApp.Windows
If LCase(Right(SHWin.FullName, 12)) = "iexplore.exe" Then
If WebNumberx = Int(ca) Then Set x = SHWin:Exit For
WebNumberx = WebNumberx + 1
End if
Next
Set SHApp = Nothing

Set WMI=GetObject("WinMgmts:")
Set Objs=WMI.InstancesOf("Win32_Process")
i = 1
For Each Obj In Objs
If LCase(Obj.name) = "iexplore.exe" Then
If i = Int(ca) Then x_pid = obj.ProcessID:Exit For
i = i + 1
End if
Next
Set Objs = Nothing:Set WMI = Nothing

===============================

这里都是获取 IE 的信息的，这样写脚本太罗嗦了吧~ 就不能一次搞定？