WebGadget does no longer resize, if I turn off JS execution

Windows specific forum
Post Reply
User avatar
Kukulkan
Addict
Addict
Posts: 1352
Joined: Mon Jun 06, 2005 2:35 pm
Location: germany
Contact:
Contact Kukulkan

WebGadget does no longer resize, if I turn off JS execution

Post by Kukulkan »

Hi,

the following code is a result of collecting snippets from this Forum and Internet. The aim is to disable JavaScript execution in WebGadget control (and printing). Most of the code for this was from this thread by hm and Justin.

Sadly, if the code is used to set the properties, the resizing does no longer work (ResizeGadget() function). If I do not use the code, resizing is fine. Any idea about, how to restore resize function?

I personally assume, that exchanging the IDispatch interfaces somehow disconnects from Freds/Purebasic interface and by this, resizing is no longer working. But I have no idea about how to prevent this because I'm really not that deep in COM and IDispatch :(

Code: Select all

EnableExplicit

; ------------------------------------------------------------------------------
;{ * 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.i
  AddRef.i
  Release.i
  GetTypeInfoCount.i
  GetTypeInfo.i
  GetIDsOfNames.i
  Invoke.i
EndStructure

Structure IDispatch_Object
  *IDispatch.IDispatch
  RefCount.l
EndStructure

Global NewList g_IDispatch_Objects.IDispatch_Object()
Global dispatchValue.i
; ------------------------------------------------------------------------------
; - IUnknown methods

Procedure IDispatch_QueryInterface(*THIS.IDispatch_Object, *iid.IID, *Object.INTEGER)
  If *Object = 0
    ProcedureReturn #E_INVALIDARG
  ElseIf CompareMemory(*iid, ?IID_IUnknown, SizeOf(IID)) Or CompareMemory(*iid, ?IID_IDispatch, SizeOf(IID))
    *Object\i = *THIS
    *THIS\RefCount + 1
    ProcedureReturn #S_OK 
  Else
    *Object\i = 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.INTEGER)
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure IDispatch_GetTypeInfo(*THIS.IDispatch_Object, iTInfo.l, lcid.l, *pptInfo.INTEGER)
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure IDispatch_GetIDsOfNames(*THIS.IDispatch_Object, *riid.IID, rgszNames.i, cNames.l, lcid.l, *rgDispID.INTEGER)
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure IDispatch_Invoke(*THIS.IDispatch_Object, dispIdMember.l, *riid.IID, lcid.l, wFlags.w, *pDispParams.DISPPARAMS, *pVarResult.Variant, pExcpInfo.i, puArgErr.i)
  If dispIdMember = #DISPID_AMBIENT_DLCONTROL
    *pVarResult\vt = #VT_I4
    *pVarResult\lVal = dispatchValue.i
    ProcedureReturn #S_OK
  EndIf
  ProcedureReturn #DISP_E_MEMBERNOTFOUND
EndProcedure

; ------------------------------------------------------------------------------
; - Data section

DataSection
  _IDispatch_Functions:
  Data.i @IDispatch_QueryInterface()
  Data.i @IDispatch_AddRef()
  Data.i @IDispatch_Release()
  Data.i @IDispatch_GetTypeInfoCount()
  Data.i @IDispatch_GetTypeInfo()
  Data.i @IDispatch_GetIDsOfNames()
  Data.i @IDispatch_Invoke()
  
  CompilerIf Defined(IID_IUnknown, #PB_Label) = 0
    IID_IUnknown: ; {00000000-0000-0000-C000-000000000046}
    Data.l $00000000
    Data.w $0000, $0000
    Data.b $C0, $00, $00, $00, $00, $00, $00, $46
  CompilerEndIf
  
  CompilerIf Defined(IID_IDispatch, #PB_Label) = 0
    IID_IDispatch: ; {00020400-0000-0000-C000-000000000046}
    Data.l $00020400
    Data.w $0000, $0000
    Data.b $C0, $00, $00, $00, $00, $00, $00, $46
  CompilerEndIf
 
EndDataSection 

; ------------------------------------------------------------------------------
; - * IOleClientSite implementation

; ------------------------------------------------------------------------------
; - Structures
Structure IOleClientSite_Functions
  QueryInterface.i
  AddRef.i
  Release.i
  SaveObject.i
  GetMoniker.i
  GetContainer.i
  ShowObject.i
  OnShowWindow.i
  RequestNewObjectLayout.i
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.INTEGER)
  If *Object = 0
    ProcedureReturn #E_INVALIDARG
  ElseIf CompareMemory(*iid, ?IID_IUnknown, SizeOf(IID)) Or CompareMemory(*iid, ?IID_IOleClientSite, SizeOf(IID))
    *Object\i = *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\i = @g_IDispatch_Objects()
    ProcedureReturn #S_OK
  Else
    *Object\i = 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.i )
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure IOleClientSite_GetContainer(*THIS.IOleClientSite_Object, container.i)
  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.i @IOleClientSite_QueryInterface()
  Data.i @IOleClientSite_AddRef()
  Data.i @IOleClientSite_Release()
  Data.i @IOleClientSite_SaveObject()
  Data.i @IOleClientSite_GetMoniker()
  Data.i @IOleClientSite_GetContainer()
  Data.i @IOleClientSite_ShowObject()
  Data.i @IOleClientSite_OnShowWindow()
  Data.i @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   
 
  ; 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

;}-----------------------------------------------------------------------------

; --------------------------------------
;{ Constants for the ExecWB Method
; -------------------------------------
#OLECMDID_OPEN              = 1 
#OLECMDID_NEW               = 2 
#OLECMDID_SAVE              = 3 
#OLECMDID_SAVEAS            = 4 
#OLECMDID_SAVECOPYAS        = 5 
#OLECMDID_PRINT             = 6 
#OLECMDID_PRINTPREVIEW      = 7 
#OLECMDID_PAGESETUP         = 8 
#OLECMDID_SPELL             = 9 
#OLECMDID_PROPERTIES        = 10 
#OLECMDID_CUT               = 11 
#OLECMDID_COPY              = 12 
#OLECMDID_PASTE             = 13 
#OLECMDID_PASTESPECIAL      = 14 
#OLECMDID_UNDO              = 15 
#OLECMDID_REDO              = 16 
#OLECMDID_SELECTALL         = 17 
#OLECMDID_CLEARSELECTION    = 18 
#OLECMDID_ZOOM              = 19 
#OLECMDID_GETZOOMRANGE      = 20 
#OLECMDID_UPDATECOMMANDS    = 21 
#OLECMDID_REFRESH           = 22 
#OLECMDID_STOP              = 23 
#OLECMDID_HIDETOOLBARS      = 24 
#OLECMDID_SETPROGRESSMAX    = 25 
#OLECMDID_SETPROGRESSPOS    = 26 
#OLECMDID_SETPROGRESSTEXT   = 27 
#OLECMDID_SETTITLE          = 28 
#OLECMDID_SETDOWNLOADSTATE  = 29 
#OLECMDID_STOPDOWNLOAD      = 30 

#OLECMDID_ONTOOLBARACTIVATED     = 31 
#OLECMDID_FIND                   = 32 
#OLECMDID_DELETE                 = 33 
#OLECMDID_HTTPEQUIV              = 34 
#OLECMDID_HTTPEQUIV_DONE         = 35 
#OLECMDID_ENABLE_INTERACTION     = 36 
#OLECMDID_ONUNLOAD               = 37 
#OLECMDID_PROPERTYBAG2           = 38 
#OLECMDID_PREREFRESH             = 39 
#OLECMDID_SHOWSCRIPTERROR        = 40 
#OLECMDID_SHOWMESSAGE            = 41 
#OLECMDID_SHOWFIND               = 42 
#OLECMDID_SHOWPAGESETUP          = 43 
#OLECMDID_SHOWPRINT              = 44 
#OLECMDID_CLOSE                  = 45 
#OLECMDID_ALLOWUILESSSAVEAS      = 46 
#OLECMDID_DONTDOWNLOADCSS        = 47 
#OLECMDID_UPDATEPAGESTATUS       = 48 
#OLECMDID_PRINT2                 = 49 
#OLECMDID_PRINTPREVIEW2          = 50 
#OLECMDID_SETPRINTTEMPLATE       = 51 
#OLECMDID_GETPRINTTEMPLATE       = 52 
#OLECMDID_PAGEACTIONBLOCKED      = 55 
#OLECMDID_PAGEACTIONUIQUERY      = 56 
#OLECMDID_FOCUSVIEWCONTROLS      = 57 
#OLECMDID_FOCUSVIEWCONTROLSQUERY = 58 

#OLECMDEXECOPT_DODEFAULT        = 0 
#OLECMDEXECOPT_PROMPTUSER       = 1 
#OLECMDEXECOPT_DONTPROMPTUSER   = 2 
#OLECMDEXECOPT_SHOWHELP         = 3
;}

Procedure PutDispatchValueToWebgadget(WebgadgetID.i)
  Protected oleObject.IOleObject
  Protected oleControl.IOleControl
  Protected myBrowser.IWebBrowser2 = GetWindowLong_(GadgetID(WebgadgetID.i), #GWL_USERDATA)
  If myBrowser\QueryInterface(?IID_IOleObject, @oleObject) = #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) = #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()
      Else
        Debug "Failed for myBrowser\QueryInterface"
      EndIf
    Else
      Debug "Failed for oleObject\SetClientSite"
    EndIf
    oleObject\Release()
  EndIf
EndProcedure

Procedure WebGadget_EnableJS(WebgadgetID.i)
  dispatchValue.i = #DLCTL_DLIMAGES | #DLCTL_VIDEOS | #DLCTL_BGSOUNDS ; do not disable anything here
  ; https://docs.microsoft.com/en-us/previous-versions/windows/internet-explorer/ie-developer/platform-apis/aa770041(v=vs.85)
  PutDispatchValueToWebgadget(WebgadgetID.i)
EndProcedure

Procedure WebGadget_DisableJS(WebgadgetID.i)
  dispatchValue.i = #DLCTL_NO_JAVA | #DLCTL_NO_SCRIPTS | 
                    #DLCTL_NO_DLACTIVEXCTLS | #DLCTL_NO_RUNACTIVEXCTLS | 
                    #DLCTL_NO_FRAMEDOWNLOAD | #DLCTL_SILENT | #DLCTL_DLIMAGES
  ; https://docs.microsoft.com/en-us/previous-versions/windows/internet-explorer/ie-developer/platform-apis/aa770041(v=vs.85)
  PutDispatchValueToWebgadget(WebgadgetID.i)
EndProcedure

Procedure SetFeature_Browser_Emulation()
  Protected lpValueName.s,lpData.l,phkResult,lpsdata.s,lpdwDisposition.i
  lpValueName.s = GetFilePart(ProgramFilename())
  lpData = 11001 ; Webpages containing standards-based !DOCTYPE directives are displayed in IE11 Standards mode.
  If RegCreateKeyEx_(#HKEY_CURRENT_USER, 
                     "SOFTWARE\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION", 
                     0, #Null, #REG_OPTION_VOLATILE, #KEY_ALL_ACCESS, #Null, 
                     @phkResult, @lpdwDisposition) = #ERROR_SUCCESS
    RegSetValueEx_(phkResult, lpValueName, 0, #REG_DWORD, @lpData, SizeOf(LONG))
    RegCloseKey_(phkResult)
  EndIf
   
EndProcedure 

Procedure WebGadget_SetNavigationCallback(WebgadgetID.i, *CallBackFunction)
  ; Somehow works by default on Windows
  SetGadgetAttribute(WebgadgetID.i, #PB_Web_NavigationCallback, 
                     *CallBackFunction)
EndProcedure

Procedure WebGadget_Print(WebgadgetID.i)
  Protected WebObject.IWebBrowser2 = GetWindowLong_(GadgetID(WebgadgetID.i), #GWL_USERDATA) 
  Protected IsReady.i
  Protected timeout.i = ElapsedMilliseconds() + 8000 ; 8 sec timeout
  Repeat 
    WebObject\get_ReadyState(@IsReady.i)
    Delay(1) 
    While WindowEvent(): Wend 
  Until IsReady.i = 4 Or ElapsedMilliseconds() > timeout.i ; 4 = READYSTATE_COMPLETE
  
  ;This prompts the user with the print properties window first 
  WebObject\ExecWB(#OLECMDID_PRINT, #OLECMDEXECOPT_PROMPTUSER, 0, 0) 
EndProcedure

SetFeature_Browser_Emulation(); activate browser emulation mode to IE11 (always!)
 

CompilerIf #PB_Compiler_IsMainFile
  ; TEST CODE
  If OpenWindow(0, 0, 0, 600, 300, "WebGadget test window", 
                #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget)
    WebGadget(0, 0, 0, 600, 300, "about:blank")
    
    ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    WebGadget_DisableJS(0) ; if not called, resizing works!
    ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    SetGadgetText(0, "https://www.purebasic.com/")
    
    Repeat 
      Define wEvt.i = WaitWindowEvent()
      If wEvt.i = #PB_Event_SizeWindow
        ResizeGadget(0, #PB_Ignore, #PB_Ignore, 
                     WindowWidth(0, #PB_Window_InnerCoordinate), 
                     WindowHeight(0, #PB_Window_InnerCoordinate))
      EndIf
    Until wEvt.i = #PB_Event_CloseWindow 
  EndIf
  
CompilerEndIf
Any idea how to keep resizing functional?
Top
Justin
Addict
Addict
Posts: 830
Joined: Sat Apr 26, 2003 2:49 pm

Re: WebGadget does no longer resize, if I turn off JS execut

Post by Justin »

You can use this function. Use SmartWindowRefresh() to avoid flickering in W7 or play with the redraw flag. I used MoveWindow() api for not messing with ResizeGadget() internals, but using it also works.

Code: Select all

Procedure ResizeWebgadget(gd.i, x.l, y.l, width.l, height.l, redraw.b = #True)
	Define.i hwGd
	Define.IWebBrowser2 wb
	Define.IOleObject oObj
	Define.IOleInPlaceObject ipObj
	Define.RECT rc
	
	hwGd = GadgetID(gd)
	wb = GetWindowLongPtr_(hwGd, #GWLP_USERDATA)
	If wb
	  If wb\QueryInterface(?IID_IOleObject, @oObj) = #S_OK
	  	If oObj\QueryInterface(?IID_IOleInPlaceObject, @ipObj) = #S_OK
	  		;Use MoveWindow() or ResizeGadget()
				MoveWindow_(hwGd, x, y, width, height, redraw)
				;ResizeGadget(gd, x, y, width, height) maybe this calls SetObjectRects() again ?
				GetClientRect_(hwGd, @rc)
				ipObj\SetObjectRects(@rc, @rc)
				ipObj\Release()
			EndIf 
			oObj\Release()
	  EndIf 
	EndIf 
EndProcedure

DataSection
  ;("00000113-0000-0000-C000-000000000046")
  IID_IOleInPlaceObject:
  Data.l $00000113
  Data.w $0000, $0000
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46 

  ; {00000112-0000-0000-C000-000000000046}
  IID_IOleObject: 
  Data.l $00000112 
  Data.w $0000, $0000 
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46  
EndDataSection
Top
User avatar
Kukulkan
Addict
Addict
Posts: 1352
Joined: Mon Jun 06, 2005 2:35 pm
Location: germany
Contact:
Contact Kukulkan

Re: WebGadget does no longer resize, if I turn off JS execut

Post by Kukulkan »

Thanks Justin! I will have a look soon. :)

[update]
It works great, thank you!
[/update]
Top
Post Reply

Return to “Windows”