大前天我遇到了一件比较无奈的事情：我的显卡坏了。前天没有时间，昨天才去卖了一块。由于
考虑到手头的项目做完之后，机器很可能会升级，所以卖了一块最差的显卡先顶着（那还有65元
钱，虽然十分不的情愿，但是还是不得不被其捅一刀）。另外浪刀兄，您的这个问题讨论到现在
，已经没有什么待解决的关键技术问题了。我想这个问题也应该可以结束了吧。
to 浪刀：
10天前（6月19日）我就E-MAIL到你所提供的E龙信箱，可能是邮丢了吧。以下便是那封信的
内容，长一些，希望其它富翁们不会见怪。
//以下这招我本来是不想外传的，但是我一想到自己当时被这个问题所折磨的样子，就抛开那
//狭义的个人主义观点，将它拿出来与大家共享。
//先建立一个OLE自动控制程序。
//以下是OLE自动控制程序的主要代码。
unit AutoUnit;
interface
uses
Sysutils, ComObj, ActiveX, ligwin1;//ligwin1是我的主窗体文件名。
type
TAuto = class(TAutoObject, IAuto)
protected
function AddUrl(const Url, Comment, Referer: WideString): WordBool;safecall;
public
procedure Initialize; override;
end;
implementation
uses ComServ;
procedure TAuto.Initialize;
begin
inherited Initialize;
// IE启动本程序后不会自动结束
if ComServer.ObjectCount=2 then ObjAddRef;
end;
function MyAutomationTerminateProc: Boolean;
begin
Result:= True;
Halt; // 去掉Ole关闭时的英文警告信息
end;
function TAuto.AddUrl(const Url, Comment, Referer: WideString): WordBool;
begin
Form1.Label1:=OleStrToString(Url);
Form1.Label2:=OleStrToString(Comment);
Result:=WordBool(true);
end;
initialization
TAutoObjectFactory.Create(ComServer, TAuto, Class_Auto,
ciMultiInstance, tmApartment);
AddTerminateProc(@MyAutomationTerminateProc);
end.
以下是IE所调用的VBS源码：
<script language="VBScript">
Sub AddLink(Url,Info)
On Error Resume Next
Set Obj=CreateObject("UrlCat.App")
if err<>0 then
MsgBox("无法初始化网址猫")
Exit Sub
end if
call Obj.AddUrl(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)
Call AddLink(external.menuArguments.document.url,external.menuArguments.document.Title)
exit sub
end if
Loop
Call AddLink(srcAnchor.href,srcAnchor.innerText)
elseif 1=1 then
MsgBox("Unknown Event Source """ + srcEvent.type + """" + vbCrLf + "Please send description of error to ligwin@cmmail.com")
end if
end sub
call OnContextMenu()
</script>
在注册表中的HKEY_CURRENT_USER/Software/Microsoft/Internet Explorer/MenuExt处新建一个
主键，其名称即为向IE窗口鼠标右键所添加的菜单项的名称。然后将其默内键值改为上面那段VBS
所存成的文件名称（一般扩展为HTM），最后，嘿嘿，运行一下你的程序，看一看效果。
应该注意的是，新建自动控制单元时，为自动控制类起的名称即以后调用时的接口名称。如本例
中接口名称为App，则调用时应该用CreateObject("UrlCat.App")（UrlCat是应用程序自己的名称
），另外包含自动控制类型库的应用程序在运行之前还要注册一下，注册方法即，单击类型库编
辑窗口上的有注册表图标的按钮（第一次使用时可能该图标不能被选中，这时可以重新进入一个
该项目，然后再单击该按钮对类型库进行注册）。另外还可以使用TRegsvr（DELPHI自带的，在BI
N目录下）进行注册，方法是Tregsvr 待注册应用程序名。程序在分发时也应该注意这个问题，幸
好现在很多的安装工具已经提供了像注册类型库这样的高级功能。
如果还有什么不懂的话，可以写信给我。
to honghs:
其实"download all by netants"的功能现起来也比较简单，基本原理同上，具体参考一下，
蚂蚁目录下的NaGetAll.htm（其实现也一个VB脚本）。
