Stop WebGadget accessing the internet

[Derren]

The thing is: if you stop any external CSS from loading, your formattig might not look the same. Same goes for JavaScript. Not an issue on this forum because it's old as the hills, but on some webshops etc they only load 12 items for example and only load more if the user scrolls down.
All this is done with JavaScript.

Now the scripts for the Shop are probably local, because they were developed for this website specially. But the core functions are most likely online. Things like jQuery etc are not put on your own server anymore. They are hosted in a so called CDN, a content delivery network. These are servers that are spread throughout the world. The intention behind this is, that the common files are server from a server near the user for faster delivery (fewer "hops")
While this forum is probably hosted in France, and all the data must travel across the atlantic ocean to get the US for example, the scripts (if this site used any) would be delivered from a data center in the US, close to the user's location.


Anyway, long story short: If you do not load these resources, your website might look and behave totally different (regardless if you remove the relevant tags from the HTML, or if you pretent to be offline)

[Marc56us]

A solution

Code: Select all

; Show page in Webgadget without (some) links
; Marc56us - 2020/06/02
; A proposed solution for 
; https://www.purebasic.fr/english/viewtopic.php?f=13&t=75430

OpenWindow(0,0,0,900,700,"",#PB_Window_SystemMenu | #PB_Window_ScreenCentered) 
URL$ = "https://www.purebasic.fr/english/viewtopic.php?f=13&t=75430&p=556006"
; Full page
; WebGadget(0,10,10,780,580,URL$)

InitNetwork()
; Filtered page
*Buffer = ReceiveHTTPMemory(URL$)
If *Buffer
    Size_Mem = MemorySize(*Buffer)
    Source$ = PeekS(*Buffer, Size_Mem, #PB_UTF8|#PB_ByteLength)
    ;Debug Source$
EndIf

If Not CreateRegularExpression(0, ~"(?:href|src)=\"(.+?)\"")
    Debug "RegEx KO"
    End
EndIf

Source_Filtered$ = ReplaceRegularExpression(0, Source$, "")
;Debug Source_Filtered$

WebGadget(0,10,10,880,680,"")
SetGadgetItemText(0, #PB_Web_HtmlCode, Source_Filtered$)

Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow

[BarryG]

The thing is: if you stop any external CSS from loading, your formattig might not look the same.

That doesn't matter. It's just for a quick HTML preview; nothing very important. Just so the user can quickly see what the file content is, without waiting for all the content to load. They're only going to look at it for about a second or two before closing it. It's just for the user to quickly and visually preview the file; not for the user to read or interact with the file. Loading the extra data just forces an unnecessary delay.

Marc56us, that won't work, because you're downloading the file. Remember, the user already has the HTML file saved locally, and that's what I want to show. [Edit] I put the local HTML data into a string, but even after your RegEx filtering it's still missing something, so the WebGadget() still tries to load from the internet. Thanks anyway.

[Marc56us]

[Edit] I put the local HTML data into a string, but even after your RegEx filtering it's still missing something, so the WebGadget() still tries to load from the internet. Thanks anyway.

The solution I propose above only removes the links type:

Code: Select all

href="<...>"
src="<...>"

You can easily add more by modify RegEx

Code: Select all

~"(?:href|src)=\"(.+?)\""

Here is already a local version

Code: Select all

; Show page in Webgadget without (some) links
; Marc56us - 2020/06/02
; A proposed solution for
; https://www.purebasic.fr/english/viewtopic.php?f=13&t=75430
; v2 local file

OpenWindow(0,0,0,900,700,"",#PB_Window_SystemMenu | #PB_Window_ScreenCentered)

If Not OpenFile(0, GetTemporaryDirectory() + "testfile.html")
    Debug "Can't load file"
    End
Else
    While Not Eof(0)
        Source$ = ReadString(0, #PB_Ascii | #PB_File_IgnoreEOL)
    Wend
    CloseFile(0)
EndIf

If Not CreateRegularExpression(0, ~"(?:href|src)=\"(.+?)\"")
    Debug "RegEx KO"
    End
EndIf

Source_Filtered$ = ReplaceRegularExpression(0, Source$, "")

WebGadget(0,10,10,880,680,"")
SetGadgetItemText(0, #PB_Web_HtmlCode, Source_Filtered$)

Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow

[firace]

Perhaps the following set of flags will meet your requirements:

#DLCTL_PRAGMA_NO_CACHE | #DLCTL_FORCEOFFLINE | #DLCTL_NO_CLIENTPULL | #DLCTL_NO_SCRIPTS

[BarryG]

You can easily add more by modify RegEx

True, but I'll never know if all link types have been covered; plus HTML5 is constantly evolving, so it's not a future-proof fix. Surely there must be a simple way of just making the WebGadget() think it's offline? It literally solves everything and future-proofs the problem.

firace, I'm already using these flags from your code, which is the best I can do for now:

Code: Select all

*pVarResult\lVal = #DLCTL_NO_SCRIPTS | #DLCTL_NO_JAVA | #DLCTL_NO_CLIENTPULL | #DLCTL_NO_FRAMEDOWNLOAD | #DLCTL_NO_DLACTIVEXCTLS | #DLCTL_NO_RUNACTIVEXCTLS | #DLCTL_OFFLINE | #DLCTL_FORCEOFFLINE | #DLCTL_NO_BEHAVIORS | #DLCTL_NO_METACHARSET

LOL, basically all the "NO" stuff. I think #DLCTL_PRAGMA_NO_CACHE wouldn't help, as that would stop caching and try to load online?

[firace]

LOL, basically all the "NO" stuff. I think #DLCTL_PRAGMA_NO_CACHE wouldn't help, as that would stop caching and try to load online?

Not sure, but I would still recommend you try the exact set of flags I mentioned - I'm getting the best results with it (fast page display, no online resource load)

Advanced webgadget customization often looks like black magic

I don't think it's PB's fault BTW - Handling the webbrowser control is quite similar in other languages.

[BarryG]

No luck with those flags, firace.

I know it's not PureBasic's fault. It's strange that "put_Offline()" does nothing -> viewtopic.php?p=556000#p556000

Maybe I'm using it wrong, or misunderstanding how it works. Maybe it's trying to load an existing offline cache, instead of current online data. I don't know.

[firace]

No luck with those flags, firace.

I know it's not PureBasic's fault. It's strange that "put_Offline()" does nothing -> viewtopic.php?p=556000#p556000

Maybe I'm using it wrong, or misunderstanding how it works. Maybe it's trying to load an existing offline cache, instead of current online data. I don't know.

I seem to remember that put_Offline was never implemented by MS but can’t find a reference right now.

If possible, can you post an example html file which does not work well with the above flags?

[BarryG]

can you post an example html file which does not work well with the above flags?

Sent you a PM because the download link is only valid only (the HTML file and related folder is about 5 MB).

[firace]

can you post an example html file which does not work well with the above flags?

Sent you a PM because the download link is only valid only (the HTML file and related folder is about 5 MB).

OK, I just tried your page - Consistently loads in a split second here, with the below code.
If it still hangs for you, try clearing your temporary internet files cache (via IE11 or the inetcpl.cpl control panel), which might have corrupted entries.

Edit: hmm... it still seems to randomly hang (for 30 sec or so). Couldnt find the cause of the issue though

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


;------------------------------------------------------------------------------
;- 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 = #DLCTL_NO_JAVA | #DLCTL_NO_DLACTIVEXCTLS | #DLCTL_NO_RUNACTIVEXCTLS | #DLCTL_SILENT
    *pVarResult\lVal = #DLCTL_FORCEOFFLINE | #DLCTL_NO_CLIENTPULL | #DLCTL_NO_SCRIPTS
    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.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() 
  
  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.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    
  
EndDataSection  

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  
  ; 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    

  ;("00000113-0000-0000-C000-000000000046")
  IID_IOleInPlaceObject:
  Data.l $00000113
  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

Define.IOleObject oleObject
Define.IOleControl oleControl
Define.i Event, WindowID, GadgetID, EventType

If OpenWindow(#Window_Main, 302, 15, 800, 620, "pb-klicker",  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
  ButtonGadget(#Button_Start, 20, 560, 110, 40, "Start")
  
  WebGadget(#Web_0, 20, 20, 760, 515, "about:blank")
  ; WebGadget initialization
  Global myBrowser.IWebBrowser2 = GetWindowLongPtr_(GadgetID(#Web_0), #GWLP_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()
      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, "c:\data\localpage.htm")  ;;  full path to local html file
      
    ElseIf GadgetID = #Web_0
      
    EndIf
  EndIf
Until Event = #PB_Event_CloseWindow ; End of the event loop

End

[BarryG]

Edit: hmm... it still seems to randomly hang (for 30 sec or so). Couldnt find the cause of the issue though

That's it. It's only consistently immediate with no delay, when there's no internet connection. Oh well. Thanks for trying.

[Marc56us]

If you are using the Windows 10 firewall, it is possible to create a dynamic rule for an application.

Something like that:

Code: Select all

netsh advfirewall firewall add rule name=NO_OUT dir=out action=block profile=any program=PureBasic_Compilation0.exe

and delete rule when quit application.

I don't know if this work with RunProgram("netsh", "advfirewall firewall add ...", ""
Don't forget to set full file name (with path)

Type this to show help in your language.

Code: Select all

netsh advfirewall firewall add rule

[BarryG]

I already knew about "netsh" but it didn't work; I'm guessing it has to be done before the exe has started. Also, it needs admin rights to work, which isn't mandatory for my app (and I don't want my users to get a UAC prompt about it). Thanks for the suggestion, though!

I've been searching StackOverflow for solutions (that's where I learned about the "netsh" idea) but nobody seems to know a reliable, quick, non-admin way when the app is already running, either.

[RASHAD]

Hi BarryG
The next snippet did not fail never once
Check and report

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

;------------------------------------------------------------------------------
;- 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 = #DLCTL_NO_JAVA | #DLCTL_NO_DLACTIVEXCTLS | #DLCTL_NO_RUNACTIVEXCTLS | #DLCTL_SILENT
    *pVarResult\lVal = #DLCTL_OFFLINEIFNOTCONNECTED | #DLCTL_FORCEOFFLINE  | #DLCTL_NO_JAVA | #DLCTL_NO_SCRIPTS | #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

;------------------------------------------------------------------------------
;- * 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

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

;------------------------------------------------------------------------------
;- * Main program

Enumeration
  #Window_Main
EndEnumeration

Enumeration
  #Button_Start
  #Web_0
EndEnumeration

Define.IOleObject oleObject
Define.IOleControl oleControl
Define.i Event, WindowID, GadgetID, EventType

If OpenWindow(#Window_Main, 302, 15, 800, 620, "pb-klicker",  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_SizeGadget )
  ButtonGadget(#Button_Start, 10, 570, 110, 40, "Start")
 
  WebGadget(#Web_0, 10, 10, 780, 550, "about:blank")
  ; WebGadget initialization
  Global myBrowser.IWebBrowser2 = GetWindowLongPtr_(GadgetID(#Web_0), #GWLP_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()
      EndIf
    EndIf
    oleObject\Release()
  EndIf
EndIf

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Quit = 1
      
    Case #PB_Event_SizeWindow
      ResizeWebgadget(#Web_0,10,10,WindowWidth(#Window_Main)-20,WindowHeight(#Window_Main)-70)
      ResizeGadget(#Button_Start,10,WindowHeight(#Window_Main)-50,110, 40)
 
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #Button_Start
          web$ = GetHomeDirectory()+"webpage.html"
          SetGadgetText(#Web_0, web$)  ;;  full path to local html file
      EndSelect
  EndSelect
Until Quit = 1

End

;- 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   

  ;("00000113-0000-0000-C000-000000000046")
  IID_IOleInPlaceObject:
  Data.l $00000113
  Data.w $0000, $0000
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46
  
  _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()
 
  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