CODEWITHSUNDEEP
delphicookiesdelphi-xe
Miguel E
Miguel E

Reputation: 1336

Silently block cookies warning with IHTMLDocument2 in Delphi

I'm using IHTMLDocument2 to crawl a group of websites. I'm creating the IHTMLDocument2 instance as this:

    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;
(...)

There's a particular website that pops up a message with:

to allow this website to provide information personalised for you, will you allow it to put a small file (called a cookie) on your computer?

I've changed the OS (Windows 2008 SE) Internet Options to block cookies without prompting, but the message keeps coming up. How can I create the IHTMLDocument2 in silent mode?

Upvotes: 2

Views: 1062

Answers (2)

kobik
kobik

Reputation: 21252

If you need to suppress IHTMLDocument user interface or user notification you will need to implement both IOleClientSite and an ambient property defined as DISPID_AMBIENT_DLCONTROL.
From the documentation "Download Control":

Hosts can control certain aspects of downloading—frames, images, Java, and so on—by implementing both IOleClientSite and an ambient property defined as DISPID_AMBIENT_DLCONTROL. When the host's IDispatch::Invoke method is called with dispidMember set to DISPID_AMBIENT_DLCONTROL, it should place zero or a combination of the following values in pvarResult.

The flag that you need in this case is DLCTL_SILENT (and maybe DLCTL_NO_SCRIPTS too).

As mentioned, the host should also implement IDispatch (.Invoke) and optionally IPropertyNotifySink (or other COM event sink object) if you wish to get event notifications from the document (such as DISPID_READYSTATE for example).

Take a look at EmbeddedWB sources to see how this is implemented. specially IEParser.pas and UI_Less.pas. It does already exactly what you need.

Here is a simplified demo based on UI_Less (without implementing IPropertyNotifySink):

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;

Upvotes: 4

SilverWarior
SilverWarior

Reputation: 8386

I'm afraid you won't be able to hide that message easily. Why?

First you need to learn about the reason why that message is even shown on that particular website. The short answer is the new law bout handling cookies that European Union started to use sometimes this year (not sure when exactly):

http://ico.org.uk/for_organisations/privacy_and_electronic_communications/the_guide/cookies?hidecookiesbanner=true

Then you need to realize that the message that is shown isn't any kind of standard popup message but it is hardcoded into the website. And for what is worse each website owner uses its own approach of doing this.

BTW Disabling cookies in your web broswer won't prevent that message from showing. Why? If a website wants to see if cookies are alowed it must send a cookie to a client computer. But the law requires that user is warned about the use of cookies before any of them are even sent to the client computer.

So it might be easier to simply click on I accept the use of cokies once and that message probably won't be shown agina. Why? Becouse in sich scenario webite creates a permament cookie which stores the information that you already agreed to use cookies.

Upvotes: 0

Related Questions