unit UIEMonitor;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, ActiveX, Classes, ComObj, SHDOCVW, Dialogs, SysUtils, Forms;
type
  TIEMonitor = 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 SetSite(const pUnkSite:IUnknown):HResult;stdcall;
    function GetSite(const riid:TIID;out site:IUnknown):HResult;stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  private
    IEThis:IWebBrowser2;
    Cookie:Integer;
  protected
  end;

const
  Class_IEMonitor: TGUID = '{47CFDDF9-6FBD-4C06-8752-24FEFBA10D51}';
  HasQuit=888;//標志已經退出
  
var
  isStart:Integer;//標志是否正在退出
 // WIMS:TWIMS;

implementation

uses ComServ;

procedure DoBeforeNavigate2(const pDisp:IDispatch;var URL:OleVariant;
  var Flags:OleVariant;var TargetFrameName:OleVariant;var PostData:OleVariant;
  var Headers:OleVariant;var Cancel:WordBool);
var
  i:Integer;
  s:string;
begin
  s:=URL;
  s:=uppercase(s);
  if pos('163',s)<>0 then  begin
        ShowMessage('notok');
        Cancel:=true;
  end else begin
  end;
end;

procedure DoDownloadComplete(IEThis:IWebBrowser2);
begin
  //可以在該函數中處理網頁文本以及圖象等信息
end;

procedure DoOnQuit;
begin
 { if(Assigned(WIMS))then
  begin
    WIMS.Free;
    //ShowMessage('釋放了TWIMS！');
  end;//}
  //ShowMessage('執行DoOnQuit事件！'+IntToStr(isStart));
  //isStart:=HasQuit;//標志已經退出
end;

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

function TIEMonitor.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
      104:begin
          DoDownLoadComplete(IEThis);
          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; 
      253:begin
          DoOnQuit();
          Result:=S_OK;
        end;
    end;//end of case DispID of
  finally
    if(bHasParams)then
      FreeMem(pDispIDs,iDispIDsSize);
  end;
end;

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

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

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

function TIEMonitor.GetSite(const riid:TIID;out site:IUnknown):HResult;
begin
  //ShowMessage('執行了GetSite事件！');
  if(Assigned(IEThis))then
    Result:=IEThis.QueryInterface(riid,site)
  else Result:=E_FAIL;
end;

function TIEMonitor.SetSite(const pUnkSite:IUnknown):HResult;
var
  cmdTarget:IOleCommandTarget;
  Sp:IServiceProvider;
  CPC:IConnectionPointContainer;
  CP:IConnectionPoint;
begin
  //ShowMessage('執行了SetSite事件！');
  if(Assigned(pUnkSite))then
  begin
    cmdTarget:=(pUnkSite as IOleCommandTarget);
    Sp:=(CmdTarget as IServiceProvider);
    if(Assigned(Sp))then//獲得IE的WebBrowser接口，
      Sp.QueryService(IWebBrowserApp,IWebBrowser2,IEThis);
    if(Assigned(IEThis))then
    begin
      IEThis.QueryInterface(IConnectionPointContainer,CPC);//尋找連接點
      CPC.FindConnectionPoint(DWEBBrowserEvents2,CP);
      CP.Advise(Self,Cookie);//通過Advise方法建立Com自身與連接點的連接
    end;
  end;
  Result:=S_OK;
end;

initialization
  TComObjectFactory.Create(ComServer, TIEMonitor, Class_IEMonitor,
    'IEMonitor', '', ciMultiInstance, tmApartment);
  isStart:=HasQuit-1;

end.