PureBasic Forums - English

Posted: **Fri Nov 02, 2007 12:39 pm**

I've got customised HTML being streamed into the webgadget using SetGadgetItemText. Some of the code is JavaScript functions.

Thanks to Freak, I know how to execute a JS function from PB.

But is it possible to have a JS function call a PB procedure?

For example, if the user did something in the webgadget that a JS function was told to detect, could that function then pass the "duty" to the PB app?

Posted: **Fri Jan 11, 2008 9:48 pm**

The Code below sets a Custom IDocHostUIHandler Interface, which returns an IDispatch-Interface through its "external" method. This Interface can than be accessed by javascript using the "external" Keyword. The IDispatch Interface currently implements only one method, called "raiseEvent", which takes two string parameters.
The Contextmenu of the Webgadget is enabled to view the HTML-Code. To disable the Contextmenu the Procedure "IDocHostUIHandlerImpl_ShowContextMenu" should return #S_OK instead of #S_FALSE.
Thanks to Freak for Parts of the Code. Since I am no real Expert for Purebasic or COM, this should be considered as a "Works-for-me" Example only.

Code: Select all

DataSection

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

IID_IHTMLDocument2: ; 332C4425-26CB-11D0-B483-00C04FD90119
  Data.l $332C4425
  Data.w $26CB, $11D0
  Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19

IID_ICustomDoc: ; 3050F3F0-98B5-11CF-BB82-00AA00BDCE0B
  Data.l $3050F3F0
  Data.w $98B5, $11CF
  Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B

IID_IDocHostUIHandler: ; BD3F23C0-D43E-11CF-893B-00AA00BDCE1A
  Data.l $BD3F23C0
  Data.w $D43E, $11CF
  Data.b $89, $3B, $00, $AA, $00, $BD, $CE, $1A


EndDataSection


#DOCHOSTUIDBLCLK_DEFAULT         = 0
#DOCHOSTUIFLAG_OPENNEWWIN        = $20
#DOCHOSTUIFLAG_DIV_BLOCKDEFAULT = $100  

Structure DOCHOSTUIINFO
  cbSize.l
  dwFlags.l
  dwDoubleClick.l
  *pchHostCss
  *pchHostNS
EndStructure

Structure IDocHostUIHandlerImpl
  *VTable
  RefCount.l
  External.IDispatch
EndStructure

Procedure.l IDocHostUIHandlerImpl_QueryInterface ( *that.IDocHostUIHandlerImpl, riid.l, ppObj.l )
  hresult.l = #E_NOINTERFACE
  TmpUnkown.IUnknown = *that
  If ppObj <> #Null And riid <> #Null
    PokeL(ppobj, 0)
    If CompareMemory(riid, ?IID_IUnkown, 16)
      PokeL(ppobj, *that)
      TmpUnkown\AddRef()
      hresult = #S_OK
    ElseIf CompareMemory(riid, ?IID_IDocHostUIHandler, 16)
      PokeL(ppobj, *that)
      TmpUnkown\AddRef()
      hresult = #S_OK
    EndIf 
  EndIf
  ProcedureReturn hresult
EndProcedure

Procedure.l IDocHostUIHandlerImpl_AddRef ( *that.IDocHostUIHandlerImpl )
  *that\RefCount = *that\RefCount + 1
  ProcedureReturn *that\RefCount
EndProcedure

Procedure.l IDocHostUIHandlerImpl_Release ( *that.IDocHostUIHandlerImpl )
  *that\RefCount = *that\RefCount - 1
  RefCount.l = *that\RefCount
  If RefCount = 0
    If *that\External <> #Null
      *that\External\Release()
    EndIf  
    FreeMemory(*that) 
  EndIf
  ProcedureReturn RefCount
EndProcedure

Procedure.l IDocHostUIHandlerImpl_ShowContextMenu ( *that.IDocHostUIHandlerImpl, dwID, ppt, pcmdTarget, pdispReserved )
  ProcedureReturn #S_FALSE
EndProcedure

Procedure.l IDocHostUIHandlerImpl_GetHostInfo ( *that.IDocHostUIHandlerImpl, *pInfo.DOCHOSTUIINFO )
  *pInfo\cbSize        = 20
  *pInfo\dwDoubleClick = #DOCHOSTUIDBLCLK_DEFAULT
  *pInfo\dwFlags       = #DOCHOSTUIFLAG_DIV_BLOCKDEFAULT + #DOCHOSTUIFLAG_OPENNEWWIN
  *pInfo\pchHostCss    = #Null
  *pInfo\pchHostNS     = #Null
  ProcedureReturn #S_OK
EndProcedure

Procedure.l IDocHostUIHandlerImpl_ShowUI ( *that.IDocHostUIHandlerImpl, dwID, pActiveObject, pCommandTarget, pFrame, pDoc )
  ProcedureReturn #S_FALSE
EndProcedure

Procedure.l IDocHostUIHandlerImpl_HideUI ( *that.IDocHostUIHandlerImpl )
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure.l IDocHostUIHandlerImpl_UpdateUI ( *that.IDocHostUIHandlerImpl )
  ProcedureReturn #S_OK
EndProcedure

Procedure.l IDocHostUIHandlerImpl_EnableModeless ( *that.IDocHostUIHandlerImpl, fEnable)
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure.l IDocHostUIHandlerImpl_OnDocWindowActivate ( *that.IDocHostUIHandlerImpl, fActivate )
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure.l IDocHostUIHandlerImpl_OnFrameWindowActivate ( *that.IDocHostUIHandlerImpl, fActivate )
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure.l IDocHostUIHandlerImpl_ResizeBorder ( *that.IDocHostUIHandlerImpl, prcBorder, pUIWindow, fFrameWindow )
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure.l IDocHostUIHandlerImpl_TranslateAccelerator ( *that.IDocHostUIHandlerImpl, lpMsg, pguidCmdGroup, nCmdID )
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure.l IDocHostUIHandlerImpl_GetOptionKeyPath ( *that.IDocHostUIHandlerImpl, pchKey, dw )
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure.l IDocHostUIHandlerImpl_GetDropTarget ( *that.IDocHostUIHandlerImpl, pDropTarget, ppDropTarget )
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure.l IDocHostUIHandlerImpl_GetExternal ( *that.IDocHostUIHandlerImpl, ppDispatch.l )
  If ppDispatch <> #Null
    PokeL(ppDispatch, *that\External)
    If *that\External <> #Null
      *that\External\AddRef()
      ProcedureReturn #S_OK
    EndIf
  EndIf
  ProcedureReturn #S_FALSE
EndProcedure

Procedure.l IDocHostUIHandlerImpl_TranslateUrl ( *that.IDocHostUIHandlerImpl, dwTranslate, pchURLIn, ppchURLOut )
  ProcedureReturn #S_FALSE
EndProcedure

Procedure.l IDocHostUIHandlerImpl_FilterDataObject ( *that.IDocHostUIHandlerImpl, pDO, ppDORet )
  ProcedureReturn #S_FALSE
EndProcedure


DataSection

IDocHostUIHandlerImplFunctionTable:
  Data.l @IDocHostUIHandlerImpl_QueryInterface()
  Data.l @IDocHostUIHandlerImpl_AddRef()
  Data.l @IDocHostUIHandlerImpl_Release()
  Data.l @IDocHostUIHandlerImpl_ShowContextMenu()
  Data.l @IDocHostUIHandlerImpl_GetHostInfo()
  Data.l @IDocHostUIHandlerImpl_ShowUI()
  Data.l @IDocHostUIHandlerImpl_HideUI()
  Data.l @IDocHostUIHandlerImpl_UpdateUI()
  Data.l @IDocHostUIHandlerImpl_EnableModeless()
  Data.l @IDocHostUIHandlerImpl_OnDocWindowActivate()
  Data.l @IDocHostUIHandlerImpl_OnFrameWindowActivate()
  Data.l @IDocHostUIHandlerImpl_ResizeBorder()
  Data.l @IDocHostUIHandlerImpl_TranslateAccelerator()
  Data.l @IDocHostUIHandlerImpl_GetOptionKeyPath()
  Data.l @IDocHostUIHandlerImpl_GetDropTarget()
  Data.l @IDocHostUIHandlerImpl_GetExternal()
  Data.l @IDocHostUIHandlerImpl_TranslateUrl()
  Data.l @IDocHostUIHandlerImpl_FilterDataObject()

EndDataSection


Procedure CreateDocHostUIHandler ( External.IDispatch )
  Protected *that.IDocHostUIHandlerImpl = AllocateMemory(SizeOf(IDocHostUIHandlerImpl))
  If #Null <> *that
    *that\VTable = ?IDocHostUIHandlerImplFunctionTable
    *that\RefCount = 1
    If External <> #Null
      External\AddRef()
    EndIf
    *that\External = External
  EndIf
  ProcedureReturn *that
EndProcedure






#DISPID_RAISEEVENT  = 100
#DISPID_UNKNOWN     = -1

Structure ExternalIDispatchImpl
  *VTable
  RefCount.l
  *CallbackFunction
EndStructure

Procedure.l ExternalIDispatchImpl_QueryInterface ( *that.ExternalIDispatchImpl, riid.l, ppObj.l )
  hresult.l = #E_NOINTERFACE
  TmpUnkown.IUnknown = *that
  If ppObj <> #Null And riid <> #Null
    PokeL(ppobj, 0)
    If CompareMemory(riid, ?IID_IUnkown, 16)
      PokeL(ppobj, *that)
      TmpUnkown\AddRef()
      hresult = #S_OK
    ElseIf CompareMemory(riid, ?IID_IDispatch, 16)
      PokeL(ppobj, *that)
      TmpUnkown\AddRef()
      hresult = #S_OK
    EndIf 
  EndIf
  ProcedureReturn hresult
EndProcedure

Procedure.l ExternalIDispatchImpl_AddRef ( *that.ExternalIDispatchImpl )
  *that\RefCount = *that\RefCount + 1
  ProcedureReturn *that\RefCount
EndProcedure

Procedure.l ExternalIDispatchImpl_Release ( *that.ExternalIDispatchImpl )
  *that\RefCount = *that\RefCount - 1
  RefCount.l = *that\RefCount
  If RefCount = 0
    FreeMemory(*that) 
  EndIf
  ProcedureReturn RefCount
EndProcedure

Procedure.l ExternalIDispatchImpl_GetTypeInfoCount ( *that.ExternalIDispatchImpl, *pcntInfo.Long )
  *pcntInfo\l = 0
  ProcedureReturn #S_OK
EndProcedure

Procedure.l ExternalIDispatchImpl_GetTypeInfo ( *that.ExternalIDispatchImpl, itinfo, lcid, pptinfo ) 
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure.l ExternalIDispatchImpl_GetIDsOfNames ( *that.ExternalIDispatchImpl, riid, ppNames.l, cntNames.l, lcid, rgdispid.l )
  hresult.l = #S_OK
  For Index = 0 To cntNames - 1
    name.s = UCase(PeekS(PeekL(ppNames + (Index * 4)), -1, #PB_Unicode))
    If name = "RAISEEVENT"
      PokeL(rgdispid + (Index * 4), #DISPID_RAISEEVENT)
    Else
      PokeL(rgdispid + (Index * 4), #DISPID_UNKNOWN)
      hresult = #DISP_E_UNKNOWNNAME
    EndIf
  Next Index
  ProcedureReturn hresult
EndProcedure

Procedure.l ExternalIDispatchImpl_Invoke ( *that.ExternalIDispatchImpl, Dispid.l, riid, lcid, flags.w, *dispparams.DISPPARAMS, *result.VARIANT, *pexecpinfo, *puArgErr.Long)
  If Dispid <> #DISPID_RAISEEVENT
    ProcedureReturn #DISP_E_MEMBERNOTFOUND 
  EndIf  
  If 0 = #DISPATCH_METHOD & flags
    ProcedureReturn #DISP_E_MEMBERNOTFOUND 
  EndIf  
  If *dispparams\cNamedArgs > 0
    ProcedureReturn #DISP_E_NONAMEDARGS
  EndIf 
  If *dispparams\cArgs <> 2
    ProcedureReturn #DISP_E_BADPARAMCOUNT
  EndIf 
 
  hresult.l = #S_OK
  Dim argument.s(1)
  Define.VARIANT TmpArg
  For Index.l = 0 To 1
    VariantInit_(@TmpArg)
    If VariantChangeType_(@TmpArg, *dispparams\rgvarg + ((1 - Index) * SizeOf(VARIANT)), 0, #VT_BSTR) <> #S_OK 
      hresult = #DISP_E_TYPEMISMATCH
      Break
    EndIf
    argument(Index) = PeekS(TmpArg\bstrVal, -1, #PB_Unicode)
    VariantClear_(@TmpArg)
  Next Index
  If hresult <> #S_OK
    ProcedureReturn hresult
  EndIf
      
  If *that\CallbackFunction <> #Null
    CallFunctionFast(*that\CallbackFunction, argument(0), argument(1))
  EndIf
  
  If *result <> #Null
    VariantInit_(*result)
    *result\vt = #VT_EMPTY
  EndIf

  ProcedureReturn #S_OK
EndProcedure

DataSection

ExternalIDispatchImplFunctionTable:
  Data.l @ExternalIDispatchImpl_QueryInterface()
  Data.l @ExternalIDispatchImpl_AddRef()
  Data.l @ExternalIDispatchImpl_Release()
  Data.l @ExternalIDispatchImpl_GetTypeInfoCount()
  Data.l @ExternalIDispatchImpl_GetTypeInfo()
  Data.l @ExternalIDispatchImpl_GetIDsOfNames()
  Data.l @ExternalIDispatchImpl_Invoke()

EndDataSection

Procedure CreateExternalDispatch ( *CallbackFunction ) 
  Protected *that.ExternalIDispatchImpl = AllocateMemory(SizeOf(ExternalIDispatchImpl))
  If *that <> #Null
    *that\VTable = ?ExternalIDispatchImplFunctionTable
    *that\RefCount = 1
    *that\CallbackFunction = *CallbackFunction
  EndIf
  ProcedureReturn *that
EndProcedure



   

Procedure GetIWebBrowser2 ( Gadget )
  Browser.IWebBrowser2 =  GetWindowLong_(GadgetID(Gadget), #GWL_USERDATA)
  If Browser <> #Null
    Browser\AddRef()
  EndIf
  ProcedureReturn Browser  
EndProcedure

Procedure GetIHTMLDocument2( Gadget )
  Result.IHTMLDocument2 = #Null 
  Browser.IWebBrowser2 = GetIWebBrowser2(Gadget)
  If Browser <> #Null
    If Browser\get_Document(@DocumentDispatch.IDispatch) = #S_OK
      If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @TmpDocument.IHTMLDocument2) = #S_OK
        Result = TmpDocument
      EndIf
      DocumentDispatch\Release()
    EndIf
    Browser\Release()  
  EndIf
  ProcedureReturn Result
EndProcedure

Procedure SetIDocHostUIHandler ( Gadget, UIHandler.IDocHostUIHandler )
  Result.l = #False
  Document.IHTMLDocument2 = GetIHTMLDocument2(Gadget)
  If Document <> #Null 
    If Document\QueryInterface(?IID_ICustomDoc, @CustomDoc.ICustomDoc) = #S_OK
      CustomDoc\SetUIHandler(UIHandler)
      CustomDoc\Release()
      Result = #True
    EndIf
    Document\Release()
  EndIf
  ProcedureReturn Result
EndProcedure 






Procedure ScriptRaiseEventCallback ( EventType.s, EventParam.s )
  Text.s = "Type: " + Chr(34) + EventType + Chr(34) + Chr(10)
  Text = Text + "Parameter: " + Chr(34) + EventParam + Chr(34) + Chr(10) 
  MessageRequester("Javascript Call", Text, #PB_MessageRequester_Ok)
EndProcedure 



If OpenWindow(0, 0, 0, 600, 300, "WebGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered) And CreateGadgetList(WindowID(0))
  WebGadget(0, 10, 10, 580, 280, "")
  
  
  html.s = "<html><head><title></title>"
  html = html + "<script language=" + Chr(34) + "javascript" + Chr(34) + ">" 
  html = html + "function buttonclick() { external.raiseEvent(" + Chr(34) + "buttonclick" + Chr(34) 
  html = html + ", " + Chr(34) + "Button Arguments" + Chr(34) + "); }"
  html = html + "function linkclick() { external.raiseEvent(" + Chr(34) + "linkclick" + Chr(34) 
  html = html + ", " + Chr(34) + "Link Arguments" + Chr(34) + "); }"
  html = html + "</script>" 
  html = html + "<body><input id=" + Chr(34) + "Button1" + Chr(34) 
  html = html + " type=" + Chr(34) + "button" + Chr(34)
  html = html + " value=" + Chr(34) + "Click me!" + Chr(34)
  html = html + " name=" + Chr(34) + "Button1" + Chr(34)
  html = html + " onclick='buttonclick()'></p>"
  html = html + "<a href=" + Chr(34) + "javascript:linkclick()" + Chr(34) + ">Me too!</a></p>"
  html = html + "</body></html>"

  SetGadgetItemText(0, #PB_Web_HtmlCode, html)
  
  External.IDispatch  = CreateExternalDispatch(@ScriptRaiseEventCallback())
  UIHandler.IDocHostUIHandler = CreateDocHostUIHandler(External)
  SetIDocHostUIHandler(0, UIHandler)
  External\Release()
  UIHandler\Release()
  
  Repeat 
    Event = WaitWindowEvent();
    Select Event
    Case #PB_Event_CloseWindow
      Break
    EndSelect
  ForEver

   
EndIf

Posted: **Fri Jan 11, 2008 10:11 pm**

Excellent.

Thanks for this.

Posted: **Sat Jan 12, 2008 1:17 am**

This is great, thank you!

Posted: **Sat Jan 12, 2008 2:44 pm**

Thanks very much for this, Waldschrath. It's way beyond my understanding but it seems to work perfectly. I spent ages trying to find a way to do this, so you've made a struggling amateur very happy!

Posted: **Thu Apr 24, 2008 9:14 pm**

Thisis very good.

The only small problem is that when calling SetIDocHostUIHandler teh webgadget get some "raised" style (look not flat like usually doeas).

Any idea howe to avoid it?

Posted: **Thu Apr 24, 2008 9:26 pm**

Using this code it show from this

to this one

how can i take it back to the firts style when runnign this code?

Any help are welcome

Posted: **Thu Apr 24, 2008 10:12 pm**

I don't see a flag that changes the style of the webgadget... Are you using Vista? or XP with the BricoPak? Either one might have changed the way this is displayed.

Is the box next to Use XP Skins checked (The Compiler Options)?

Lastly my thought is that the webgadget uses IE installed on your computer and you did an update to IE and Microsoft changed something...

My $0.02 !

Posted: **Thu Apr 24, 2008 10:32 pm**

Rook Zimbabwe wrote:I don't see a flag that changes the style of the webgadget... Are you using Vista? or XP with the BricoPak? Either one might have changed the way this is displayed.

Is the box next to Use XP Skins checked (The Compiler Options)?

Lastly my thought is that the webgadget uses IE installed on your computer and you did an update to IE and Microsoft changed something...

My $0.02 !

No. The change (as its showed in the image) its when code is inserted. If i put as comment that line the webgadget shows flat like always.

I guess i know why (because im setting some custom doc) in CustomDoc.ICustomDoc

But what i want to know is any idea on how reverting or changing style or something that let me have it flat again using that code.

Tthanks

Posted: **Thu Apr 24, 2008 11:30 pm**

if after

Code: Select all

SetGadgetItemText(0, #PB_Web_HtmlCode, html)

You create a second webgadget with 0,0,0,0 top, left, width and height, the raised border is gone.

If create the webgadget before that SetGadgetItemText, it dont changes... strange...

Posted: **Fri Apr 25, 2008 5:16 pm**

Define the following constant:

Code: Select all

#DOCHOSTUIFLAG_NO3DBORDER = $4

and change the line below, which is in the Procedure IDocHostUIHandlerImpl_GetHostInfo, from

Code: Select all

  *pInfo\dwFlags = #DOCHOSTUIFLAG_DIV_BLOCKDEFAULT + #DOCHOSTUIFLAG_OPENNEWWIN

to

Code: Select all

  *pInfo\dwFlags = #DOCHOSTUIFLAG_DIV_BLOCKDEFAULT + #DOCHOSTUIFLAG_OPENNEWWIN + #DOCHOSTUIFLAG_NO3DBORDER

For more info on possible Flags search MSDN for DOCHOSTUIFLAG.

Posted: **Sat Apr 26, 2008 4:29 pm**

Thank you!!!

Posted: **Mon Apr 30, 2018 6:52 pm**

I'm trying this now, ten years later, and things seem to have changed because it isn't working. I'm on a 64-bit system now, of course, and have changed all the longs to integers. I've also changed strings to @strings, where the PB IDE was complaining. Everything seems fine... until I click on either of the buttons inside the webgadget, and then IE raises an error, saying that "external" (the object created by the PB code) is undefined. Does anyone have any ideas?

Posted: **Tue May 01, 2018 7:54 am**

Works here too

Not see this code before

It's not a reason for not thanks the author for sharing

Posted: **Tue May 01, 2018 10:59 am**

Perhaps if we could specifically target GTK we could use WebKit and JavaScriptCore to create a bridge to PB functions similar to this example in C.

I think some of PB's gadgets are too limited (particularly not having a grid that enables us to select / draw into a single cell) and either the option of GTK itself or a WebView (possibly based on GTK) would give some alternative options for creating a UI.

PureBasic Forums - English

Calling a PB procedure from JavaScript?

Calling a PB procedure from JavaScript?

Re: Calling a PB procedure from JavaScript?

Re: Calling a PB procedure from JavaScript?

Re: Calling a PB procedure from JavaScript?