弱智问题，安装IE插件(50分)

我开发了一个activeX ie插件但是不会安装，只有一个.dll的文件
请问各位大侠我怎样才能安装这个.dll文件呀

我想应该是将它重新编译为OCX控件，然后安装吧，
既然是自己写的ACTIVEX插件，那么改为OCX不难吧！

regsvr32 yourdll.dll

对，asp插件在服务器上注册一下就可以。

这样已经可以做到象3721那样的效果了吗？即
在地址栏填一个地址，自动通过这个程序做其它东西

利用Delphi编写IE扩展

在自己的程序中使用过WebBrowser控件的朋友都知道，WebBrowser控件定义了诸如BeforeNavigate、DownloadComplete 等事件，我们可以通过编写事件处理代码实现对WebBrowser控件的操作。那么如何实现对IE的事件响应和处理呢？同建立IE面板一样。我们需要建立一个实现IObjectWithSite接口的COM组件，不同的是，我们还需要实现IDispatch接口，在IObjectWithSite接口的SetSite方法中获得IE的WebBrowser接口并建立自身与WebBrowser的连接，然后如果在IE的Webbrowser对象中发生什么事件的话，那么IE就会回调连接的IDispatch接口的Invoke方法。我们通过在Invoke方法中编写代码就可以获得IE事件了。这个利用的是COM编程的回调接口原理。
下面我们首先来实现代码。点击Delphi菜单 File | New 。在 ActiveX 页面中选择Active Library ，然后点击 OK 按钮。然后用同样的方法建立一个COM Object。在COM Object Wizard 窗口中，将复选框 Included typelibrary 去掉。然后在Class Name中输入IEHelper，在Implemented Interface中输入：IDispatch；IObjectwithSite 。然后点击 OK 按钮建立一个COM组件。保存工程，将工程保存为IEHelper.dpr，将Unit1保存为IEHelperUnit.pas。下面是IEHelperUnit.pas的具体代码：
unit iehelperunit;

interface

uses
WIndows, Comobj, ActiveX, SHDOCVW, MSHTML,Dialogs;


type

TIEHelperFactory = class(TComObjectFactory)
private
procedure AddKeys;
procedure RemoveKeys;
public
procedure UpdateRegistry(Register: Boolean)
override;
end;


TIEHelper = class(TComObject, IDispatch, IObjectWithSite)
public
function GetTypeInfoCount(out Count: Integer): HResult
stdcall;
function GetTypeInfo(Index, LocaleID: Integer
out TypeInfo):
HResult
stdcall;
function GetIDsOfNames(const IID: TGUID
Names: Pointer;
NameCount, LocaleID: Integer
DispIDs: Pointer): HResult;
stdcall;
function Invoke(DispID: Integer
const IID: TGUID
LocaleID:
Integer;
Flags: Word
var Params
VarResult, ExcepInfo, ArgErr:
Pointer): HResult
stdcall;
function SetSite(const pUnkSite: IUnknown): HResult
stdcall;
function GetSite(const riid: TIID
out site: IUnknown): HResult;
stdcall;
private
IE: IWebbrowser2;
Cookie: Integer;
end;

const
Class_IEHelper: TGUID = '{3D898C55-74CC-4B7C-B5F1-45913F368388}';


implementation

uses ComServ, Registry, SysUtils;


procedure DoStatusTextChange(const Text: WideString);
begin

end;

procedure DoProgressChange(Progress: Integer
ProgressMax: Integer);
begin

end;

procedure DoCommandStateChange(Command: Integer
Enable: WordBool);
begin

end;

procedure DoDownloadBegin;
begin

end;

procedure DoDownloadComplete;
begin

end;

procedure DoTitleChange(const Text: WideString);
begin

end;

procedure DoPropertyChange(const szProperty: WideString);
begin

end;

procedure DoBeforeNavigate2(const pDisp: IDispatch
var URL:
OleVariant
var Flags: OleVariant
var TargetFrameName: OleVariant;
var PostData: OleVariant
var Headers: OleVariant
var Cancel:
WordBool);
begin
if URL<>'http://www.applevb.com/'then begin
Showmessage('你不可以浏览其它站点');
Cancel:=True;
URL:='http://www.applevb.com';
(pDisp as
IWebbrowser2).Navigate2(URL,Flags,TargetFrameName,PostData,Headers);
end;
end;

procedure DoNewWindow2(var ppDisp: IDispatch
var Cancel: WordBool);
begin

end;

procedure DoNavigateComplete2(const pDisp: IDispatch
var URL:
OleVariant);
begin

end;

procedure DoDocumentComplete(const pDisp: IDispatch
var URL:
OleVariant);
begin

end;

procedure DoOnQuit;
begin

end;

procedure DoOnVisible(Visible: WordBool);
begin

end;

procedure DoOnToolBar(ToolBar: WordBool);
begin

end;

procedure DoOnMenuBar(MenuBar: WordBool);
begin

end;

procedure DoOnStatusBar(StatusBar: WordBool);
begin

end;

procedure DoOnFullScreen(FullScreen: WordBool);
begin

end;

procedure DoOnTheaterMode(TheaterMode: WordBool);
begin

end;


procedure BuildPositionalDispIds(pDispIds: PDispIdList
const dps:
TDispParams);
var
i: integer;
begin
Assert(pDispIds <> nil);
for i := 0 to dps.cArgs - 1 do
pDispIds^ := dps.cArgs - 1 - i;
if (dps.cNamedArgs <= 0) then Exit;
for i := 0 to dps.cNamedArgs - 1 do
pDispIds^[dps.rgdispidNamedArgs^] := i;
end;

function TIEHelper.Invoke(DispID: Integer
const IID: TGUID;
LocaleID: Integer;
Flags: Word
var Params
VarResult, ExcepInfo, ArgErr: Pointer):
HResult;
type
POleVariant = ^OleVariant;
var
dps: TDispParams absolute Params;
bHasParams: boolean;
pDispIds: PDispIdList;
iDispIdsSize: integer;
begin
Result := DISP_E_MEMBERNOTFOUND;
pDispIds := nil;
iDispIdsSize := 0;
bHasParams := (dps.cArgs > 0);
if (bHasParams) then
begin
iDispIdsSize := dps.cArgs * SizeOf(TDispId);
GetMem(pDispIds, iDispIdsSize);
end;
try
if (bHasParams) then BuildPositionalDispIds(pDispIds, dps);
case DispId of
102:
begin
DoStatusTextChange(dps.rgvarg^[pDispIds^[0]].bstrval);
Result := S_OK;
end;
108:
begin
DoProgressChange(dps.rgvarg^[pDispIds^[0]].lval,
dps.rgvarg^[pDispIds^[1]].lval);
Result := S_OK;
end;
105:
begin
DoCommandStateChange(dps.rgvarg^[pDispIds^[0]].lval,
dps.rgvarg^[pDispIds^[1]].vbool);
Result := S_OK;
end;
106:
begin
DoDownloadBegin();
Result := S_OK;
end;
104:
begin
DoDownloadComplete();
Result := S_OK;
end;
113:
begin
DoTitleChange(dps.rgvarg^[pDispIds^[0]].bstrval);
Result := S_OK;
end;
112:
begin
DoPropertyChange(dps.rgvarg^[pDispIds^[0]].bstrval);
Result := S_OK;
end;
250:
begin

DoBeforeNavigate2(IDispatch(dps.rgvarg^[pDispIds^[0]].dispval),
POleVariant(dps.rgvarg^[pDispIds^[1]].pvarval)^,
POleVariant(dps.rgvarg^[pDispIds^[2]].pvarval)^,
POleVariant(dps.rgvarg^[pDispIds^[3]].pvarval)^,
POleVariant(dps.rgvarg^[pDispIds^[4]].pvarval)^,
POleVariant(dps.rgvarg^[pDispIds^[5]].pvarval)^,
dps.rgvarg^[pDispIds^[6]].pbool^);
Result := S_OK;
end;
251:
begin

DoNewWindow2(IDispatch(dps.rgvarg^[pDispIds^[0]].pdispval^),
dps.rgvarg^[pDispIds^[1]].pbool^);
Result := S_OK;
end;
252:
begin

DoNavigateComplete2(IDispatch(dps.rgvarg^[pDispIds^[0]].dispval),
POleVariant(dps.rgvarg^[pDispIds^[1]].pvarval)^);
Result := S_OK;
end;
259:
begin

DoDocumentComplete(IDispatch(dps.rgvarg^[pDispIds^[0]].dispval),
POleVariant(dps.rgvarg^[pDispIds^[1]].pvarval)^);
Result := S_OK;
end;
253:
begin
DoOnQuit();
Result := S_OK;
end;
254:
begin
DoOnVisible(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;
255:
begin
DoOnToolBar(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;
256:
begin
DoOnMenuBar(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;
257:
begin
DoOnStatusBar(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;
258:
begin
DoOnFullScreen(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;
260:
begin
DoOnTheaterMode(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;
end;
finally
if (bHasParams) then FreeMem(pDispIds, iDispIdsSize);
end;
end;


function TIEHelper.GetIDsOfNames(const IID: TGUID
Names: Pointer;
NameCount, LocaleID: Integer
DispIDs: Pointer): HResult;
begin
Result := E_NOTIMPL;
end;

function TIEHelper.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
Result := E_NOTIMPL;
pointer(TypeInfo) := nil;
end;

function TIEHelper.GetTypeInfoCount(out Count: Integer): HResult;
begin
Result := E_NOTIMPL;
Count := 0;
end;


function TIEHelper.GetSite(const riid: TIID
out site: IUnknown):
HResult;
begin
// Result := S_OK;
if Assigned(IE) then result:=IE.QueryInterface(riid, site)
else
Result:= E_FAIL;
end;

function TIEHelper.SetSite(const pUnkSite: IUnknown): HResult;
var
cmdTarget: IOleCommandTarget;
Sp: IServiceProvider;
CPC: IConnectionPointContainer;
CP: ICOnnectionPoint;
begin
if Assigned(pUnkSite) then begin
cmdTarget := pUnkSite as IOleCommandTarget;
Sp := CmdTarget as IServiceProvider;

if Assigned(Sp)then
Sp.QueryService(IWebbrowserApp, IWebbrowser2, IE);
if Assigned(IE) then begin
IE.QueryInterface(IConnectionPointContainer, CPC);
CPC.FindConnectionPoint(DWEBbrowserEvents2, CP);
CP.Advise(Self, Cookie)
end;
end;
Result := S_OK;
end;


procedure TIEHelperFactory.AddKeys;
var S: string;
begin
S := GUIDToString(CLASS_IEHelper);
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
if
OpenKey('Software/Microsoft/Windows/CurrentVersion/explorer/Browser
Helper Objects/' + S, TRUE)
then CloseKey;
finally
free;
end;
end;

procedure TIEHelperFactory.RemoveKeys;
var S: string;
begin
S := GUIDToString(CLASS_IEHelper);
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;

DeleteKey('Software/Microsoft/Windows/CurrentVersion/explorer/Browser
Helper Objects/' + S);
finally
free;
end;
end;

procedure TIEHelperFactory.UpdateRegistry(Register: Boolean);
begin
inherited UpdateRegistry(Register);
if Register then AddKeys else RemoveKeys;
end;

initialization
TIEHelperFactory.Create(ComServer, TIEHelper, Class_IEHelper,
'IEHelper', '', ciMultiInstance, tmApartment);
end.

代码很长，但是关键的是TIEHelper.SetSite方法以及TIEHelper.Invoke方
法。在TIEHelper.SetSite方法中注意以下语句：
if Assigned(Sp)then
Sp.QueryService(IWebbrowserApp, IWebbrowser2, IE);
if Assigned(IE) then begin
IE.QueryInterface(IConnectionPointContainer, CPC);
CPC.FindConnectionPoint(DWEBbrowserEvents2, CP);
CP.Advise(Self, Cookie)

上面的语句作用是，首先获得IE的Webbrowser接口，然后寻找到连接点。并通过Advise方法建立COM自身与连接点的连接。当连接建立成功后，IE在有事件引发后，会调用连接到自身的IDispatch接口对象的Invoke方法。不同的事件对应不同的DispID编码，我们可以在程序中判断DispID并做相应的处理。在上面的程序中，我们只处理了BeforeNavigate2事件，处理函数是DoBeforeNavigate2，在该函数中，如果浏览的站点不是'http://www.applevb.com/'的话，程序会提示：'你不可以浏览其它站点'并强行转到http://www.applevb.com。
很多的软件，象“护花使者”以及“3721”一类的中文网址”都是利用上面的原理来实现对IE浏览器事件响应的，例如3721，当用户输入一个中文词并浏览时，COM组件可以在BeforeNavigate2 事件中编写代码访问服务器并转到正确的站点上去

这个程序到底哪里出现了问题！我虽然编释成功，但是并没有实到限制的功能！
Help~~~

help me~~~

关注！

up~~~

我自己写的IE插件，主要是限制只能上哪些网的作用

unit IEHelperOP_IMPL;

interface

uses
Windows, ActiveX, ComObj, SHDocVw;

type

TIEHelperOPFactory = class(TComObjectFactory)
private
procedure AddKeys;
procedure RemoveKeys;
public
procedure UpdateRegistry(Register: Boolean)
override;
end;

TIEHelperOP = class(TComObject, IObjectWithSite, IDispatch)
private
FConnection: Longint;
FWebBrowser: IWebBrowser2;

procedure Connect2Browser(const Connect: Boolean = True);
procedure SpyBeforeNavigate(Params: Pointer);

protected
{IObjectWithSite methods}
function SetSite(const pUnkSite: IUnknown ):HResult
stdcall;
function GetSite(const riid: TIID
out site: IUnknown):HResult
stdcall;
{IDispatch methods}
function GetTypeInfoCount(out Count: Integer): HResult
stdcall;
function GetTypeInfo(Index, LocaleID: Integer
out TypeInfo): HResult
stdcall;
function GetIDsOfNames(const IID: TGUID
Names: Pointer;
NameCount, LocaleID: Integer
DispIDs: Pointer): HResult
stdcall;
function Invoke(DispID: Integer
const IID: TGUID
LocaleID: Integer;
Flags: Word
var Params
VarResult, ExcepInfo, ArgErr: Pointer): HResult
stdcall;

public
procedure Initialize()
override;
destructor Destroy()
override;

end;

const
Class_IEHelperOP: TGUID = '{49E0E0F0-5C30-11D4-945D-000000000000}';

implementation

uses ComServ, SysUtils, Registry;

resourcestring
BHO_ROOT_KEY = 'SOFTWARE/Microsoft/Windows/CurrentVersion/Explorer/Browser Helper Objects/';

procedure TIEHelperOPFactory.AddKeys;
begin
with TRegistry.Create() do
try
RootKey := HKEY_LOCAL_MACHINE;
if OpenKey( BHO_ROOT_KEY + GUIDToString(Class_IEHelperOP), True)
then CloseKey;
finally
Free();
end;
end;

procedure TIEHelperOPFactory.RemoveKeys;
begin
with TRegistry.Create() do
try
RootKey := HKEY_LOCAL_MACHINE;
DeleteKey(BHO_ROOT_KEY + GUIDToString(Class_IEHelperOP));
finally
Free();
end;
end;

procedure TIEHelperOPFactory.UpdateRegistry(Register: Boolean);
begin
inherited;
if Register then
Self.AddKeys()
else Self.RemoveKeys();
end;

procedure TIEHelperOP.Initialize;
begin
inherited;
end;

destructor TIEHelperOP.Destroy;
begin
inherited;
end;

procedure TIEHelperOP.Connect2Browser(const Connect: Boolean);
begin
if Connect then
InterfaceConnect(FWebBrowser, DWebBrowserEvents2, Self, FConnection)
else
InterfaceDisconnect(FWebBrowser, DWebBrowserEvents2, FConnection);
end;

procedure TIEHelperOP.SpyBeforeNavigate(Params: Pointer);
var
BlockFile: TextFile;
ISBlock: Boolean;
WebVar: String;
begin
if PDispParams(Params).cArgs >= 5 then
begin
AssignFile(BlockFile, 'c:/windows/IEBlock');
Reset(BlockFile);
if POS('http://',PDispParams(Params)^.rgvarg[5].pvarVal^)<1 then
ISBlock:= True;

//判断IEBlock有没有这个地址
if (not ISBlock) then
while not SeekEof(BlockFile) do
begin
Readln(BlockFile, WebVar);
if POS(WebVar,PDispParams(Params)^.rgvarg[5].pvarVal^)>0 then
begin
ISBlock:= True;
Break;
end;
end;

if not ISBlock then
begin
PDispParams(Params)^.rgvarg[0].pbVal^ := 1;
try
Self.FWebBrowser.Stop();
Self.FWebBrowser.Navigate('about:blank', EmptyParam, EmptyParam, EmptyParam, EmptyParam);
Windows.MessageBox(0, PChar(Format('该网址不可以连接: %s', [PDispParams(Params)^.rgvarg[5].pvarVal^])), 'IEBlock', MB_OK);
except
on E: Exception do
Windows.MessageBox(0, PChar(Format('Exception raised: %s', [E.Message])), 'IEBlock', MB_OK);
end;
end;

CloseFile(BlockFile);
end;

end;

function TIEHelperOP.SetSite(const pUnkSite: IUnknown): HResult;
begin
if Assigned(pUnkSite) then
begin
Self.FWebBrowser := pUnkSite as IWebBrowser2;
Self.Connect2Browser();
Result := S_OK;
end
else
Result := E_FAIL;
end;

function TIEHelperOP.GetSite(const riid: TIID
out site: IUnknown): HResult;
begin
site := nil;
Result := E_FAIL;
end;

function TIEHelperOP.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
Result := E_NOTIMPL;
end;

function TIEHelperOP.GetTypeInfoCount(out Count: Integer): HResult;
begin
Count := 0;
Result := S_OK;
end;

function TIEHelperOP.GetIDsOfNames(const IID: TGUID
Names: Pointer;
NameCount, LocaleID: Integer
DispIDs: Pointer): HResult;
begin
Result := E_NOTIMPL;
end;

function TIEHelperOP.Invoke(DispID: Integer
const IID: TGUID;
LocaleID: Integer
Flags: Word
var Params
VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
begin
case DispID of
103: Self.Connect2Browser(False);
250: Self.SpyBeforeNavigate(Pointer(@Params));
end;
Result := S_OK

end;

initialization
TIEHelperOPFactory.Create(ComServer, TIEHelperOP, Class_IEHelperOP,
'IEHelperOP', 'IE 4.x-5.x BHO in ObjectPascal', ciMultiInstance, tmApartment);

多人接受答案了。