[Windows] WebGadget download control: block scripts,java,img
Posted: Thu May 07, 2009 1:49 am
After reading MSDN and many examples on the web I am finally ready to present an example of WebGadget customization.
This example shows how you can block images, videos, background sounds, script execution, java, activex, ... in a WebGadget. Look at MSDN for the whole list.
It is based heavily on the code of soerenkj & nico's IDispatch implementation and the UI-lessParser, a Delphi example showing the use of MSHTML as a HTML parser without user interface (based on WalkAll example from Windows SDK), some code generated by visual designer and some datasection lines of srod's COMate.
It involves iplementing two interfaces: IDispatch and IOleClientSite.
The new IOleClientSite interface is registered with the WebGadget by querying its IOleObject interface and calling the SetClientSite method.
Then we query the WebGadgets IOleControl interface and call the OnAmbientPropertyChange method. This triggers the WebGadget to query our IOleClientSite for IDispatch interface and call Invoke method of our IDispatch implementation. This is where we can control the browsers behavior just by setting the referenced pVarResult accordingly.
Please read MSDN or the Delphi example website for more information on internal workings and for a description of the flags you can use.
There are probably some errors like missing de-initialization => memory leaks... so please report errors and enhancements.
tested on XP media center edition, IE7
you can have the same effect by implementing IDispatch but without implementing IOleClientSite. the methods being called are IOleClientSite::QueryInterface and IDispatch::Invoke.
you could give IDispatch as param to IOleObject::SetClientSite => QueryInterface method of IDispatch is called and returns ref to self => Invoke method of IDispatch is called to ask for Download Control flags.
please report errors and enhancements.
This example shows how you can block images, videos, background sounds, script execution, java, activex, ... in a WebGadget. Look at MSDN for the whole list.
It is based heavily on the code of soerenkj & nico's IDispatch implementation and the UI-lessParser, a Delphi example showing the use of MSHTML as a HTML parser without user interface (based on WalkAll example from Windows SDK), some code generated by visual designer and some datasection lines of srod's COMate.
It involves iplementing two interfaces: IDispatch and IOleClientSite.
The new IOleClientSite interface is registered with the WebGadget by querying its IOleObject interface and calling the SetClientSite method.
Then we query the WebGadgets IOleControl interface and call the OnAmbientPropertyChange method. This triggers the WebGadget to query our IOleClientSite for IDispatch interface and call Invoke method of our IDispatch implementation. This is where we can control the browsers behavior just by setting the referenced pVarResult accordingly.
Please read MSDN or the Delphi example website for more information on internal workings and for a description of the flags you can use.
There are probably some errors like missing de-initialization => memory leaks... so please report errors and enhancements.
tested on XP media center edition, IE7
you can have the same effect by implementing IDispatch but without implementing IOleClientSite. the methods being called are IOleClientSite::QueryInterface and IDispatch::Invoke.
you could give IDispatch as param to IOleObject::SetClientSite => QueryInterface method of IDispatch is called and returns ref to self => Invoke method of IDispatch is called to ask for Download Control flags.
Code: Select all
;------------------------------------------------------------------------------
;- * IDispatch implementation
;------------------------------------------------------------------------------
;- Constants
#DISPID_AMBIENT_DLCONTROL = -5512
#DLCTL_DLIMAGES = $00000010
#DLCTL_VIDEOS = $00000020
#DLCTL_BGSOUNDS = $00000040
#DLCTL_NO_SCRIPTS = $00000080
#DLCTL_NO_JAVA = $00000100
#DLCTL_NO_RUNACTIVEXCTLS = $00000200
#DLCTL_NO_DLACTIVEXCTLS = $00000400
#DLCTL_DOWNLOADONLY = $00000800
#DLCTL_NO_FRAMEDOWNLOAD = $00001000
#DLCTL_RESYNCHRONIZE = $00002000
#DLCTL_PRAGMA_NO_CACHE = $00004000
#DLCTL_NO_BEHAVIORS = $00008000
#DLCTL_NO_METACHARSET = $00010000
#DLCTL_URL_ENCODING_DISABLE_UTF8 = $00020000
#DLCTL_URL_ENCODING_ENABLE_UTF8 = $00040000
#DLCTL_FORCEOFFLINE = $10000000
#DLCTL_NO_CLIENTPULL = $20000000
#DLCTL_SILENT = $40000000
#DLCTL_OFFLINEIFNOTCONNECTED = $80000000
#DLCTL_OFFLINE = #DLCTL_OFFLINEIFNOTCONNECTED
;------------------------------------------------------------------------------
;- Structures
Structure IDispatch_Functions
QueryInterface.l
AddRef.l
Release.l
GetTypeInfoCount.l
GetTypeInfo.l
GetIDsOfNames.l
Invoke.l
EndStructure
Structure IDispatch_Object
*IDispatch.IDispatch
RefCount.l
EndStructure
Global NewList g_IDispatch_Objects.IDispatch_Object()
;------------------------------------------------------------------------------
;- IUnknown methods
Procedure IDispatch_QueryInterface(*THIS.IDispatch_Object, *iid.IID, *Object.Long)
If *Object = 0
ProcedureReturn #E_INVALIDARG
ElseIf CompareMemory(*iid, ?IID_IUnknown, SizeOf(IID)) Or CompareMemory(*iid, ?IID_IDispatch, SizeOf(IID))
*Object\l = *THIS
*THIS\RefCount + 1
ProcedureReturn #S_OK
Else
*Object\l = 0
ProcedureReturn #E_NOINTERFACE
EndIf
EndProcedure
Procedure IDispatch_AddRef(*THIS.IDispatch_Object)
*THIS\RefCount + 1
ProcedureReturn *THIS\RefCount
EndProcedure
Procedure IDispatch_Release(*THIS.IDispatch_Object)
*THIS\RefCount - 1
If *THIS\RefCount <= 0
ChangeCurrentElement(g_IDispatch_Objects(), *THIS)
DeleteElement(g_IDispatch_Objects())
ProcedureReturn 0
Else
ProcedureReturn *THIS\RefCount
EndIf
EndProcedure
;------------------------------------------------------------------------------
;- IDispatch methods
Procedure IDispatch_GetTypeInfoCount(*THIS.IDispatch_Object, *pctinfo.Long)
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure IDispatch_GetTypeInfo(*THIS.IDispatch_Object, iTInfo, lcid, *pptInfo)
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure IDispatch_GetIDsOfNames(*THIS.IDispatch_Object, *riid.IID, *rgszNames, cNames, lcid, *rgDispID.Long)
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure IDispatch_Invoke(*THIS.IDispatch_Object, dispIdMember, *riid.IID, lcid, wFlags.w, *pDispParams.DISPPARAMS, *pVarResult.Variant, *pExcpInfo, *puArgErr)
If dispIdMember = #DISPID_AMBIENT_DLCONTROL
*pVarResult\vt = #VT_I4
*pVarResult\lVal = #DLCTL_NO_JAVA | #DLCTL_NO_DLACTIVEXCTLS | #DLCTL_NO_RUNACTIVEXCTLS | #DLCTL_SILENT
Debug "**** IDispatch::Invoke() #DISPID_AMBIENT_DLCONTROL"
Debug *pVarResult\lVal
Debug "****"
ProcedureReturn #S_OK
EndIf
ProcedureReturn #DISP_E_MEMBERNOTFOUND
EndProcedure
;------------------------------------------------------------------------------
;- Data section
DataSection
_IDispatch_Functions:
Data.l @IDispatch_QueryInterface()
Data.l @IDispatch_AddRef()
Data.l @IDispatch_Release()
Data.l @IDispatch_GetTypeInfoCount()
Data.l @IDispatch_GetTypeInfo()
Data.l @IDispatch_GetIDsOfNames()
Data.l @IDispatch_Invoke()
IID_IUnknown: ; {00000000-0000-0000-C000-000000000046}
Data.l $00000000
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
IID_IDispatch: ; {00020400-0000-0000-C000-000000000046}
Data.l $00020400
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
EndDataSection
;------------------------------------------------------------------------------
;- * IOleClientSite implementation
;------------------------------------------------------------------------------
;- Structures
Structure IOleClientSite_Functions
QueryInterface.l
AddRef.l
Release.l
SaveObject.l
GetMoniker.l
GetContainer.l
ShowObject.l
OnShowWindow.l
RequestNewObjectLayout.l
EndStructure
Structure IOleClientSite_Object
*IOleClientSite.IOleClientSite
RefCount.l
EndStructure
Global NewList g_IOleClientSite_Objects.IOleClientSite_Object()
;------------------------------------------------------------------------------
;- IUnknown methods
Procedure IOleClientSite_QueryInterface(*THIS.IOleClientSite_Object, *iid.IID, *Object.Long)
If *Object = 0
ProcedureReturn #E_INVALIDARG
ElseIf CompareMemory(*iid, ?IID_IUnknown, SizeOf(IID)) Or CompareMemory(*iid, ?IID_IOleClientSite, SizeOf(IID))
*Object\l = *THIS
*THIS\RefCount + 1
ProcedureReturn #S_OK
; return pointer to IDispatch object (IDispatch is queried by the webbrowser control on its initialization)
ElseIf CompareMemory(*iid, ?IID_IDispatch, SizeOf(IID))
*Object\l = @g_IDispatch_Objects()
ProcedureReturn #S_OK
Else
*Object\l = 0
ProcedureReturn #E_NOINTERFACE
EndIf
EndProcedure
Procedure IOleClientSite_AddRef(*THIS.IOleClientSite_Object)
*THIS\RefCount + 1
ProcedureReturn *THIS\RefCount
EndProcedure
Procedure IOleClientSite_Release(*THIS.IOleClientSite_Object)
*THIS\RefCount - 1
If *THIS\RefCount <= 0
ChangeCurrentElement(g_IOleClientSite_Objects(), *THIS)
DeleteElement(g_IOleClientSite_Objects())
ProcedureReturn 0
Else
ProcedureReturn *THIS\RefCount
EndIf
EndProcedure
;------------------------------------------------------------------------------
;- IOleClientSite methods
Procedure IOleClientSite_SaveObject(*THIS.IOleClientSite_Object)
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure IOleClientSite_GetMoniker(*THIS.IOleClientSite_Object, dwAssign.l, dwWhichMoniker.l, mk.IMoniker )
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure IOleClientSite_GetContainer(*THIS.IOleClientSite_Object, container.IOleContainer)
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure IOleClientSite_ShowObject(*THIS.IOleClientSite_Object)
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure IOleClientSite_OnShowWindow(*THIS.IOleClientSite_Object, fShow.l)
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure IOleClientSite_RequestNewObjectLayout(*THIS.IOleClientSite_Object)
ProcedureReturn #E_NOTIMPL
EndProcedure
;------------------------------------------------------------------------------
;- Data section
DataSection
_IOleClientSite_Functions:
Data.l @IOleClientSite_QueryInterface()
Data.l @IOleClientSite_AddRef()
Data.l @IOleClientSite_Release()
Data.l @IOleClientSite_SaveObject()
Data.l @IOleClientSite_GetMoniker()
Data.l @IOleClientSite_GetContainer()
Data.l @IOleClientSite_ShowObject()
Data.l @IOleClientSite_OnShowWindow()
Data.l @IOleClientSite_RequestNewObjectLayout()
; IOleClientSite
; {00000118-0000-0000-C000-000000000046}
IID_IOleClientSite:
Data.l $00000118
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
EndDataSection
;------------------------------------------------------------------------------
;- * Main program
Enumeration
#Window_Main
EndEnumeration
Enumeration
#Button_Start
#Web_0
EndEnumeration
If OpenWindow(#Window_Main, 302, 15, 600, 320, "pb-klicker", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
ButtonGadget(#Button_Start, 20, 260, 110, 40, "Start")
WebGadget(#Web_0, 20, 20, 560, 215, "about:blank")
; WebGadget initialization
Global myBrowser.IWebBrowser2 = GetWindowLong_(GadgetID(#Web_0), #GWL_USERDATA)
If myBrowser\QueryInterface(?IID_IOleObject, @oleObject.IOleObject) = #S_OK
; new IDispatch object
AddElement(g_IDispatch_Objects())
g_IDispatch_Objects()\IDispatch = ?_IDispatch_Functions
; new IOleClientSite object
AddElement(g_IOleClientSite_Objects())
g_IOleClientSite_Objects()\IOleClientSite = ?_IOleClientSite_Functions
; tell the webbrowser client about our IOleClientSite object
If oleObject\SetClientSite(@g_IOleClientSite_Objects()) = #S_OK
If myBrowser\QueryInterface(?IID_IOleControl, @oleControl.IOleControl) = #S_OK
; tell the webbrowser control that Ambient Properties have changed so it queries our IOleClientSite object for the IDispatch interface and calls IDispatch::Invoke with DISPID_AMBIENT_DLCONTROL
oleControl\OnAmbientPropertyChange(#DISPID_AMBIENT_DLCONTROL)
oleControl\Release()
EndIf
EndIf
oleObject\Release()
EndIf
EndIf
Repeat
Event = WaitWindowEvent()
WindowID = EventWindow()
GadgetID = EventGadget()
EventType = EventType()
If Event = #PB_Event_Gadget
If GadgetID = #Button_Start
SetGadgetText(#Web_0, "http://www.purebasic.com/")
ElseIf GadgetID = #Web_0
EndIf
EndIf
Until Event = #PB_Event_CloseWindow ; End of the event loop
End
DataSection
; IOleObject
; {00000112-0000-0000-C000-000000000046}
IID_IOleObject:
Data.l $00000112
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
; IOleControl
; {B196B288-BAB4-101A-B69C-00AA00341D07}
IID_IOleControl:
Data.l $B196B288
Data.w $BAB4, $101A
Data.b $B6, $9C, $00, $AA, $00, $34, $1D, $07
EndDataSection
