需要建立一个COM对象，实现IDispatch, IObjectWithSite接口，如下

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;

在SetSite方法中处理与IE的连接：

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;

然后当IE事件引发后，会调用服务器的Invoke事件，在事件中判断DispID并执行

相应的处理：

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;

最后，需要在注册时在注册表中添加附加信息以便IE调用：

type

 TIEHelperFactory = class(TComObjectFactory)

 private

   procedure AddKeys;

   procedure RemoveKeys;

 public

   procedure UpdateRegistry(Register: Boolean); override;

 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.