It is currently Fri Apr 03, 2020 5:50 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 3 posts ] 
Author Message
 Post subject: WebGadget does no longer resize, if I turn off JS execution
PostPosted: Thu Nov 15, 2018 3:52 pm 
Offline
Addict
Addict
User avatar

Joined: Mon Jun 06, 2005 2:35 pm
Posts: 1223
Location: germany
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:
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
 Profile  
Reply with quote  
 Post subject: Re: WebGadget does no longer resize, if I turn off JS execut
PostPosted: Fri Nov 16, 2018 6:29 pm 
Offline
Enthusiast
Enthusiast

Joined: Sat Apr 26, 2003 2:49 pm
Posts: 664
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:
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
 Profile  
Reply with quote  
 Post subject: Re: WebGadget does no longer resize, if I turn off JS execut
PostPosted: Mon Nov 19, 2018 8:20 am 
Offline
Addict
Addict
User avatar

Joined: Mon Jun 06, 2005 2:35 pm
Posts: 1223
Location: germany
Thanks Justin! I will have a look soon. :)

[update]
It works great, thank you!
[/update]


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 3 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 2 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye