Sub OnContextMenu()
'On Error Resume Next
set objCatcher=CreateObject("WebCatcherAPI.Catcher")
set objDoc = external.menuArguments.document
if err<>0 then
MsgBox("WebCatcher haven't installed in your computer!")
else
objCatcher.Title = objDoc.Title
objCatcher.URL = objDoc.URL
Set objRange = objDoc.selection.createRange()
call objCatcher.AllByText(objRange.htmlText)
end if
Set objCatcher = Nothing
end sub
这个文件是下载专家所使用的HTML文件调用自己的DLL的
<html><head></head><body>
<script language="VBScript">
Sub AddLink(Url,Info)
set dlexpertapi= CreateObject("dlexpertapi")
call dlexpertapi.addjob(url,info)
end sub
Sub OnContextMenu()
set srcEvent = external.menuArguments.event
set EventElement = external.menuArguments.document.elementFromPoint ( srcEvent.clientX, srcEvent.clientY )
if srcEvent.type = "MenuExtAnchor" then
set srcAnchor = EventElement
do until TypeName(srcAnchor)="HTMLAnchorElement"
set srcAnchor=srcAnchor.parentElement
Loop
Call AddLink(srcAnchor.href,srcAnchor.innerText)
elseif srcEvent.type="MenuExtImage" then
if TypeName(EventElement)="HTMLAreaElement" then
Call AddLink(EventElement.href,EventElement.Alt)
else
set srcImage = EventElement
set srcAnchor = srcImage.parentElement
do until TypeName(srcAnchor)="HTMLAnchorElement"
set srcAnchor=srcAnchor.parentElement
if TypeName(srcAnchor)="Nothing" then
call AddLink(srcImage.href,srcImage.Alt)
exit sub
end if
Loop
Call AddLink(srcAnchor.href,srcImage.Alt)
end if
elseif srcEvent.type="MenuExtUnknown" then
set srcAnchor = EventElement
do until TypeName(srcAnchor)="HTMLAnchorElement"
set srcAnchor=srcAnchor.parentElement
if TypeName(srcAnchor)="Nothing" then
Call AddLink(EventElement.href,EventElement.innerText)
exit sub
end if
Loop
Call AddLink(srcAnchor.href,srcAnchor.innerText)
elseif 1=1 then
MsgBox("Unknown Event Source """ + srcEvent.type + """" + vbCrLf)
end if
end sub
call OnContextMenu()
</script>
</body></html>