Table of Contents

Created by: gwideman, Feb 1, 2012 10:31 am
Revised by: gwideman, Feb 1, 2012 10:46 am (3 revisions)

Overview

After struggling to figure out how to tell TWebBrowser not to run scripts or download images and videos etc, and wading through a mountain of OLE baloney, it all turns out to be pretty simple...
  • Create a new component TWebBrowserTamed
    • Inherits from TWebBrowser (or optionally from TWebBrowserEx)
    • Implement IDispatch.Invoke
      • set Ambient Control flags as desired.

Code

Component unit
unit WebBrowserTamed;
 
{ Super quick and dirty version of TWebBrowser
which disables scripts and also download and
playing of videos, sounds, images
 
Version history
----------------
2011-02-01 GW Original
 
Graham Wideman (gwideman)
}
 
 
 
interface
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.OleCtrls
  , SHDocVw
  , Vcl.StdCtrls
  , MSHTML
  ;
 
type
  //--------------------------------------
  // Shamelessly cadged from TWebBrowserEx
  //--------------------------------------
  TWebBrowserTamed = class(TWebBrowser, IDispatch {+ others from ancestor })
  //--------------------------------------
    { IDispatch }
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  end;
implementation
uses
    Mshtmdid
  , Winapi.ActiveX;
 
 
{ TWebBrowserTamed }
 
function TWebBrowserTamed.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): HResult;
var
  AmbientControlFlags: Integer;
begin
  Result := inherited Invoke(DispID, IID, LocaleID, Flags, Params, VarResult, ExcepInfo, ArgErr);
  if (Flags and DISPATCH_PROPERTYGET <> 0) and (VarResult <> nil) then
  begin
    Result := S_OK;
    case DispID of
      DISPID_AMBIENT_DLCONTROL:
      begin
        AmbientControlFlags :=
          //------ complete list ------
          //  DLCTL_DLIMAGES +
          //  DLCTL_VIDEOS +
          //  DLCTL_BGSOUNDS +
            DLCTL_NO_SCRIPTS +
            DLCTL_NO_JAVA +
            DLCTL_NO_RUNACTIVEXCTLS +
            DLCTL_NO_DLACTIVEXCTLS +
          //  DLCTL_DOWNLOADONLY +
          //  DLCTL_NO_FRAMEDOWNLOAD +
          //  DLCTL_RESYNCHRONIZE +
          //  DLCTL_PRAGMA_NO_CACHE +
          //  DLCTL_NO_BEHAVIORS +
          //  DLCTL_NO_METACHARSET +
          //  DLCTL_URL_ENCODING_DISABLE_UTF8 +
          //  DLCTL_URL_ENCODING_ENABLE_UTF8 +
          //  DLCTL_FORCEOFFLINE +
          //  DLCTL_NO_CLIENTPULL +  // ???
          //  DLCTL_SILENT +         // Might be desireable
          //  DLCTL_OFFLINEIFNOTCONNECTED +
          0 ;
 
        PVariant(VarResult)^ := AmbientControlFlags;
        Result := S_OK;
        PVariant(VarResult)^ := AmbientControlFlags;
      end;
      DISPID_AMBIENT_USERMODE:
        PVariant(VarResult)^ := WordBool(True);
    else
      Result := DISP_E_MEMBERNOTFOUND;
    end;
  end;
end;
end.
 

Invocation test code
procedure Tfm_Main.bt_CreateWBClick(Sender: TObject);
begin
  wb := TWebBrowserTamed.Create(self);
  TControl(wb).Parent := pa_Browser;
  wb.Align := alClient;
  wb.Visible := true;
end;
 
procedure Tfm_Main.bt_NavigateClick(Sender: TObject);
begin
  wb.Navigate(ed_URL.Text);
end;

Further Thoughts

Of course, this could be prettied up a bit.

AmbientControlFlags should be a property, from which IDispatch.Invoke would read. Setting the property would call IOLEControl.OnAmbientPropertyChange to prompt TWebBrowserTamed to re-request the ambient values.

And of course, it should be turned into a visual component.