在Delphi中使用IHTMLDocument2以静默方式阻止cookies警告

在Delphi中使用IHTMLDocument2以静默方式阻止cookies警告,delphi,cookies,delphi-xe,Delphi,Cookies,Delphi Xe,我正在使用IHTMLDocument2对一组网站进行爬网。我正在创建IHTMLDocument2实例,如下所示: var myDownload : TDownLoadURL; doc: OleVariant; (...) myDownload:= TDownLoadURL.Create(nil); with myDownload do begin URL:=myURL; Filename:

我正在使用IHTMLDocument2对一组网站进行爬网。我正在创建IHTMLDocument2实例,如下所示:

    var
      myDownload : TDownLoadURL;
      doc: OleVariant;
    (...)
      myDownload:= TDownLoadURL.Create(nil);
      with myDownload do
      begin
        URL:=myURL;
        Filename:= GetTempDirectory+'temp_download_url_complete2.txt';
        ExecuteTarget(nil);
      end;
(...)
      doc := coHTMLDocument.Create as IHTMLDocument2;
      doc.write(html);
      doc.close;
(...)
有一个特定的网站会弹出一条消息,其中包含:

要允许本网站为您提供个性化信息, 你会允许它在你的电脑上放一个叫做cookie的小文件吗 电脑


我已将操作系统Windows 2008 SE Internet选项更改为在没有提示的情况下阻止Cookie,但消息不断出现。如何在静默模式下创建IHTMLDocument2?

恐怕您无法轻松隐藏该消息。为什么?

首先,你需要了解为什么这条信息会出现在特定的网站上。简而言之,欧盟今年开始使用的关于处理饼干的新法律并不确定具体何时:

然后,您需要意识到显示的消息不是任何类型的标准弹出消息,而是硬编码到网站中。更糟糕的是,每个网站所有者都使用自己的方法来实现这一点

顺便说一句,禁用web浏览器中的Cookie不会阻止显示该消息。为什么?如果一个网站想要查看是否有cookie,它必须向客户端计算机发送cookie。但法律要求用户在任何cookie被发送到客户端计算机之前都要得到有关cookie使用的警告


因此,只需单击一次“我接受使用cokies”可能会更容易,而且该消息可能不会显示在agina上。为什么?因为在sich场景中,webite会创建一个永久cookie,其中存储您已经同意使用cookie的信息。

如果您需要抑制IHTMLDocument用户界面或用户通知,则需要同时实现IOleClientSite和定义为DISPID_ambient_DLCONTROL的ambient属性。 从文件中:

主机可以控制下载帧、图像、Java、, 依此类推,通过实现IOleClientSite和环境属性 定义为DISPID\u AMBIENT\u DLCONTROL。当主机的IDispatch::Invoke 方法调用时,DISPID member设置为DISPID\u AMBIENT\u DLCONTROL,则 应将零或以下值的组合置于 pvarResult

在这种情况下,您需要的标志是DLCTL_SILENT,也可能是DLCTL_NO_脚本

如前所述,如果希望从文档(例如DISPID_READYSTATE)获取事件通知,主机还应实现IDispatch.Invoke和可选的IPropertyNotifySink或其他对象

看看源代码,看看这是如何实现的。特别是IEParser.pas和UI_Less.pas。它已经完全满足了你的需要

以下是一个基于UI_Less的简化演示,无需实现IPropertyNotifySink:


您设置了静默标志吗?您可以使用websearch TDownloadURL没有静默属性,对吗?我想要么使用隐藏的TWebBrowser,要么使用IOleClientSite和SetClientSite。@David是对的。您需要实现IOleClientSite;IPropertyNotifySink;如果要在不使用TWebBrowser的情况下使用IHTMLDocument2,请使用IDispatch。我建议你看看资料来源。特别是IEParser.pas和UI_Less.pas。您可能需要考虑直接使用这些组件。这正是你需要的。他没有浏览器控件,所以他看不到页面。似乎正在显示一个弹出对话框。该警告作为Windows安全警告通过操作系统发出。我已经将所有安全策略降低到最低限度,但没有成功,真的吗?如果不是秘密,介意分享网页链接吗?我以前从未见过这种行为。@SilverWarior我想知道为什么这个答案仍然以这种形式存在,因为你知道它是wrong@SilverWarior这里记录了操作系统的这种行为:你是一个英雄。非常感谢你!
uses ..., ActiveX, MSHTML;

const
  DISPID_AMBIENT_DLCONTROL = (-5512);

type
  TUILess = class(TComponent, IUnknown, IDispatch, IOleClientSite)
    protected
    // IDispatch
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HRESULT; stdcall;
    // IOleClientSite
    function SaveObject: HRESULT; stdcall;
    function GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;
      out mk: IMoniker): HRESULT; stdcall;
    function GetContainer(out container: IOleContainer): HRESULT; stdcall;
    function ShowObject: HRESULT; stdcall;
    function OnShowWindow(fShow: BOOL): HRESULT; stdcall;
    function RequestNewObjectLayout: HRESULT; stdcall;
  end;

implementation

function TUILess.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HRESULT;
const
  DLCTL_NO_SCRIPTS = $00000080;
  DLCTL_NO_JAVA = $00000100;
  DLCTL_NO_RUNACTIVEXCTLS = $00000200;
  DLCTL_NO_DLACTIVEXCTLS = $00000400;
  DLCTL_DOWNLOADONLY = $00000800;
  DLCTL_SILENT = $40000000;
var
  I: Integer;
begin
  if DISPID_AMBIENT_DLCONTROL = DispID then
  begin
    I := DLCTL_DOWNLOADONLY + DLCTL_NO_SCRIPTS +
      DLCTL_NO_JAVA + DLCTL_NO_DLACTIVEXCTLS +
      DLCTL_NO_RUNACTIVEXCTLS +
      DLCTL_SILENT;
    PVariant(VarResult)^ := I;
    Result := S_OK;
  end
  else
    Result := DISP_E_MEMBERNOTFOUND;
end;

function TUILess.SaveObject: HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TUILess.GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;
  out mk: IMoniker): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TUILess.GetContainer(out container: IOleContainer): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TUILess.ShowObject: HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TUILess.OnShowWindow(fShow: BOOL): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TUILess.RequestNewObjectLayout: HRESULT;
begin
  Result := E_NOTIMPL;
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  cHTML: WideString = '<b>test</b><script>alert("boo")</script>';
var
  Doc: IHTMLDocument2;
  DocClientSite: TUILess;
begin
  DocClientSite := TUILess.Create(nil);
  try
    Doc := coHTMLDocument.Create as IHTMLDocument2;
    try
      (Doc as IOleObject).SetClientSite(DocClientSite);
      (Doc as IOleControl).OnAmbientPropertyChange(DISPID_AMBIENT_DLCONTROL); // Invoke
      OleVariant(Doc).write(cHTML);
      Doc.close;
      ShowMessage(Doc.body.innerHtml); // Test
    finally
      (Doc as IOleObject).SetClientSite(nil);
      Doc := nil;
    end;
  finally
    DocClientSite.Free;
  end;
end;